From d6fb2adb267c4fae57d93a28bcd82ee5a59a2499 Mon Sep 17 00:00:00 2001 From: Mirko Westermeier Date: Wed, 31 Jul 2024 20:32:26 +0200 Subject: [PATCH] Use the LiBro monad for Config-ured effects --- lib/LiBro/Base.hs | 18 ++++++++++ lib/LiBro/Control.hs | 25 +++++++------ lib/LiBro/Data/Storage.hs | 75 ++++++++++++++++++++------------------- libro-backend.cabal | 4 ++- 4 files changed, 73 insertions(+), 49 deletions(-) create mode 100644 lib/LiBro/Base.hs diff --git a/lib/LiBro/Base.hs b/lib/LiBro/Base.hs new file mode 100644 index 0000000..6e9767a --- /dev/null +++ b/lib/LiBro/Base.hs @@ -0,0 +1,18 @@ +-- | Basic definitions. +module LiBro.Base where + +import LiBro.Config +import Control.Monad.Reader + +newtype LiBro a = LiBro + { unLiBro :: ReaderT Config IO a + } deriving ( Functor + , Applicative + , Monad + , MonadReader Config + , MonadFail + , MonadIO + ) + +runLiBro :: Config -> LiBro a -> IO a +runLiBro config = flip runReaderT config . unLiBro diff --git a/lib/LiBro/Control.hs b/lib/LiBro/Control.hs index 068c399..ef89a53 100644 --- a/lib/LiBro/Control.hs +++ b/lib/LiBro/Control.hs @@ -1,10 +1,12 @@ -- | Controlling the LiBro data flow. module LiBro.Control where +import LiBro.Base import LiBro.Config import LiBro.Data import LiBro.Data.Storage import Control.Concurrent +import Control.Monad.Reader -- | Represents a blocking action because the system is loading -- or saving data. @@ -15,22 +17,23 @@ data Blocking -- | Initially load data and put it into the shared state. -- Expects the given 'MVar' to be empty. -initData :: Config -> MVar Blocking -> MVar LiBroData -> IO () -initData config blocking libroData = do - putMVar blocking Reading - putMVar libroData =<< loadData config - _ <- takeMVar blocking +initData :: MVar Blocking -> MVar LiBroData -> LiBro () +initData blocking libroData = do + liftIO $ putMVar blocking Reading + ld <- loadData + _ <- liftIO $ putMVar libroData ld + _ <- liftIO $ takeMVar blocking return () -- | Try to store shared state data. Expects the given blocking 'MVar' -- to be empty. Iff not, returns 'False'. -saveData :: Config -> MVar Blocking -> MVar LiBroData -> IO Bool -saveData config blocking libroData = do - isBlocked <- not <$> isEmptyMVar blocking +saveData :: MVar Blocking -> MVar LiBroData -> LiBro Bool +saveData blocking libroData = do + isBlocked <- not <$> liftIO (isEmptyMVar blocking) if isBlocked then return False else do - putMVar blocking Writing - storeData config =<< readMVar libroData - _ <- takeMVar blocking + liftIO $ putMVar blocking Writing + storeData =<< liftIO (readMVar libroData) + _ <- liftIO $ takeMVar blocking return True diff --git a/lib/LiBro/Data/Storage.hs b/lib/LiBro/Data/Storage.hs index aa796de..250d37a 100644 --- a/lib/LiBro/Data/Storage.hs +++ b/lib/LiBro/Data/Storage.hs @@ -18,6 +18,7 @@ module LiBro.Data.Storage , loadData ) where +import LiBro.Base import LiBro.Config import LiBro.Data import LiBro.Data.SafeText @@ -28,6 +29,7 @@ import qualified Data.Map as M import Data.Tree import Data.Csv import qualified Data.ByteString.Char8 as B +import Control.Monad.Reader import GHC.Generics import System.FilePath import System.Directory @@ -97,56 +99,55 @@ taskRecordsToTasks pmap trs = } -- | Store 'Person's at the configured storage space --- via 'Config'. -storePersons :: Config -> Persons -> IO () -storePersons conf pmap = do - let sconf = storage conf - fp = directory sconf personFile sconf - storeAsXlsx fp $ M.elems pmap +storePersons :: Persons -> LiBro () +storePersons pmap = do + sconf <- asks storage + let fp = directory sconf personFile sconf + liftIO $ storeAsXlsx fp $ M.elems pmap --- | Load a list of 'Person's from the configured storage space --- via 'Config'. Returns empty data if no input file was found. -loadPersons :: Config -> IO Persons -loadPersons conf = do - let sconf = storage conf - fp = directory sconf personFile sconf - exists <- doesFileExist fp +-- | Load a list of 'Person's from the configured storage space. +-- Returns empty data if no input file was found. +loadPersons :: LiBro Persons +loadPersons = do + sconf <- asks storage + let fp = directory sconf personFile sconf + exists <- liftIO $ doesFileExist fp if not exists then return M.empty else do - Right prs <- loadFromXlsx fp + Right prs <- liftIO $ loadFromXlsx fp return $ personMap prs --- | Store 'Tasks' at the configured storage space via 'Config'. -storeTasks :: Config -> Tasks -> IO () -storeTasks conf ts = do - let sconf = storage conf - fp = directory sconf tasksFile sconf - storeAsXlsx fp $ tasksToTaskRecords ts +-- | Store 'Tasks' at the configured storage space. +storeTasks :: Tasks -> LiBro () +storeTasks ts = do + sconf <- asks storage + let fp = directory sconf tasksFile sconf + liftIO $ storeAsXlsx fp $ tasksToTaskRecords ts --- | Load 'Tasks' from the configured storage space via 'Config'. +-- | Load 'Tasks' from the configured storage space. -- Needs an additional 'Data.Map.Map' to find 'Person's for given -- person ids ('Int'). Returns empty data if no input file was found. -loadTasks :: Config -> Persons -> IO Tasks -loadTasks conf pmap = do - let sconf = storage conf - fp = directory sconf tasksFile sconf - exists <- doesFileExist fp +loadTasks :: Persons -> LiBro Tasks +loadTasks pmap = do + sconf <- asks storage + let fp = directory sconf tasksFile sconf + exists <- liftIO $ doesFileExist fp if not exists then return [] else do - Right records <- loadFromXlsx fp + Right records <- liftIO $ loadFromXlsx fp return $ taskRecordsToTasks pmap records --- | Store a complete dataset at the 'Config'ured file system +-- | Store a complete dataset at the configured file system -- locations. -storeData :: Config -> LiBroData -> IO () -storeData conf ld = do - storePersons conf (persons ld) - storeTasks conf (tasks ld) +storeData :: LiBroData -> LiBro () +storeData ld = do + storePersons $ persons ld + storeTasks $ tasks ld --- | Load a complete dataset from the 'Config'ured file system +-- | Load a complete dataset from the configured file system -- locations. Returns empty data if no input files were found. -loadData :: Config -> IO LiBroData -loadData conf = do - pmap <- loadPersons conf - ts <- loadTasks conf pmap +loadData :: LiBro LiBroData +loadData = do + pmap <- loadPersons + ts <- loadTasks pmap return $ LBS pmap ts diff --git a/libro-backend.cabal b/libro-backend.cabal index 8a60bb7..480480b 100644 --- a/libro-backend.cabal +++ b/libro-backend.cabal @@ -33,8 +33,10 @@ common consumer library import: basic default-extensions: OverloadedStrings + , GeneralizedNewtypeDeriving , DeriveGeneric - exposed-modules: LiBro.Config + exposed-modules: LiBro.Base + , LiBro.Config , LiBro.Data , LiBro.Data.Storage , LiBro.Data.SafeText