salak 0.1.0 → 0.1.1
raw patch · 8 files changed
+336/−237 lines, 8 filesdep −bytestring
Dependencies removed: bytestring
Files
- salak.cabal +8/−11
- src/Data/Salak.hs +77/−11
- src/Data/Salak/Aeson.hs +13/−12
- src/Data/Salak/CommandLine.hs +12/−1
- src/Data/Salak/Environment.hs +2/−1
- src/Data/Salak/Property.hs +0/−200
- src/Data/Salak/Types.hs +222/−0
- src/Data/Salak/Yaml.hs +2/−1
salak.cabal view
@@ -2,17 +2,17 @@ -- -- see: https://github.com/sol/hpack ----- hash: 0f2d8453e74e53a24b06a57047e8a2cbff0554c3d8008c00c80746a3715498f6+-- hash: 5c22b23921e52c02d6bfc91c02e5cd2945f51b95d388cd2e07e992173557b53e name: salak-version: 0.1.0-synopsis: Configuration-description: Configuration+version: 0.1.1+synopsis: Configuration Loader+description: Configuration Loader for Production in Haskell category: Library homepage: https://github.com/leptonyu/salak#readme author: Daniel YU-maintainer: Daniel YU <leptonyu@gmail.com>-copyright: (c) Daniel YU+maintainer: Daniel YU <leptonyu@gmail.com>+copyright: (c) 2018 Daniel YU license: BSD3 license-file: LICENSE build-type: Simple@@ -24,7 +24,7 @@ exposed-modules: Data.Salak other-modules:- Data.Salak.Property+ Data.Salak.Types Data.Salak.Environment Data.Salak.CommandLine Data.Salak.Aeson@@ -34,7 +34,6 @@ build-depends: aeson , base >=4.7 && <5- , bytestring , directory , filepath , scientific@@ -54,7 +53,6 @@ build-depends: aeson , base >=4.7 && <5- , bytestring , directory , filepath , scientific@@ -73,7 +71,7 @@ Data.Salak.Aeson Data.Salak.CommandLine Data.Salak.Environment- Data.Salak.Property+ Data.Salak.Types Data.Salak.Yaml Paths_salak hs-source-dirs:@@ -83,7 +81,6 @@ QuickCheck , aeson , base >=4.7 && <5- , bytestring , directory , filepath , hspec ==2.*
src/Data/Salak.hs view
@@ -1,23 +1,40 @@ {-# LANGUAGE NoImplicitPrelude #-}-+-- |+-- Module: Data.Salak+-- Copyright: (c) 2018 Daniel YU+-- License: BSD3+-- Maintainer: Daniel YU <leptonyu@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Configuration Loader for Production in Haskell. +-- module Data.Salak(- Property(..)+ -- * How to use this library+ -- $use++ -- * Properties Loader+ defaultProperties+ , ParseCommandLine+ , defaultProperties'+ , defaultPropertiesWithFile+ , empty+ -- * Lookup Properties+ , lookup+ , toKeys+ -- * Types+ , Property(..) , Properties(..) , Key+ , FromProperties(..) , Return(..)+ -- * Properties Loader Helper , insert- , toKeys- , empty- , lookup , makePropertiesFromEnvironment , defaultParseCommandLine , makePropertiesFromCommandLine- , ParseCommandLine , makePropertiesFromJson , makePropertiesFromYaml- , defaultProperties- , defaultProperties'- , defaultPropertiesWithFile , FileName ) where @@ -25,23 +42,38 @@ import Data.Salak.Aeson import Data.Salak.CommandLine import Data.Salak.Environment-import Data.Salak.Property+import Data.Salak.Types import Data.Salak.Yaml import Prelude hiding (empty, lookup) import System.Directory import System.FilePath ((</>)) +-- | Initialize default properties from `CommandLine` and `Environment`. +-- `CommandLine` use default parser. defaultProperties :: IO Properties defaultProperties = defaultProperties' defaultParseCommandLine +-- | Initialize default properties from `CommandLine` and `Environment`. defaultProperties' :: ParseCommandLine -> IO Properties defaultProperties' dpc = makePropertiesFromCommandLine dpc empty >>= makePropertiesFromEnvironment +-- | Yaml file name. type FileName = String -defaultPropertiesWithFile :: FileName -> IO Properties+-- | Initialize default properties from `CommandLine`, `Environment` and `Yaml` files.+-- All these configuration sources has orders, from highest order to lowest order:+--+-- > 1. CommandLine+-- > 2. Environment+-- > 3. Specified Yaml file(file in "salak.config.dir")+-- > 4. Yaml file in current directory+-- > 5. Yaml file in home directory+--+defaultPropertiesWithFile + :: FileName -- ^ specify default config file name, can reset by config "salak.config.name" from `CommandLine` or `Environment`.+ -> IO Properties defaultPropertiesWithFile name = do p <- defaultProperties let n = fromMaybe name $ (lookup "salak.config.name" p :: Maybe String)@@ -57,3 +89,37 @@ if b then makePropertiesFromYaml f p' else if ok then return p' else error $ "File " ++ f ++ " not found"+++-- $use+-- +-- | This library default a standard configuration load process. It can load properties from `CommandLine`, `Environment`, +-- `JSON value` and `Yaml` files. They all load to the same format `Properties`. Earler property source has higher order +-- to load property. For example:+--+-- > CommandLine: --package.a.enabled=true+-- > Environment: PACKAGE_A_ENABLED: false+--+-- > lookup "package.a.enabled" properties => Just True+--+-- `CommandLine` has higher order then `Environment`, for the former load properties earler then later.+--+-- Usage:+--+-- > data Config = Config+-- > { name :: Text+-- > , dir :: Maybe Text+-- > , ext :: Int+-- > } deriving (Eq, Show)+-- > +-- > instance FromJSON Config where+-- > parseJSON = withObject "Config" $ \v -> Config+-- > <$> v .: "name"+-- > <*> v .:? "dir"+-- > <*> (fromMaybe 1 <$> v .:? "ext")+-- +-- > main = do+-- > p <- defaultPropertiesWithFile "salak.yml"+-- > let Just config = lookup "salak.config" p :: Maybe Config+-- > print config+
src/Data/Salak/Aeson.hs view
@@ -8,18 +8,19 @@ import Data.Char import qualified Data.HashMap.Strict as M import Data.Maybe-import Data.Salak.Property+import Data.Salak.Types import Data.Text (pack, unpack) import Data.Vector (fromList, toList) +-- | Load `Properties` from JSON `Value` makePropertiesFromJson :: Value -> Properties -> Properties makePropertiesFromJson Null p = p makePropertiesFromJson (Bool b) p = insert [] (PBool b) p makePropertiesFromJson (Number n) p = insert [] (PNum n) p makePropertiesFromJson (String s) p = insert [] (PStr $ unpack s) p-makePropertiesFromJson (Array v) (Node ps ms) = let (nps,nms) = fromArray v in Node (ps++nps) (ms++nms)-makePropertiesFromJson (Object o) (Node ps []) = Node ps [M.map jsonToProperties o]-makePropertiesFromJson (Object o) (Node ps [m]) = Node ps [m `M.union` M.map jsonToProperties o]+makePropertiesFromJson (Array v) (Properties ps ms) = let (nps,nms) = fromArray v in Properties (ps++nps) (ms++nms)+makePropertiesFromJson (Object o) (Properties ps []) = Properties ps [M.map jsonToProperties o]+makePropertiesFromJson (Object o) (Properties ps [m]) = Properties ps [m `M.union` M.map jsonToProperties o] makePropertiesFromJson (Object o) p = p jsonToProperties :: Value -> Properties@@ -27,19 +28,19 @@ fromArray v = foldl g3 ([],[]) $ go . jsonToProperties <$> toList v where- go (Node ps ms) = (g2 ps,g2 ms)+ go (Properties ps ms) = (g2 ps,g2 ms) g2 [] = [] g2 (a:_) = [a] g3 (as,bs) (a,b) = (as++a,bs++b) instance FromProperties Value where- fromProperties (Node [] []) = Empty- fromProperties (Node [PBool p] []) = OK $ Bool p- fromProperties (Node [PNum p] []) = OK $ Number p- fromProperties (Node [PStr p] []) = OK $ String $ pack p- fromProperties (Node ps []) = OK $ Array $ fromList $ mapReturn (fromProperties.(\p-> Node [p] [])) ps- fromProperties (Node _ [m]) = OK $ Object $ M.map (fromReturn Null . fromProperties) m- fromProperties (Node _ ms) = OK $ Array $ fromList $ mapReturn (fromProperties.(\m-> Node [] [m])) ms+ fromProperties (Properties [] []) = Empty+ fromProperties (Properties [PBool p] []) = OK $ Bool p+ fromProperties (Properties [PNum p] []) = OK $ Number p+ fromProperties (Properties [PStr p] []) = OK $ String $ pack p+ fromProperties (Properties ps []) = OK $ Array $ fromList $ mapReturn (fromProperties.(\p-> Properties [p] [])) ps+ fromProperties (Properties _ [m]) = OK $ Object $ M.map (fromReturn Null . fromProperties) m+ fromProperties (Properties _ ms) = OK $ Array $ fromList $ mapReturn (fromProperties.(\m-> Properties [] [m])) ms instance {-# OVERLAPPABLE #-} FromJSON a => FromProperties a where fromProperties a = do
src/Data/Salak/CommandLine.hs view
@@ -2,11 +2,21 @@ import Data.Char import Data.Maybe-import Data.Salak.Property+import Data.Salak.Types import System.Environment +-- | CommandLine parser. Parse command line into property key values. type ParseCommandLine = [String] -> IO [(String,Property)] +-- | Default command line parsers.+-- Use format:+-- +-- > --KEY=VALUE+--+-- For example:+--+-- > --salak.config.name=test.yml => ("salak.config.name", PStr "test.yml")+-- defaultParseCommandLine :: ParseCommandLine defaultParseCommandLine = return . mapMaybe go where@@ -15,6 +25,7 @@ _ -> Nothing go _ = Nothing +-- | Load `Properties` from 'CommandLine' makePropertiesFromCommandLine :: ParseCommandLine -> Properties -> IO Properties makePropertiesFromCommandLine parser p = getArgs >>= (\a -> makePropertiesFromCommandLine' a parser p)
src/Data/Salak/Environment.hs view
@@ -1,9 +1,10 @@ module Data.Salak.Environment where import Data.Char-import Data.Salak.Property+import Data.Salak.Types import System.Environment +-- | Load `Properties` from 'Environment' makePropertiesFromEnvironment :: Properties -> IO Properties makePropertiesFromEnvironment p = getEnvironment >>= (\v -> return $ makePropertiesFromEnvironment' v p)
− src/Data/Salak/Property.hs
@@ -1,200 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeSynonymInstances #-}-module Data.Salak.Property where--import Control.Monad ((>=>))-import Data.Char-import qualified Data.HashMap.Strict as M-import Data.Int-import Data.List.Split-import Data.Maybe-import Data.Scientific-import Data.Text (Text, pack, unpack)-import Data.Word-import Foreign.C.Types-import Text.Read--type Key = Text--data Properties- = Node [Property] [M.HashMap Key Properties]- deriving (Eq)--instance Show Properties where- show = unlines . go ""- where- go p (Node ps ms) = fmap (g2 p) ps ++ concat (fmap (g3 p) ms)- g2 p (PNum n) = p ++ "=" ++ show n- g2 p (PStr n) = p ++ "=" ++ n- g2 p (PBool n) = p ++ "=" ++ show n- g3 :: String -> M.HashMap Key Properties -> [String]- g3 p m = concat $ fmap (g4 p) $ M.toList m- g4 "" (p2,ps) = go (unpack p2) ps- g4 p (p2,ps) = go (p ++ "." ++ unpack p2) ps--data Property- = PNum Scientific- | PStr String- | PBool Bool- deriving (Eq, Show)--empty :: Properties-empty = Node [] []--toKeys :: String -> [Key]-toKeys = fmap pack . filter (not.null) . splitOneOf "."--insert :: [Key] -> Property -> Properties -> Properties-insert [] p (Node [] m) = Node [p] m-insert [] _ (Node ps m) = Node ps m-insert (a:as) p (Node ps []) = Node ps [M.insert a (insert as p empty) M.empty]-insert (a:as) p (Node ps ms) = Node ps $ go a as p <$> ms- where- go a as p m = case M.lookup a m of- Just n -> M.insert a (insert as p n) m- Nothing -> M.insert a (insert as p empty) m--lookup :: FromProperties a => String -> Properties -> Maybe a-lookup = go . toKeys- where- go [] p = from $ fromProperties p- go (a:as) (Node _ [m]) = case M.lookup a m of- Just n -> go as n- Nothing -> Nothing- go (a:as) _ = Nothing--makeProperties :: [(String, Property)] -> Properties -> Properties-makeProperties ps m = foldl go m ps- where- go m (k,v) = insert (toKeys k) v m--data Return a- = Empty- | OK a- | Fail String- deriving Show--instance Functor Return where- fmap f (OK a) = OK (f a)- fmap _ Empty = Empty- fmap _ (Fail b) = Fail b--instance Applicative Return where- pure = OK- (OK f) <*> (OK a) = OK (f a)- (Fail x) <*> (Fail y) = Fail $ x ++ ";" ++ y- (Fail x) <*> _ = Fail x- _ <*> (Fail y) = Fail y- _ <*> _ = Empty--instance Monad Return where- (OK a) >>= f = f a- Empty >>= _ = Empty- (Fail b) >>= _ = Fail b--fromReturn :: b -> Return b -> b-fromReturn _ (OK a) = a-fromReturn a _ = a--mapReturn :: (a -> Return b) -> [a] -> [b]-mapReturn f as = go $ fmap f as- where- go [] = []- go (OK a:as) = a : go as- go (_:as) = go as--class FromProperties a where- fromProperties :: Properties -> Return a--instance FromProperties Property where- fromProperties (Node (a:_) _) = OK a- fromProperties _ = Empty--instance {-# OVERLAPPABLE #-} FromProperties a => FromProperties [a] where- fromProperties (Node ps ms) =- let ns = fmap (\p -> Node [p] []) ps ++ fmap (\m -> Node [] [m]) ms- in OK $ mapReturn fromProperties ns--instance FromProperties Scientific where- fromProperties = fromProperties >=> go- where- go (PNum a) = OK a- go (PStr a) = to readMaybe a- go _ = Empty--instance FromProperties String where- fromProperties = fromProperties >=> go- where- go (PStr a) = OK a- go (PNum a) = OK $ show a- go (PBool a) = OK $ toLower <$> show a--instance FromProperties Text where- fromProperties a = pack <$> fromProperties a--instance FromProperties Float where- fromProperties a = toRealFloat <$> fromProperties a--instance FromProperties Double where- fromProperties a = toRealFloat <$> fromProperties a--instance FromProperties Int where- fromProperties = fromProperties >=> to toBoundedInteger--instance FromProperties Int8 where- fromProperties = fromProperties >=> to toBoundedInteger--instance FromProperties Int16 where- fromProperties = fromProperties >=> to toBoundedInteger--instance FromProperties Int32 where- fromProperties = fromProperties >=> to toBoundedInteger--instance FromProperties Int64 where- fromProperties = fromProperties >=> to toBoundedInteger--instance FromProperties Word where- fromProperties = fromProperties >=> to toBoundedInteger--instance FromProperties Word8 where- fromProperties = fromProperties >=> to toBoundedInteger--instance FromProperties Word16 where- fromProperties = fromProperties >=> to toBoundedInteger--instance FromProperties Word32 where- fromProperties = fromProperties >=> to toBoundedInteger--instance FromProperties Word64 where- fromProperties = fromProperties >=> to toBoundedInteger--to :: (b -> Maybe a) -> b -> Return a-to v a = case v a of- Just a -> OK a- Nothing -> Fail "number convert failed"--from :: Return a -> Maybe a-from (OK a) = Just a-from Empty = Nothing-from (Fail e) = error e--instance FromProperties Bool where- fromProperties = fromProperties >=> go- where- go (PBool a) = OK a- go (PStr a) = g2 $ fmap toLower a- go _ = Fail "number cannot convert to bool"- g2 "true" = OK True- g2 "false" = OK False- g2 _ = Empty--instance FromProperties Char where- fromProperties = fromProperties >=> go- where- go (PStr (a:_)) = OK a- go _ = Fail "cannot convert to char"--instance FromProperties CTime where- fromProperties a = CTime <$> fromProperties a-
+ src/Data/Salak/Types.hs view
@@ -0,0 +1,222 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Data.Salak.Types where++import Control.Monad ((>=>))+import Data.Char+import qualified Data.HashMap.Strict as M+import Data.Int+import Data.List.Split+import Data.Maybe+import Data.Scientific+import Data.Text (Text, pack, unpack)+import Data.Word+import Foreign.C.Types+import Text.Read++-- | Property key+type Key = Text++-- | A Property value represented as a Haskell value.+data Property+ = PNum !Scientific -- ^ Numeric Property+ | PStr !String -- ^ String Property+ | PBool !Bool -- ^ Bool Property+ deriving (Eq, Show)++-- | A Property Container to hold all properties+data Properties+ = Properties [Property] [M.HashMap Key Properties]+ deriving (Eq)++instance Show Properties where+ show = unlines . go ""+ where+ {-# INLINE go #-}+ {-# INLINE g2 #-}+ {-# INLINE g3 #-}+ {-# INLINE g4 #-}+ go p (Properties ps ms) = fmap (g2 p) ps ++ concat (fmap (g3 p) ms)+ g2 p (PNum n) = p ++ "=" ++ show n+ g2 p (PStr n) = p ++ "=" ++ n+ g2 p (PBool n) = p ++ "=" ++ show n+ g3 :: String -> M.HashMap Key Properties -> [String]+ g3 p m = concat $ fmap (g4 p) $ M.toList m+ g4 "" (p2,ps) = go (unpack p2) ps+ g4 p (p2,ps) = go (p ++ "." ++ unpack p2) ps++-- | The empty `Properties`+empty :: Properties+empty = Properties [] []++-- | Split origin key by '.' to sub keys:+-- +-- > "salak.config.name" -> ["salak","config","name"]+-- > "" -> []+-- > "a..b" -> ["a","b"]+-- +toKeys :: String -> [Key]+toKeys = fmap pack . filter (not.null) . splitOneOf "."++-- | Insert simple `Property` into `Properties` by `Key`.+-- If the key already have values then the new property will discard.+insert :: [Key] -> Property -> Properties -> Properties+insert [] p (Properties [] m) = Properties [p] m+insert [] _ (Properties ps m) = Properties ps m+insert (a:as) p (Properties ps []) = Properties ps [M.insert a (insert as p empty) M.empty]+insert (a:as) p (Properties ps ms) = Properties ps $ go a as p <$> ms+ where+ go a as p m = case M.lookup a m of+ Just n -> M.insert a (insert as p n) m+ Nothing -> M.insert a (insert as p empty) m++-- | Find `Properties` by key and convert to specific Haskell value.+-- Return `Nothing` means not found, and throw `ErrorCall` means convert failed.+lookup :: FromProperties a => String -> Properties -> Maybe a+lookup = go . toKeys+ where+ go [] p = from $ fromProperties p+ go (a:as) (Properties _ [m]) = case M.lookup a m of+ Just n -> go as n+ Nothing -> Nothing+ go (a:as) _ = Nothing++-- | Insert batch properties to `Properties`+makeProperties :: [(String, Property)] -> Properties -> Properties+makeProperties ps m = foldl go m ps+ where+ go m (k,v) = insert (toKeys k) v m++-- | Return of `FromProperties`+data Return a+ = Empty+ | OK a+ | Fail String+ deriving Show++instance Functor Return where+ fmap f (OK a) = OK (f a)+ fmap _ Empty = Empty+ fmap _ (Fail b) = Fail b++instance Applicative Return where+ pure = OK+ (OK f) <*> (OK a) = OK (f a)+ (Fail x) <*> (Fail y) = Fail $ x ++ ";" ++ y+ (Fail x) <*> _ = Fail x+ _ <*> (Fail y) = Fail y+ _ <*> _ = Empty++instance Monad Return where+ (OK a) >>= f = f a+ Empty >>= _ = Empty+ (Fail b) >>= _ = Fail b++fromReturn :: b -> Return b -> b+fromReturn _ (OK a) = a+fromReturn a _ = a++mapReturn :: (a -> Return b) -> [a] -> [b]+mapReturn f as = go $ fmap f as+ where+ go [] = []+ go (OK a:as) = a : go as+ go (_:as) = go as++-- | Convert `Properties` to Haskell value.+class FromProperties a where+ fromProperties :: Properties -> Return a++instance FromProperties Property where+ fromProperties (Properties (a:_) _) = OK a+ fromProperties _ = Empty++instance {-# OVERLAPPABLE #-} FromProperties a => FromProperties [a] where+ fromProperties (Properties ps ms) =+ let ns = fmap (\p -> Properties [p] []) ps ++ fmap (\m -> Properties [] [m]) ms+ in OK $ mapReturn fromProperties ns++instance FromProperties Scientific where+ fromProperties = fromProperties >=> go+ where+ go (PNum a) = OK a+ go (PStr a) = to readMaybe a+ go _ = Empty++instance FromProperties String where+ fromProperties = fromProperties >=> go+ where+ go (PStr a) = OK a+ go (PNum a) = OK $ show a+ go (PBool a) = OK $ toLower <$> show a++instance FromProperties Text where+ fromProperties a = pack <$> fromProperties a++instance FromProperties Float where+ fromProperties a = toRealFloat <$> fromProperties a++instance FromProperties Double where+ fromProperties a = toRealFloat <$> fromProperties a++instance FromProperties Int where+ fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Int8 where+ fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Int16 where+ fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Int32 where+ fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Int64 where+ fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word where+ fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word8 where+ fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word16 where+ fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word32 where+ fromProperties = fromProperties >=> to toBoundedInteger++instance FromProperties Word64 where+ fromProperties = fromProperties >=> to toBoundedInteger++to :: (b -> Maybe a) -> b -> Return a+to v a = case v a of+ Just a -> OK a+ Nothing -> Fail "number convert failed"++from :: Return a -> Maybe a+from (OK a) = Just a+from Empty = Nothing+from (Fail e) = error e++instance FromProperties Bool where+ fromProperties = fromProperties >=> go+ where+ go (PBool a) = OK a+ go (PStr a) = g2 $ fmap toLower a+ go _ = Fail "number cannot convert to bool"+ g2 "true" = OK True+ g2 "false" = OK False+ g2 _ = Empty++instance FromProperties Char where+ fromProperties = fromProperties >=> go+ where+ go (PStr (a:_)) = OK a+ go _ = Fail "cannot convert to char"++instance FromProperties CTime where+ fromProperties a = CTime <$> fromProperties a+
src/Data/Salak/Yaml.hs view
@@ -1,9 +1,10 @@ module Data.Salak.Yaml where import Data.Salak.Aeson-import Data.Salak.Property+import Data.Salak.Types import Data.Yaml +-- | Load `Properties` from `Yaml` file. makePropertiesFromYaml :: FilePath -> Properties -> IO Properties makePropertiesFromYaml file p = do v <- decodeFileThrow file