packages feed

titan-1.0.2: src/Hails/MVC/Controller/Conditions/Config.hs

module Hails.MVC.Controller.Conditions.Config where

import qualified Control.Exception as E
import           Control.Monad
import           System.FilePath
import           System.Directory

import Control.Exception.Extra

-- | A config IO layer reads and writes 
-- an environment from a string. It's like a
-- read/show combination for configuration files
-- to and from Environments
type ConfigIO e = ( Maybe String -> e -> IO () -- Reader
                  , e -> IO String             -- Shower
                  )

defaultRead :: ConfigIO e -> String -> e -> IO()
defaultRead (readConf, _) app cenv = 
  void $ E.handle (anyway (readConf Nothing cenv)) $ do
    dir <- getAppUserDataDirectory app
    let file = dir </> "config"
    c <- readFile file
    readConf (Just c) cenv

defaultWrite :: ConfigIO e -> String -> e -> IO()
defaultWrite (_, showConf) app cenv = 
  void $ E.handle (anyway (return ())) $ do
    dir <- getAppUserDataDirectory app
    createDirectoryIfMissing True dir
    let file = dir </> "config"
    writeFile file =<< showConf cenv