diff options
Diffstat (limited to 'Data')
-rw-r--r-- | Data/ConfigManager.hs | 27 | ||||
-rw-r--r-- | Data/ConfigManager/Config.hs | 11 | ||||
-rw-r--r-- | Data/ConfigManager/Parser.hs | 60 | ||||
-rw-r--r-- | Data/ConfigManager/Types.hs | 13 |
4 files changed, 111 insertions, 0 deletions
diff --git a/Data/ConfigManager.hs b/Data/ConfigManager.hs new file mode 100644 index 0000000..d972cd8 --- /dev/null +++ b/Data/ConfigManager.hs @@ -0,0 +1,27 @@ +module Data.ConfigManager + ( readConfig + , lookup + , lookupDefault + ) where + +import Prelude hiding (lookup) +import Text.Read (readMaybe) +import Control.Monad (join) + +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Data.HashMap.Strict as M + +import Data.ConfigManager.Config +import Data.ConfigManager.Parser (parseConfig) +import Data.ConfigManager.Types + +readConfig :: FilePath -> IO (Either Text Config) +readConfig path = parseConfig <$> T.readFile path + +lookup :: Read a => Name -> Config -> Maybe a +lookup name config = join . fmap (readMaybe . T.unpack) $ M.lookup name (hashMap config) + +lookupDefault :: Value -> Name -> Config -> Value +lookupDefault defaultValue name config = M.lookupDefault defaultValue name (hashMap config) diff --git a/Data/ConfigManager/Config.hs b/Data/ConfigManager/Config.hs new file mode 100644 index 0000000..a98dbbb --- /dev/null +++ b/Data/ConfigManager/Config.hs @@ -0,0 +1,11 @@ +module Data.ConfigManager.Config + ( Config(..) + ) where + +import Data.HashMap.Strict + +import Data.ConfigManager.Types + +data Config = Config + { hashMap :: HashMap Name Value + } deriving (Eq, Read, Show) diff --git a/Data/ConfigManager/Parser.hs b/Data/ConfigManager/Parser.hs new file mode 100644 index 0000000..e2329b6 --- /dev/null +++ b/Data/ConfigManager/Parser.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.ConfigManager.Parser + ( parseConfig + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.HashMap.Strict as M +import Data.Char (isSpace, isAlphaNum) + +import Text.ParserCombinators.Parsec + +import Data.ConfigManager.Config (Config(..)) +import Data.ConfigManager.Types + +parseConfig :: Text -> Either Text Config +parseConfig input = + case parse bindingsParser "" (T.unpack (T.concat [input, "\n"])) of + Right bindings -> Right . Config . M.fromList $ bindings + Left parserError -> Left . T.pack . show $ parserError + +bindingsParser :: Parser [Binding] +bindingsParser = skip *> many (bindingParser <* restOfLine <* skip) <* eof + +bindingParser :: Parser Binding +bindingParser = do + name <- nameParser + _ <- spaces + _ <- char '=' + _ <- spaces + value <- valueParser + return (name, value) + +nameParser :: Parser Name +nameParser = do + first <- letter + rest <- many (satisfy (\c -> isAlphaNum c || c == '-' || c == '_')) + return . T.pack $ first : rest + +valueParser :: Parser Value +valueParser = T.strip . T.pack <$> many (noneOf "\n#") + +skip :: Parser () +skip = + (satisfy isSpace *> skip) + <|> (comment *> skip) + <|> (return ()) + +comment :: Parser () +comment = do + _ <- char '#' *> (many $ noneOf "\n") >> return () + return () + +restOfLine :: Parser () +restOfLine = do + _ <- many (char ' ') + _ <- optional comment + _ <- newline + return () diff --git a/Data/ConfigManager/Types.hs b/Data/ConfigManager/Types.hs new file mode 100644 index 0000000..2f2f00e --- /dev/null +++ b/Data/ConfigManager/Types.hs @@ -0,0 +1,13 @@ +module Data.ConfigManager.Types + ( Binding + , Name + , Value + ) where + +import Data.Text (Text) + +type Binding = (Name, Value) + +type Name = Text + +type Value = Text |