{-# LANGUAGE TemplateHaskell #-}

module RsiBreak.Model.Settings where

import Control.Lens (makeLenses)
import Data.Ini.Config.Bidir
import RsiBreak.Model.Minutes (Minutes)

data TimerSetting = TimerSetting
    { TimerSetting -> Minutes
_workInterval :: Minutes
    , TimerSetting -> Minutes
_restInterval :: Minutes
    }
    deriving (TimerSetting -> TimerSetting -> Bool
(TimerSetting -> TimerSetting -> Bool)
-> (TimerSetting -> TimerSetting -> Bool) -> Eq TimerSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimerSetting -> TimerSetting -> Bool
== :: TimerSetting -> TimerSetting -> Bool
$c/= :: TimerSetting -> TimerSetting -> Bool
/= :: TimerSetting -> TimerSetting -> Bool
Eq, Minutes -> TimerSetting -> ShowS
[TimerSetting] -> ShowS
TimerSetting -> String
(Minutes -> TimerSetting -> ShowS)
-> (TimerSetting -> String)
-> ([TimerSetting] -> ShowS)
-> Show TimerSetting
forall a.
(Minutes -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Minutes -> TimerSetting -> ShowS
showsPrec :: Minutes -> TimerSetting -> ShowS
$cshow :: TimerSetting -> String
show :: TimerSetting -> String
$cshowList :: [TimerSetting] -> ShowS
showList :: [TimerSetting] -> ShowS
Show)

$(makeLenses 'TimerSetting)

defSetting :: TimerSetting
defSetting :: TimerSetting
defSetting = Minutes -> Minutes -> TimerSetting
TimerSetting Minutes
20 Minutes
10

timerSettingSpec :: IniSpec TimerSetting ()
timerSettingSpec :: IniSpec TimerSetting ()
timerSettingSpec =
    Text -> SectionSpec TimerSetting () -> IniSpec TimerSetting ()
forall s. Text -> SectionSpec s () -> IniSpec s ()
section Text
"TimerSetting" (SectionSpec TimerSetting () -> IniSpec TimerSetting ())
-> SectionSpec TimerSetting () -> IniSpec TimerSetting ()
forall a b. (a -> b) -> a -> b
$ do
        (Minutes -> f Minutes) -> TimerSetting -> f TimerSetting
Lens' TimerSetting Minutes
workInterval
            Lens' TimerSetting Minutes
-> FieldDescription Minutes -> SectionSpec TimerSetting ()
forall t s.
Eq t =>
Lens s s t t -> FieldDescription t -> SectionSpec s ()
.= Text -> FieldValue Minutes -> FieldDescription Minutes
forall a. Text -> FieldValue a -> FieldDescription a
field Text
"workInterval" FieldValue Minutes
forall a. (Show a, Read a, Num a, Typeable a) => FieldValue a
number
            FieldDescription Minutes
-> (FieldDescription Minutes -> FieldDescription Minutes)
-> FieldDescription Minutes
forall a b. a -> (a -> b) -> b
& [Text] -> FieldDescription Minutes -> FieldDescription Minutes
forall t. [Text] -> FieldDescription t -> FieldDescription t
comment [Text
"The desired work interval in minutes"]
        (Minutes -> f Minutes) -> TimerSetting -> f TimerSetting
Lens' TimerSetting Minutes
restInterval
            Lens' TimerSetting Minutes
-> FieldDescription Minutes -> SectionSpec TimerSetting ()
forall t s.
Eq t =>
Lens s s t t -> FieldDescription t -> SectionSpec s ()
.= Text -> FieldValue Minutes -> FieldDescription Minutes
forall a. Text -> FieldValue a -> FieldDescription a
field Text
"restInterval" FieldValue Minutes
forall a. (Show a, Read a, Num a, Typeable a) => FieldValue a
number
            FieldDescription Minutes
-> (FieldDescription Minutes -> FieldDescription Minutes)
-> FieldDescription Minutes
forall a b. a -> (a -> b) -> b
& [Text] -> FieldDescription Minutes -> FieldDescription Minutes
forall t. [Text] -> FieldDescription t -> FieldDescription t
comment [Text
"The desired rest interval in minutes"]