module Alga.Configuration
( Params
, parseConfig
, lookupCfg )
where
import Control.Applicative
import Control.Monad
import Data.Char (isSpace)
import Data.Map (Map)
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Text.Lazy (Text)
import Numeric.Natural
import Text.Megaparsec
import Text.Megaparsec.Text.Lazy
import qualified Data.Map as M
import qualified Text.Megaparsec.Lexer as L
type Params = Map String String
class Read a => Parsable a where
parseValue :: String -> Maybe a
instance Parsable String where
parseValue = Just
instance Parsable Natural where
parseValue = parseNum
instance Parsable Double where
parseValue = parseNum
instance Parsable Bool where
parseValue "true" = Just True
parseValue "false" = Just False
parseValue _ = Nothing
lookupCfg :: Parsable a
=> Params
-> String
-> a
-> a
lookupCfg cfg v d = fromMaybe d $ M.lookup v cfg >>= parseValue
parseConfig :: String -> Text -> Either String Params
parseConfig file = either (Left . show) Right . parse pConfig file
pConfig :: Parser Params
pConfig = M.fromList <$> (sc *> many pItem <* eof)
pItem :: Parser (String, String)
pItem = (,) <$> pIdentifier <* pOperator "=" <*> (pString <|> pThing)
pIdentifier :: Parser String
pIdentifier = lexeme $ (:) <$> first <*> many other
where first = letterChar <|> char '_'
other = alphaNumChar <|> char '_'
pOperator :: String -> Parser String
pOperator = lexeme . string
pString :: Parser String
pString = lexeme $ char '"' >> manyTill L.charLiteral (char '"')
pThing :: Parser String
pThing = lexeme $ many (satisfy $ not . isSpace)
lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc
sc :: Parser ()
sc = L.space (void spaceChar) (L.skipLineComment "#") empty
parseNum :: (Num a, Read a) => String -> Maybe a
parseNum = fmap fst . listToMaybe . reads