-----------------------------------------------------------------------------
-- |
-- Module      :  Xmobar.Config
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- The configuration types
--
-----------------------------------------------------------------------------

module Xmobar.Config.Types
    ( -- * Configuration
      -- $config
      Config (..)
    , XPosition (..), Align (..), Border (..), TextOutputFormat (..)
    , SignalChan (..)
    ) where

import qualified Control.Concurrent.STM as STM
import Xmobar.Run.Runnable (Runnable(..))
import Xmobar.System.Signal (SignalType)

-- $config
-- Configuration data type

-- | The configuration data type
data Config =
    Config { Config -> String
font :: String         -- ^ Font
           , Config -> [String]
additionalFonts :: [String] -- ^ List of alternative fonts
           , Config -> String
wmClass :: String      -- ^ X11 WM_CLASS property value
           , Config -> String
wmName :: String       -- ^ X11 WM_NAME property value
           , Config -> String
bgColor :: String      -- ^ Backgroud color
           , Config -> String
fgColor :: String      -- ^ Default font color
           , Config -> XPosition
position :: XPosition  -- ^ Top Bottom or Static
           , Config -> Bool
textOutput :: Bool     -- ^ Write data to stdout instead of X
           , Config -> TextOutputFormat
textOutputFormat :: TextOutputFormat -- ^ Which color format to use for stdout: Ansi or Pango
           , Config -> Int
textOffset :: Int      -- ^ Offset from top of window for text
           , Config -> [Int]
textOffsets :: [Int]   -- ^ List of offsets for additionalFonts
           , Config -> Int
iconOffset :: Int      -- ^ Offset from top of window for icons
           , Config -> Border
border :: Border       -- ^ NoBorder TopB BottomB or FullB
           , Config -> String
borderColor :: String  -- ^ Border color
           , Config -> Int
borderWidth :: Int     -- ^ Border width
           , Config -> Int
alpha :: Int           -- ^ Transparency from 0 (transparent)
                                    --   to 255 (opaque)
           , Config -> Bool
hideOnStart :: Bool    -- ^ Hide (Unmap) the window on
                                    --   initialization
           , Config -> Bool
allDesktops :: Bool    -- ^ Tell the WM to map to all desktops
           , Config -> Bool
overrideRedirect :: Bool -- ^ Needed for dock behaviour in some
                                      --   non-tiling WMs
           , Config -> Bool
pickBroadest :: Bool   -- ^ Use the broadest display
                                    --   instead of the first one by
                                    --   default
           , Config -> Bool
lowerOnStart :: Bool   -- ^ lower to the bottom of the
                                    --   window stack on initialization
           , Config -> Bool
persistent :: Bool     -- ^ Whether automatic hiding should
                                    --   be enabled or disabled
           , Config -> String
iconRoot :: FilePath   -- ^ Root folder for icons
           , Config -> [Runnable]
commands :: [Runnable] -- ^ For setting the command,
                                    --   the command arguments
                                    --   and refresh rate for the programs
                                    --   to run (optional)
           , Config -> String
sepChar :: String      -- ^ The character to be used for indicating
                                    --   commands in the output template
                                    --   (default '%')
           , Config -> String
alignSep :: String     -- ^ Separators for left, center and
                                    --   right text alignment
           , Config -> String
template :: String     -- ^ The output template
           , Config -> Bool
verbose :: Bool        -- ^ Emit additional debug messages
           , Config -> SignalChan
signal :: SignalChan   -- ^ The signal channel used to send signals to xmobar
           } deriving (ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
(Int -> ReadS Config)
-> ReadS [Config]
-> ReadPrec Config
-> ReadPrec [Config]
-> Read Config
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Config]
$creadListPrec :: ReadPrec [Config]
readPrec :: ReadPrec Config
$creadPrec :: ReadPrec Config
readList :: ReadS [Config]
$creadList :: ReadS [Config]
readsPrec :: Int -> ReadS Config
$creadsPrec :: Int -> ReadS Config
Read, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

data XPosition = Top
               | TopH Int
               | TopW Align Int
               | TopSize Align Int Int
               | TopP Int Int
               | Bottom
               | BottomH Int
               | BottomP Int Int
               | BottomW Align Int
               | BottomSize Align Int Int
               | Static {XPosition -> Int
xpos, XPosition -> Int
ypos, XPosition -> Int
width, XPosition -> Int
height :: Int}
               | OnScreen Int XPosition
                 deriving ( ReadPrec [XPosition]
ReadPrec XPosition
Int -> ReadS XPosition
ReadS [XPosition]
(Int -> ReadS XPosition)
-> ReadS [XPosition]
-> ReadPrec XPosition
-> ReadPrec [XPosition]
-> Read XPosition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XPosition]
$creadListPrec :: ReadPrec [XPosition]
readPrec :: ReadPrec XPosition
$creadPrec :: ReadPrec XPosition
readList :: ReadS [XPosition]
$creadList :: ReadS [XPosition]
readsPrec :: Int -> ReadS XPosition
$creadsPrec :: Int -> ReadS XPosition
Read, Int -> XPosition -> ShowS
[XPosition] -> ShowS
XPosition -> String
(Int -> XPosition -> ShowS)
-> (XPosition -> String)
-> ([XPosition] -> ShowS)
-> Show XPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPosition] -> ShowS
$cshowList :: [XPosition] -> ShowS
show :: XPosition -> String
$cshow :: XPosition -> String
showsPrec :: Int -> XPosition -> ShowS
$cshowsPrec :: Int -> XPosition -> ShowS
Show, XPosition -> XPosition -> Bool
(XPosition -> XPosition -> Bool)
-> (XPosition -> XPosition -> Bool) -> Eq XPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPosition -> XPosition -> Bool
$c/= :: XPosition -> XPosition -> Bool
== :: XPosition -> XPosition -> Bool
$c== :: XPosition -> XPosition -> Bool
Eq )

data Align = L | R | C deriving ( ReadPrec [Align]
ReadPrec Align
Int -> ReadS Align
ReadS [Align]
(Int -> ReadS Align)
-> ReadS [Align]
-> ReadPrec Align
-> ReadPrec [Align]
-> Read Align
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Align]
$creadListPrec :: ReadPrec [Align]
readPrec :: ReadPrec Align
$creadPrec :: ReadPrec Align
readList :: ReadS [Align]
$creadList :: ReadS [Align]
readsPrec :: Int -> ReadS Align
$creadsPrec :: Int -> ReadS Align
Read, Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
(Int -> Align -> ShowS)
-> (Align -> String) -> ([Align] -> ShowS) -> Show Align
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Align] -> ShowS
$cshowList :: [Align] -> ShowS
show :: Align -> String
$cshow :: Align -> String
showsPrec :: Int -> Align -> ShowS
$cshowsPrec :: Int -> Align -> ShowS
Show, Align -> Align -> Bool
(Align -> Align -> Bool) -> (Align -> Align -> Bool) -> Eq Align
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Align -> Align -> Bool
$c/= :: Align -> Align -> Bool
== :: Align -> Align -> Bool
$c== :: Align -> Align -> Bool
Eq )

data Border = NoBorder
            | TopB
            | BottomB
            | FullB
            | TopBM Int
            | BottomBM Int
            | FullBM Int
              deriving ( ReadPrec [Border]
ReadPrec Border
Int -> ReadS Border
ReadS [Border]
(Int -> ReadS Border)
-> ReadS [Border]
-> ReadPrec Border
-> ReadPrec [Border]
-> Read Border
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Border]
$creadListPrec :: ReadPrec [Border]
readPrec :: ReadPrec Border
$creadPrec :: ReadPrec Border
readList :: ReadS [Border]
$creadList :: ReadS [Border]
readsPrec :: Int -> ReadS Border
$creadsPrec :: Int -> ReadS Border
Read, Int -> Border -> ShowS
[Border] -> ShowS
Border -> String
(Int -> Border -> ShowS)
-> (Border -> String) -> ([Border] -> ShowS) -> Show Border
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Border] -> ShowS
$cshowList :: [Border] -> ShowS
show :: Border -> String
$cshow :: Border -> String
showsPrec :: Int -> Border -> ShowS
$cshowsPrec :: Int -> Border -> ShowS
Show, Border -> Border -> Bool
(Border -> Border -> Bool)
-> (Border -> Border -> Bool) -> Eq Border
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Border -> Border -> Bool
$c/= :: Border -> Border -> Bool
== :: Border -> Border -> Bool
$c== :: Border -> Border -> Bool
Eq )

data TextOutputFormat = Plain | Ansi | Pango | Swaybar deriving (ReadPrec [TextOutputFormat]
ReadPrec TextOutputFormat
Int -> ReadS TextOutputFormat
ReadS [TextOutputFormat]
(Int -> ReadS TextOutputFormat)
-> ReadS [TextOutputFormat]
-> ReadPrec TextOutputFormat
-> ReadPrec [TextOutputFormat]
-> Read TextOutputFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextOutputFormat]
$creadListPrec :: ReadPrec [TextOutputFormat]
readPrec :: ReadPrec TextOutputFormat
$creadPrec :: ReadPrec TextOutputFormat
readList :: ReadS [TextOutputFormat]
$creadList :: ReadS [TextOutputFormat]
readsPrec :: Int -> ReadS TextOutputFormat
$creadsPrec :: Int -> ReadS TextOutputFormat
Read, Int -> TextOutputFormat -> ShowS
[TextOutputFormat] -> ShowS
TextOutputFormat -> String
(Int -> TextOutputFormat -> ShowS)
-> (TextOutputFormat -> String)
-> ([TextOutputFormat] -> ShowS)
-> Show TextOutputFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextOutputFormat] -> ShowS
$cshowList :: [TextOutputFormat] -> ShowS
show :: TextOutputFormat -> String
$cshow :: TextOutputFormat -> String
showsPrec :: Int -> TextOutputFormat -> ShowS
$cshowsPrec :: Int -> TextOutputFormat -> ShowS
Show, TextOutputFormat -> TextOutputFormat -> Bool
(TextOutputFormat -> TextOutputFormat -> Bool)
-> (TextOutputFormat -> TextOutputFormat -> Bool)
-> Eq TextOutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextOutputFormat -> TextOutputFormat -> Bool
$c/= :: TextOutputFormat -> TextOutputFormat -> Bool
== :: TextOutputFormat -> TextOutputFormat -> Bool
$c== :: TextOutputFormat -> TextOutputFormat -> Bool
Eq)

newtype SignalChan = SignalChan { SignalChan -> Maybe (TMVar SignalType)
unSignalChan :: Maybe (STM.TMVar SignalType) }

instance Read SignalChan where
  readsPrec :: Int -> ReadS SignalChan
readsPrec Int
_ String
_ = ReadS SignalChan
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SignalChan is not readable from a String"

instance Show SignalChan where
  show :: SignalChan -> String
show (SignalChan (Just TMVar SignalType
_)) = String
"SignalChan (Just <tmvar>)"
  show (SignalChan Maybe (TMVar SignalType)
Nothing) = String
"SignalChan Nothing"