-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.SpawnNamedPipe
-- Description :  A module for spawning a pipe whose handle lives in the XMonad state.
-- Copyright   :  (c) Christian Wills 2014
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  cwills.dev@gmail.com
-- Stability   :  unstable
-- Portability :  not portable
--
-- A module for spawning a pipe whose "Handle" lives in the Xmonad state.
--
-----------------------------------------------------------------------------

module XMonad.Util.SpawnNamedPipe (
  -- * Usage
  -- $usage
    spawnNamedPipe
  , getNamedPipe
  ) where

import XMonad
import XMonad.Util.Run
import System.IO
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Prelude
import qualified Data.Map as Map

-- $usage
-- This module makes it possible to spawn a pipe to Dzen2 in the startupHook
-- and write to it from inside the logHook without the need for global
-- variables.
--
-- > import XMonad.Util.SpawnNamedPipe
-- > import Data.Maybe
-- >
-- > -- StartupHook
-- > startupHook' = spawnNamedPipe "dzen2" "dzenPipe"
-- >
-- > -- LogHook
-- > logHook' = do
-- >     mh <- getNamedPipeHandle "dzenPipe"
-- >         dynamicLogWithPP $ def {
-- >             ppOutput = maybe (\s -> return ()) (hPutStrLn) mh}
-- >
-- > -- Main
-- > main = xmonad $ def { startupHook = startupHook'
-- >                     , logHook = logHook'}
--

newtype NamedPipes = NamedPipes { NamedPipes -> Map String Handle
pipeMap :: Map.Map String Handle }
    deriving (Int -> NamedPipes -> ShowS
[NamedPipes] -> ShowS
NamedPipes -> String
(Int -> NamedPipes -> ShowS)
-> (NamedPipes -> String)
-> ([NamedPipes] -> ShowS)
-> Show NamedPipes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NamedPipes] -> ShowS
$cshowList :: [NamedPipes] -> ShowS
show :: NamedPipes -> String
$cshow :: NamedPipes -> String
showsPrec :: Int -> NamedPipes -> ShowS
$cshowsPrec :: Int -> NamedPipes -> ShowS
Show)

instance ExtensionClass NamedPipes where
    initialValue :: NamedPipes
initialValue = Map String Handle -> NamedPipes
NamedPipes Map String Handle
forall k a. Map k a
Map.empty

-- | When 'spawnNamedPipe' is executed with a command "String" and a name
-- "String" respectively.  The command string is spawned with 'spawnPipe' (as
-- long as the name chosen hasn't been used already) and the "Handle" returned
-- is saved in Xmonad's state associated with the name "String".
spawnNamedPipe :: String -> String -> X ()
spawnNamedPipe :: String -> String -> X ()
spawnNamedPipe String
cmd String
name = do
  Bool
b <- (NamedPipes -> Bool) -> X Bool
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets (String -> Map String Handle -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member String
name (Map String Handle -> Bool)
-> (NamedPipes -> Map String Handle) -> NamedPipes -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedPipes -> Map String Handle
pipeMap)
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Handle
h <- String -> X Handle
forall (m :: * -> *). MonadIO m => String -> m Handle
spawnPipe String
cmd
    (NamedPipes -> NamedPipes) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (Map String Handle -> NamedPipes
NamedPipes (Map String Handle -> NamedPipes)
-> (NamedPipes -> Map String Handle) -> NamedPipes -> NamedPipes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Handle -> Map String Handle -> Map String Handle
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name Handle
h (Map String Handle -> Map String Handle)
-> (NamedPipes -> Map String Handle)
-> NamedPipes
-> Map String Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedPipes -> Map String Handle
pipeMap)

-- | Attempts to retrieve a "Handle" to a pipe previously stored in Xmonad's
-- state associated with the given string via a call to 'spawnNamedPipe'. If the
-- given string doesn't exist in the map stored in Xmonad's state Nothing is
-- returned.
getNamedPipe :: String -> X (Maybe Handle)
getNamedPipe :: String -> X (Maybe Handle)
getNamedPipe String
name = (NamedPipes -> Maybe Handle) -> X (Maybe Handle)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets (String -> Map String Handle -> Maybe Handle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name (Map String Handle -> Maybe Handle)
-> (NamedPipes -> Map String Handle) -> NamedPipes -> Maybe Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedPipes -> Map String Handle
pipeMap)