From 47623ec732ec19c765c0a1ebffd9b234f81e0d01 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 13 Mar 2016 21:26:03 +0100
Subject: Initial commit

---
 Data/ConfigManager.hs        | 27 ++++++++++++++++++++
 Data/ConfigManager/Config.hs | 11 ++++++++
 Data/ConfigManager/Parser.hs | 60 ++++++++++++++++++++++++++++++++++++++++++++
 Data/ConfigManager/Types.hs  | 13 ++++++++++
 4 files changed, 111 insertions(+)
 create mode 100644 Data/ConfigManager.hs
 create mode 100644 Data/ConfigManager/Config.hs
 create mode 100644 Data/ConfigManager/Parser.hs
 create mode 100644 Data/ConfigManager/Types.hs

(limited to 'Data')

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
-- 
cgit v1.2.3