initHEAD1.0.0master

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"