i3ipc (empty) → 0.1.0.0
raw patch · 10 files changed
+1455/−0 lines, 10 filesdep +aesondep +basedep +binarysetup-changed
Dependencies added: aeson, base, binary, bytestring, containers, hspec, i3ipc, network, text, typed-process, vector
Files
- LICENSE +30/−0
- README.md +45/−0
- Setup.hs +2/−0
- i3ipc.cabal +90/−0
- src/I3IPC.hs +328/−0
- src/I3IPC/Event.hs +287/−0
- src/I3IPC/Message.hs +68/−0
- src/I3IPC/Reply.hs +526/−0
- src/I3IPC/Subscribe.hs +43/−0
- test/Spec.hs +36/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Evan Cameron (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Evan Cameron nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,45 @@+# i3ipc++[](https://travis-ci.com/leshow/i3ipc)++Haskell type-safe bindings for working with i3 using it's unix socket IPC++Subscribe to events:++```haskell+import qualified I3IPC.Subscribe as Sub+import I3IPC ( subscribe )++-- will print all events+main :: IO ()+main = subscribe print [Sub.Workspace, Sub.Window]+```++Sending Messages to i3:++```haskell+import I3IPC ( connecti3+ , getWorkspaces+ )++main :: IO ()+main = do+ soc <- connecti3+ print getWorkspaces+```++Alternatively, you can ignore the convenience functions and construct these messages yourself:++```haskell+import qualified I3IPC.Message as Msg+import I3IPC ( connecti3+ , receiveMsg+ )++main :: IO ()+main = do+ soc <- connecti3+ print $ Msg.sendMsg soc Msg.Workspaces >> receiveMsg soc+```++I'm happy to take PRs or suggestions, or simply fix issues for this library.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ i3ipc.cabal view
@@ -0,0 +1,90 @@+name: i3ipc+version: 0.1.0.0+description: Library for controlling i3 through it's IPC. i3 communicates using a JSON interface over a unix socket.+ For JSON parsing I'm using Aeson. I've written out all the records and types to allow anyone to + easily interact with i3 from a Haskell application.+homepage: https://github.com/leshow/i3ipc#readme+license: BSD3+license-file: LICENSE+author: Evan Cameron+maintainer: cameron.evan@gmail.com+synopsis: A type-safe wrapper around i3's IPC+copyright: 2019 Evan Cameron+category: Lib+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: I3IPC+ , I3IPC.Event+ , I3IPC.Message+ , I3IPC.Reply+ , I3IPC.Subscribe+ build-depends: base >= 4.7 && < 5+ , aeson >= 1.2 && < 1.5+ , bytestring >= 0.10 && < 0.11+ , containers >= 0.5.10 && < 0.7+ , binary >= 0.8.6 && < 0.10+ , text >= 1.2.1.0 && < 1.3+ , vector >= 0.11.0 && < 0.13+ , network >= 2.6.3.5 && < 3.1+ , typed-process >= 0.2.4 && < 0.3+ + default-language: Haskell2010+ ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + default-extensions: DeriveFoldable+ , DeriveFunctor+ , DeriveGeneric+ , DeriveTraversable+ , DeriveLift+ , DerivingStrategies+ , DeriveAnyClass+ , GeneralizedNewtypeDeriving+ , OverloadedStrings+ , OverloadedLabels+ , ExistentialQuantification+ , StandaloneDeriving+ , ScopedTypeVariables+ , UnicodeSyntax+ , BinaryLiterals+ , NumDecimals+ , ConstraintKinds+ , RankNTypes+ , PolyKinds+ , DataKinds+ , TypeApplications+ , GADTs+ , NamedFieldPuns+ , InstanceSigs+ , TypeSynonymInstances+ , MultiParamTypeClasses+ , FunctionalDependencies+ , ConstrainedClassMethods+ , InstanceSigs+ , FlexibleInstances+ , FlexibleContexts+ , BangPatterns+ , ViewPatterns+ , PatternGuards+ , MultiWayIf+ , EmptyCase+ , LambdaCase+ , TupleSections++test-suite i3ipc-test + type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs + build-depends: base + , hspec+ , bytestring+ , aeson+ , i3ipc+ ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/leshow/i3ipc
+ src/I3IPC.hs view
@@ -0,0 +1,328 @@+-- |+-- Module: I3IPC+-- Copyright: (c) 2019 Evan Cameron+-- License: BSD3+-- Maintainer: Evan Cameron <cameron.evan@gmail.com>+--+-- Types and functions for interacting with i3's IPC mechanism+--+++module I3IPC+ (+ -- ** Subscribe to events+ -- $sub++ -- ** Sending messages+ -- $msg++ -- ** Convenience functions+ -- $func + getSocketPath+ , Response(..)+ , subscribe+ , receive+ , receive'+ , receiveMsg+ , receiveMsg'+ , getReply+ , connecti3+ , receiveEvent+ , receiveEvent'+ , runCommand+ , runCommand'+ , getWorkspaces+ , getWorkspaces'+ , getOutputs+ , getOutputs'+ , getTree+ , getTree'+ , getMarks+ , getMarks'+ , getVersion+ , getVersion'+ , getBarConfig+ , getBarConfig'+ , getBarIds+ , getBindingModes+ , getBindingModes'+ , getConfig+ , getConfig'+ , getTick+ , getTick'+ , getSync+ , getSync'+ )+where++import qualified I3IPC.Message as Msg+import qualified I3IPC.Subscribe as Sub+import qualified I3IPC.Event as Evt+import I3IPC.Reply++import System.Environment ( lookupEnv )+import Data.Maybe ( isJust )+import Data.Semigroup ( (<>) )+import System.Process.Typed ( proc+ , readProcess+ )+import System.Exit ( ExitCode(..)+ , exitFailure+ )++import Network.Socket hiding ( send+ , sendTo+ , recv+ , recvFrom+ )+import Network.Socket.ByteString.Lazy+import Data.Aeson ( encode )+import Data.Binary.Get+import Data.Bifunctor ( second )+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Bits ( testBit+ , clearBit+ )++-- | Get a new unix socket path from i3+getSocketPath :: IO (Maybe BL.ByteString)+getSocketPath = do+ res <- lookupEnv "I3SOCK"+ if isJust res+ then pure $ fmap BL.pack res+ else do+ (exitCode, out, _) <- readProcess $ proc "i3" ["--get-socketpath"]+ if exitCode /= ExitSuccess+ then pure Nothing+ else pure $ Just (BL.filter (/= '\n') out)+++-- | Subscribe with a list of 'I3IPC.Subscribe.Subscribe' types, and subscribe will to respond with specific 'I3IPC.Event.Event'+subscribe :: (Either String Evt.Event -> IO ()) -> [Sub.Subscribe] -> IO ()+subscribe handle subtypes = do+ soc <- socket AF_UNIX Stream 0+ addr <- getSocketPath+ case addr of+ Nothing -> putStrLn "Failed to get i3 socket path" >> exitFailure+ Just addr' ->+ connect soc (SockAddrUnix $ BL.unpack addr')+ >> Msg.sendMsgPayload soc Msg.Subscribe (encode subtypes)+ >> receiveMsg soc+ >> handleSoc soc+ >> close soc+ where+ handleSoc soc = do+ r <- receiveEvent soc+ handle r+ handleSoc soc+++-- | Connect to an i3 socket and return it+connecti3 :: IO Socket+connecti3 = do+ soc <- socket AF_UNIX Stream 0+ addr <- getSocketPath+ case addr of+ Nothing -> putStrLn "Failed to get i3 socket path" >> exitFailure+ Just addr' -> do+ connect soc (SockAddrUnix $ BL.unpack addr')+ pure soc++-- | Useful for when you are receiving Events or Messages.+data Response = Message MsgReply | Event Evt.Event deriving (Show, Eq)++-- | Get and parse the response using i3's IPC+getReply :: Socket -> IO (Either String (Int, BL.ByteString))+getReply soc = do+ magic <- recv soc 6+ if magic == "i3-ipc"+ then do+ len <- fromIntegral . runGet getWord32le <$> recv soc 4+ ty <- fromIntegral . runGet getWord32le <$> recv soc 4+ body <- recv soc len+ pure $ Right (ty, body)+ else pure $ Left "Failed to get reply"++test :: Int -> BL.ByteString -> IO Int+test ty body = do+ putStrLn $ "type " <> show (ty `clearBit` 31)+ BL.putStrLn $ "body " <> body+ BL.putStrLn ""+ pure ty++-- | Parse response from socket, returning either an error or a 'I3IPC.Response', representing a sum type of a 'I3IPC.Reply.MsgReply' or 'I3IPC.Event.Event'+receive :: Socket -> IO (Either String Response)+receive soc = do+ reply <- getReply soc+ case reply of+ Right (ty, body) -> pure $ if testBit ty 31+ then Event `second` Evt.toEvent (ty `clearBit` 31) body+ else Message `second` toMsgReply ty body+ _ -> pure $ Left "Get Reply failed"++-- | Like receive but strict-- will use eitherDecode' under the hood to parse+receive' :: Socket -> IO (Either String Response)+receive' soc = do+ reply <- getReply soc+ case reply of+ Right (ty, body) -> pure $ if testBit ty 31+ then Event `second` Evt.toEvent' (ty `clearBit` 31) body+ else Message `second` toMsgReply' ty body+ _ -> pure $ Left "Get Reply failed"++-- | Receive but specifically for msgs, for when you know the response won't include any Events+receiveMsg :: Socket -> IO (Either String MsgReply)+receiveMsg soc = do+ r <- getReply soc+ pure $ do+ (ty, body) <- r+ toMsgReply ty body++-- | Like 'I3IPC.receiveMsg' but strict-- uses eitherDecode'+receiveMsg' :: Socket -> IO (Either String MsgReply)+receiveMsg' soc = do+ r <- getReply soc+ pure $ do+ (ty, body) <- r+ toMsgReply' ty body++-- | 'I3IPC.receive' specifically for Event+receiveEvent :: Socket -> IO (Either String Evt.Event)+receiveEvent soc = do+ r <- getReply soc+ pure $ do+ (ty, body) <- r+ Evt.toEvent (ty `clearBit` 31) body++-- | like 'receiveEvent' but strict-- uses eitherDecode'+receiveEvent' :: Socket -> IO (Either String Evt.Event)+receiveEvent' soc = do+ r <- getReply soc+ pure $ do+ (ty, body) <- r+ Evt.toEvent' (ty `clearBit` 31) body++-- | Run a command represented as a ByteString, all the following functions are convenience wrappers around+--+-- > Msg.sendMsgPayload soc Msg.X b >> receiveMsg soc+--+-- Or, if there is no message body:+--+-- > Msg.sendMsg soc Msg.X >> receiveMsg soc+runCommand :: Socket -> BL.ByteString -> IO (Either String MsgReply)+runCommand soc b = Msg.sendMsgPayload soc Msg.RunCommand b >> receiveMsg soc++runCommand' :: Socket -> BL.ByteString -> IO (Either String MsgReply)+runCommand' soc b = Msg.sendMsgPayload soc Msg.RunCommand b >> receiveMsg' soc++getWorkspaces :: Socket -> IO (Either String MsgReply)+getWorkspaces soc = Msg.sendMsg soc Msg.Workspaces >> receiveMsg soc++getWorkspaces' :: Socket -> IO (Either String MsgReply)+getWorkspaces' soc = Msg.sendMsg soc Msg.Workspaces >> receiveMsg' soc++getOutputs :: Socket -> IO (Either String MsgReply)+getOutputs soc = Msg.sendMsg soc Msg.Outputs >> receiveMsg soc++getOutputs' :: Socket -> IO (Either String MsgReply)+getOutputs' soc = Msg.sendMsg soc Msg.Outputs >> receiveMsg' soc++getTree :: Socket -> IO (Either String MsgReply)+getTree soc = Msg.sendMsg soc Msg.Tree >> receiveMsg soc++getTree' :: Socket -> IO (Either String MsgReply)+getTree' soc = Msg.sendMsg soc Msg.Tree >> receiveMsg' soc++getMarks :: Socket -> IO (Either String MsgReply)+getMarks soc = Msg.sendMsg soc Msg.Marks >> receiveMsg soc++getMarks' :: Socket -> IO (Either String MsgReply)+getMarks' soc = Msg.sendMsg soc Msg.Marks >> receiveMsg' soc++getBarIds :: Socket -> IO (Either String BarIds)+getBarIds soc = do+ _ <- Msg.sendMsg soc Msg.BarConfig+ r <- getReply soc+ pure $ do+ body <- r+ decodeBarIds (snd body)++-- | Get a bar's config based on it's id+getBarConfig :: Socket -> BL.ByteString -> IO (Either String MsgReply)+getBarConfig soc b = Msg.sendMsgPayload soc Msg.BarConfig b >> receiveMsg' soc++-- | Like 'I3IPC.getBarConfig' but strict+getBarConfig' :: Socket -> BL.ByteString -> IO (Either String MsgReply)+getBarConfig' soc b = Msg.sendMsgPayload soc Msg.BarConfig b >> receiveMsg' soc++getVersion :: Socket -> IO (Either String MsgReply)+getVersion soc = Msg.sendMsg soc Msg.Version >> receiveMsg soc++getVersion' :: Socket -> IO (Either String MsgReply)+getVersion' soc = Msg.sendMsg soc Msg.Version >> receiveMsg' soc++getBindingModes :: Socket -> IO (Either String MsgReply)+getBindingModes soc = Msg.sendMsg soc Msg.BindingModes >> receiveMsg soc++getBindingModes' :: Socket -> IO (Either String MsgReply)+getBindingModes' soc = Msg.sendMsg soc Msg.BindingModes >> receiveMsg' soc++getConfig :: Socket -> IO (Either String MsgReply)+getConfig soc = Msg.sendMsg soc Msg.Config >> receiveMsg soc++getConfig' :: Socket -> IO (Either String MsgReply)+getConfig' soc = Msg.sendMsg soc Msg.Config >> receiveMsg' soc++getTick :: Socket -> IO (Either String MsgReply)+getTick soc = Msg.sendMsg soc Msg.Tick >> receiveMsg soc++getTick' :: Socket -> IO (Either String MsgReply)+getTick' soc = Msg.sendMsg soc Msg.Tick >> receiveMsg' soc++getSync :: Socket -> IO (Either String MsgReply)+getSync soc = Msg.sendMsg soc Msg.Sync >> receiveMsg soc++getSync' :: Socket -> IO (Either String MsgReply)+getSync' soc = Msg.sendMsg soc Msg.Sync >> receiveMsg' soc++++-- $sub+--+-- Commonly, you just want to subscribe to a set of event types and do something with the response:+--+-- > import qualified I3IPC.Subscribe as Sub+-- > import I3IPC ( subscribe )+-- > +-- > main :: IO ()+-- > main = subscribe print [Sub.Workspace, Sub.Window]+--++-- $msg+--+-- Other times, you want to send some kind of command to i3, or get a specific response as a one-time action.+--+-- > import I3IPC ( connecti3+-- > , getWorkspaces+-- > )+-- > +-- > main :: IO ()+-- > main = do+-- > soc <- connecti3+-- > print getWorkspaces+-- +-- $func+--+-- All of the "getX" functions are provided for convenience, but also exported are the building blocks to write whatever you like.+-- There are strict and non-strict variants provided, the tick (') implies strict.+-- For instance, the above could be written as:+--+-- > import qualified I3IPC.Message as Msg+-- > import I3IPC ( connecti3+-- > , receiveMsg+-- > )+-- > +-- > main :: IO ()+-- > main = do+-- > soc <- connecti3+-- > print $ Msg.sendMsg soc Msg.Workspaces >> receiveMsg soc
+ src/I3IPC/Event.hs view
@@ -0,0 +1,287 @@+{-|+Related to `I3IPC.Subscribe.Subscribe', specifically, each 'I3IPC.Event.Event' constructor matches a constructor for 'I3IPC.Subscribe.Subscribe'+-}+{-# 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 )++-- | Responses to the various events you can subscribe to.+data Event =+ -- | See 'I3IPC.Event.WorkspaceEvent' for response. Sent when the user switches to a different workspace, when a new workspace is initialized or when a workspace is removed (because the last client vanished). + Workspace !WorkspaceEvent+ -- | See 'I3IPC.Event.OutputEvent' for response. Sent when RandR issues a change notification (of either screens, outputs, CRTCs or output properties). + | Output !OutputEvent+ -- | See 'I3IPC.Event.ModeEvent' for response. Sent whenever i3 changes its binding mode. + | Mode !ModeEvent+ -- | See 'I3IPC.Event.WindowEvent' for response. Sent when a client’s window is successfully reparented (that is when i3 has finished fitting it into a container), when a window received input focus or when certain properties of the window have changed. + | Window !WindowEvent+ -- | See 'I3IPC.Event.BarConfigUpdateEvent' for response. Sent when the hidden_state or mode field in the barconfig of any bar instance was updated and when the config is reloaded.+ | BarConfigUpdate !BarConfigUpdateEvent+ -- | See 'I3IPC.Event.BindingEvent' for response. Sent when a configured command binding is triggered with the keyboard or mouse + | Binding !BindingEvent+ -- | See 'I3IPC.Event.ShutdownEvent' for response. Sent when the ipc shuts down because of a restart or exit by user command + | Shutdown !ShutdownEvent+ -- | See 'I3IPC.Event.TickEvent' for response. Sent when the ipc client subscribes to the tick event (with "first": true) or when any ipc client sends a SEND_TICK message (with "first": false).+ | 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++-- | Workspace Event+-- This event consists of a single serialized map containing a property change (string) which indicates the type of the change ("focus", "init", "empty", "urgent", "reload", "rename", "restored", "move"). A current (object) property will be present with the affected workspace whenever the type of event affects a workspace (otherwise, it will be +null).+-- When the change is "focus", an old (object) property will be present with the previous workspace. When the first switch occurs (when i3 focuses the workspace visible at the beginning) there is no previous workspace, and the old property will be set to null. Also note that if the previous is empty it will get destroyed when switching, but will still be present in the "old" property.+data WorkspaceEvent = WorkspaceEvent {+ wrk_change :: !WorkspaceChange -- ^ Type of workspace change+ , wrk_current :: !(Maybe Node) -- ^ If the type of event affects the workspace this will have a Just instance+ , wrk_old :: !(Maybe Node) -- ^ Will be Just only when change is Focus and there was a previous workspace+} 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 { .. }++-- | Output Event+-- This event consists of a single serialized map containing a property change (string) which indicates the type of the change (currently only "unspecified").+data OutputEvent = OutputEvent {+ output_change :: !Text -- ^ Currently only "unspecified"+} deriving (Eq, Generic, Show)++instance ToJSON OutputEvent where+ toEncoding =+ genericToEncoding defaultOptions { fieldLabelModifier = drop 7 }++instance FromJSON OutputEvent where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 7 }++-- | Mode Event+-- This event consists of a single serialized map containing a property change (string) which holds the name of current mode in use. The name is the same as specified in config when creating a mode. The default mode is simply named default. It contains a second property, pango_markup, which defines whether pango markup shall be used for displaying this mode.+data ModeEvent = ModeEvent {+ mode_change :: !Text -- ^ always "default"+ , mode_pango_markup :: !Bool -- ^ Whether pango markup should be used for displaying this mode+} deriving (Eq, Generic, Show)+++instance ToJSON ModeEvent where+ toEncoding =+ genericToEncoding defaultOptions { fieldLabelModifier = drop 5 }++instance FromJSON ModeEvent where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 5 }+++-- | Window Event+-- This event consists of a single serialized map containing a property change (string) which indicates the type of the change+data WindowEvent = WindowEvent {+ win_change :: !WindowChange+ , win_container :: !Node -- ^ Additionally a container (object) field will be present, which consists of the window’s parent container. Be aware that for the "new" event, the container will hold the initial name of the newly reparented window (e.g. if you run urxvt with a shell that changes the title, you will still at this point get the window title as "urxvt").+} 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 -- ^ the window has become managed by i3 + | WinClose -- ^ the window has closed + | WinFocus -- ^ the window has received input focus + | WinTitle -- ^ the window’s title has changed + | WinFullscreenMode -- ^ the window has entered or exited fullscreen mode + | WinMove -- ^ the window has changed its position in the tree + | WinFloating -- ^ the window has transitioned to or from floating + | WinUrgent -- ^ the window has become urgent or lost its urgent status + | WinMark -- ^ a mark has been added to or removed from the window + 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+++-- | BarConfig_Update Event+-- This event consists of a single serialized map reporting on options from the barconfig of the specified bar_id that were updated in i3. This event is the same as a GET_BAR_CONFIG reply for the bar with the given id.+type BarConfigUpdateEvent = BarConfigReply++-- | Binding Event+-- This event consists of a single serialized map reporting on the details of a binding that ran a command because of user input. The change (string) field indicates what sort of binding event was triggered (right now it will always be "run" but may be expanded in the future).+data BindingEvent = BindingEvent {+ bind_change :: !Text -- ^ right now this is always "run"+ , bind_binding :: !BindingObject -- ^ Details about the binding that was run+} 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 }++-- | Bind type+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"++-- | Shutdown Event+-- This event is triggered when the connection to the ipc is about to shutdown because of a user action such as a restart or exit command. The change (string) field indicates why the ipc is shutting down. It can be either "restart" or "exit".+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"++-- | Tick Event+-- This event is triggered by a subscription to tick events or by a 'I3IPC.Message.Tick' message.+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 }
+ src/I3IPC/Message.hs view
@@ -0,0 +1,68 @@+module I3IPC.Message+ ( MessageType(..)+ , createMsg+ , createMsgPayload+ , sendMsg+ , sendMsgPayload+ )+where++import Network.Socket.ByteString.Lazy+import Network.Socket ( Socket )+import qualified Data.ByteString.Lazy as BSL+import Data.Binary.Put+import Data.Function ( (&) )+import Data.Int++-- | I3 IPC Commands https://i3wm.org/docs/ipc.html#_sending_messages_to_i3+-- +data MessageType =+ -- | Run the payload as an i3 command (like the commands you can bind to keys).+ RunCommand+ -- | Get the list of current workspaces. + | Workspaces+ -- | Subscribe this IPC connection to the event types specified in the message payload. + | Subscribe+ -- | Get the list of current outputs.+ | Outputs+ -- | Get the i3 layout tree.+ | Tree+ -- | Gets the names of all currently set marks.+ | Marks+ -- | Gets the specified bar configuration or the names of all bar configurations if payload is empty.+ | BarConfig+ -- | Gets the i3 version.+ | Version+ -- | Gets the names of all currently configured binding modes.+ | BindingModes+ -- | Returns the last loaded i3 config. + | Config+ -- | Sends a tick event with the specified payload.+ | Tick+ -- | Sends an i3 sync event with the specified random value to the specified window.+ | Sync+ deriving (Enum, Show, Eq)++-- | Create a message for i3 based on on 'MessageType' +-- Output of the form: "i3-ipc" <msglen> <msgtype> <payload>+createMsgPayload :: MessageType -> BSL.ByteString -> BSL.ByteString+createMsgPayload msgtype msg = runPut $ do+ putByteString "i3-ipc"+ putWord32host $ fromIntegral (BSL.length msg)+ putWord32host $ fromIntegral (fromEnum msgtype)+ putLazyByteString msg++-- | Create a msg for i3 based on 'MessageType' without a message body, based on 'createMsg'+createMsg :: MessageType -> BSL.ByteString+createMsg msgtype = runPut $ do+ putByteString "i3-ipc"+ putWord32host $ fromIntegral @Int 0+ putWord32host $ fromIntegral (fromEnum msgtype)++-- | Send a message over the socket of 'MessageType' and some content+sendMsgPayload :: Socket -> MessageType -> BSL.ByteString -> IO Int64+sendMsgPayload soc msgtype msg = createMsgPayload msgtype msg & send soc++-- | Similar to 'sendMsg' but with no message body+sendMsg :: Socket -> MessageType -> IO Int64+sendMsg soc msgtype = createMsg msgtype & send soc
+ src/I3IPC/Reply.hs view
@@ -0,0 +1,526 @@+module I3IPC.Reply where++import GHC.Generics+import Control.Monad ( mzero )+import Data.Aeson+import Data.Aeson.Encoding ( text )+import qualified Data.ByteString.Lazy as BL+import Data.Int+import Data.Map.Strict ( Map )+import Data.Vector ( Vector )+import Data.Text ( Text )++data MsgReply =+ -- | Run the payload as an i3 command (like the commands you can bind to keys).+ RunCommand !Success+ -- | Get the list of current workspaces. + | Workspaces !WorkspaceReply+ -- | Subscribe this IPC connection to the event types specified in the message payload. + | Subscribe !Success+ -- | Get the list of current outputs.+ | Outputs !OutputsReply+ -- | Get the i3 layout tree.+ | Tree !Node+ -- | Gets the names of all currently set marks.+ | Marks !MarksReply+ -- | Gets the specified bar configuration or the names of all bar configurations if payload is empty.+ | BarConfig !BarConfigReply+ -- | Gets the i3 version.+ | Version !VersionReply+ -- | Gets the names of all currently configured binding modes.+ | BindingModes !BindingModesReply+ -- | Returns the last loaded i3 config. + | Config !ConfigReply+ -- | Sends a tick event with the specified payload.+ | Tick !Success+ -- | Sends an i3 sync event with the specified random value to the specified window.+ | Sync !Success+ deriving (Show, Eq)++toMsgReply' :: Int -> BL.ByteString -> Either String MsgReply+toMsgReply' 0 = (RunCommand <$>) . eitherDecode'+toMsgReply' 1 = (Workspaces <$>) . eitherDecode'+toMsgReply' 2 = (Subscribe <$>) . eitherDecode'+toMsgReply' 3 = (Outputs <$>) . eitherDecode'+toMsgReply' 4 = (Tree <$>) . eitherDecode'+toMsgReply' 5 = (Marks <$>) . eitherDecode'+toMsgReply' 6 = (BarConfig <$>) . eitherDecode'+toMsgReply' 7 = (Version <$>) . eitherDecode'+toMsgReply' 8 = (BindingModes <$>) . eitherDecode'+toMsgReply' 9 = (Config <$>) . eitherDecode'+toMsgReply' 10 = (Tick <$>) . eitherDecode'+toMsgReply' 11 = (Sync <$>) . eitherDecode'+toMsgReply' _ = error "Unknown Event type found"++toMsgReply :: Int -> BL.ByteString -> Either String MsgReply+toMsgReply 0 = (RunCommand <$>) . eitherDecode+toMsgReply 1 = (Workspaces <$>) . eitherDecode+toMsgReply 2 = (Subscribe <$>) . eitherDecode+toMsgReply 3 = (Outputs <$>) . eitherDecode+toMsgReply 4 = (Tree <$>) . eitherDecode+toMsgReply 5 = (Marks <$>) . eitherDecode+toMsgReply 6 = (BarConfig <$>) . eitherDecode+toMsgReply 7 = (Version <$>) . eitherDecode+toMsgReply 8 = (BindingModes <$>) . eitherDecode+toMsgReply 9 = (Config <$>) . eitherDecode+toMsgReply 10 = (Tick <$>) . eitherDecode+toMsgReply 11 = (Sync <$>) . eitherDecode+toMsgReply _ = error "Unknown Event type found"++decodeBarIds :: BL.ByteString -> Either String BarIds+decodeBarIds = eitherDecode++-- | Success Reply+-- used for Sync, Subscribe, Command, Tick+data Success = Success {+ success :: !Bool+} deriving (Eq, Show, Generic, FromJSON)++instance ToJSON Success where+ toEncoding = genericToEncoding defaultOptions++-- | Workspaces Reply+-- The reply consists of a serialized list of workspaces. +data WorkspaceReply = WorkspaceReply !(Vector Workspace) deriving (Eq, Generic, Show)++instance ToJSON WorkspaceReply where+ toEncoding = genericToEncoding defaultOptions++instance FromJSON WorkspaceReply where+ parseJSON = genericParseJSON defaultOptions++data Workspace = Workspace {+ ws_num :: !Int32 -- ^ The logical number of the workspace. Corresponds to the command to switch to this workspace. For named workspaces, this will be -1. + , ws_name :: !Text -- ^ The name of this workspace (by default num+1), as changed by the user. Encoded in UTF-8. + , ws_visible :: !Bool -- ^ Whether this workspace is currently visible on an output (multiple workspaces can be visible at the same time). + , ws_focused :: !Bool -- ^ Whether this workspace currently has the focus (only one workspace can have the focus at the same time).+ , ws_urgent :: !Bool -- ^ Whether a window on this workspace has the "urgent" flag set. + , ws_rect :: !Rect -- ^ The rectangle of this workspace (equals the rect of the output it is on), consists of x, y, width, height. + , ws_output :: !Text -- ^ The video output this workspace is on (LVDS1, VGA1, …). +} deriving (Eq, Generic, Show)++instance ToJSON Workspace where+ toEncoding =+ genericToEncoding defaultOptions { fieldLabelModifier = drop 3 }++instance FromJSON Workspace where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 3 }++-- | Outputs Reply+-- The reply consists of a serialized list of outputs. +data OutputsReply = OutputsReply !(Vector Output) deriving (Eq, Generic, Show)++instance ToJSON OutputsReply where+ toEncoding = genericToEncoding defaultOptions++instance FromJSON OutputsReply where+ parseJSON = genericParseJSON defaultOptions++data Output = Output {+ output_name :: !Text+ , output_active :: !Bool+ , output_primary :: !Bool+ , output_current_workspace :: !(Maybe Text)+ , output_rect :: !Rect+} deriving (Eq, Show, Generic)++instance ToJSON Output where+ toEncoding =+ genericToEncoding defaultOptions { fieldLabelModifier = drop 7 }++instance FromJSON Output where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 7 }++-- | Tree Reply+-- The reply consists of a serialized tree. Each node in the tree (representing one container) has at least the properties listed below. While the nodes might have more properties, please do not use any properties which are not documented here. They are not yet finalized and will probably change!+data Node = Node {+ node_id :: !Int -- ^ The internal ID (actually a C pointer value) of this container. Do not make any assumptions about it. You can use it to (re-)identify and address containers when talking to i3. + , node_name :: !(Maybe Text) -- ^ The internal name of this container. For all containers which are part of the tree structure down to the workspace contents, this is set to a nice human-readable name of the container. For containers that have an X11 window, the content is the title (_NET_WM_NAME property) of that window. For all other containers, the content is not defined (yet). + , node_type :: !NodeType -- ^ Type of this container. Can be one of "root", "output", "con", "floating_con", "workspace" or "dockarea". + , node_output :: !(Maybe Text) -- ^ The X11 display the node is drawn in. ex. "DP-4.8"+ , node_orientation :: !NodeOrientation -- ^ Can either be "horizontal" "vertical" or "none"+ , node_border :: !NodeBorder -- ^ Can be either "normal", "none" or "pixel", depending on the container’s border style. + , node_current_border_width :: !Int32 -- ^ Number of pixels of the border width. + , node_layout :: !NodeLayout -- ^ Can be either "splith", "splitv", "stacked", "tabbed", "dockarea" or "output". Other values might be possible in the future, should we add new layouts. + , node_percent :: !(Maybe Float) -- ^ The percentage which this container takes in its parent. A value of null means that the percent property does not make sense for this container, for example for the root container. + , node_rect :: !Rect -- ^ The absolute display coordinates for this container. Display coordinates means that when you have two 1600x1200 monitors on a single X11 Display (the standard way), the coordinates of the first window on the second monitor are { "x": 1600, "y": 0, "width": 1600, "height": 1200 }. + , node_window_rect :: !Rect -- ^ The coordinates of the actual client window inside its container. These coordinates are relative to the container and do not include the window decoration (which is actually rendered on the parent container). So, when using the default layout, you will have a 2 pixel border on each side, making the window_rect { "x": 2, "y": 0, "width": 632, "height": 366 } (for example). + , node_deco_rect :: !Rect -- ^ The coordinates of the window decoration inside its container. These coordinates are relative to the container and do not include the actual client window. + , node_geometry :: !Rect -- ^ The original geometry the window specified when i3 mapped it. Used when switching a window to floating mode, for example. + , node_window :: !(Maybe Int32) -- ^ The X11 window ID of the actual client window inside this container. This field is set to null for split containers or otherwise empty containers. This ID corresponds to what xwininfo(1) and other X11-related tools display (usually in hex). + , node_window_properties :: !(Maybe (Map WindowProperty (Maybe Text))) -- ^ X11 window properties title, instance, class, window_role and transient_for. + , node_urgent :: !Bool -- ^ Whether this container (window, split container, floating container or workspace) has the urgency hint set, directly or indirectly. All parent containers up until the workspace container will be marked urgent if they have at least one urgent child. + , node_focused :: !Bool -- ^ Whether this container is currently focused. + , node_focus :: !(Vector Int64) -- ^ List of child node IDs (see nodes, floating_nodes and id) in focus order. Traversing the tree by following the first entry in this array will result in eventually reaching the one node with focused set to true. + , node_sticky :: !Bool+ , node_floating_nodes :: !(Vector Node) -- ^ The floating child containers of this node. Only non-empty on nodes with type workspace. + , node_nodes :: !(Vector Node) -- ^ The tiling (i.e. non-floating) child containers of this node. +} deriving (Eq, Generic, Show)++data NodeOrientation =+ Horizontal+ | Vertical+ | OrientNone+ deriving (Eq, Generic, Show)++instance FromJSON NodeOrientation where+ parseJSON (String s) = pure $! case s of+ "none" -> OrientNone+ "horizontal" -> Horizontal+ "vertical" -> Vertical+ _ -> error "Unrecognized NodeOrientation"+ parseJSON _ = mzero++instance ToJSON NodeOrientation where+ toEncoding = \case+ OrientNone -> text "none"+ Vertical -> text "vertical"+ Horizontal -> text "horizontal"++instance ToJSON Node where+ toEncoding =+ genericToEncoding defaultOptions { fieldLabelModifier = drop 5 }++instance FromJSON Node where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 5 }++data WindowProperty =+ Title+ | Instance+ | Class+ | WindowRole+ | TransientFor+ deriving (Eq, Enum, Ord, Generic, Show)++instance FromJSONKey WindowProperty where+ fromJSONKey = FromJSONKeyText f+ where+ f x = case x of+ "title" -> Title+ "instance" -> Instance+ "class" -> Class+ "window_role" -> WindowRole+ "transient_for" -> TransientFor+ _ -> error "Unrecognized window property"++instance ToJSONKey WindowProperty where+ toJSONKey = ToJSONKeyText f g+ where+ f x = case x of+ Title -> "title"+ Instance -> "instance"+ Class -> "class"+ WindowRole -> "window_role"+ TransientFor -> "transient_for"+ g x = case x of+ Title -> text "title"+ Instance -> text "instance"+ Class -> text "class"+ WindowRole -> text "window_role"+ TransientFor -> text "transient_for"++instance FromJSON WindowProperty where+ parseJSON (String s) = pure $! case s of+ "title" -> Title+ "instance" -> Instance+ "class" -> Class+ "window_role" -> WindowRole+ "transient_for" -> TransientFor+ _ -> error "Unrecognized WindowProperty variant found"+ parseJSON _ = mzero+++instance ToJSON WindowProperty where+ toEncoding = \case+ Title -> text "title"+ Instance -> text "instance"+ Class -> text "class"+ WindowRole -> text "window_role"+ TransientFor -> text "transient_for"++-- | Marks Reply+-- The reply consists of a single array of strings for each container that has a mark. A mark can only be set on one container, so the array is unique. The order of that array is undefined.+-- If no window has a mark the response will be the empty array [].+data MarksReply = MarksReply !(Vector Text) deriving (Eq, Generic, Show, FromJSON)++instance ToJSON MarksReply where+ toEncoding = genericToEncoding defaultOptions++data NodeBorder =+ Normal+ | None+ | Pixel+ deriving (Eq, Generic, Show)++instance ToJSON NodeBorder where+ toEncoding = \case+ Normal -> text "normal"+ None -> text "none"+ Pixel -> text "pixel"++instance FromJSON NodeBorder where+ parseJSON (String s) = pure $! case s of+ "normal" -> Normal+ "none" -> None+ "pixel" -> Pixel+ _ -> error "Unrecognized NodeBorder found"+ parseJSON _ = mzero++data Rect = Rect {+ x :: !Int32+ , y :: !Int32+ , width :: !Int32+ , height :: !Int32+} deriving (Eq, Generic, Show, FromJSON)++instance ToJSON Rect where+ toEncoding = genericToEncoding defaultOptions++data NodeType =+ RootType+ | OutputType+ | ConType+ | FloatingConType+ | WorkspaceType+ | DockAreaType+ deriving (Eq, Generic, Show)++instance ToJSON NodeType where+ toEncoding = \case+ RootType -> text "root"+ OutputType -> text "output"+ ConType -> text "con"+ FloatingConType -> text "floating_con"+ WorkspaceType -> text "workspace"+ DockAreaType -> text "dockarea"++instance FromJSON NodeType where+ parseJSON (String s) = pure $! case s of+ "root" -> RootType+ "output" -> OutputType+ "con" -> ConType+ "floating_con" -> FloatingConType+ "workspace" -> WorkspaceType+ "dockarea" -> DockAreaType+ _ -> error "Received unrecognized NodeType"+ parseJSON _ = mzero++data NodeLayout =+ SplitHorizontalLayout+ | SplitVerticalLayout+ | StackedLayout+ | TabbedLayout+ | DockAreaLayout+ | OutputLayout+ deriving (Eq, Generic, Show)++instance ToJSON NodeLayout where+ toEncoding = \case+ SplitHorizontalLayout -> text "splith"+ SplitVerticalLayout -> text "splitv"+ StackedLayout -> text "stacked"+ TabbedLayout -> text "tabbed"+ DockAreaLayout -> text "dockarea"+ OutputLayout -> text "output"++instance FromJSON NodeLayout where+ parseJSON (String s) = pure $! case s of+ "splith" -> SplitHorizontalLayout+ "splitv" -> SplitVerticalLayout+ "stacked" -> StackedLayout+ "tabbed" -> TabbedLayout+ "dockarea" -> DockAreaLayout+ "output" -> OutputLayout+ _ -> error "Received unrecognized NodeLayout"+ parseJSON _ = mzero++-- | BarConfig Reply+-- This can be used by third-party workspace bars (especially i3bar, but others are free to implement compatible alternatives) to get the bar block configuration from i3.+data BarIds = BarIds !(Vector Text) deriving (Eq, Generic, Show)++instance ToJSON BarIds where+ toEncoding = genericToEncoding defaultOptions++instance FromJSON BarIds where+ parseJSON = genericParseJSON defaultOptions++data BarConfigReply = BarConfigReply {+ bar_id :: !Text+ , bar_mode :: !Text+ , bar_position :: !Text+ , bar_status_command :: !Text+ , bar_font :: !Text+ , bar_workspace_buttons :: !Bool+ , bar_binding_mode_indicator :: !Bool+ , bar_verbose :: !Bool+ , bar_colors :: !(Map BarPart Text)+} deriving (Eq, Generic, Show)++instance ToJSON BarConfigReply where+ toEncoding =+ genericToEncoding defaultOptions { fieldLabelModifier = drop 4 }++instance FromJSON BarConfigReply where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 4 }++data BarPart =+ Background+ | Statusline+ | Separator+ | FocusedBackground+ | FocusedStatusline+ | FocusedSeparator+ | FocusedWorkspaceText+ | FocusedWorkspaceBg+ | FocusedWorkspaceBorder+ | ActiveWorkspaceText+ | ActiveWorkspaceBg+ | ActiveWorkspaceBorder+ | InactiveWorkspaceText+ | InactiveWorkspaceBg+ | InactiveWorkspaceBorder+ | UrgentWorkspaceText+ | UrgentWorkspaceBg+ | UrgentWorkspaceBorder+ | BindingModeText+ | BindingModeBg+ | BindingModeBorder+ deriving (Eq, Enum, Ord, Generic, Show, FromJSONKey)++instance ToJSONKey BarPart where+ toJSONKey = ToJSONKeyText f g+ where+ f x = case x of+ Background -> "background"+ Statusline -> "statusline"+ Separator -> "separator"+ FocusedBackground -> "focused_background"+ FocusedStatusline -> "focused_statusline"+ FocusedSeparator -> "focused_separator"+ FocusedWorkspaceText -> "focused_workspace_text"+ FocusedWorkspaceBg -> "focused_workspace_bg"+ FocusedWorkspaceBorder -> "focused_workspace_border"+ ActiveWorkspaceText -> "active_workspace_text"+ ActiveWorkspaceBg -> "active_workspace_bg"+ ActiveWorkspaceBorder -> "active_workspace_border"+ InactiveWorkspaceText -> "inactive_workspace_text"+ InactiveWorkspaceBg -> "inactive_workspace_bg"+ InactiveWorkspaceBorder -> "inactive_workspace_border"+ UrgentWorkspaceText -> "urgent_workspace_text"+ UrgentWorkspaceBg -> "urgent_workspace_bg"+ UrgentWorkspaceBorder -> "urgent_workspace_border"+ BindingModeText -> "binding_mode_text"+ BindingModeBg -> "binding_mode_bg"+ BindingModeBorder -> "binding_mode_border"+ g x = case x of+ Background -> text "background"+ Statusline -> text "statusline"+ Separator -> text "separator"+ FocusedBackground -> text "focused_background"+ FocusedStatusline -> text "focused_statusline"+ FocusedSeparator -> text "focused_separator"+ FocusedWorkspaceText -> text "focused_workspace_text"+ FocusedWorkspaceBg -> text "focused_workspace_bg"+ FocusedWorkspaceBorder -> text "focused_workspace_border"+ ActiveWorkspaceText -> text "active_workspace_text"+ ActiveWorkspaceBg -> text "active_workspace_bg"+ ActiveWorkspaceBorder -> text "active_workspace_border"+ InactiveWorkspaceText -> text "inactive_workspace_text"+ InactiveWorkspaceBg -> text "inactive_workspace_bg"+ InactiveWorkspaceBorder -> text "inactive_workspace_border"+ UrgentWorkspaceText -> text "urgent_workspace_text"+ UrgentWorkspaceBg -> text "urgent_workspace_bg"+ UrgentWorkspaceBorder -> text "urgent_workspace_border"+ BindingModeText -> text "binding_mode_text"+ BindingModeBg -> text "binding_mode_bg"+ BindingModeBorder -> text "binding_mode_border"++instance FromJSON BarPart where+ parseJSON (String s) = pure $! case s of+ "background" -> Background+ "statusline" -> Statusline+ "separator" -> Separator+ "focused_background" -> FocusedBackground+ "focused_statusline" -> FocusedStatusline+ "focused_separator" -> FocusedSeparator+ "focused_workspace_text" -> FocusedWorkspaceText+ "focused_workspace_bg" -> FocusedWorkspaceBg+ "focused_workspace_border" -> FocusedWorkspaceBorder+ "active_workspace_text" -> ActiveWorkspaceText+ "active_workspace_bg" -> ActiveWorkspaceBg+ "active_workspace_border" -> ActiveWorkspaceBorder+ "inactive_workspace_text" -> InactiveWorkspaceText+ "inactive_workspace_bg" -> InactiveWorkspaceBg+ "inactive_workspace_border" -> InactiveWorkspaceBorder+ "urgent_workspace_text" -> UrgentWorkspaceText+ "urgent_workspace_bg" -> UrgentWorkspaceBg+ "urgent_workspace_border" -> UrgentWorkspaceBorder+ "binding_mode_text" -> BindingModeText+ "binding_mode_bg" -> BindingModeBg+ "binding_mode_border" -> BindingModeBorder+ _ -> error "Unrecognized BarPart variant found"+ parseJSON _ = mzero++instance ToJSON BarPart where+ toEncoding = \case+ Background -> text "background"+ Statusline -> text "statusline"+ Separator -> text "separator"+ FocusedBackground -> text "focused_background"+ FocusedStatusline -> text "focused_statusline"+ FocusedSeparator -> text "focused_separator"+ FocusedWorkspaceText -> text "focused_workspace_text"+ FocusedWorkspaceBg -> text "focused_workspace_bg"+ FocusedWorkspaceBorder -> text "focused_workspace_border"+ ActiveWorkspaceText -> text "active_workspace_text"+ ActiveWorkspaceBg -> text "active_workspace_bg"+ ActiveWorkspaceBorder -> text "active_workspace_border"+ InactiveWorkspaceText -> text "inactive_workspace_text"+ InactiveWorkspaceBg -> text "inactive_workspace_bg"+ InactiveWorkspaceBorder -> text "inactive_workspace_border"+ UrgentWorkspaceText -> text "urgent_workspace_text"+ UrgentWorkspaceBg -> text "urgent_workspace_bg"+ UrgentWorkspaceBorder -> text "urgent_workspace_border"+ BindingModeText -> text "binding_mode_text"+ BindingModeBg -> text "binding_mode_bg"+ BindingModeBorder -> text "binding_mode_border"++-- | Version Reply+data VersionReply = VersionReply {+ v_major :: !Int32+ , v_minor :: !Int32+ , v_patch :: !Int32+ , v_human_readable :: !Text+ , v_loaded_config_file_name :: !Text+} deriving (Eq, Generic, Show)++instance ToJSON VersionReply where+ toEncoding =+ genericToEncoding defaultOptions { fieldLabelModifier = drop 2 }++instance FromJSON VersionReply where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }++-- | BindingModes Reply+-- The reply consists of an array of all currently configured binding modes.+data BindingModesReply = BindingModesReply !(Vector Text) deriving (Eq, Generic, Show)++instance ToJSON BindingModesReply where+ toEncoding = genericToEncoding defaultOptions++instance FromJSON BindingModesReply where+ parseJSON = genericParseJSON defaultOptions++-- | Config Reply+-- The config reply is a map which currently only contains the "config" member, which is a string containing the config file as loaded by i3 most recently.+data ConfigReply = ConfigReply {+ c_config :: !Text+} deriving (Eq, Generic, Show)+++instance ToJSON ConfigReply where+ toEncoding =+ genericToEncoding defaultOptions { fieldLabelModifier = drop 2 }++instance FromJSON ConfigReply where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }
+ src/I3IPC/Subscribe.hs view
@@ -0,0 +1,43 @@+{-|+Describes the different kinds of events one can subscribe to.+-}+module I3IPC.Subscribe+ ( Subscribe(..)+ )+where++import GHC.Generics+import Data.Aeson+import Data.Aeson.Encoding ( text )+++-- | Subscribe from i3 have the following types (https://i3wm.org/docs/ipc.html#_events)+data Subscribe =+ -- | Sent when the user switches to a different workspace, when a new workspace is initialized or when a workspace is removed (because the last client vanished). + Workspace+ -- | Sent when RandR issues a change notification (of either screens, outputs, CRTCs or output properties). + | Output+ -- | Sent whenever i3 changes its binding mode. + | Mode+ -- | Sent when a client’s window is successfully reparented (that is when i3 has finished fitting it into a container), when a window received input focus or when certain properties of the window have changed. + | Window+ -- | Sent when the hidden_state or mode field in the barconfig of any bar instance was updated and when the config is reloaded. + | BarConfigUpdate+ -- | Sent when a configured command binding is triggered with the keyboard or mouse + | Binding+ -- | Sent when the ipc shuts down because of a restart or exit by user command + | Shutdown+ -- | Sent when the ipc client subscribes to the tick event (with "first": true) or when any ipc client sends a SEND_TICK message (with "first": false). + | Tick+ deriving (Enum, Eq, Generic, Show)++instance ToJSON Subscribe where+ toEncoding = \case+ Workspace -> text "workspace"+ Output -> text "output"+ Mode -> text "mode"+ Window -> text "window"+ BarConfigUpdate -> text "barconfig_update"+ Binding -> text "binding"+ Shutdown -> text "shutdown"+ Tick -> text "tick"
+ test/Spec.hs view
@@ -0,0 +1,36 @@+import Test.Hspec+import qualified Data.ByteString.Lazy as BL+import Data.Aeson ( decode )+import Data.Maybe ( isJust )++import qualified I3IPC.Event as Evt+import qualified I3IPC.Reply as Reply++main :: IO ()+main = hspec $ do+ describe "Events" $ do+ it "Deserialize WindowEvent" $ do+ f <- BL.readFile "./test/event/winevent.json"+ let w = decode f :: Maybe Evt.WindowEvent+ isJust w `shouldBe` True+ it "Deserialize WorkspaceEvent" $ do+ f <- BL.readFile "./test/event/workspace.json"+ let w = decode f :: Maybe Evt.WorkspaceEvent+ isJust w `shouldBe` True+ describe "Replies" $ do + it "Deserialise OutputReply" $ do + f <- BL.readFile "./test/reply/output.json"+ let o = decode f :: Maybe Reply.OutputsReply+ isJust o `shouldBe` True+ it "Deserialise TreeReply" $ do + f <- BL.readFile "./test/reply/tree.json"+ let o = decode f :: Maybe Reply.Node+ isJust o `shouldBe` True+ it "Deserialise VersionReply" $ do + f <- BL.readFile "./test/reply/version.json"+ let o = decode f :: Maybe Reply.VersionReply+ isJust o `shouldBe` True+ it "Deserialise WorkspaceReply" $ do + f <- BL.readFile "./test/reply/workspace.json"+ let o = decode f :: Maybe Reply.WorkspaceReply+ isJust o `shouldBe` True