-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.HandleReader
-- Copyright   :  (c) Pavan Rikhi
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Pavan Rikhi <pavan.rikhi@gmail.com>
-- Stability   :  unstable
-- Portability :  portable
--
-- A plugin for reading from 'Handle's
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.HandleReader
    ( HandleReader(..)
    )
where

import           System.IO                      ( Handle
                                                , hIsEOF
                                                , hGetLine
                                                )

import           Xmobar.Run.Exec                ( Exec(..) )


-- | A HandleReader displays any text received from a Handle.
--
-- This is only useful if you are running @xmobar@ from other Haskell code.
-- You can create a pair of @(read, write)@ 'Handle's using
-- 'System.Process.createPipe'. Pass the @read@ 'Handle' to HandleReader
-- and write your desired output to the @write@ 'Handle'.
--
-- @
--  (readHandle, writeHandle) <- 'System.Process.createPipe'
--  xmobarProcess <- 'System.Posix.Process.forkProcess' $ 'Xmobar.xmobar' myConfig
--          { commands =
--              'Xmobar.Run' ('HandleReader' readHandle "handle") : 'Xmobar.commands' myConfig
--          }
--  'System.IO.hPutStr' writeHandle "Hello World"
-- @
data HandleReader
    = HandleReader
        Handle
        -- ^ The Handle to read from.
        String
        -- ^ Alias for the HandleReader
    deriving (Int -> HandleReader -> ShowS
[HandleReader] -> ShowS
HandleReader -> String
(Int -> HandleReader -> ShowS)
-> (HandleReader -> String)
-> ([HandleReader] -> ShowS)
-> Show HandleReader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandleReader] -> ShowS
$cshowList :: [HandleReader] -> ShowS
show :: HandleReader -> String
$cshow :: HandleReader -> String
showsPrec :: Int -> HandleReader -> ShowS
$cshowsPrec :: Int -> HandleReader -> ShowS
Show)

-- | WARNING: This Read instance will throw an exception if used! It is
-- only implemented because it is required to use HandleReader with
-- 'Xmobar.Run' in 'Xmobar.commands'.
instance Read HandleReader where
    -- | Throws an 'error'!
    readsPrec :: Int -> ReadS HandleReader
readsPrec = String -> Int -> ReadS HandleReader
forall a. HasCallStack => String -> a
error String
"HandleReader: Read instance is stub"

-- | Asynchronously read from the 'Handle'.
instance Exec HandleReader where
    -- | Read from the 'Handle' until it is closed.
    start :: HandleReader -> (String -> IO ()) -> IO ()
start (HandleReader Handle
handle String
_) String -> IO ()
cb =
        IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
untilM (Handle -> IO Bool
hIsEOF Handle
handle) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO String
hGetLine Handle
handle IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
cb
    -- | Use the 2nd argument to HandleReader as its alias.
    alias :: HandleReader -> String
alias (HandleReader Handle
_ String
a) = String
a

-- Loop the action until predicateM returns True.
untilM :: Monad m => m Bool -> m () -> m ()
untilM :: m Bool -> m () -> m ()
untilM m Bool
predicateM m ()
action = do
    Bool
predicate <- m Bool
predicateM
    if Bool
predicate then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else m ()
action m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
untilM m Bool
predicateM m ()
action