Data/ConfigManager/Reader.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.ConfigManager.Reader
  ( readConfig
  ) where

import Control.Monad (foldM)
import Control.Exception (catch, IOException)

import System.FilePath.Posix (dropFileName, (</>))

import qualified Data.HashMap.Strict as M
import Data.Text (Text)
import qualified Data.Text.IO as T
import qualified Data.Text as T

import Data.ConfigManager.Parser (parseConfig)
import Data.ConfigManager.Types

readConfig :: Requirement -> FilePath -> IO (Either Text Config)
readConfig requirement path =
  catch
    (T.readFile path >>= readConfigText (dropFileName path))
    (\(_ :: IOException) -> return $
      case requirement of
        Required -> Left . T.concat $ ["File ", T.pack path, " not found."]
        Optional -> Right . Config . M.fromList $ []
    )

readConfigText :: FilePath -> Text -> IO (Either Text Config)
readConfigText fileDir input =
  case parseConfig input of
    Left errorMessage ->
      return . Left $ errorMessage
    Right exprs ->
      foldM (go fileDir) (Right . Config . M.fromList $ []) exprs

go :: FilePath -> Either Text Config -> Expr -> IO (Either Text Config)
go _ errorMessage@(Left _) _ = return errorMessage
go fileDir (Right config) expr =
  case expr of
    Binding name value ->
      return . Right . Config $ M.insert name value (hashMap config)
    Import requirement path -> do
      eitherConfig <- readConfig requirement (fileDir </> path)
      case eitherConfig of
        Left errorMessage ->
          return . Left $ errorMessage
        Right importedConfig ->
          let unionConfig = (hashMap importedConfig) `M.union` (hashMap config)
          in  return . Right . Config $ unionConfig