{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE ConstraintKinds    #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}

module Graphics.XHB.Ewmh.Types where

import Control.Applicative (Applicative, (<$>), (<*>))
import Control.Monad (replicateM)
import Control.Monad.IO.Class (MonadIO)
import Data.Typeable (Typeable)
import Data.Word (Word8, Word32)
import Graphics.XHB (ButtonIndex(..), StackMode(..), WINDOW)
import Graphics.XHB.AtomCache
import Graphics.XHB.Ewmh.Atoms
import Graphics.XHB.Ewmh.Serialize
import Graphics.XHB.Ewmh.Values

type EwmhT = AtomCacheT

type EwmhCtx m = (Applicative m, MonadIO m, AtomCacheCtx m)

data NetSupported = NetSupported
    { ewmhAtoms           :: [EWMH_ATOM]
    , netWmStates         :: [NET_WM_STATE]
    , netWmAllowedActions :: [NET_WM_ALLOWED_ACTIONS]
    , netWmWindowTypes    :: [NET_WM_WINDOW_TYPE]
    }
    deriving (Eq, Ord, Read, Show, Typeable)

data NetDesktopGeometry = NetDesktopGeometry
    { netDesktopGeometry_width  :: Word32
    , netDesktopGeometry_height :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetDesktopGeometry where
    serialize v = mapM_ ($ v) [ serialize . netDesktopGeometry_width
                              , serialize . netDesktopGeometry_height
                              ]
    deserialize = NetDesktopGeometry <$> deserialize <*> deserialize

data Viewport = Viewport
    { viewport_x :: Word32
    , viewport_y :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize Viewport where
    serialize v = mapM_ ($ v) [ serialize . viewport_x
                              , serialize . viewport_y
                              ]
    deserialize = Viewport <$> deserialize <*> deserialize

data NetDesktopViewport = NetDesktopViewport
    { netDesktopViewport_viewports :: [Viewport]
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetDesktopViewport where
    serialize = serialize . netDesktopViewport_viewports
    deserialize = NetDesktopViewport <$> deserialize

data NetActiveWindow = NetActiveWindow
    { netActiveWindow_source_indication       :: SourceIndication
    , netActiveWindow_currently_active_window :: Maybe WINDOW
    }
    deriving (Eq, Ord, Show, Typeable)

data Workarea = Workarea
    { workarea_x      :: Word32
    , workarea_y      :: Word32
    , workarea_width  :: Word32
    , workarea_height :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize Workarea where
    serialize v = mapM_ ($ v) [ serialize . workarea_x
                              , serialize . workarea_y
                              , serialize . workarea_width
                              , serialize . workarea_height
                              ]
    deserialize = Workarea <$> deserialize
                           <*> deserialize
                           <*> deserialize
                           <*> deserialize

data NetWorkarea = NetWorkarea
    { netWorkarea_workareas :: [Workarea]
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetWorkarea where
    serialize = serialize . netWorkarea_workareas
    deserialize = NetWorkarea <$> deserialize

data NetDesktopLayout = NetDesktopLayout
    { orientation     :: NET_DESKTOP_LAYOUT_ORIENTATION
    , starting_corner :: NET_DESKTOP_LAYOUT_STARTING_CORNER
    , columns         :: Word32
    , rows            :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetDesktopLayout where
    serialize (NetDesktopLayout o s c r) = do
        serialize o
        serialize c
        serialize r
        serialize s

    deserialize = do
        o <- deserialize
        c <- deserialize
        r <- deserialize
        s <- deserialize
        return $ NetDesktopLayout o s c r

data NetMoveresizeWindow = NetMoveresizeWindow
    { netMoveresizeWindow_source_indication :: SourceIndication
    , netMoveresizeWindow_gravity           :: Gravity
    , netMoveresizeWindow_x                 :: Maybe Int
    , netMoveresizeWindow_y                 :: Maybe Int
    , netMoveresizeWindow_width             :: Maybe Word32
    , netMoveresizeWindow_height            :: Maybe Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

-- TODO: push to xhb package
deriving instance Eq ButtonIndex
deriving instance Ord ButtonIndex
deriving instance Read ButtonIndex

data NetWmMoveresize = NetWmMoveresize
    { netWmMoveresize_x_root            :: Maybe Int
    , netWmMoveresize_y_root            :: Maybe Int
    , netWmMoveresize_direction         :: NET_WM_MOVERESIZE_DIRECTION
    , netWmMoveresize_button            :: ButtonIndex
    , netWmMoveresize_source_indication :: SourceIndication
    }
    deriving (Eq, Ord, Read, Show, Typeable)

-- TODO: push to xhb package
deriving instance Eq StackMode
deriving instance Ord StackMode
deriving instance Read StackMode

-- no Read because there's no Read instance for WINDOW
data NetRestackWindow = NetRestackWindow
    { netRestackWindow_source_indication :: SourceIndication
    , netRestackWindow_sibling_window    :: WINDOW
    , netRestackWindow_detail            :: StackMode
    }
    deriving (Eq, Ord, Show, Typeable)

data NetWmDesktop = NetWmDesktop
    { netWmDesktop_new_desktop       :: Word32
    , netWmDesktop_source_indication :: SourceIndication
    }
    deriving (Eq, Ord, Read, Show, Typeable)

data NetWmState = NetWmState
    { netWmState_action :: NET_WM_STATE_ACTION
    , netWmState_first_property :: NET_WM_STATE
    , netWmState_second_property :: Maybe NET_WM_STATE
    , netWmState_source_indication :: SourceIndication
    }
    deriving (Eq, Ord, Read, Show, Typeable)

data NetWmStrut = NetWmStrut
    { netWmStrut_left   :: Word32
    , netWmStrut_right  :: Word32
    , netWmStrut_top    :: Word32
    , netWmStrut_bottom :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetWmStrut where
    serialize v = mapM_ ($ v) [ serialize . netWmStrut_left
                              , serialize . netWmStrut_right
                              , serialize . netWmStrut_top
                              , serialize . netWmStrut_bottom
                              ]

    deserialize = NetWmStrut <$> deserialize
                             <*> deserialize
                             <*> deserialize
                             <*> deserialize

data NetWmStrutPartial = NetWmStrutPartial
    { netWmStrutPartial_left           :: Word32
    , netWmStrutPartial_right          :: Word32
    , netWmStrutPartial_top            :: Word32
    , netWmStrutPartial_bottom         :: Word32
    , netWmStrutPartial_left_start_y   :: Word32
    , netWmStrutPartial_left_end_y     :: Word32
    , netWmStrutPartial_right_start_y  :: Word32
    , netWmStrutPartial_right_end_y    :: Word32
    , netWmStrutPartial_top_start_x    :: Word32
    , netWmStrutPartial_top_end_x      :: Word32
    , netWmStrutPartial_bottom_start_x :: Word32
    , netWmStrutPartial_bottom_end_x   :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetWmStrutPartial where
    serialize v = mapM_ ($ v) [ serialize . netWmStrutPartial_left
                              , serialize . netWmStrutPartial_right
                              , serialize . netWmStrutPartial_top
                              , serialize . netWmStrutPartial_bottom
                              , serialize . netWmStrutPartial_left_start_y
                              , serialize . netWmStrutPartial_left_end_y
                              , serialize . netWmStrutPartial_right_start_y
                              , serialize . netWmStrutPartial_right_end_y
                              , serialize . netWmStrutPartial_top_start_x
                              , serialize . netWmStrutPartial_top_end_x
                              , serialize . netWmStrutPartial_bottom_start_x
                              , serialize . netWmStrutPartial_bottom_end_x
                              ]

    deserialize = NetWmStrutPartial <$> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize

data NetWmIconGeometry = NetWmIconGeometry
    { netWmIconGeometry_x      :: Word32
    , netWmIconGeometry_y      :: Word32
    , netWmIconGeometry_width  :: Word32
    , netWmIconGeometry_height :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetWmIconGeometry where
    serialize v = mapM_ ($ v) [ serialize . netWmIconGeometry_x
                              , serialize . netWmIconGeometry_y
                              , serialize . netWmIconGeometry_width
                              , serialize . netWmIconGeometry_height
                              ]

    deserialize = NetWmIconGeometry <$> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize

data NetWmIconData = NetWmIconData
    { netWmIconData_a :: Word8
    , netWmIconData_r :: Word8
    , netWmIconData_g :: Word8
    , netWmIconData_b :: Word8
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetWmIconData where
    serialize v = mapM_ ($ v) [ serialize . netWmIconData_a
                              , serialize . netWmIconData_r
                              , serialize . netWmIconData_g
                              , serialize . netWmIconData_b
                              ]

    deserialize = NetWmIconData <$> deserialize
                                <*> deserialize
                                <*> deserialize
                                <*> deserialize

data NetWmIcon = NetWmIcon
    { netWmIcon_width  :: Word32
    , netWmIcon_height :: Word32
    , netWmIcon_data   :: [[NetWmIconData]]
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetWmIcon where
    serialize v = mapM_ ($ v) [ serialize . netWmIcon_width
                              , serialize . netWmIcon_height
                              , serialize . netWmIcon_data
                              ]

    deserialize = do
        width  <- deserialize
        height <- deserialize
        NetWmIcon width height <$>
            replicateM (fromIntegral height)
                (replicateM (fromIntegral width) deserialize)

netWmIconToPPM :: NetWmIcon -> String
netWmIconToPPM (NetWmIcon w h d) =
    "P3\n"
    ++ show w ++ " " ++ show h ++ "\n"
    ++ "255\n"
    ++ unlines (map (unwords . map conv) d)
    where
    conv (NetWmIconData _ r g b) = show r ++ " " ++ show g ++ " " ++ show b

data NetFrameExtents = NetFrameExtents
    { netFrameExtents_left   :: Word32
    , netFrameExtents_right  :: Word32
    , netFrameExtents_top    :: Word32
    , netFrameExtents_bottom :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetFrameExtents where
    serialize v = mapM_ ($ v) [ serialize . netFrameExtents_left
                              , serialize . netFrameExtents_right
                              , serialize . netFrameExtents_top
                              , serialize . netFrameExtents_bottom
                              ]

    deserialize = NetFrameExtents <$> deserialize
                                  <*> deserialize
                                  <*> deserialize
                                  <*> deserialize

data NetWmOpaqueRegion = NetWmOpaqueRegion
    { netWmOpaqueRegion_x      :: Word32
    , netWmOpaqueRegion_y      :: Word32
    , netWmOpaqueRegion_width  :: Word32
    , netWmOpaqueRegion_height :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

instance Serialize NetWmOpaqueRegion where
    serialize v = mapM_ ($ v) [ serialize . netWmOpaqueRegion_x
                              , serialize . netWmOpaqueRegion_y
                              , serialize . netWmOpaqueRegion_width
                              , serialize . netWmOpaqueRegion_height
                              ]

    deserialize = NetWmOpaqueRegion <$> deserialize
                                    <*> deserialize
                                    <*> deserialize
                                    <*> deserialize

data NetWmSyncRequest = NetWmSyncRequest
    { netWmSyncRequest_low  :: Word32
    , netWmSyncRequest_high :: Word32
    }
    deriving (Eq, Ord, Read, Show, Typeable)

data NetWmFullscreenMonitors = NetWmFullscreenMonitors
    { netWmFullscreenMonitors_top               :: Word32
    , netWmFullscreenMonitors_bottom            :: Word32
    , netWmFullscreenMonitors_left              :: Word32
    , netWmFullscreenMonitors_right             :: Word32
    , netWmFullscreenMonitors_source_indication :: SourceIndication
    }
    deriving (Eq, Ord, Read, Show, Typeable)