{-# 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 configOrError <- readConfig requirement (fileDir path) case configOrError of Left errorMessage -> return . Left $ errorMessage Right importedConfig -> let unionConfig = (hashMap importedConfig) `M.union` (hashMap config) in return . Right . Config $ unionConfig