summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/XMonad/Aeson.hs118
1 files changed, 118 insertions, 0 deletions
diff --git a/src/XMonad/Aeson.hs b/src/XMonad/Aeson.hs
new file mode 100644
index 0000000..020f4e3
--- /dev/null
+++ b/src/XMonad/Aeson.hs
@@ -0,0 +1,118 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module XMonad.Aeson () where
+
+import Data.Aeson
+import Graphics.X11.Xlib.Aeson ()
+import XMonad (ScreenDetail(SD), ScreenId(S), Window)
+import XMonad.Core (Layout,description)
+import XMonad.Operations (StateFile(StateFile))
+import XMonad.StackSet (RationalRect(RationalRect), StackSet(StackSet))
+import XMonad.StackSet (Screen(Screen), Workspace(Workspace), Stack(Stack))
+
+
+instance ToJSON a => ToJSON (Stack a) where
+ toJSON (Stack _focus _up _down) =
+ object
+ [ "focus" .= toJSON _focus
+ , "up" .= toJSON _up
+ , "down" .= toJSON _down
+ ]
+
+instance FromJSON a => FromJSON (Stack a) where
+ parseJSON = withObject "Stack" $ \v -> Stack
+ <$> v .: "focus"
+ <*> v .: "up"
+ <*> v .: "down"
+
+instance (ToJSON i, ToJSON l, ToJSON a)
+ => ToJSON (Workspace i l a) where
+ toJSON (Workspace _tag _layout _stack) =
+ object
+ [ "tag" .= _tag
+ , "layout" .= toJSON _layout
+ , "stack" .= _stack
+ ]
+
+instance ToJSON (Layout Window) where
+ toJSON _layout =
+ object
+ [ "show" .= show _layout
+ , "description" .= description _layout
+ ]
+
+instance (FromJSON i, FromJSON l, FromJSON a)
+ => FromJSON (Workspace i l a) where
+ parseJSON = withObject "Workspace" $ \v -> Workspace
+ <$> v .: "tag"
+ <*> v .: "layout"
+ <*> v .: "stack"
+
+instance (ToJSON i, ToJSON l, ToJSON a, ToJSON sid, ToJSON sd)
+ => ToJSON (Screen i l a sid sd) where
+ toJSON (Screen _workspace _screen _screenDetail) =
+ object
+ [ "workspace" .= _workspace
+ , "screen" .= _screen
+ , "screenDetail" .= _screenDetail
+ ]
+
+instance (FromJSON i, FromJSON l, FromJSON a, FromJSON sid, FromJSON sd)
+ => FromJSON (Screen i l a sid sd) where
+ parseJSON = withObject "Screen" $ \v -> Screen
+ <$> v .: "workspace"
+ <*> v .: "screen"
+ <*> v .: "screenDetail"
+
+instance ToJSON ScreenId where
+ toJSON (S i) = toJSON i
+
+instance FromJSON ScreenId where
+ parseJSON v = S <$> parseJSON v
+
+instance ToJSON ScreenDetail where
+ toJSON (SD r) = toJSON r
+
+instance FromJSON ScreenDetail where
+ parseJSON v = SD <$> parseJSON v
+
+
+instance (ToJSON i, ToJSON l, ToJSON a, ToJSONKey a, ToJSON sid, ToJSON sd)
+ => ToJSON (StackSet i l a sid sd) where
+ toJSON (StackSet _current _visible _hidden _floating) =
+ object
+ [ "current" .= _current
+ , "visible" .= _visible
+ , "hidden" .= _hidden
+ , "floating" .= _floating
+ ]
+
+instance (FromJSON i, FromJSON l, Ord a, FromJSON a, FromJSONKey a, FromJSON sid, FromJSON sd)
+ => FromJSON (StackSet i l a sid sd) where
+ parseJSON = withObject "StackSet" $ \v -> StackSet
+ <$> v .: "current"
+ <*> v .: "visible"
+ <*> v .: "hidden"
+ <*> v .: "floating"
+
+instance ToJSON RationalRect where
+ toJSON (RationalRect a b c d) =
+ toJSON (a, b, c, d)
+
+instance FromJSON RationalRect where
+ parseJSON v = do
+ (a,b,c,d) <- parseJSON v
+ return (RationalRect a b c d)
+
+instance ToJSON StateFile where
+ toJSON (StateFile _sfWins _sfExt) =
+ object
+ [ "sfWins" .= _sfWins
+ , "sfExt" .= _sfExt
+ ]
+
+instance FromJSON StateFile where
+ parseJSON = withObject "StateFile" $ \v -> StateFile
+ <$> v .: "sfWins"
+ <*> v .: "sfExt"