{-# 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"