{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Xmobar.Runnable
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- The existential type to store the list of commands to be executed.
-- I must thank Claus Reinke for the help in understanding the mysteries of
-- reading existential types. The Read instance of Runnable must be credited to
-- him.
--
-- See here:
-- http:\/\/www.haskell.org\/pipermail\/haskell-cafe\/2007-July\/028227.html
--
-----------------------------------------------------------------------------

module Xmobar.Run.Runnable where

import Control.Monad
import Text.Read
import Xmobar.Run.Types (runnableTypes)
import Xmobar.Run.Exec

data Runnable = forall r . (Exec r, Read r, Show r) => Run r

instance Exec Runnable where
     start :: Runnable -> (String -> IO ()) -> IO ()
start   (Run r
a) = r -> (String -> IO ()) -> IO ()
forall e. Exec e => e -> (String -> IO ()) -> IO ()
start   r
a
     alias :: Runnable -> String
alias   (Run r
a) = r -> String
forall e. Exec e => e -> String
alias   r
a
     trigger :: Runnable -> (Maybe SignalType -> IO ()) -> IO ()
trigger (Run r
a) = r -> (Maybe SignalType -> IO ()) -> IO ()
forall e. Exec e => e -> (Maybe SignalType -> IO ()) -> IO ()
trigger r
a

instance Show Runnable where
    show :: Runnable -> String
show (Run r
x) = String
"Run " String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> String
forall a. Show a => a -> String
show r
x

instance Read Runnable where
    readPrec :: ReadPrec Runnable
readPrec = ReadPrec Runnable
readRunnable

class ReadAsAnyOf ts ex where
    -- | Reads an existential type as any of hidden types ts
    readAsAnyOf :: ts -> ReadPrec ex

instance ReadAsAnyOf () ex where
    readAsAnyOf :: () -> ReadPrec ex
readAsAnyOf ~() = ReadPrec ex
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance (Read t, Exec t, ReadAsAnyOf ts Runnable) => ReadAsAnyOf (t,ts) Runnable where
    readAsAnyOf :: (t, ts) -> ReadPrec Runnable
readAsAnyOf ~(t
t,ts
ts) = t -> ReadPrec Runnable
forall r. (Read r, Exec r) => r -> ReadPrec Runnable
r t
t ReadPrec Runnable -> ReadPrec Runnable -> ReadPrec Runnable
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ts -> ReadPrec Runnable
forall ts ex. ReadAsAnyOf ts ex => ts -> ReadPrec ex
readAsAnyOf ts
ts
              where r :: r -> ReadPrec Runnable
r r
ty = do { r
m <- ReadPrec r
forall a. Read a => ReadPrec a
readPrec; Runnable -> ReadPrec Runnable
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Runnable
forall r. (Exec r, Read r, Show r) => r -> Runnable
Run (r
m r -> r -> r
forall a. a -> a -> a
`asTypeOf` r
ty)) }

-- | The 'Prelude.Read' parser for the 'Runnable' existential type. It
-- needs an 'Prelude.undefined' with a type signature containing the
-- list of all possible types hidden within 'Runnable'. See 'Config.runnableTypes'.
-- Each hidden type must have a 'Prelude.Read' instance.
readRunnable :: ReadPrec Runnable
readRunnable :: ReadPrec Runnable
readRunnable = Int -> ReadPrec Runnable -> ReadPrec Runnable
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec Runnable -> ReadPrec Runnable)
-> ReadPrec Runnable -> ReadPrec Runnable
forall a b. (a -> b) -> a -> b
$ do
                 Ident String
"Run" <- ReadPrec Lexeme
lexP
                 ReadPrec Runnable -> ReadPrec Runnable
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec Runnable -> ReadPrec Runnable)
-> ReadPrec Runnable -> ReadPrec Runnable
forall a b. (a -> b) -> a -> b
$ (Command
 :*: (Monitors
      :*: (Date
           :*: (PipeReader
                :*: (BufferedPipeReader
                     :*: (CommandReader
                          :*: (StdinReader
                               :*: (XMonadLog
                                    :*: (EWMH
                                         :*: (Kbd
                                              :*: (Locks
                                                   :*: (NotmuchMail
                                                        :*: (MarqueePipeReader :*: ())))))))))))))
-> ReadPrec Runnable
forall ts ex. ReadAsAnyOf ts ex => ts -> ReadPrec ex
readAsAnyOf Command
:*: (Monitors
     :*: (Date
          :*: (PipeReader
               :*: (BufferedPipeReader
                    :*: (CommandReader
                         :*: (StdinReader
                              :*: (XMonadLog
                                   :*: (EWMH
                                        :*: (Kbd
                                             :*: (Locks
                                                  :*: (NotmuchMail
                                                       :*: (MarqueePipeReader :*: ()))))))))))))
runnableTypes