diff options
author | Joris | 2016-03-18 09:50:39 +0100 |
---|---|---|
committer | Joris | 2016-03-18 09:50:39 +0100 |
commit | bf804f73ce3494be430054499c5ce18f232f68ca (patch) | |
tree | 6b89c204b9f997d6f6d4134cfaa72ecc6f2234f6 /Data/ConfigManager | |
parent | 9c3c43835addc950c3af7fab8fd53e24e7e29ad9 (diff) |
Add optional imports
Diffstat (limited to 'Data/ConfigManager')
-rw-r--r-- | Data/ConfigManager/Config.hs | 11 | ||||
-rw-r--r-- | Data/ConfigManager/Expr.hs | 16 | ||||
-rw-r--r-- | Data/ConfigManager/Parser.hs | 15 | ||||
-rw-r--r-- | Data/ConfigManager/Reader.hs | 33 | ||||
-rw-r--r-- | Data/ConfigManager/Types.hs | 17 | ||||
-rw-r--r-- | Data/ConfigManager/Types/Internal.hs | 39 |
6 files changed, 87 insertions, 44 deletions
diff --git a/Data/ConfigManager/Config.hs b/Data/ConfigManager/Config.hs deleted file mode 100644 index 8c79956..0000000 --- a/Data/ConfigManager/Config.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Data.ConfigManager.Config - ( Config(..) - ) where - -import Data.HashMap.Strict - -import Data.ConfigManager.Expr - -data Config = Config - { hashMap :: HashMap Name Value - } deriving (Eq, Read, Show) diff --git a/Data/ConfigManager/Expr.hs b/Data/ConfigManager/Expr.hs deleted file mode 100644 index 3aa8825..0000000 --- a/Data/ConfigManager/Expr.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Data.ConfigManager.Expr - ( Expr(..) - , Name - , Value - ) where - -import Data.Text (Text) - -data Expr = - Binding Name Value - | Import FilePath - deriving (Eq, Read, Show) - -type Name = Text - -type Value = Text diff --git a/Data/ConfigManager/Parser.hs b/Data/ConfigManager/Parser.hs index 856ccfd..b49f586 100644 --- a/Data/ConfigManager/Parser.hs +++ b/Data/ConfigManager/Parser.hs @@ -10,7 +10,7 @@ import Data.Char (isSpace, isAlphaNum) import Text.ParserCombinators.Parsec -import Data.ConfigManager.Expr +import Data.ConfigManager.Types parseConfig :: Text -> Either Text [Expr] parseConfig input = @@ -22,7 +22,10 @@ exprsParser :: Parser [Expr] exprsParser = skip *> many (exprParser <* restOfLine <* skip) <* eof exprParser :: Parser Expr -exprParser = (try bindingParser) <|> (try importParser) +exprParser = + (try bindingParser) + <|> (try $ importParser "import" (Import Required)) + <|> (try $ importParser "importMaybe" (Import Optional)) bindingParser :: Parser Expr bindingParser = do @@ -33,14 +36,14 @@ bindingParser = do value <- valueParser return $ Binding name value -importParser :: Parser Expr -importParser = do - _ <- string "import" +importParser :: String -> (FilePath -> Expr) -> Parser Expr +importParser name exprFromPath = do + _ <- string name _ <- spaces _ <- char '"' path <- many (noneOf "\"") _ <- char '"' - return $ Import path + return $ exprFromPath path nameParser :: Parser Name nameParser = do 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 diff --git a/Data/ConfigManager/Types.hs b/Data/ConfigManager/Types.hs new file mode 100644 index 0000000..ddc578f --- /dev/null +++ b/Data/ConfigManager/Types.hs @@ -0,0 +1,17 @@ +-- | +-- Module: Data.ConfigManager.Config +-- License: GPL-3 +-- Maintainer: Joris Guyonvarch <joris@guyonvarch.me> +-- Stability: experimental +-- +-- Types for working with configuration files. + +module Data.ConfigManager.Types + ( Config(..) + , Expr(..) + , Name + , Value + , Requirement(..) + ) where + +import Data.ConfigManager.Types.Internal diff --git a/Data/ConfigManager/Types/Internal.hs b/Data/ConfigManager/Types/Internal.hs new file mode 100644 index 0000000..5b91802 --- /dev/null +++ b/Data/ConfigManager/Types/Internal.hs @@ -0,0 +1,39 @@ +module Data.ConfigManager.Types.Internal + ( Config(..) + , Expr(..) + , Name + , Value + , Requirement(..) + ) where + +import Data.Text (Text) + +import Data.HashMap.Strict + +-- | Configuration data + +data Config = Config + { hashMap :: HashMap Name Value + } deriving (Eq, Read, Show) + +-- | An expression is either a binding or an import + +data Expr = + Binding Name Value + | Import Requirement FilePath + deriving (Eq, Read, Show) + +-- | A name is a text + +type Name = Text + +-- | A value is a text + +type Value = Text + +-- | A requirement is either required or optional + +data Requirement = + Required + | Optional + deriving (Eq, Read, Show) |