MainState.hs

{-
 *  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