{-#LANGUAGE RecordWildCards#-}

------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Plugins.Monitors.Types
-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Dec 02, 2018 04:31
--
--
-- Type definitions and constructors for Monitors
--
------------------------------------------------------------------------------


module Xmobar.Plugins.Monitors.Common.Types ( Monitor
                                            , MConfig (..)
                                            , Opts (..)
                                            , Selector
                                            , setConfigValue
                                            , mkMConfig
                                            , io
                                            , MonitorConfig (..)
                                            , getPConfigValue
                                            , getConfigValue
                                            , getMonitorConfig
                                            , PSelector
                                            , TemplateInput(..)
                                            ) where

import Control.Monad.Reader (ReaderT, ask, liftIO)
import Data.IORef (IORef, modifyIORef, newIORef, readIORef)


type Monitor a = ReaderT MConfig IO a

io :: IO a -> Monitor a
io :: IO a -> Monitor a
io = IO a -> Monitor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

data TemplateInput = TemplateInput {
      TemplateInput -> [String]
temMonitorValues :: [String],
      TemplateInput -> [(String, String, String)]
temInputTemplate :: [(String, String, String)],
      TemplateInput -> [(String, [(String, String, String)])]
temAllTemplate :: [(String, [(String, String, String)])]
    }

data MConfig =
    MC { MConfig -> IORef (Maybe String)
normalColor :: IORef (Maybe String)
       , MConfig -> IORef Int
low :: IORef Int
       , MConfig -> IORef (Maybe String)
lowColor :: IORef (Maybe String)
       , MConfig -> IORef Int
high :: IORef Int
       , MConfig -> IORef (Maybe String)
highColor :: IORef (Maybe String)
       , MConfig -> IORef String
template :: IORef String
       , MConfig -> IORef [String]
export :: IORef [String]
       , MConfig -> IORef Int
ppad :: IORef Int
       , MConfig -> IORef Int
decDigits :: IORef Int
       , MConfig -> IORef Int
minWidth :: IORef Int
       , MConfig -> IORef Int
maxWidth :: IORef Int
       , MConfig -> IORef String
maxWidthEllipsis :: IORef String
       , MConfig -> IORef String
padChars :: IORef String
       , MConfig -> IORef Bool
padRight :: IORef Bool
       , MConfig -> IORef String
barBack :: IORef String
       , MConfig -> IORef String
barFore :: IORef String
       , MConfig -> IORef Int
barWidth :: IORef Int
       , MConfig -> IORef Bool
useSuffix :: IORef Bool
       , MConfig -> IORef String
naString :: IORef String
       , MConfig -> IORef Int
maxTotalWidth :: IORef Int
       , MConfig -> IORef String
maxTotalWidthEllipsis :: IORef String
       }

data MonitorConfig =
  MonitorConfig
    { MonitorConfig -> Maybe String
pNormalColor :: Maybe String
    , MonitorConfig -> Int
pLow :: Int
    , MonitorConfig -> Maybe String
pLowColor :: Maybe String
    , MonitorConfig -> Int
pHigh :: Int
    , MonitorConfig -> Maybe String
pHighColor :: Maybe String
    , MonitorConfig -> String
pTemplate :: String
    , MonitorConfig -> [String]
pExport :: [String]
    , MonitorConfig -> Int
pPpad :: Int
    , MonitorConfig -> Int
pDecDigits :: Int
    , MonitorConfig -> Int
pMinWidth :: Int
    , MonitorConfig -> Int
pMaxWidth :: Int
    , MonitorConfig -> String
pMaxWidthEllipsis :: String
    , MonitorConfig -> String
pPadChars :: String
    , MonitorConfig -> Bool
pPadRight :: Bool
    , MonitorConfig -> String
pBarBack :: String
    , MonitorConfig -> String
pBarFore :: String
    , MonitorConfig -> Int
pBarWidth :: Int
    , MonitorConfig -> Bool
pUseSuffix :: Bool
    , MonitorConfig -> String
pNaString :: String
    , MonitorConfig -> Int
pMaxTotalWidth :: Int
    , MonitorConfig -> String
pMaxTotalWidthEllipsis :: String
    }
  deriving (MonitorConfig -> MonitorConfig -> Bool
(MonitorConfig -> MonitorConfig -> Bool)
-> (MonitorConfig -> MonitorConfig -> Bool) -> Eq MonitorConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorConfig -> MonitorConfig -> Bool
$c/= :: MonitorConfig -> MonitorConfig -> Bool
== :: MonitorConfig -> MonitorConfig -> Bool
$c== :: MonitorConfig -> MonitorConfig -> Bool
Eq, Eq MonitorConfig
Eq MonitorConfig
-> (MonitorConfig -> MonitorConfig -> Ordering)
-> (MonitorConfig -> MonitorConfig -> Bool)
-> (MonitorConfig -> MonitorConfig -> Bool)
-> (MonitorConfig -> MonitorConfig -> Bool)
-> (MonitorConfig -> MonitorConfig -> Bool)
-> (MonitorConfig -> MonitorConfig -> MonitorConfig)
-> (MonitorConfig -> MonitorConfig -> MonitorConfig)
-> Ord MonitorConfig
MonitorConfig -> MonitorConfig -> Bool
MonitorConfig -> MonitorConfig -> Ordering
MonitorConfig -> MonitorConfig -> MonitorConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MonitorConfig -> MonitorConfig -> MonitorConfig
$cmin :: MonitorConfig -> MonitorConfig -> MonitorConfig
max :: MonitorConfig -> MonitorConfig -> MonitorConfig
$cmax :: MonitorConfig -> MonitorConfig -> MonitorConfig
>= :: MonitorConfig -> MonitorConfig -> Bool
$c>= :: MonitorConfig -> MonitorConfig -> Bool
> :: MonitorConfig -> MonitorConfig -> Bool
$c> :: MonitorConfig -> MonitorConfig -> Bool
<= :: MonitorConfig -> MonitorConfig -> Bool
$c<= :: MonitorConfig -> MonitorConfig -> Bool
< :: MonitorConfig -> MonitorConfig -> Bool
$c< :: MonitorConfig -> MonitorConfig -> Bool
compare :: MonitorConfig -> MonitorConfig -> Ordering
$ccompare :: MonitorConfig -> MonitorConfig -> Ordering
$cp1Ord :: Eq MonitorConfig
Ord)

getMonitorConfig :: MConfig -> IO MonitorConfig
getMonitorConfig :: MConfig -> IO MonitorConfig
getMonitorConfig MC{IORef Bool
IORef Int
IORef String
IORef [String]
IORef (Maybe String)
maxTotalWidthEllipsis :: IORef String
maxTotalWidth :: IORef Int
naString :: IORef String
useSuffix :: IORef Bool
barWidth :: IORef Int
barFore :: IORef String
barBack :: IORef String
padRight :: IORef Bool
padChars :: IORef String
maxWidthEllipsis :: IORef String
maxWidth :: IORef Int
minWidth :: IORef Int
decDigits :: IORef Int
ppad :: IORef Int
export :: IORef [String]
template :: IORef String
highColor :: IORef (Maybe String)
high :: IORef Int
lowColor :: IORef (Maybe String)
low :: IORef Int
normalColor :: IORef (Maybe String)
maxTotalWidthEllipsis :: MConfig -> IORef String
maxTotalWidth :: MConfig -> IORef Int
naString :: MConfig -> IORef String
useSuffix :: MConfig -> IORef Bool
barWidth :: MConfig -> IORef Int
barFore :: MConfig -> IORef String
barBack :: MConfig -> IORef String
padRight :: MConfig -> IORef Bool
padChars :: MConfig -> IORef String
maxWidthEllipsis :: MConfig -> IORef String
maxWidth :: MConfig -> IORef Int
minWidth :: MConfig -> IORef Int
decDigits :: MConfig -> IORef Int
ppad :: MConfig -> IORef Int
export :: MConfig -> IORef [String]
template :: MConfig -> IORef String
highColor :: MConfig -> IORef (Maybe String)
high :: MConfig -> IORef Int
lowColor :: MConfig -> IORef (Maybe String)
low :: MConfig -> IORef Int
normalColor :: MConfig -> IORef (Maybe String)
..} = do
  Maybe String
pNormalColor <- IORef (Maybe String) -> IO (Maybe String)
forall a. IORef a -> IO a
readIORef IORef (Maybe String)
normalColor
  Int
pLow <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
low
  Maybe String
pLowColor <- IORef (Maybe String) -> IO (Maybe String)
forall a. IORef a -> IO a
readIORef IORef (Maybe String)
lowColor
  Int
pHigh <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
high
  Maybe String
pHighColor <- IORef (Maybe String) -> IO (Maybe String)
forall a. IORef a -> IO a
readIORef IORef (Maybe String)
highColor
  String
pTemplate <- IORef String -> IO String
forall a. IORef a -> IO a
readIORef IORef String
template
  [String]
pExport <- IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
export
  Int
pPpad <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
ppad
  Int
pDecDigits <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
decDigits
  Int
pMinWidth <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
minWidth
  Int
pMaxWidth <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
maxWidth
  String
pMaxWidthEllipsis <- IORef String -> IO String
forall a. IORef a -> IO a
readIORef IORef String
maxWidthEllipsis
  String
pPadChars <- IORef String -> IO String
forall a. IORef a -> IO a
readIORef IORef String
padChars
  Bool
pPadRight <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
padRight
  String
pBarBack <- IORef String -> IO String
forall a. IORef a -> IO a
readIORef IORef String
barBack
  String
pBarFore <- IORef String -> IO String
forall a. IORef a -> IO a
readIORef IORef String
barFore
  Int
pBarWidth <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
barWidth
  Bool
pUseSuffix <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
useSuffix 
  String
pNaString <- IORef String -> IO String
forall a. IORef a -> IO a
readIORef IORef String
naString
  Int
pMaxTotalWidth <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
maxTotalWidth
  String
pMaxTotalWidthEllipsis <- IORef String -> IO String
forall a. IORef a -> IO a
readIORef IORef String
maxTotalWidthEllipsis
  MonitorConfig -> IO MonitorConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MonitorConfig -> IO MonitorConfig)
-> MonitorConfig -> IO MonitorConfig
forall a b. (a -> b) -> a -> b
$ MonitorConfig :: Maybe String
-> Int
-> Maybe String
-> Int
-> Maybe String
-> String
-> [String]
-> Int
-> Int
-> Int
-> Int
-> String
-> String
-> Bool
-> String
-> String
-> Int
-> Bool
-> String
-> Int
-> String
-> MonitorConfig
MonitorConfig {Bool
Int
String
[String]
Maybe String
pMaxTotalWidthEllipsis :: String
pMaxTotalWidth :: Int
pNaString :: String
pUseSuffix :: Bool
pBarWidth :: Int
pBarFore :: String
pBarBack :: String
pPadRight :: Bool
pPadChars :: String
pMaxWidthEllipsis :: String
pMaxWidth :: Int
pMinWidth :: Int
pDecDigits :: Int
pPpad :: Int
pExport :: [String]
pTemplate :: String
pHighColor :: Maybe String
pHigh :: Int
pLowColor :: Maybe String
pLow :: Int
pNormalColor :: Maybe String
pMaxTotalWidthEllipsis :: String
pMaxTotalWidth :: Int
pNaString :: String
pUseSuffix :: Bool
pBarWidth :: Int
pBarFore :: String
pBarBack :: String
pPadRight :: Bool
pPadChars :: String
pMaxWidthEllipsis :: String
pMaxWidth :: Int
pMinWidth :: Int
pDecDigits :: Int
pPpad :: Int
pExport :: [String]
pTemplate :: String
pHighColor :: Maybe String
pHigh :: Int
pLowColor :: Maybe String
pLow :: Int
pNormalColor :: Maybe String
..}

-- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState'
type Selector a = MConfig -> IORef a
type PSelector a = MonitorConfig -> a

psel :: MonitorConfig -> PSelector a -> a
psel :: MonitorConfig -> PSelector a -> a
psel MonitorConfig
value PSelector a
accessor = PSelector a
accessor MonitorConfig
value

sel :: Selector a -> Monitor a
sel :: Selector a -> Monitor a
sel Selector a
s =
    do MConfig
hs <- ReaderT MConfig IO MConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
       IO a -> Monitor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Monitor a) -> IO a -> Monitor a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef (Selector a
s MConfig
hs)

mods :: Selector a -> (a -> a) -> Monitor ()
mods :: Selector a -> (a -> a) -> Monitor ()
mods Selector a
s a -> a
m =
    do MConfig
v <- ReaderT MConfig IO MConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
       IO () -> Monitor ()
forall a. IO a -> Monitor a
io (IO () -> Monitor ()) -> IO () -> Monitor ()
forall a b. (a -> b) -> a -> b
$ IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (Selector a
s MConfig
v) a -> a
m

setConfigValue :: a -> Selector a -> Monitor ()
setConfigValue :: a -> Selector a -> Monitor ()
setConfigValue a
v Selector a
s =
       Selector a -> (a -> a) -> Monitor ()
forall a. Selector a -> (a -> a) -> Monitor ()
mods Selector a
s (a -> a -> a
forall a b. a -> b -> a
const a
v)

getConfigValue :: Selector a -> Monitor a
getConfigValue :: Selector a -> Monitor a
getConfigValue = Selector a -> Monitor a
forall a. Selector a -> Monitor a
sel

getPConfigValue :: MonitorConfig -> PSelector a -> a
getPConfigValue :: MonitorConfig -> PSelector a -> a
getPConfigValue = MonitorConfig -> PSelector a -> a
forall a. MonitorConfig -> PSelector a -> a
psel

mkMConfig :: String
          -> [String]
          -> IO MConfig
mkMConfig :: String -> [String] -> IO MConfig
mkMConfig String
tmpl [String]
exprts =
    do IORef (Maybe String)
lc <- Maybe String -> IO (IORef (Maybe String))
forall a. a -> IO (IORef a)
newIORef Maybe String
forall a. Maybe a
Nothing
       IORef Int
l  <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
33
       IORef (Maybe String)
nc <- Maybe String -> IO (IORef (Maybe String))
forall a. a -> IO (IORef a)
newIORef Maybe String
forall a. Maybe a
Nothing
       IORef Int
h  <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
66
       IORef (Maybe String)
hc <- Maybe String -> IO (IORef (Maybe String))
forall a. a -> IO (IORef a)
newIORef Maybe String
forall a. Maybe a
Nothing
       IORef String
t  <- String -> IO (IORef String)
forall a. a -> IO (IORef a)
newIORef String
tmpl
       IORef [String]
e  <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef [String]
exprts
       IORef Int
p  <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
       IORef Int
d  <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
       IORef Int
mn <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
       IORef Int
mx <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
       IORef String
mel <- String -> IO (IORef String)
forall a. a -> IO (IORef a)
newIORef String
""
       IORef String
pc <- String -> IO (IORef String)
forall a. a -> IO (IORef a)
newIORef String
" "
       IORef Bool
pr <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
       IORef String
bb <- String -> IO (IORef String)
forall a. a -> IO (IORef a)
newIORef String
":"
       IORef String
bf <- String -> IO (IORef String)
forall a. a -> IO (IORef a)
newIORef String
"#"
       IORef Int
bw <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
10
       IORef Bool
up <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
       IORef String
na <- String -> IO (IORef String)
forall a. a -> IO (IORef a)
newIORef String
"N/A"
       IORef Int
mt <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
       IORef String
mtel <- String -> IO (IORef String)
forall a. a -> IO (IORef a)
newIORef String
""
       MConfig -> IO MConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (MConfig -> IO MConfig) -> MConfig -> IO MConfig
forall a b. (a -> b) -> a -> b
$ IORef (Maybe String)
-> IORef Int
-> IORef (Maybe String)
-> IORef Int
-> IORef (Maybe String)
-> IORef String
-> IORef [String]
-> IORef Int
-> IORef Int
-> IORef Int
-> IORef Int
-> IORef String
-> IORef String
-> IORef Bool
-> IORef String
-> IORef String
-> IORef Int
-> IORef Bool
-> IORef String
-> IORef Int
-> IORef String
-> MConfig
MC IORef (Maybe String)
nc IORef Int
l IORef (Maybe String)
lc IORef Int
h IORef (Maybe String)
hc IORef String
t IORef [String]
e IORef Int
p IORef Int
d IORef Int
mn IORef Int
mx IORef String
mel IORef String
pc IORef Bool
pr IORef String
bb IORef String
bf IORef Int
bw IORef Bool
up IORef String
na IORef Int
mt IORef String
mtel

data Opts = HighColor String
          | NormalColor String
          | LowColor String
          | Low String
          | High String
          | Template String
          | PercentPad String
          | DecDigits String
          | MinWidth String
          | MaxWidth String
          | Width String
          | WidthEllipsis String
          | PadChars String
          | PadAlign String
          | BarBack String
          | BarFore String
          | BarWidth String
          | UseSuffix String
          | NAString String
          | MaxTotalWidth String
          | MaxTotalWidthEllipsis String