salak 0.1.7 → 0.1.8
raw patch · 10 files changed
+140/−40 lines, 10 filesdep +menshendep +stmdep −aeson-prettydep −bytestringdep ~QuickCheckdep ~aesondep ~base
Dependencies added: menshen, stm
Dependencies removed: aeson-pretty, bytestring
Dependency ranges changed: QuickCheck, aeson, base, directory, filepath, mtl, scientific, text, transformers, unordered-containers, vector, yaml
Files
- README.md +1/−1
- salak.cabal +32/−32
- src/Data/Salak.hs +3/−1
- src/Data/Salak/Aeson.hs +5/−0
- src/Data/Salak/Dynamic.hs +56/−0
- src/Data/Salak/Operation.hs +1/−1
- src/Data/Salak/Types.hs +9/−2
- src/Data/Salak/Yaml.hs +10/−0
- test/Spec.hs +17/−3
- test/salak.yml +6/−0
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.1.7+version: 0.1.8 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU@@ -27,22 +27,23 @@ Data.Salak.Aeson Data.Salak.Yaml Data.Salak.Operation+ Data.Salak.Dynamic 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,- mtl >=2.2.2 && <2.3,- scientific >=0.3.6.2 && <0.4,- text >=1.2.3.1 && <1.3,- transformers >=0.5.5.0 && <0.6,- 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,+ menshen <0.1,+ mtl <2.3,+ scientific <0.4,+ stm <2.6,+ text <1.3,+ transformers <0.6,+ unordered-containers <0.3,+ vector <0.13,+ yaml <0.12 test-suite spec type: exitcode-stdio-1.0@@ -52,28 +53,27 @@ Data.Salak Data.Salak.Aeson Data.Salak.CommandLine+ Data.Salak.Dynamic 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+ 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.*,- mtl >=2.2.2 && <2.3,- scientific >=0.3.6.2 && <0.4,- text >=1.2.3.1 && <1.3,- transformers >=0.5.5.0 && <0.6,- unordered-containers >=0.2.9.0 && <0.3,- vector >=0.12.0.2 && <0.13,- yaml >=0.11.0.0 && <0.12+ menshen <0.1,+ mtl <2.3,+ scientific <0.4,+ stm <2.6,+ text <1.3,+ transformers <0.6,+ unordered-containers <0.3,+ vector <0.13,+ yaml <0.12
src/Data/Salak.hs view
@@ -36,7 +36,6 @@ -- * Types , Property(..) , Properties(..)- , Key , FromProperties(..) , Return -- * Properties Loader Helper@@ -46,12 +45,15 @@ , FileName -- * Operations , module Data.Salak.Operation+ -- * Dynamic Load+ , module Data.Salak.Dynamic ) where import Control.Monad.Trans.Class (lift) import Data.Maybe import Data.Salak.Aeson import Data.Salak.CommandLine+import Data.Salak.Dynamic import Data.Salak.Environment import Data.Salak.Operation import Data.Salak.Types
src/Data/Salak/Aeson.hs view
@@ -7,7 +7,9 @@ import Control.Monad.IO.Class import Control.Monad.State import Data.Aeson+import Data.Aeson.Types import qualified Data.HashMap.Strict as M+import Data.Menshen import Data.Salak.Types import Data.Vector (toList) @@ -24,6 +26,9 @@ jsonToProperties :: Value -> Properties jsonToProperties = (`makePropertiesFromJson` empty)++instance HasValid Parser where+ invalid = fail . toI18n fromArray v = foldl g3 ([],[]) $ go . jsonToProperties <$> toList v where
+ src/Data/Salak/Dynamic.hs view
@@ -0,0 +1,56 @@+module Data.Salak.Dynamic(+ LoaderT+ , load+ , runLoader+ , askSetProperties+ ) where++import Control.Concurrent.STM.TVar+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.State+import Control.Monad.STM+import qualified Data.HashMap.Strict as M+import Data.Salak.Operation+import Data.Salak.Types+import Data.Text (Text)++type Loader = (IO Properties, Properties -> IO ())++type LoaderT = StateT Loader++dynamicLoader :: Properties -> IO Loader+dynamicLoader mp = do+ m <- newTVarIO mp+ return (readTVarIO m,\np -> atomically $ modifyTVar' m (go np))+ where+ go (Properties [] m1) (Properties p m2) = Properties p (gm m1 m2)+ go (Properties p m1) (Properties _ m2) = Properties p (gm m1 m2)+ gm [] m = m+ gm [m] [n] = [M.unionWithKey (\_ -> go) m n]+ gm m _ = m++-- | Load default properties+load :: (FromProperties a, MonadIO m, Show a) => Text -> LoaderT m (IO a)+load key = do+ (iop, ios) <- get+ p <- liftIO iop+ v <- liftIO $ newTVarIO $ p .>> key+ let go np = do+ ios np+ p' <- iop+ let a = p' .>> key+ atomically $ writeTVar v a+ put (iop, go)+ return (readTVarIO v)++-- | Run loader+runLoader :: MonadIO m => Properties -> LoaderT m a -> m a+runLoader p a = do+ l <- liftIO $ dynamicLoader p+ fst <$> runStateT a l++-- | Ask properties setter.+askSetProperties :: MonadIO m => LoaderT m (Properties -> m ())+askSetProperties = do+ (_, ios) <- get+ return $ liftIO . ios
src/Data/Salak/Operation.hs view
@@ -35,5 +35,5 @@ (.>>) :: FromProperties a => Properties -> Text -> a (.>>) p key = case p .?> key of Right v -> v- Left (EmptyKey k) -> error $ "property " <> unpack k <> " not set"+ 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,12 +6,13 @@ 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 import Data.Maybe+import Data.Menshen import Data.Scientific import Data.String import Data.Text (Text)@@ -18,7 +20,9 @@ import Data.Word import System.Directory import Text.Read (readMaybe)-+#if __GLASGOW_HASKELL__ <= 802+import Data.Monoid ((<>))+#endif -- | Property key type Key = Text @@ -120,6 +124,9 @@ -- | Return of `FromProperties` type Return = Either ErrResult data ErrResult = EmptyKey Text | Fail String deriving Show++instance HasValid Return where+ invalid = Left . Fail . toI18n -- | Convert `Properties` to Haskell value. class FromProperties a where
src/Data/Salak/Yaml.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Data.Salak.Yaml where import Control.Monad.IO.Class@@ -9,7 +10,16 @@ -- | 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
test/Spec.hs view
@@ -18,10 +18,11 @@ spec :: Spec spec = do- describe "Data.Salak.Types" specProperty- describe "Data.Salak" specProperties+ describe "Data.Salak.Types" specProperty+ describe "Data.Salak" specProperties+ describe "Data.Salak.Dynamic" specDynamic -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@@ -122,6 +123,19 @@ (p .>> "array" :: Maybe [String]) `shouldBe` Just ["a","b"] (p .>> "array" :: Maybe [Int]) `shouldFail` Nothing (p .>> "array" :: Maybe String) `shouldFail` Nothing++specDynamic = do+ context "Dynamic" $ do+ it "dynamic load" $ do+ p <- defaultPropertiesWithFile "salak.yml"+ (c,s) <- runLoader p $ (,) <$> load "config" <*> askSetProperties+ c1 <- c+ s $ insert ["config","name"] "world" empty+ c2 <- c+ name c1 `shouldBe` "hello"+ name c2 `shouldBe` "world"+ dir c1 `shouldBe` dir c2+ ext c1 `shouldBe` ext c2
test/salak.yml view
@@ -1,3 +1,9 @@ array: - a - b+hello:+ world++config:+ name: hello+ dir: /root