salak 0.2.1 → 0.2.2
raw patch · 10 files changed
+224/−125 lines, 10 filesdep +mtldep +transformersdep −aeson-prettydep −bytestringdep ~QuickCheckdep ~aesondep ~base
Dependencies added: mtl, transformers
Dependencies removed: aeson-pretty, bytestring
Dependency ranges changed: QuickCheck, aeson, base, directory, filepath, scientific, text, unordered-containers, vector, yaml
Files
- README.md +1/−1
- salak.cabal +26/−28
- src/Data/Salak.hs +42/−35
- src/Data/Salak/Aeson.hs +10/−2
- src/Data/Salak/CommandLine.hs +13/−1
- src/Data/Salak/Environment.hs +9/−1
- src/Data/Salak/Operation.hs +16/−2
- src/Data/Salak/Types.hs +51/−20
- src/Data/Salak/Yaml.hs +27/−0
- test/Spec.hs +29/−35
README.md view
@@ -1,6 +1,6 @@ # salak -[](https://hackage.haskell.org/package/salak)+[](https://hackage.haskell.org/package/salak) [](https://travis-ci.org/leptonyu/salak)
salak.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: salak-version: 0.2.1+version: 0.2.2 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU@@ -28,19 +28,19 @@ Data.Salak.Yaml Data.Salak.Operation default-language: Haskell2010- ghc-options: -Wall -Wcompat -Wincomplete-record-updates- -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-orphans- -fno-warn-missing-signatures+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures build-depends:- aeson >=1.4.2.0 && <1.5,- base >=4.11 && <5,- directory >=1.3.3.0 && <1.4,- filepath >=1.4.2.1 && <1.5,- scientific >=0.3.6.2 && <0.4,- text >=1.2.3.1 && <1.3,- unordered-containers >=0.2.9.0 && <0.3,- vector >=0.12.0.2 && <0.13,- yaml >=0.11.0.0 && <0.12+ aeson <1.5,+ base >=4.7 && <5,+ directory <1.4,+ filepath <1.5,+ mtl <2.3,+ scientific <0.4,+ text <1.3,+ transformers <0.6,+ unordered-containers <0.3,+ vector <0.13,+ yaml <0.12 test-suite spec type: exitcode-stdio-1.0@@ -56,20 +56,18 @@ Data.Salak.Yaml Paths_salak default-language: Haskell2010- ghc-options: -Wall -Wcompat -Wincomplete-record-updates- -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-orphans- -fno-warn-missing-signatures+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures build-depends:- QuickCheck >=2.12.6.1 && <2.13,- aeson >=1.4.2.0 && <1.5,- aeson-pretty >=0.8.7 && <0.9,- base >=4.11 && <5,- bytestring >=0.10.8.2 && <0.11,- directory >=1.3.3.0 && <1.4,- filepath >=1.4.2.1 && <1.5,+ QuickCheck <2.13,+ aeson <1.5,+ base >=4.7 && <5,+ directory <1.4,+ filepath <1.5, hspec ==2.*,- scientific >=0.3.6.2 && <0.4,- text >=1.2.3.1 && <1.3,- unordered-containers >=0.2.9.0 && <0.3,- vector >=0.12.0.2 && <0.13,- yaml >=0.11.0.0 && <0.12+ mtl <2.3,+ scientific <0.4,+ text <1.3,+ transformers <0.6,+ unordered-containers <0.3,+ vector <0.13,+ yaml <0.12
src/Data/Salak.hs view
@@ -15,15 +15,23 @@ -- $use -- * Properties Loader- defaultProperties- , ParseCommandLine+ LoadProperties+ , runLoad+ , askProperties+ , setValue+ , loadCommandLine+ , loadEnvironment+ , loadJSON+ , loadYaml+ , loadYamlIfExists+ -- ** Predefined Loaders+ , defaultProperties , defaultProperties' , defaultPropertiesWithFile , defaultPropertiesWithFile' , empty -- * Lookup Properties , lookup- , lookup' , toKeys -- * Types , Property(..)@@ -33,16 +41,14 @@ , Return -- * Properties Loader Helper , insert- , makePropertiesFromEnvironment , defaultParseCommandLine- , makePropertiesFromCommandLine- , makePropertiesFromJson- , makePropertiesFromYaml+ , ParseCommandLine , FileName -- * Operations , module Data.Salak.Operation ) where +import Control.Monad.Trans.Class (lift) import Data.Maybe import Data.Salak.Aeson import Data.Salak.CommandLine@@ -50,10 +56,10 @@ import Data.Salak.Operation import Data.Salak.Types import Data.Salak.Yaml-import Data.Text (Text, unpack)-import Prelude hiding (lookup)+import Data.Text (pack)+import Prelude hiding (lookup) import System.Directory-import System.FilePath ((</>))+import System.FilePath ((</>)) -- | Initialize default properties from `CommandLine` and `Environment`. -- `CommandLine` use default parser.@@ -62,12 +68,12 @@ -- | Initialize default properties from `CommandLine` and `Environment`. defaultProperties' :: ParseCommandLine -> IO Properties-defaultProperties' dpc- = makePropertiesFromCommandLine dpc empty- >>= makePropertiesFromEnvironment+defaultProperties' dpc = runLoad $ do+ loadCommandLine dpc+ loadEnvironment -- | Yaml file name.-type FileName = Text+type FileName = String -- | Initialize default properties from `CommandLine`, `Environment` and `Yaml` files. -- All these configuration sources has orders, from highest order to lowest order:@@ -96,21 +102,20 @@ :: 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)]- where- 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"+defaultPropertiesWithFile' name dpc = runLoad $ do+ loadCommandLine dpc+ loadEnvironment+ p <- askProperties+ let n = fromMaybe name $ p .>> "salak.config.name"+ f = p .>> "salak.config.dir"+ setValue "salak.config.name" (PStr $ pack n)+ case f of+ Just y -> loadYaml (y </> n)+ _ -> return ()+ c <- lift getCurrentDirectory+ loadYamlIfExists (Just $ c </> n)+ h <- lift getHomeDirectory+ loadYamlIfExists (Just $ h </> n) -- $use --@@ -133,14 +138,16 @@ -- > , ext :: Int -- > } deriving (Eq, Show) -- >--- > instance FromJSON Config where--- > parseJSON = withObject "Config" $ \v -> Config--- > <$> v .: "name"--- > <*> v .:? "dir"--- > <*> (fromMaybe 1 <$> v .:? "ext")+-- > instance FromProperties Config where+-- > fromProperties v = Config+-- > <$> v .?> "name"+-- > <*> v .?> "dir"+-- > <*> v .?> "ext" .?= 1 -- -- > main = do -- > p <- defaultPropertiesWithFile "salak.yml"--- > let Just config = lookup "salak.config" p :: Maybe Config+-- > let config = p .>> "salak.config" :: Config+-- > enabled = p .?> "salak.enabled" .|= True -- > print config+-- > print enabled
src/Data/Salak/Aeson.hs view
@@ -4,10 +4,12 @@ module Data.Salak.Aeson where +import Control.Monad.IO.Class+import Control.Monad.State import Data.Aeson-import qualified Data.HashMap.Strict as M+import qualified Data.HashMap.Strict as M import Data.Salak.Types-import Data.Vector (toList)+import Data.Vector (toList) -- | Load `Properties` from JSON `Value` makePropertiesFromJson :: Value -> Properties -> Properties@@ -29,3 +31,9 @@ g2 [] = [] g2 (a:_) = [a] g3 (as,bs) (a,b) = (as++a,bs++b)++-- | Load Properties from JSON Value+--+-- @since 0.2.2+loadJSON :: MonadIO m => Value -> LoadProperties m ()+loadJSON = modify . makePropertiesFromJson
src/Data/Salak/CommandLine.hs view
@@ -1,8 +1,10 @@ module Data.Salak.CommandLine where +import Control.Monad.IO.Class+import Control.Monad.State import Data.Maybe import Data.Salak.Types-import Data.Text (pack)+import Data.Text (pack) import System.Environment -- | CommandLine parser. Parse command line into property key values.@@ -33,3 +35,13 @@ makePropertiesFromCommandLine' args parser p = do v <- parser args return $ makeProperties (fmap (\(a,b) -> (pack a,b)) v) p+++-- | Load Properties from CommandLine+--+-- @since 0.2.2+loadCommandLine :: MonadIO m => ParseCommandLine -> LoadProperties m ()+loadCommandLine pcl = do+ p <- get+ q <- liftIO $ makePropertiesFromCommandLine pcl p+ put q
src/Data/Salak/Environment.hs view
@@ -1,8 +1,10 @@ module Data.Salak.Environment where +import Control.Monad.IO.Class+import Control.Monad.State import Data.Char import Data.Salak.Types-import Data.Text (pack)+import Data.Text (pack) import System.Environment -- | Load `Properties` from 'Environment'@@ -16,3 +18,9 @@ go (k,v) = (pack $ fmap g2 k,PStr $ pack v) g2 '_' = '.' g2 a = toLower a++-- | Load Properties from CommandLine+--+-- @since 0.2.2+loadEnvironment :: MonadIO m => LoadProperties m ()+loadEnvironment = get >>= liftIO . makePropertiesFromEnvironment >>= put
src/Data/Salak/Operation.hs view
@@ -3,23 +3,37 @@ import Data.Salak.Types import Data.Text (Text, unpack) +-- | Find `Properties` by key and convert to specific Haskell value.+--+-- @since 0.2.1 infixl 5 .?> (.?>) :: FromProperties a => Properties -> Text -> Return a-(.?>) = flip lookup'+(.?>) = flip Data.Salak.Types.lookup +-- | Get property or use default value if not found, but will throw+-- exception if parse failed.+--+-- @since 0.2.1 infixl 5 .|= (.|=) :: Return a -> a -> a (.|=) (Right a) _ = a (.|=) (Left (Fail e)) _ = error e (.|=) _ d = d +-- | Use default value if Key not found+--+-- @since 0.2.1 infixl 5 .?= (.?=) :: Return a -> a -> Return a (.?=) a b = Right (a .|= b) +-- | Find `Properties` by key and convert to specific Haskell value.+-- Throw error if property not found or parse failed+--+-- @since 0.2.1 infixl 5 .>> (.>>) :: FromProperties a => Properties -> Text -> a (.>>) p key = case p .?> key of Right v -> v- Left (EmptyKey k) -> error $ "Config " <> unpack k <> " not found"+ Left (EmptyKey k) -> error $ "property " ++ unpack k ++ " not set" Left (Fail e) -> error e
src/Data/Salak/Types.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -5,7 +6,8 @@ module Data.Salak.Types where -import Control.Monad ((>=>))+import Control.Monad ()+import Control.Monad.State import Data.Char import qualified Data.HashMap.Strict as M import Data.Int@@ -15,8 +17,11 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Word-import Text.Read-+import System.Directory+import Text.Read (readMaybe)+#if __GLASGOW_HASKELL__ <= 802+import Data.Monoid ((<>))+#endif -- | Property key type Key = Text @@ -65,7 +70,6 @@ empty :: Properties empty = Properties [] [] - singleton :: Property -> Properties singleton p = Properties [p] [] @@ -92,26 +96,17 @@ 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 => Text -> Properties -> Maybe a-lookup k = from . lookup' k- where- from :: Return a -> Maybe a- from (Right a) = Just a- from (Left (EmptyKey _)) = Nothing- from (Left (Fail e)) = error e---- | Find `Properties` by key and convert to specific Haskell value.-lookup' :: FromProperties a => Text -> Properties -> Return a-lookup' k = go (toKeys k)+lookup :: FromProperties a => Text -> Properties -> Return a+lookup k = go (toKeys k) where+ {-# INLINE go #-} go [] p = fromProperties p- go (a:as) (Properties _ [m]) = case M.lookup a m of- Just n -> case go as n of+ go (a:as) (Properties _ ms) = case go as $ fromMaybe empty $ select a ms of Left (EmptyKey ke) -> Left $ EmptyKey $ joinKey a ke v -> v- _ -> Left $ EmptyKey $ T.intercalate "." (a:as)- go ke _ = Left $ EmptyKey $ T.intercalate "." ke+ select _ [] = Nothing+ select a [m] = M.lookup a m+ select _ _ = Nothing joinKey :: Text -> Text -> Text@@ -141,6 +136,12 @@ instance {-# OVERLAPPABLE #-} FromProperties a => FromProperties [a] where fromProperties (Properties ps ms) = traverse fromProperties $ fmap singleton ps <> fmap singletonMap ms +instance {-# OVERLAPPABLE #-} FromProperties a => FromProperties (Maybe a) where+ fromProperties p = case fromProperties p of+ Right a -> Right (Just a)+ Left (EmptyKey _) -> Right Nothing+ Left r -> Left r+ instance FromProperties Scientific where fromProperties = fromProperties >=> go where@@ -222,3 +223,33 @@ | otherwise = Right $ T.head s go _ = Left $ Fail "cannot convert to char" +-- | Monad to Load Properties+--+-- @since 0.2.2+type LoadProperties = StateT Properties++-- | Load Properties+--+-- @since 0.2.2+runLoad :: Monad m => LoadProperties m a -> m Properties+runLoad a = snd <$> runStateT a empty++-- | Get current Properties+--+-- @since 0.2.2+askProperties :: Monad m => LoadProperties m Properties+askProperties = get++-- | Set value to current properties+--+-- @since 0.2.2+setValue :: Monad m => Text -> Property -> LoadProperties m ()+setValue k v = do+ p <- askProperties+ put (insert (toKeys k) v p)++loadIfExists :: MonadIO m => Maybe FilePath -> (FilePath -> LoadProperties m ()) -> LoadProperties m ()+loadIfExists (Just f) a = do+ e <- liftIO $ doesFileExist f+ when e (a f)+loadIfExists _ _ = return ()
src/Data/Salak/Yaml.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE CPP #-} module Data.Salak.Yaml where +import Control.Monad.IO.Class+import Control.Monad.State import Data.Salak.Aeson import Data.Salak.Types import Data.Yaml@@ -7,5 +10,29 @@ -- | Load `Properties` from `Yaml` file. makePropertiesFromYaml :: FilePath -> Properties -> IO Properties makePropertiesFromYaml file p = do++#if __GLASGOW_HASKELL__ <= 710+ x <- decodeFile file+ v <- case x of+ Just a -> return a+ _ -> error $ "load " ++ file ++ " failed"+#else v <- decodeFileThrow file+#endif+ return $ makePropertiesFromJson v p++-- | Load Properties from Yaml+--+-- @since 0.2.2+loadYaml :: MonadIO m => FilePath -> LoadProperties m ()+loadYaml file = do+ p <- get+ q <- liftIO $ makePropertiesFromYaml file p+ put q++-- | Load Properties from Yaml if exists+--+-- @since 0.2.2+loadYamlIfExists :: MonadIO m => Maybe FilePath -> LoadProperties m ()+loadYamlIfExists mf = loadIfExists mf loadYaml
test/Spec.hs view
@@ -9,7 +9,6 @@ import Data.Salak.CommandLine import Data.Salak.Environment import Data.Salak.Operation ()-import qualified Data.Salak.Types as P import Data.Text (Text, intercalate, pack) import System.Environment import Test.Hspec@@ -22,7 +21,7 @@ describe "Data.Salak.Types" specProperty describe "Data.Salak" specProperties -shouldFail :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation+shouldFail :: (Show a, Eq a) => a -> a -> Expectation shouldFail f a = (f `shouldBe` a) `shouldThrow` anyErrorCall data Config = Config@@ -62,39 +61,39 @@ it "Reject replacement" $ do insert k "1" m `shouldBe` m it "quickCheck" $ do- quickCheck $ \a' (b :: Int) -> let a = pack a' in Just b == P.lookup a (insert (toKeys a) (PNum $ fromIntegral 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)+ quickCheck $ \a' (b :: Int) -> let a = pack a' in Just b == (insert (toKeys a) (PNum $ fromIntegral b) empty) .>> a+ quickCheck $ \a' (b :: Bool) -> let a = pack a' in Just b == (insert (toKeys a) (PBool b) empty) .>> a+ quickCheck $ \a' (b :: String) -> let a = pack a' in Just b == (insert (toKeys a) (PStr $ pack b) empty) .>> a context "lookup" $ do it "normal" $ do let m = insert ["a"] (PNum 1) empty n = insert ["a"] (PStr "true") empty- (P.lookup "a" empty :: Maybe Int) `shouldBe` Nothing- (P.lookup "a" m :: Maybe Int) `shouldBe` Just 1- (P.lookup "a" m :: Maybe Bool) `shouldFail` Nothing- (P.lookup "a" m :: Maybe String) `shouldBe` Just "1.0"- (P.lookup "a" n :: Maybe Int) `shouldFail` Nothing- (P.lookup "a" n :: Maybe Bool) `shouldBe` Just True- (P.lookup "a" n :: Maybe Text) `shouldBe` Just "true"+ (empty .>> "a" :: Maybe Int) `shouldBe` Nothing+ (m .>> "a" :: Maybe Int) `shouldBe` Just 1+ (m .>> "a" :: Maybe Bool) `shouldFail` Nothing+ (m .>> "a" :: Maybe String) `shouldBe` Just "1.0"+ (n .>> "a" :: Maybe Int) `shouldFail` Nothing+ (n .>> "a" :: Maybe Bool) `shouldBe` Just True+ (n .>> "a" :: Maybe Text) `shouldBe` Just "true" context "makeProperties" $ do it "normal" $ do m <- makePropertiesFromEnvironment empty h <- getEnv "HOME"- (P.lookup "home" m) `shouldBe` Just h+ (m .>> "home") `shouldBe` Just h context "command-line" $ do it "normal" $ do let args = ["--package.a.enabled=true","--package.b.enabled=false","package.c.enabled=false"] m <- makePropertiesFromCommandLine' args defaultParseCommandLine empty- 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+ (m .>> "package.a.enabled") `shouldBe` Just True+ (m .>> "package.b.enabled") `shouldBe` Just False+ (m .>> "package.c.enabled" :: Maybe Bool )`shouldBe` Nothing context "environment" $ do it "normal" $ do let args = [("PACKAGE_A_ENABLED","true"),("PACKAGE_B_ENABLED","false")] m = makePropertiesFromEnvironment' args empty- 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+ (m .>> "package.a.enabled") `shouldBe` Just True+ (m .>> "package.b.enabled") `shouldBe` Just False+ (m .>> "package.c.enabled" :: Maybe Bool )`shouldBe` Nothing specProperties = do context "defaultPropertiesWithFile" $ do@@ -102,32 +101,27 @@ confName' = pack confName it "read config" $ do unsetEnv "SALAK_CONFIG_NAME"- p <- defaultPropertiesWithFile confName'- P.lookup "salak.config.name" p `shouldBe` Just confName+ p <- defaultPropertiesWithFile confName+ p .>> "salak.config.name" `shouldBe` Just confName it "read config - replacement" $ do setEnv "SALAK_CONFIG_NAME" confName p <- defaultPropertiesWithFile "salak.ok"- P.lookup "salak.config.name" p `shouldBe` Just confName+ p .>> "salak.config.name" `shouldBe` Just confName it "read config - not found" $ do setEnv "SALAK_CONFIG_NAME" "salak.notfound" setEnv "SALAK_CONFIG_DIR" "test"- defaultPropertiesWithFile confName' `shouldThrow` anyErrorCall+ defaultPropertiesWithFile confName `shouldThrow` anyException it "read config - read file parse Config" $ do setEnv "SALAK_CONFIG_NAME" confName setEnv "SALAK_CONFIG_DIR" "test" 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+ p <- defaultPropertiesWithFile confName+ (p .>> "salak.config.name") `shouldBe` Just confName+ (p .>> "salak.config") `shouldBe` Just confName+ (p .>> "salak.config" :: Maybe Config) `shouldBe` Just (Config confName' "test" 1)+ (p .>> "array" :: Maybe [String]) `shouldBe` Just ["a","b"]+ (p .>> "array" :: Maybe [Int]) `shouldFail` Nothing+ (p .>> "array" :: Maybe String) `shouldFail` Nothing