-- |
--
-- Copyright   : (C) Keera Studios Ltd, 2013
-- License     : BSD3
-- Maintainer  : support@keera.co.uk
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 :: ConfigIO e -> String -> e -> IO ()
defaultRead (Maybe String -> e -> IO ()
readConf, e -> IO String
_) String
app e
cenv =
  IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (IO () -> SomeException -> IO ()
forall a. a -> SomeException -> a
anyway (Maybe String -> e -> IO ()
readConf Maybe String
forall a. Maybe a
Nothing e
cenv)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String
dir <- String -> IO String
getAppUserDataDirectory String
app
    let file :: String
file = String
dir String -> String -> String
</> String
"config"
    String
c <- String -> IO String
readFile String
file
    Maybe String -> e -> IO ()
readConf (String -> Maybe String
forall a. a -> Maybe a
Just String
c) e
cenv

defaultWrite :: ConfigIO e -> String -> e -> IO()
defaultWrite :: ConfigIO e -> String -> e -> IO ()
defaultWrite (Maybe String -> e -> IO ()
_, e -> IO String
showConf) String
app e
cenv =
  IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (IO () -> SomeException -> IO ()
forall a. a -> SomeException -> a
anyway (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String
dir <- String -> IO String
getAppUserDataDirectory String
app
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
    let file :: String
file = String
dir String -> String -> String
</> String
"config"
    String -> String -> IO ()
writeFile String
file (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< e -> IO String
showConf e
cenv