salak 0.2.0 → 0.2.1
raw patch · 7 files changed
+144/−151 lines, 7 filesdep ~QuickCheckdep ~aesondep ~aeson-pretty
Dependency ranges changed: QuickCheck, aeson, aeson-pretty, base, bytestring, directory, filepath, scientific, text, unordered-containers, vector, yaml
Files
- README.md +1/−1
- salak.cabal +67/−70
- src/Data/Salak.hs +4/−1
- src/Data/Salak/Aeson.hs +1/−17
- src/Data/Salak/Operation.hs +25/−0
- src/Data/Salak/Types.hs +37/−52
- test/Spec.hs +9/−10
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,78 +1,75 @@ cabal-version: 1.12---- This file has been generated from package.yaml by hpack version 0.31.1.------ see: https://github.com/sol/hpack------ hash: 65d137fa16b84c27133c76282e7859306d30f334f45be6cb7332a144552ef7ce--name: salak-version: 0.2.0-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) 2018 Daniel YU-license: BSD3-license-file: LICENSE-build-type: Simple+name: salak+version: 0.2.1+license: BSD3+license-file: LICENSE+copyright: (c) 2018 Daniel YU+maintainer: Daniel YU <leptonyu@gmail.com>+author: Daniel YU+homepage: https://github.com/leptonyu/salak#readme+synopsis: Configuration Loader+description:+ Configuration Loader for Production in Haskell+category: Library+build-type: Simple extra-source-files: README.md test/salak.yml library- exposed-modules:- Data.Salak- other-modules:- Data.Salak.Types- Data.Salak.Environment- Data.Salak.CommandLine- Data.Salak.Aeson- 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- , text- , unordered-containers- , vector- , yaml- default-language: Haskell2010+ exposed-modules:+ Data.Salak+ hs-source-dirs: src+ other-modules:+ Data.Salak.Types+ Data.Salak.Environment+ Data.Salak.CommandLine+ Data.Salak.Aeson+ 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+ 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 test-suite spec- type: exitcode-stdio-1.0- main-is: Spec.hs- other-modules:- Data.Salak- Data.Salak.Aeson- Data.Salak.CommandLine- Data.Salak.Environment- Data.Salak.Types- Data.Salak.Yaml- Paths_salak- 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- , text- , unordered-containers- , vector- , yaml- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test src+ other-modules:+ Data.Salak+ Data.Salak.Aeson+ Data.Salak.CommandLine+ Data.Salak.Environment+ Data.Salak.Operation+ Data.Salak.Types+ 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+ 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,+ 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
src/Data/Salak.hs view
@@ -30,7 +30,7 @@ , Properties(..) , Key , FromProperties(..)- , Return(..)+ , Return -- * Properties Loader Helper , insert , makePropertiesFromEnvironment@@ -39,12 +39,15 @@ , makePropertiesFromJson , makePropertiesFromYaml , FileName+ -- * Operations+ , module Data.Salak.Operation ) where import Data.Maybe import Data.Salak.Aeson import Data.Salak.CommandLine import Data.Salak.Environment+import Data.Salak.Operation import Data.Salak.Types import Data.Salak.Yaml import Data.Text (Text, unpack)
src/Data/Salak/Aeson.hs view
@@ -7,7 +7,7 @@ import Data.Aeson import qualified Data.HashMap.Strict as M import Data.Salak.Types-import Data.Vector (fromList, toList)+import Data.Vector (toList) -- | Load `Properties` from JSON `Value` makePropertiesFromJson :: Value -> Properties -> Properties@@ -29,19 +29,3 @@ g2 [] = [] g2 (a:_) = [a] g3 (as,bs) (a,b) = (as++a,bs++b)--instance FromProperties Value where- fromProperties (Properties [] []) = Empty- fromProperties (Properties [PBool p] []) = OK $ Bool p- fromProperties (Properties [PNum p] []) = OK $ Number p- 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) = Array . fromList <$> traverse (fromProperties.singletonMap) ms--instance {-# OVERLAPPABLE #-} FromJSON a => FromProperties a where- fromProperties a = do- v :: Value <- fromProperties a- case fromJSON v of- Success r -> OK r- Error e -> Fail e
+ src/Data/Salak/Operation.hs view
@@ -0,0 +1,25 @@+module Data.Salak.Operation where++import Data.Salak.Types+import Data.Text (Text, unpack)++infixl 5 .?>+(.?>) :: FromProperties a => Properties -> Text -> Return a+(.?>) = flip lookup'++infixl 5 .|=+(.|=) :: Return a -> a -> a+(.|=) (Right a) _ = a+(.|=) (Left (Fail e)) _ = error e+(.|=) _ d = d++infixl 5 .?=+(.?=) :: Return a -> a -> Return a+(.?=) a b = Right (a .|= b)++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 (Fail e) -> error e
src/Data/Salak/Types.hs view
@@ -97,20 +97,28 @@ lookup k = from . lookup' k where from :: Return a -> Maybe a- from (OK a) = Just a- from Empty = Nothing- from (Fail e) = error e+ 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' = go . toKeys+lookup' k = go (toKeys k) where go [] p = fromProperties p go (a:as) (Properties _ [m]) = case M.lookup a m of- Just n -> go as n- _ -> Empty- go _ _ = Empty+ Just n -> case go as n of+ Left (EmptyKey ke) -> Left $ EmptyKey $ joinKey a ke+ v -> v+ _ -> Left $ EmptyKey $ T.intercalate "." (a:as)+ go ke _ = Left $ EmptyKey $ T.intercalate "." ke ++joinKey :: Text -> Text -> Text+joinKey "" k = k+joinKey k "" = k+joinKey a b = a <> "." <> b+ -- | Insert batch properties to `Properties` makeProperties :: [(Text, Property)] -> Properties -> Properties makeProperties = flip (foldl go)@@ -118,52 +126,27 @@ 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+type Return = Either ErrResult+data ErrResult = EmptyKey Text | Fail String deriving Show -- | Convert `Properties` to Haskell value. class FromProperties a where fromProperties :: Properties -> Return a instance FromProperties Property where- fromProperties (Properties [a] _) = OK a- fromProperties (Properties [] _) = Empty- fromProperties _ = Fail "property has multi values"+ fromProperties (Properties [a] _) = Right a+ fromProperties (Properties [] _) = Left $ EmptyKey ""+ fromProperties _ = Left $ Fail "property has multi values" instance {-# OVERLAPPABLE #-} FromProperties a => FromProperties [a] where- fromProperties (Properties ps ms) = traverse fromProperties $ fmap singleton ps ++ fmap singletonMap ms+ 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 (PNum a) = Right a go (PStr a) = to readMaybe $ T.unpack a- go _ = Fail "bool cannot convert to number"+ go _ = Left $ Fail "bool cannot convert to number" instance FromProperties String where fromProperties a = T.unpack <$> fromProperties a@@ -171,8 +154,8 @@ instance FromProperties Text where fromProperties = fromProperties >=> go where- go (PStr a) = OK a- go a = OK $ T.pack $ show a+ go (PStr a) = Right a+ go a = Right $ T.pack $ show a instance FromProperties Float where fromProperties a = toRealFloat <$> fromProperties a@@ -215,25 +198,27 @@ to :: (b -> Maybe a) -> b -> Return a to v b = case v b of- Just a -> OK a- Nothing -> Fail "number convert failed"+ Just a -> Right a+ Nothing -> Left $ Fail "number convert failed" instance FromProperties Bool where fromProperties = fromProperties >=> go where- go (PBool a) = OK a+ go (PBool a) = Right a go (PStr a) = g2 $ T.toLower a- go _ = Fail "number cannot convert to bool"+ go _ = Left $ Fail "number cannot convert to bool" g2 :: Text -> Return Bool- g2 "true" = OK True- g2 "false" = OK False- g2 _ = Fail "string value cannot convert to bool"+ g2 "1" = Right True+ g2 "true" = Right True+ g2 "0" = Right False+ g2 "false" = Right False+ g2 _ = Left $ Fail "string value cannot convert to bool" instance FromProperties Char where fromProperties = fromProperties >=> go where go (PStr s)- | T.null s = Empty- | otherwise = OK $ T.head s- go _ = Fail "cannot convert to char"+ | T.null s = Left $ EmptyKey ""+ | otherwise = Right $ T.head s+ go _ = Left $ Fail "cannot convert to char"
test/Spec.hs view
@@ -4,12 +4,11 @@ module Main where -import Data.Aeson import qualified Data.HashMap.Strict as M-import Data.Maybe import Data.Salak 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@@ -32,11 +31,11 @@ , 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 specProperty = do context "empty" $ do@@ -63,9 +62,9 @@ it "Reject replacement" $ do 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)+ 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) context "lookup" $ do it "normal" $ do let m = insert ["a"] (PNum 1) empty