{- * Programmer: Piotr Borek * E-mail: piotrborek@op.pl * Copyright 2016 Piotr Borek * * Distributed under the terms of the GPL (GNU Public License) * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module Coin.UI.MainState ( MainState (..), mainStateNew, mainStateReadPropertiesAction, mainStateReadPropertiesFromDisk, propertyRead, propertyRead2, propertyRead3, propertyRead4, mainStateSavePropertiesOnDisk, mainStateSavePropertiesAction, propertyInsert, propertyInsertMaybe, -- P.PropertyMap, module Coin.UI.Utils.Observable ) where import qualified Data.Binary as Binary import qualified Database.Persist as DB import qualified Coin.Utils.PropertyMap as P import Control.Monad.Reader import Control.Monad.State.Strict import Data.IORef import Data.Foldable import System.Directory import Coin.DB.Tables import Coin.UI.Utils.Observable import Coin.Config.Dirs data MainState = MainState { mainStateSelectedAccountName :: Observable String, mainStateTagsUpdated :: Observable [DB.Entity TagsTable], mainStateAccountsUpdated :: Observable [DB.Entity AccountsTable], mainStatePropertySaveActions :: IORef [(String, StateT P.PropertyMap IO ())], mainStatePropertyReadActions :: IORef [(String, ReaderT P.PropertyMap IO ())], mainStateIncomeID :: AccountsTableId, mainStateOutcomeID :: AccountsTableId, mainStateCashID :: AccountsTableId, mainStateIncomeName :: String, mainStateOutcomeName :: String, mainStateCashName :: String, mainStateNoneName :: String } mainStateNew :: IO MainState mainStateNew = do accountName <- observableNew tagsUpdated <- observableNew accountsUpdated <- observableNew propertySaveActions <- newIORef [] propertyReadActions <- newIORef [] incomeID <- accountsTableIncomeID outcomeID <- accountsTableOutcomeID cashID <- accountsTableCashID noneID <- tagsTableNoneID incomeName <- accountsTableSelectName incomeID outcomeName <- accountsTableSelectName outcomeID cashName <- accountsTableSelectName cashID noneName <- tagsTableSelectName noneID return MainState { mainStateSelectedAccountName = accountName, mainStateTagsUpdated = tagsUpdated, mainStateAccountsUpdated = accountsUpdated, mainStatePropertySaveActions = propertySaveActions, mainStatePropertyReadActions = propertyReadActions, mainStateIncomeID = incomeID, mainStateOutcomeID = outcomeID, mainStateCashID = cashID, mainStateIncomeName = incomeName, mainStateOutcomeName = outcomeName, mainStateCashName = cashName, mainStateNoneName = noneName } mainStateReadPropertiesAction :: MainState -> String -> ReaderT P.PropertyMap IO () -> IO () mainStateReadPropertiesAction mainState prefix action = modifyIORef' (mainStatePropertyReadActions mainState) $ \list -> (prefix, action):list mainStateReadProperties :: P.PropertyMap -> (String, ReaderT P.PropertyMap IO ()) -> IO () mainStateReadProperties propertyMap (prefix, action) = case P.lookup prefix propertyMap of Just properties -> runReaderT action properties Nothing -> return () mainStateReadPropertiesFromDisk :: MainState -> IO () mainStateReadPropertiesFromDisk mainState = do dir <- configGetDirectory exists <- doesFileExist $ dir ++ "/app_state.st" propertyMap <- if exists then Binary.decodeFile (dir ++ "/app_state.st") else return P.empty actions <- readIORef $ mainStatePropertyReadActions mainState forM_ actions $ mainStateReadProperties propertyMap propertyRead :: P.IsProperty a => String -> (a -> ReaderT P.PropertyMap IO ()) -> ReaderT P.PropertyMap IO () propertyRead key action = do properties <- ask case P.lookup key properties of Just value -> action value Nothing -> return () propertyRead2 :: P.IsProperty a => String -> String -> (a -> a -> ReaderT P.PropertyMap IO ()) -> ReaderT P.PropertyMap IO () propertyRead2 key1 key2 action = do propertyRead key1 $ \value1 -> propertyRead key2 $ \value2 -> action value1 value2 propertyRead3 :: P.IsProperty a => String -> String -> String -> (a -> a -> a -> ReaderT P.PropertyMap IO ()) -> ReaderT P.PropertyMap IO () propertyRead3 key1 key2 key3 action = do propertyRead key1 $ \value1 -> propertyRead2 key2 key3 $ \value2 value3 -> action value1 value2 value3 propertyRead4 :: P.IsProperty a => String -> String -> String -> String -> (a -> a -> a -> a -> ReaderT P.PropertyMap IO ()) -> ReaderT P.PropertyMap IO () propertyRead4 key1 key2 key3 key4 action = do propertyRead key1 $ \value1 -> propertyRead3 key2 key3 key4 $ \value2 value3 value4 -> action value1 value2 value3 value4 mainStateSavePropertiesOnDisk :: MainState -> IO () mainStateSavePropertiesOnDisk mainState = do actions <- readIORef $ mainStatePropertySaveActions mainState properties <- foldrM (\(prefix, action) m -> do m0 <- execStateT action P.empty return $ case P.lookup prefix m of Just m' -> P.insert prefix (P.union m' m0) m Nothing -> P.insert prefix m0 m ) P.empty actions dir <- configGetDirectory Binary.encodeFile (dir ++ "/app_state.st") properties mainStateSavePropertiesAction :: MainState -> String -> StateT P.PropertyMap IO () -> IO () mainStateSavePropertiesAction mainState prefix action = do modifyIORef' (mainStatePropertySaveActions mainState) $ \list -> (prefix, action):list propertyInsert :: P.IsProperty a => String -> a -> StateT P.PropertyMap IO () propertyInsert key value = get >>= \m -> put $ P.insert key value m propertyInsertMaybe :: P.IsProperty a => String -> Maybe a -> StateT P.PropertyMap IO () propertyInsertMaybe key value = get >>= \m -> put $ P.insertMaybe key value m