{-# LANGUAGE RecordWildCards #-}
module I3IPC.Event where
import I3IPC.Reply ( Node
, BarConfigReply
)
import Control.Monad ( mzero )
import GHC.Generics
import Data.Aeson
import Data.Aeson.Encoding ( text )
import qualified Data.ByteString.Lazy as BL
import Data.Int
import Data.Vector ( Vector )
import Data.Text ( Text )
data Event =
Workspace !WorkspaceEvent
| Output !OutputEvent
| Mode !ModeEvent
| Window !WindowEvent
| BarConfigUpdate !BarConfigUpdateEvent
| Binding !BindingEvent
| Shutdown !ShutdownEvent
| Tick !TickEvent
deriving (Eq, Show)
toEvent' :: Int -> BL.ByteString -> Either String Event
toEvent' 0 = (Workspace <$>) . eitherDecode'
toEvent' 1 = (Output <$>) . eitherDecode'
toEvent' 2 = (Mode <$>) . eitherDecode'
toEvent' 3 = (Window <$>) . eitherDecode'
toEvent' 4 = (BarConfigUpdate <$>) . eitherDecode'
toEvent' 5 = (Binding <$>) . eitherDecode'
toEvent' 6 = (Shutdown <$>) . eitherDecode'
toEvent' 7 = (Tick <$>) . eitherDecode'
toEvent' _ = error "Unknown Event type found"
toEvent :: Int -> BL.ByteString -> Either String Event
toEvent 0 = (Workspace <$>) . eitherDecode
toEvent 1 = (Output <$>) . eitherDecode
toEvent 2 = (Mode <$>) . eitherDecode
toEvent 3 = (Window <$>) . eitherDecode
toEvent 4 = (BarConfigUpdate <$>) . eitherDecode
toEvent 5 = (Binding <$>) . eitherDecode
toEvent 6 = (Shutdown <$>) . eitherDecode
toEvent 7 = (Tick <$>) . eitherDecode
toEvent _ = error "Unknown Event type found"
data WorkspaceChange =
Focus
| Init
| Empty
| Urgent
| Rename
| Reload
| Restored
| Move
deriving (Eq, Generic, Show)
instance ToJSON WorkspaceChange where
toEncoding = \case
Focus -> text "focus"
Init -> text "init"
Empty -> text "empty"
Urgent -> text "urgent"
Rename -> text "rename"
Reload -> text "reload"
Restored -> text "restored"
Move -> text "move"
instance FromJSON WorkspaceChange where
parseJSON (String s) = pure $! case s of
"focus" -> Focus
"init" -> Init
"empty" -> Empty
"urgent" -> Rename
"rename" -> Rename
"reload" -> Reload
"restored" -> Restored
"move" -> Move
_ -> error "Received unrecognized WorkspaceChange"
parseJSON _ = mzero
data WorkspaceEvent = WorkspaceEvent {
wrk_change :: !WorkspaceChange
, wrk_current :: !(Maybe Node)
, wrk_old :: !(Maybe Node)
} deriving (Eq, Generic, Show)
instance ToJSON WorkspaceEvent where
toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = drop 4
, omitNothingFields = True
}
instance FromJSON WorkspaceEvent where
parseJSON = withObject "WorkspaceEvent" $ \o -> do
wrk_change <- o .: "change"
wrk_current <- o .:? "current"
wrk_old <- o .:? "old"
pure $! WorkspaceEvent { .. }
data OutputEvent = OutputEvent {
output_change :: !Text
} deriving (Eq, Generic, Show)
instance ToJSON OutputEvent where
toEncoding =
genericToEncoding defaultOptions { fieldLabelModifier = drop 7 }
instance FromJSON OutputEvent where
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 7 }
data ModeEvent = ModeEvent {
mode_change :: !Text
, mode_pango_markup :: !Bool
} deriving (Eq, Generic, Show)
instance ToJSON ModeEvent where
toEncoding =
genericToEncoding defaultOptions { fieldLabelModifier = drop 5 }
instance FromJSON ModeEvent where
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 5 }
data WindowEvent = WindowEvent {
win_change :: !WindowChange
, win_container :: !Node
} deriving (Eq, Show, Generic)
instance ToJSON WindowEvent where
toEncoding =
genericToEncoding defaultOptions { fieldLabelModifier = drop 4 }
instance FromJSON WindowEvent where
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 4 }
data WindowChange =
WinNew
| WinClose
| WinFocus
| WinTitle
| WinFullscreenMode
| WinMove
| WinFloating
| WinUrgent
| WinMark
deriving (Eq, Show, Generic)
instance ToJSON WindowChange where
toEncoding = \case
WinNew -> text "new"
WinFocus -> text "focus"
WinTitle -> text "title"
WinFullscreenMode -> text "fullscreen_mode"
WinMove -> text "move"
WinFloating -> text "floating"
WinUrgent -> text "urgent"
WinMark -> text "mark"
WinClose -> text "close"
instance FromJSON WindowChange where
parseJSON (String s) = pure $! case s of
"new" -> WinNew
"focus" -> WinFocus
"title" -> WinTitle
"fullscreen_mode" -> WinFullscreenMode
"move" -> WinMove
"floating" -> WinFloating
"urgent" -> WinUrgent
"mark" -> WinMark
"close" -> WinClose
_ -> error "Received unrecognized WorkspaceChange"
parseJSON _ = mzero
type BarConfigUpdateEvent = BarConfigReply
data BindingEvent = BindingEvent {
bind_change :: !Text
, bind_binding :: !BindingObject
} deriving (Eq, Show, Generic)
instance ToJSON BindingEvent where
toEncoding =
genericToEncoding defaultOptions { fieldLabelModifier = drop 5 }
instance FromJSON BindingEvent where
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 5 }
data BindingObject = BindingObject {
bind_command :: !Text
, bind_event_state_mask :: !(Vector Text)
, bind_input_code :: !Int32
, bind_symbol :: !(Maybe Text)
, bind_input_type :: !BindType
} deriving (Eq, Show, Generic)
instance ToJSON BindingObject where
toEncoding =
genericToEncoding defaultOptions { fieldLabelModifier = drop 5 }
instance FromJSON BindingObject where
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 5 }
data BindType = Keyboard | Mouse deriving (Eq, Show, Generic)
instance FromJSON BindType where
parseJSON (String s) = pure $! case s of
"keyboard" -> Keyboard
"mouse" -> Mouse
_ -> error "Found BindType not recognized"
parseJSON _ = mzero
instance ToJSON BindType where
toEncoding = \case
Keyboard -> text "keyboard"
Mouse -> text "mouse"
data ShutdownEvent = ShutdownEvent {
shutdown_change :: !ShutdownChange
} deriving (Eq, Show, Generic)
instance FromJSON ShutdownEvent where
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 9 }
instance ToJSON ShutdownEvent where
toEncoding =
genericToEncoding defaultOptions { fieldLabelModifier = drop 9 }
data ShutdownChange = Restart | Exit deriving (Eq, Show, Generic)
instance FromJSON ShutdownChange where
parseJSON (String s) = pure $! case s of
"restart" -> Restart
"exit" -> Exit
_ -> error "Found ShutdownChange not recognized"
parseJSON _ = mzero
instance ToJSON ShutdownChange where
toEncoding = \case
Restart -> text "restart"
Exit -> text "exit"
data TickEvent = TickEvent {
tick_first :: !Bool
, tick_payload :: !Text
} deriving (Eq, Show, Generic)
instance ToJSON TickEvent where
toEncoding =
genericToEncoding defaultOptions { fieldLabelModifier = drop 5 }
instance FromJSON TickEvent where
parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 5 }