Merge branch 'feature/config-file'

default.nix

@@ -1,17 +1,18 @@
-{ mkDerivation, async, base, lens, lib, monomer, process, text
-, text-show, time
+{ mkDerivation, async, base, config-ini, directory, filepath, lens
+, lib, monomer, process, text, text-show, time
 }:
 mkDerivation {
   pname = "rsi-break";
   version = "0.1.0.0";
   src = ./.;
   isLibrary = true;
   isExecutable = true;
+  enableSeparateDataOutput = true;
   libraryHaskellDepends = [
-    async base lens monomer process text text-show time
+    async base config-ini directory filepath lens monomer process text
+    text-show time
   ];
-  executableHaskellDepends = [ base ];
+  executableHaskellDepends = [ base monomer process ];
   testHaskellDepends = [ base ];
   license = lib.licenses.bsd2;
-  mainProgram = "rsi-break";
 }

rsi-break.cabal

@@ -35,9 +35,12 @@ library
                       RsiBreak.Widget.Timer
                       RsiBreak.Widget.Clockdown
                       RsiBreak.Model.Minutes
+                      RsiBreak.Model.Settings
+                      RsiBreak.Actions
     other-modules:    Paths_rsi_break
     default-extensions: StrictData
                         OverloadedStrings
+                        ImportQualifiedPost
     -- other-extensions:
     build-depends:    base >= 4.16.4.0 && < 4.18,
                       monomer,
@@ -46,7 +49,10 @@ library
                       text-show,
                       async,
                       time,
-                      process
+                      process,
+                      config-ini,
+                      directory,
+                      filepath
     hs-source-dirs:   src
     default-language: Haskell2010
 

src/RsiBreak/Actions.hs

@@ -0,0 +1,50 @@
+{- |
+Module      : RsiBreak.Actions
+Copyright   : (c) Ruben Astudillo, 2023
+License     : BSD-2
+Maintainer  : [email protected]
+
+Actions to be run on change of values such as settings.
+-}
+
+module RsiBreak.Actions (getOrCreateConfigFile, storeSettingsOnConfigFile) where
+
+import Control.Monad (unless)
+import Data.Ini.Config.Bidir
+import Data.Text.IO qualified as TIO (readFile, writeFile)
+import RsiBreak.Model.Settings
+import System.Directory
+import System.FilePath ((</>))
+
+getOrCreateConfigFile :: IO TimerSetting
+getOrCreateConfigFile = do
+    dir <- getXdgDirectory XdgConfig "rsi-break"
+    let file = dir </> "settings.ini"
+    settingsFileExist <- doesFileExist file
+    unless settingsFileExist $
+        createNewInitialSettings dir file
+    settingFileContent <- TIO.readFile file
+    let eIniSettings = parseIni settingFileContent defaultIni
+    case eIniSettings of
+        Left _err -> do
+            removeDirectoryRecursive dir
+            createNewInitialSettings dir file
+            pure defSetting
+        Right ini' -> pure (getIniValue ini')
+  where
+    createNewInitialSettings dir file = do
+        createDirectory dir
+        TIO.writeFile file (serializeIni defaultIni)
+
+defaultIni :: Ini TimerSetting
+defaultIni =
+    setIniUpdatePolicy
+        (defaultUpdatePolicy{updateGeneratedCommentPolicy = CommentPolicyAddFieldComment})
+        (ini defSetting timerSettingSpec)
+
+storeSettingsOnConfigFile :: TimerSetting -> IO ()
+storeSettingsOnConfigFile updatedSettings = do
+    let updatedIni = updateIni updatedSettings defaultIni
+    dir <- getXdgDirectory XdgConfig "rsi-break"
+    let file = dir </> "settings.ini"
+    TIO.writeFile file (serializeIni updatedIni)

src/RsiBreak/Model/Settings.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module RsiBreak.Model.Settings where
+
+import Control.Lens (makeLenses)
+import Data.Ini.Config.Bidir
+import RsiBreak.Model.Minutes (Minutes)
+
+data TimerSetting = TimerSetting
+    { _workInterval :: Minutes
+    , _restInterval :: Minutes
+    }
+    deriving (Eq, Show)
+
+$(makeLenses 'TimerSetting)
+
+defSetting :: TimerSetting
+defSetting = TimerSetting 20 10
+
+timerSettingSpec :: IniSpec TimerSetting ()
+timerSettingSpec =
+    section "TimerSetting" $ do
+        workInterval
+            .= field "workInterval" number
+            & comment ["The desired work interval in minutes"]
+        restInterval
+            .= field "restInterval" number
+            & comment ["The desired rest interval in minutes"]

src/RsiBreak/RealMain.hs

@@ -5,12 +5,14 @@ module RsiBreak.RealMain (realMain) where
 import Data.String (IsString (..))
 import Monomer
 import Paths_rsi_break
-import qualified RsiBreak.Widget.Clockdown as Clockdown
-import qualified RsiBreak.Widget.Settings as Settings
-import qualified RsiBreak.Widget.Timer as Timer
+import RsiBreak.Actions (getOrCreateConfigFile)
+import RsiBreak.Widget.Clockdown qualified as Clockdown
+import RsiBreak.Widget.Timer qualified as Timer
 
 realMain :: IO ()
 realMain = do
+    timerSettings <- getOrCreateConfigFile
+    let model = Clockdown.ClockModel "0:00" Timer.TimerNoWait timerSettings
     windowIconPath <- fromString <$> getDataFileName "assets/images/icon.png"
     robotoRegularFont <- fromString <$> getDataFileName "assets/fonts/Roboto-Regular.ttf"
     let cfg = config windowIconPath robotoRegularFont
@@ -22,4 +24,3 @@ realMain = do
         , appTheme darkTheme
         , appFontDef "Regular" roboto
         ]
-    model = Clockdown.ClockModel "0:00" Timer.TimerNoWait (Settings.TimerSetting 20 10)

src/RsiBreak/Widget/Clockdown.hs

@@ -1,5 +1,14 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE BangPatterns #-}
 
+{- |
+Module      : RsiBreak.Widget.Clockdown
+Copyright   : (c) Ruben Astudillo, 2023
+License     : BSD-2
+Maintainer  : [email protected]
+
+Main composite of the the application.
+-}
 module RsiBreak.Widget.Clockdown (
     ClockModel (ClockModel),
     handleEvent,
@@ -8,20 +17,20 @@ module RsiBreak.Widget.Clockdown (
 
 import Control.Lens (ALens', lens, makeLensesFor)
 import Data.String (IsString (fromString))
-import Data.Text
+import Data.Text (Text)
 import Data.Time (NominalDiffTime, defaultTimeLocale, formatTime)
 import Monomer
-import qualified RsiBreak.Widget.Settings as Settings
-import RsiBreak.Widget.Timer (TimerModel (..), TimerState (..))
-import qualified RsiBreak.Widget.Timer as Timer
+import RsiBreak.Widget.Settings qualified as Settings
+import RsiBreak.Model.Settings qualified as Settings
+import RsiBreak.Widget.Timer qualified as Timer
 
 greenBgStyle, blueBgStyle :: StyleState
 greenBgStyle = mempty{_sstBgColor = Just (Color 0 128 0 1)}
 blueBgStyle = mempty{_sstBgColor = Just (Color 0 0 128 1)}
 
 data ClockModel = ClockModel
     { _cmClock :: Text
-    , _cmTimer :: TimerState
+    , _cmTimer :: Timer.TimerState
     , _cmSettings :: Settings.TimerSetting
     }
     deriving (Eq)
@@ -45,22 +54,27 @@ buildUI _wenv (ClockModel _ timer _) =
         , composite "settings-parameters" cmSettings Settings.buildUI (Settings.handleEvent ClockCancelTimer)
         , spacer
         , composite "timer" toTimerModel Timer.buildUI (Timer.handleEvent ClockUpdate) `nodeKey` mainCounter
-        ] `styleBasic` [padding 10]
+        ]
+        `styleBasic` [padding 10]
 
 handleEvent :: EventHandler ClockModel ClockEvent es ep
 handleEvent _wenv _node model (ClockUpdate td) =
-    let tdText = fromString (formatTime defaultTimeLocale "%m:%02S" td)
+    let !tdText = fromString (formatTime defaultTimeLocale "%m:%02S" td)
      in [Model (model{_cmClock = tdText}), Request RenderOnce]
 handleEvent _ _ _ ClockCancelTimer = [Message mainCounterKey Timer.TimerStop]
 
-countdownStyle :: TimerState -> StyleState
+countdownStyle :: Timer.TimerState -> StyleState
 countdownStyle settings = case settings of
-    TimerWorkWait _ -> greenBgStyle
-    TimerRestWait _ -> blueBgStyle
+    Timer.TimerWorkWait _ -> greenBgStyle
+    Timer.TimerRestWait _ -> blueBgStyle
     _ -> mempty
 
-toTimerModel :: ALens' ClockModel TimerModel
+toTimerModel :: ALens' ClockModel Timer.TimerModel
 toTimerModel = lens getter setter
   where
-    getter clock = TimerModel (_cmSettings clock) (_cmTimer clock)
-    setter clock timer = clock{_cmTimer = tmState timer, _cmSettings = tmSettings timer}
+    getter clock = Timer.TimerModel (_cmSettings clock) (_cmTimer clock)
+    setter clock timer =
+        clock
+            { _cmTimer = Timer.tmState timer
+            , _cmSettings = Timer.tmSettings timer
+            }

src/RsiBreak/Widget/Settings.hs

@@ -1,42 +1,48 @@
-{-# LANGUAGE TemplateHaskell #-}
+{- |
+Module      : RsiBreak.Widget.Settings
+Copyright   : (c) Ruben Astudillo, 2023
+License     : BSD-2
+Maintainer  : [email protected]
 
+Composite for setting values and their modifications.
+-}
 module RsiBreak.Widget.Settings (
-    TimerSetting (..),
     handleEvent,
     buildUI,
 ) where
 
-import Control.Lens (makeLenses, set)
+import Control.Lens (set)
 import Monomer
+import RsiBreak.Actions (storeSettingsOnConfigFile)
 import RsiBreak.Model.Minutes (Minutes)
+import RsiBreak.Model.Settings (TimerSetting (..), restInterval, workInterval)
 
-data TimerSetting = TimerSetting
-    { _workInterval :: Minutes
-    , _restInterval :: Minutes
-    }
+data TimerChange = TSENewWorkTime Minutes | TSENewRestTime Minutes
     deriving (Eq, Show)
 
-$(makeLenses 'TimerSetting)
-
-data TimerSettingEvent = TSENewWorkTime Minutes | TSENewRestTime Minutes
+data TimerSettingEvent = TimerChangeEvent TimerChange | TSENoOp
     deriving (Eq, Show)
 
 handleEvent :: ep -> EventHandler TimerSetting TimerSettingEvent sp ep
-handleEvent onChangeEvent _wenv _node model evt =
-    let changeModel = case evt of
-            TSENewWorkTime newm -> Model (set workInterval newm model)
-            TSENewRestTime newm -> Model (set restInterval newm model)
-     in [changeModel, Report onChangeEvent]
+handleEvent _onChangeEvent _wenv _node _model TSENoOp = []
+handleEvent onChangeEvent _wenv _node model (TimerChangeEvent evt) =
+    let newModel = case evt of
+            TSENewWorkTime newm -> set workInterval newm model
+            TSENewRestTime newm -> set restInterval newm model
+     in [ Model newModel
+        , Report onChangeEvent
+        , Task (TSENoOp <$ storeSettingsOnConfigFile newModel)
+        ]
 
 buildUI :: UIBuilder TimerSetting TimerSettingEvent
 buildUI _wenv _model =
     vstack
         [ hstack
             [ label "Work time: "
-            , numericField_ workInterval [minValue 0, maxValue 300, onChange TSENewWorkTime]
+            , numericField_ workInterval [minValue 0, maxValue 300, onChange (TimerChangeEvent . TSENewWorkTime)]
             ]
         , hstack
             [ label "Rest time: "
-            , numericField_ restInterval [minValue 0, maxValue 300, onChange TSENewRestTime]
+            , numericField_ restInterval [minValue 0, maxValue 300, onChange (TimerChangeEvent . TSENewRestTime)]
             ]
         ]