From bf804f73ce3494be430054499c5ce18f232f68ca Mon Sep 17 00:00:00 2001
From: Joris
Date: Fri, 18 Mar 2016 09:50:39 +0100
Subject: Add optional imports

---
 Data/ConfigManager/Reader.hs | 33 ++++++++++++++++++++++-----------
 1 file changed, 22 insertions(+), 11 deletions(-)

(limited to 'Data/ConfigManager/Reader.hs')

diff --git a/Data/ConfigManager/Reader.hs b/Data/ConfigManager/Reader.hs
index 9f4cc3c..c2f75a7 100644
--- a/Data/ConfigManager/Reader.hs
+++ b/Data/ConfigManager/Reader.hs
@@ -1,38 +1,49 @@
+{-# 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.Expr
-import Data.ConfigManager.Config
+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 $ []
+    )
 
-readConfig :: FilePath -> IO (Either Text Config)
-readConfig path = do
-  input <- T.readFile path
+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 emptyConfig) exprs
-      where fileDir = dropFileName path
-            emptyConfig = Config $ M.fromList []
+      foldM (go fileDir) (Right . Config . M.fromList $ []) exprs
 
-go :: String -> Either Text Config -> Expr -> IO (Either Text Config)
+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 path -> do
-      eitherConfig <- readConfig (fileDir </> path)
+    Import requirement path -> do
+      eitherConfig <- readConfig requirement (fileDir </> path)
       case eitherConfig of
         Left errorMessage ->
           return . Left $ errorMessage
-- 
cgit v1.2.3