salak 0.1.2 → 0.1.3
raw patch · 9 files changed
+168/−139 lines, 9 filesdep +aeson-prettydep +bytestringdep −splitdep ~base
Dependencies added: aeson-pretty, bytestring
Dependencies removed: split
Dependency ranges changed: base
Files
- Main.hs +0/−5
- README.md +1/−1
- salak.cabal +6/−23
- src/Data/Salak.hs +26/−9
- src/Data/Salak/Aeson.hs +6/−9
- src/Data/Salak/CommandLine.hs +3/−3
- src/Data/Salak/Environment.hs +2/−1
- src/Data/Salak/Types.hs +88/−71
- test/Spec.hs +36/−17
− Main.hs
@@ -1,5 +0,0 @@-module Main where--main :: IO ()-main = do- putStrLn "hello world"
README.md view
@@ -1,6 +1,6 @@ # salak -[](https://hackage.haskell.org/package/salak)+[](https://hackage.haskell.org/package/salak) Configuration Loader for Production in Haskell.
salak.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 82f2482ba7f49ee8ad36d437e333c17b1bbfe849d8d94af64aeb66a611d3a71c+-- hash: 23ec79db8365c6f1dee0d024ad785c8e8a99b04bfa21907880d9474e7c0d003b name: salak-version: 0.1.2+version: 0.1.3 synopsis: Configuration Loader description: Configuration Loader for Production in Haskell category: Library@@ -31,38 +31,19 @@ Data.Salak.Yaml hs-source-dirs: src+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-orphans -fno-warn-missing-signatures build-depends: aeson , base >=4.7 && <5 , directory , filepath , scientific- , split , text , unordered-containers , vector , yaml default-language: Haskell2010 -executable salak- main-is: Main.hs- other-modules:- Paths_salak- hs-source-dirs:- ./.- build-depends:- aeson- , base >=4.7 && <5- , directory- , filepath- , scientific- , split- , text- , unordered-containers- , vector- , yaml- default-language: Haskell2010- test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs@@ -77,15 +58,17 @@ hs-source-dirs: test src+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-orphans -fno-warn-missing-signatures build-depends: QuickCheck , aeson+ , aeson-pretty , base >=4.7 && <5+ , bytestring , directory , filepath , hspec ==2.* , scientific- , split , text , unordered-containers , vector
src/Data/Salak.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} -- | -- Module: Data.Salak -- Copyright: (c) 2018 Daniel YU@@ -21,6 +22,7 @@ , empty -- * Lookup Properties , lookup+ , lookup' , toKeys -- * Types , Property(..)@@ -44,7 +46,8 @@ import Data.Salak.Environment import Data.Salak.Types import Data.Salak.Yaml-import Prelude hiding (empty, lookup)+import Data.Text (Text, unpack)+import Prelude hiding (lookup) import System.Directory import System.FilePath ((</>)) @@ -60,7 +63,7 @@ >>= makePropertiesFromEnvironment -- | Yaml file name.-type FileName = String+type FileName = Text -- | Initialize default properties from `CommandLine`, `Environment` and `Yaml` files. -- All these configuration sources has orders, from highest order to lowest order:@@ -74,22 +77,36 @@ 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)+defaultPropertiesWithFile name = defaultPropertiesWithFile' name defaultParseCommandLine++-- | 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`.+ -> ParseCommandLine -- ^ parser for command line+ -> IO Properties+defaultPropertiesWithFile' name dpc = do+ p <- defaultProperties' dpc+ let n = fromMaybe name $ lookup "salak.config.name" p p' = insert (toKeys "salak.config.name") (PStr n) p c <- getCurrentDirectory h <- getHomeDirectory- foldl (go n) (return p') $ [(lookup "salak.config.dir" p, False), (Just c, True), (Just h, True)]+ foldl (go n) (return p') [(lookup "salak.config.dir" p, False), (Just c, True), (Just h, True)] where- go _ p (Nothing, _) = p- go name p (Just d, ok) = let f = d </> name in do+ go _ p (Nothing, _) = p+ go n p (Just d, ok) = let f = d </> unpack n in do p' <- p b <- doesFileExist f if b then makePropertiesFromYaml f p' else if ok then return p' else error $ "File " ++ f ++ " not found"- -- $use --
src/Data/Salak/Aeson.hs view
@@ -5,11 +5,8 @@ module Data.Salak.Aeson where import Data.Aeson-import Data.Char import qualified Data.HashMap.Strict as M-import Data.Maybe import Data.Salak.Types-import Data.Text (pack, unpack) import Data.Vector (fromList, toList) -- | Load `Properties` from JSON `Value`@@ -17,11 +14,11 @@ 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 (String s) p = insert [] (PStr s) p 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+makePropertiesFromJson (Object _) p = p jsonToProperties :: Value -> Properties jsonToProperties = (`makePropertiesFromJson` empty)@@ -35,12 +32,12 @@ instance FromProperties Value where fromProperties (Properties [] []) = Empty- fromProperties (Properties [PBool p] []) = OK $ Bool p+ 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 [PStr p] []) = OK $ String p+ fromProperties (Properties ps []) = Array . fromList <$> traverse (fromProperties.singleton) ps fromProperties (Properties _ [m]) = OK $ Object $ M.map (fromReturn Null . fromProperties) m- fromProperties (Properties _ ms) = OK $ Array $ fromList $ mapReturn (fromProperties.(\m-> Properties [] [m])) ms+ fromProperties (Properties _ ms) = Array . fromList <$> traverse (fromProperties.singletonMap) ms instance {-# OVERLAPPABLE #-} FromJSON a => FromProperties a where fromProperties a = do
src/Data/Salak/CommandLine.hs view
@@ -1,8 +1,8 @@ module Data.Salak.CommandLine where -import Data.Char import Data.Maybe import Data.Salak.Types+import Data.Text (pack) import System.Environment -- | CommandLine parser. Parse command line into property key values.@@ -21,7 +21,7 @@ defaultParseCommandLine = return . mapMaybe go where go ('-':'-':as) = case break (=='=') as of- (a,'=':b) -> Just (a,PStr b)+ (a,'=':b) -> Just (a,PStr $ pack b) _ -> Nothing go _ = Nothing @@ -32,4 +32,4 @@ makePropertiesFromCommandLine' :: [String] -> ParseCommandLine -> Properties -> IO Properties makePropertiesFromCommandLine' args parser p = do v <- parser args- return $ makeProperties v p+ return $ makeProperties (fmap (\(a,b) -> (pack a,b)) v) p
src/Data/Salak/Environment.hs view
@@ -2,6 +2,7 @@ import Data.Char import Data.Salak.Types+import Data.Text (pack) import System.Environment -- | Load `Properties` from 'Environment'@@ -12,6 +13,6 @@ makePropertiesFromEnvironment' :: [(String,String)] -> Properties -> Properties makePropertiesFromEnvironment' vs = makeProperties $ go <$> vs where- go (k,v) = (fmap g2 k,PStr v)+ go (k,v) = (pack $ fmap g2 k,PStr $ pack v) g2 '_' = '.' g2 a = toLower a
src/Data/Salak/Types.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -8,12 +9,12 @@ 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.String+import Data.Text (Text)+import qualified Data.Text as T import Data.Word-import Foreign.C.Types import Text.Read -- | Property key@@ -22,70 +23,97 @@ -- | A Property value represented as a Haskell value. data Property = PNum !Scientific -- ^ Numeric Property- | PStr !String -- ^ String Property+ | PStr !Text -- ^ String Property | PBool !Bool -- ^ Bool Property- deriving (Eq, Show)+ deriving Eq +instance Show Property where+ {-# INLINE show #-}+ show (PNum n) = show n+ show (PStr n) = T.unpack n+ show (PBool n) = toLower <$> show n++instance IsString Property where+ fromString = PStr . T.pack+ -- | A Property Container to hold all properties data Properties = Properties [Property] [M.HashMap Key Properties] deriving (Eq) instance Show Properties where+ {-# INLINE show #-} 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+ {-# INLINE convert #-}+ go p (Properties ps ms) = convert p g2 ps ++ concat (convert p g3 ms)+ g2 "" a = ".=" ++ show a+ g2 p a = p ++ "=" ++ show a 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+ g3 p = concatMap (g4 p) . M.toList+ g4 "" (p2,ps) = go (T.unpack p2) ps+ g4 p (p2,ps) = go (p ++ "." ++ T.unpack p2) ps+ convert _ _ [] = []+ convert p f [a] = [f p a]+ convert p f as = zipWith (\(i :: Int) a -> f (p ++ "[" ++ show i ++ "]") a) [0..] as -- | The empty `Properties` empty :: Properties empty = Properties [] [] ++singleton :: Property -> Properties+singleton p = Properties [p] []++singletonMap :: M.HashMap Key Properties -> Properties+singletonMap m = Properties [] [m]+ -- | 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 "."+toKeys :: Text -> [Key]+toKeys = filter (not.T.null) . T.splitOn "." -- | 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+insert (a:as) p (Properties ps []) = Properties ps [insertMap as p a M.empty]+insert (a:as) p (Properties ps ms) = Properties ps $ insertMap as p a <$> ms +insertMap as p = M.alter (Just . insert as p . fromMaybe empty)+ -- | 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+lookup :: FromProperties a => Text -> Properties -> Maybe a+lookup k = from . lookup' k where- go [] p = from $ fromProperties p+ from :: Return a -> Maybe a+ from (OK a) = Just a+ from Empty = Nothing+ from (Fail e) = error e++-- | Find `Properties` by key and convert to specific Haskell value.+lookup' :: FromProperties a => Text -> Properties -> Return a+lookup' = go . toKeys+ where+ go [] p = fromProperties p go (a:as) (Properties _ [m]) = case M.lookup a m of- Just n -> go as n- Nothing -> Nothing- go (a:as) _ = Nothing+ Just n -> go as n+ _ -> Empty+ go _ _ = Empty -- | Insert batch properties to `Properties`-makeProperties :: [(String, Property)] -> Properties -> Properties-makeProperties ps m = foldl go m ps+makeProperties :: [(Text, Property)] -> Properties -> Properties+makeProperties = flip (foldl go) where go m (k,v) = insert (toKeys k) v m @@ -118,42 +146,33 @@ 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+ fromProperties (Properties [a] _) = OK a+ fromProperties (Properties [] _) = Empty+ fromProperties _ = Fail "property has multi values" 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+ fromProperties (Properties ps ms) = traverse fromProperties $ fmap singleton ps ++ fmap singletonMap ms instance FromProperties Scientific where fromProperties = fromProperties >=> go where go (PNum a) = OK a- go (PStr a) = to readMaybe a- go _ = Empty+ go (PStr a) = to readMaybe $ T.unpack a+ go _ = Fail "bool cannot convert to number" 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+ fromProperties a = T.unpack <$> fromProperties a instance FromProperties Text where- fromProperties a = pack <$> fromProperties a+ fromProperties = fromProperties >=> go+ where+ go (PStr a) = OK a+ go a = OK $ T.pack $ show a instance FromProperties Float where fromProperties a = toRealFloat <$> fromProperties a@@ -162,61 +181,59 @@ fromProperties a = toRealFloat <$> fromProperties a instance FromProperties Int where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric instance FromProperties Int8 where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric instance FromProperties Int16 where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric instance FromProperties Int32 where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric instance FromProperties Int64 where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric instance FromProperties Word where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric instance FromProperties Word8 where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric instance FromProperties Word16 where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric instance FromProperties Word32 where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric instance FromProperties Word64 where- fromProperties = fromProperties >=> to toBoundedInteger+ fromProperties = toNumeric +toNumeric :: (Bounded i, Integral i) => Properties -> Return i+toNumeric = fromProperties >=> to toBoundedInteger+ to :: (b -> Maybe a) -> b -> Return a-to v a = case v a of+to v b = case v b 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 (PStr a) = g2 $ T.toLower a go _ = Fail "number cannot convert to bool"+ g2 :: Text -> Return Bool g2 "true" = OK True g2 "false" = OK False- g2 _ = Empty+ g2 _ = Fail "string value cannot convert to bool" 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+ go (PStr s)+ | T.null s = Empty+ | otherwise = OK $ T.head s+ go _ = Fail "cannot convert to char"
test/Spec.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} module Main where -import Control.Exception (SomeException) import Data.Aeson import qualified Data.HashMap.Strict as M import Data.Maybe@@ -11,15 +11,17 @@ import Data.Salak.CommandLine import Data.Salak.Environment import qualified Data.Salak.Types as P-import Data.Text (Text, pack)+import Data.Text (Text, intercalate, pack) import System.Environment import Test.Hspec+import Test.QuickCheck main = hspec spec spec :: Spec spec = do describe "Data.Salak.Types" specProperty+ describe "Data.Salak" specProperties shouldFail :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation shouldFail f a = (f `shouldBe` a) `shouldThrow` anyErrorCall@@ -49,6 +51,8 @@ ["a"] `shouldBe` toKeys "a." ["a","b"] `shouldBe` toKeys "a.b" ["a","b"] `shouldBe` toKeys "a.....b"+ it "quickCheck" $ do+ quickCheck $ \a -> let b = toKeys $ pack a in b == toKeys (intercalate "." b) context "insert" $ do let p = PStr "Hello" k = toKeys "a.b"@@ -57,7 +61,11 @@ insert [] p empty `shouldBe` Properties [p] [] insert k p empty `shouldBe` Properties [] [M.insert "a" (Properties [] [M.insert "b" (Properties [p] []) M.empty]) M.empty] it "Reject replacement" $ do- insert k (PStr "1") m `shouldBe` m+ insert k "1" m `shouldBe` m+ it "quickCheck" $ do+ quickCheck $ \a' (b :: Integer) -> let a = pack a' in Just b == P.lookup a (insert (toKeys a) (PNum $ fromInteger b) empty)+ quickCheck $ \a' (b :: Bool) -> let a = pack a' in Just b == P.lookup a (insert (toKeys a) (PBool b) empty)+ quickCheck $ \a' (b :: String) -> let a = pack a' in Just b == P.lookup a (insert (toKeys a) (PStr $ pack b) empty) context "lookup" $ do it "normal" $ do let m = insert ["a"] (PNum 1) empty@@ -88,28 +96,39 @@ P.lookup "package.a.enabled" m `shouldBe` Just True P.lookup "package.b.enabled" m `shouldBe` Just False (P.lookup "package.c.enabled" m :: Maybe Bool )`shouldBe` Nothing++specProperties = do context "defaultPropertiesWithFile" $ do- let name = "salak.yml" :: String+ let confName = "salak.yml" :: String+ confName' = pack confName it "read config" $ do unsetEnv "SALAK_CONFIG_NAME"- p <- defaultPropertiesWithFile name- P.lookup "salak.config.name" p `shouldBe` Just name+ p <- defaultPropertiesWithFile confName'+ P.lookup "salak.config.name" p `shouldBe` Just confName it "read config - replacement" $ do- setEnv "SALAK_CONFIG_NAME" name+ setEnv "SALAK_CONFIG_NAME" confName p <- defaultPropertiesWithFile "salak.ok"- P.lookup "salak.config.name" p `shouldBe` Just name+ P.lookup "salak.config.name" p `shouldBe` Just confName it "read config - not found" $ do setEnv "SALAK_CONFIG_NAME" "salak.notfound" setEnv "SALAK_CONFIG_DIR" "test"- defaultPropertiesWithFile name `shouldThrow` anyErrorCall+ defaultPropertiesWithFile confName' `shouldThrow` anyErrorCall it "read config - read file parse Config" $ do- setEnv "SALAK_CONFIG_NAME" name+ setEnv "SALAK_CONFIG_NAME" confName setEnv "SALAK_CONFIG_DIR" "test"- p <- defaultPropertiesWithFile name- print p- P.lookup "salak.config.name" p `shouldBe` Just name- (P.lookup "salak.config" p :: Maybe Config) `shouldBe` Just (Config (pack name) "test" 1)- (P.lookup "array" p :: Maybe [String]) `shouldBe` Just ["a","b"]+ setEnv "SALAK_CONFIG" confName+ p <- defaultPropertiesWithFile confName'+ let get :: FromProperties a => Text -> Maybe a+ get = flip P.lookup p+ -- print p+ -- let v::Return Value = fromProperties p+ -- P.fromReturn (return ()) $ BC.putStrLn . encodePretty <$> v+ get "salak.config.name" `shouldBe` Just confName+ get "salak.config" `shouldBe` Just confName+ (get "salak.config" :: Maybe Config) `shouldBe` Just (Config confName' "test" 1)+ (get "array" :: Maybe [String]) `shouldBe` Just ["a","b"]+ (get "array" :: Maybe [Int]) `shouldFail` Nothing+ (get "array" :: Maybe String) `shouldFail` Nothing