salak 0.2.6 → 0.2.7
raw patch · 16 files changed
+705/−471 lines, 16 filesdep +salak-tomldep +salak-yamldep +timedep −aesondep −transformersdep −unordered-containersdep ~QuickCheckdep ~attoparsecdep ~base
Dependencies added: salak-toml, salak-yaml, time
Dependencies removed: aeson, transformers, unordered-containers, vector, yaml
Dependency ranges changed: QuickCheck, attoparsec, base, containers, data-default, directory, filepath, menshen, mtl, pqueue, scientific, text
Files
- README.md +66/−15
- salak.cabal +41/−44
- src/Salak.hs +139/−51
- src/Salak/Dynamic.hs +0/−71
- src/Salak/Env.hs +0/−34
- src/Salak/Json.hs +0/−38
- src/Salak/Load.hs +34/−0
- src/Salak/Load/Dynamic.hs +73/−0
- src/Salak/Load/Env.hs +35/−0
- src/Salak/Prop.hs +21/−19
- src/Salak/Types.hs +38/−161
- src/Salak/Types/Selector.hs +59/−0
- src/Salak/Types/Source.hs +86/−0
- src/Salak/Types/Value.hs +68/−0
- test/Spec.hs +45/−29
- test/salak.yml +0/−9
README.md view
@@ -5,24 +5,63 @@ [](http://stackage.org/nightly/package/salak) [](https://travis-ci.org/leptonyu/salak) +Configuration (re)loader in Haskell. -Configuration Loader in Haskell.+## salak-yaml+[](https://hackage.haskell.org/package/salak-yaml)+## salak-toml+[](https://hackage.haskell.org/package/salak-toml) -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 `SourcePack`. Earler property source has higher order-to load property. For example:+This library define a universal procedure to load configurations and parse properties, also supports reload configuration files. +We can load configurations from command line, environment, configuration files such as yaml or toml etc, and we may want to have our own strategies to load configurations from multi sources and overwrite properties by orders of these sources.++`PropConfig` defines a common loading strategy:+> 1. loadCommandLine+> 2. loadEnvironment+> 3. loadConfFiles+> 4. load file from folder `salak.conf.dir` if defined+> 5. load file from current folder if enabled+> 6. load file from home folder if enabled+> 7. file extension matching, support yaml or toml or any other loader.++Load earlier has higher orders, orders cannot be changed.++`ReaderT SourcePack m` defines how to read properties:+```Haskell+require "abc.prop" ```-CommandLine: --package.a.enabled=true-Environment: PACKAGE_A_ENABLED: false -lookup "package.a.enabled" properties => Just True+`ReloadableSourcePackT m` defines how to read reloadable properties:+```Haskell+requireD "abc.dynamic.prop" ``` -`CommandLine` has higher order then `Environment`, for the former load properties earler then later.+For commandline and environment, +```+CommandLine: --package.a.enabled=true+Environment: PACKAGE_A_ENABLED: false+``` Usage: ++Environment:+```+export TEST_CONFIG_NAME=daniel+```+Current Directory: salak.yaml+```YAML+test.config:+ name: noop+ dir: ls+```+Current Directory: salak.toml+```TOML+[test.config]+ext=2+```+ ```Haskell data Config = Config { name :: Text@@ -32,16 +71,28 @@ instance FromProp Config where fromProp = Config- <$> "user"+ <$> "user" ? pattern "[a-z]{5,16}" <*> "pwd" <*> "ext" .?= 1 -main = do- c :: Config <- defaultLoadSalak def $ require ""- print c+main = runSalak def { configName = Just "salak", loadExt = loadByExt $ YAML :|: TOML } $ do+ c :: Config <- require "test.config"+ lift $ print c ``` -```-λ> c-Config {name = "daniel", dir = Nothing, ext = 1}+GHCi play+```Haskell+λ> import Salak+λ> import Salak.Load.YAML+λ> import Salak.Load.TOML+λ> import Data.Menshen+λ> :set -XTypeApplications+λ> instance FromProp Config where fromProp = Config <$> "user" <*> "dir" <*> "ext" .?= 1+λ> f = runSalak def { configName = Just "salak", loadExt = loadByExt $ YAML :|: TOML }+λ> f (require "") >>= print @Config+Config {name = "daniel", dir = Just "ls", ext = 2} ```+++TODO:+- Add git pull support.
salak.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: salak-version: 0.2.6+version: 0.2.7 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU@@ -8,41 +8,38 @@ author: Daniel YU homepage: https://github.com/leptonyu/salak#readme synopsis: Configuration Loader-category: Library+category: Library, Configuration build-type: Simple extra-source-files: README.md- test/salak.yml library exposed-modules: Salak+ Salak.Load hs-source-dirs: src other-modules: Salak.Types- Salak.Env- Salak.Json+ Salak.Types.Value+ Salak.Types.Selector+ Salak.Types.Source+ Salak.Load.Env+ Salak.Load.Dynamic Salak.Prop- Salak.Dynamic default-language: Haskell2010- ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures build-depends:- aeson <1.5,- attoparsec <0.14,- base >=4.7 && <5,- containers <0.7,- data-default <0.8,- directory <1.4,- filepath <1.5,- menshen <0.1,- mtl <2.3,- pqueue <1.5,- scientific <0.4,- text <1.3,- transformers <0.6,- unordered-containers <0.3,- vector <0.13,- yaml <0.12+ attoparsec >=0.13.2.2 && <0.14,+ base >=4.10 && <5,+ containers >=0.6.0.1 && <0.7,+ data-default >=0.7.1.1 && <0.8,+ directory >=1.3.3.0 && <1.4,+ filepath >=1.4.2.1 && <1.5,+ menshen >=0.0.2 && <0.1,+ mtl >=2.2.2 && <2.3,+ pqueue >=1.4.1.2 && <1.5,+ scientific >=0.3.6.2 && <0.4,+ text >=1.2.3.1 && <1.3,+ time >=1.8.0.2 && <1.9 test-suite spec type: exitcode-stdio-1.0@@ -50,30 +47,30 @@ hs-source-dirs: test src other-modules: Salak- Salak.Dynamic- Salak.Env- Salak.Json+ Salak.Load+ Salak.Load.Dynamic+ Salak.Load.Env Salak.Prop Salak.Types+ Salak.Types.Selector+ Salak.Types.Source+ Salak.Types.Value Paths_salak default-language: Haskell2010- ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures build-depends:- QuickCheck <2.14,- aeson <1.5,- attoparsec <0.14,- base >=4.7 && <5,- containers <0.7,- data-default <0.8,- directory <1.4,- filepath <1.5,+ QuickCheck >=2.12.6.1 && <2.14,+ attoparsec >=0.13.2.2 && <0.14,+ base >=4.10 && <5,+ containers >=0.6.0.1 && <0.7,+ data-default >=0.7.1.1 && <0.8,+ directory >=1.3.3.0 && <1.4,+ filepath >=1.4.2.1 && <1.5, hspec ==2.*,- menshen <0.1,- mtl <2.3,- pqueue <1.5,- scientific <0.4,- text <1.3,- transformers <0.6,- unordered-containers <0.3,- vector <0.13,- yaml <0.12+ menshen >=0.0.2 && <0.1,+ mtl >=2.2.2 && <2.3,+ pqueue >=1.4.1.2 && <1.5,+ salak-toml >=0.2.7 && <0.3,+ salak-yaml >=0.2.7 && <0.3,+ scientific >=0.3.6.2 && <0.4,+ text >=1.2.3.1 && <1.3,+ time >=1.8.0.2 && <1.9
src/Salak.hs view
@@ -1,7 +1,9 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-} -- | -- Module: Salak -- Copyright: (c) 2019 Daniel YU@@ -17,18 +19,19 @@ -- $use -- * Salak- defaultLoadSalak- , loadSalak+ loadAndRunSalak+ , runSalak , PropConfig(..)- -- * Static Load+ -- * Static Get Properties , HasSourcePack(..) , fetch , require- -- * Dynamic Load+ -- * Dynamic Get Properties , ReloadableSourcePack , ReloadableSourcePackT , ReloadResult(..) , reloadable+ , reloadAction , fetchD , requireD -- * Prop Parser@@ -40,14 +43,21 @@ -- * SourcePack , SourcePack , SourcePackT- , loadYaml+ -- * Load configurations , loadCommandLine , loadEnv , loadMock- , defaultParseCommandLine+ -- ** Load By Extension+ , ExtLoad+ , loadByExt+ , HasLoad(..)+ , (:|:)(..)+ -- * Other , ParseCommandLine+ , defaultParseCommandLine , Priority , Value(..)+ , defaultLoadSalak ) where import Control.Applicative@@ -57,11 +67,11 @@ import Control.Monad.State import Data.Default import Data.Text (Text)-import Salak.Dynamic-import Salak.Env-import Salak.Json+import Salak.Load.Dynamic+import Salak.Load.Env import Salak.Prop import Salak.Types+import Salak.Types.Value import System.Directory import System.FilePath ((</>)) @@ -72,47 +82,93 @@ , searchCurrent :: Bool -- ^ Search current directory, default true , searchHome :: Bool -- ^ Search home directory, default false. , commandLine :: ParseCommandLine -- ^ How to parse commandline+ , loadExt :: FilePath -> SourcePackT IO () } instance Default PropConfig where- def = PropConfig Nothing "salak.conf" True False defaultParseCommandLine+ def = PropConfig+ Nothing+ "salak.conf.dir"+ True+ False+ defaultParseCommandLine+ (\_ -> return ()) --- | Load salak `SourcePack` and fetch properties.-loadSalak+-- | Load and run salak `SourcePack` and fetch properties.+loadAndRunSalak :: Monad m- => ReaderT SourcePack m a -- ^ Fetch properties monad.- -> SourcePackT m () -- ^ Load properties monad.+ => SourcePackT m () -- ^ Load properties monad.+ -> ReaderT SourcePack m a -- ^ Fetch properties monad. -> m a-loadSalak a spm = do- (es, sp) <- runSourcePackT spm+loadAndRunSalak spm a = do+ sp <- runSourcePackT spm+ let es = errs sp unless (null es) $ fail (head es) runReaderT a sp ++-- | Load file by extension+type ExtLoad = (String, FilePath -> SourcePackT IO ())++class HasLoad a where+ loaders :: a -> [ExtLoad]++data a :|: b = a :|: b+infixr 3 :|:++instance (HasLoad a, HasLoad b) => HasLoad (a :|: b) where+ loaders (a :|: b) = loaders a ++ loaders b++loadByExt :: (HasLoad a, MonadIO m) => a -> FilePath -> SourcePackT m ()+loadByExt xs f = mapM_ go (loaders xs)+ where+ go (ext, ly) = tryLoadFile (jump . ly) $ f ++ "." ++ ext++jump :: MonadIO m => StateT SourcePack IO a -> StateT SourcePack m ()+jump a = get >>= lift . liftIO . execStateT a >>= put+ -- | Default load salak.--- All these configuration sources has orders, from highest order to lowest order:+-- All these configuration sources has orders, from highest priority to lowest priority: ----- > 1. CommandLine--- > 2. Environment--- > 3. Specified Yaml file(file in `configDirKey`)--- > 4. Yaml file in current directory--- > 5. Yaml file in home directory+-- > 1. loadCommandLine+-- > 2. loadEnvironment+-- > 3. loadConfFiles+-- > 4. load file from folder `salak.conf.dir` if defined+-- > 5. load file from current folder if enabled+-- > 6. load file from home folder if enabled+-- > 7. file extension matching, support yaml or toml or any other loader. ---defaultLoadSalak :: MonadIO m => PropConfig -> ReaderT SourcePack m a -> m a-defaultLoadSalak PropConfig{..} a = loadSalak a $ do+runSalak :: MonadIO m => PropConfig -> ReaderT SourcePack m a -> m a+runSalak PropConfig{..} = loadAndRunSalak $ do loadCommandLine commandLine loadEnv- cf <- fetch configDirKey- maybe (return ()) (go cf) configName+ forM_ configName $ forM_+ [ require configDirKey+ , ifS searchCurrent getCurrentDirectory+ , ifS searchHome getHomeDirectory+ ] . loadConf where- go ck n = do- case ck of- Left _ -> return ()- Right d -> loadYaml $ d </> n- c <- liftIO getCurrentDirectory- when searchCurrent $ tryLoadYaml $ c </> n- h <- liftIO getHomeDirectory- when searchHome $ tryLoadYaml $ h </> n+ ifS True gxd = Just <$> liftIO gxd+ ifS _ _ = return Nothing+ loadConf n mf = mf >>= mapM_ (jump . loadExt . (</> n)) +{-# DEPRECATED defaultLoadSalak "use runSalak instead" #-}+defaultLoadSalak :: MonadIO m => PropConfig -> ReaderT SourcePack m a -> m a+defaultLoadSalak = runSalak+++ -- loadC ffa n = (mapM_ . mapM_) g+ -- cf <- fetch configDirKey+ -- where+ -- go ck n = do+ -- case ck of+ -- Left _ -> return ()+ -- Right d -> defaultLoadByExt $ d </> n+ -- c <- liftIO getCurrentDirectory+ -- when searchCurrent $ defaultLoadByExt $ c </> n+ -- h <- liftIO getHomeDirectory+ -- when searchHome $ defaultLoadByExt $ h </> n+ class Monad m => HasSourcePack m where askSourcePack :: m SourcePack @@ -173,19 +229,42 @@ -- $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 `SourcePack`. Earler property source has higher order--- to load property. For example:+-- | This library define a universal procedure to load configurations and parse properties, also supports reload configuration files. ----- > CommandLine: --package.a.enabled=true--- > Environment: PACKAGE_A_ENABLED: false ----- > lookup "package.a.enabled" properties => Just True+-- We can load configurations from command line, environment, configuration files such as yaml or toml etc, and we may want to have our own strategies to load configurations from multi sources and overwrite properties by orders of these sources. ----- `CommandLine` has higher order then `Environment`, for the former load properties earler then later.+-- `PropConfig` defines a common loading strategy: --+-- > 1. loadCommandLine+-- > 2. loadEnvironment+-- > 3. loadConfFiles+-- > 4. load file from folder `salak.conf.dir` if defined+-- > 5. load file from current folder if enabled+-- > 6. load file from home folder if enabled+-- > 7. file extension matching, support yaml or toml or any other loader.+--+-- Load earlier has higher priority, priorities cannot be changed.+--+-- -- Usage: --+--+-- Environment:+--+-- > export TEST_CONFIG_NAME=daniel+--+-- Current Directory: salak.yaml+--+-- > test.config:+-- > name: noop+-- > dir: ls+--+-- Current Directory: salak.toml+--+-- > [test.config]+-- > ext=2+-- -- > data Config = Config -- > { name :: Text -- > , dir :: Maybe Text@@ -194,13 +273,22 @@ -- > -- > instance FromProp Config where -- > fromProp = Config--- > <$> "user"+-- > <$> "user" ? pattern "[a-z]{5,16}" -- > <*> "pwd" -- > <*> "ext" .?= 1+-- >+-- > main = runSalak def { configName = Just "salak", loadExt = loadByExt $ YAML :|: TOML } $ do+-- > c :: Config <- require "test.config"+-- > lift $ print c ----- > main = do--- > c :: Config <- defaultLoadSalak def $ require ""--- > print c+-- GHCi play ----- > λ> c--- > Config {name = "daniel", dir = Nothing, ext = 1}+-- > λ> import Salak+-- > λ> import Salak.Load.YAML+-- > λ> import Salak.Load.TOML+-- > λ> :set -XTypeApplications+-- > λ> instance FromProp Config where fromProp = Config <$> "user" <*> "dir" <*> "ext" .?= 1+-- > λ> f = runSalak def { configName = Just "salak", loadExt = loadByExt $ YAML :|: TOML }+-- > λ> f (require "") >>= print @Config+-- > Config {name = "daniel", dir = Just "ls", ext = 2}+--
− src/Salak/Dynamic.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}-module Salak.Dynamic where--import Control.Concurrent.MVar-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.State-import qualified Data.IntMap.Strict as MI-import Data.Text (Text)-import Salak.Prop-import Salak.Types--data ReloadResult = ReloadResult- { isError :: Bool- , msg :: [String]- } deriving (Eq, Show)---- | Reloadable SourcePack-data ReloadableSourcePack = ReloadableSourcePack- { sourcePack :: MVar SourcePack- , reloadAll :: (SourcePack -> IO ([IO ()], [String])) -> IO ReloadResult- }--reloadableSourcePack :: MonadIO m => SourcePack -> m ReloadableSourcePack-reloadableSourcePack sp = do- msp <- liftIO $ newMVar sp- return $ ReloadableSourcePack msp (reloadAll' msp)- where- reloadAll' v f = do- sp'@(SourcePack _ _ _ it) <- readMVar v- as <- filter (not . nullSource . snd) <$> mapM go (MI.toList it)- if null as- then return (ReloadResult True [])- else do- let (es, sp'') = extractErr' $ foldl g2 sp' as- (ac, es') <- f sp''- if null es'- then putMVar v sp'' >> sequence_ ac >> return (ReloadResult True es)- else return (ReloadResult False es')- go (i, Reload _ f) = (i,) <$> f i- g2 (SourcePack ss i s it) (x,s') = SourcePack ss i (replace x s' s) it--type ReloadableSourcePackT = StateT ReloadableSourcePack--search' :: (MonadIO m, FromProp a) => Text -> ReloadableSourcePackT m (Either String (IO a))-search' k = do- ReloadableSourcePack{..} <- get- sp <- liftIO $ takeMVar sourcePack- case search k sp of- Left e -> return (Left e)- Right r -> do- v <- liftIO $ newMVar r- put (ReloadableSourcePack sourcePack (reloadAll . go v))- return $ Right $ readMVar v- where- go x f sp = do- (as,es) <- f sp- case search k sp of- Left e -> return (as, e:es)- Right r -> return (putMVar x r:as, es)--reload :: Monad m => ReloadableSourcePackT m (IO ReloadResult)-reload = do- ReloadableSourcePack{..} <- get- return $ reloadAll $ \_ -> return ([], [])--runReloadable :: MonadIO m => ReloadableSourcePackT m a -> SourcePack -> m a-runReloadable r sp = reloadableSourcePack sp >>= evalStateT r---
− src/Salak/Env.hs
@@ -1,34 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Salak.Env where--import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.State-import Data.Maybe-import qualified Data.Text as T-import Salak.Types-import System.Environment--loadEnv :: MonadIO m => SourcePackT m ()-loadEnv = do- args <- liftIO getEnvironment- modify $ load (emptyReload "environment") args go- where- go p (k,v) = (g2 k, VStr p $ T.pack v)- g2 = T.toLower . T.pack . map (\c -> if c == '_' then '.' else c)--type ParseCommandLine = [String] -> IO [(T.Text,Priority -> Value)]--defaultParseCommandLine :: ParseCommandLine-defaultParseCommandLine = return . mapMaybe go- where- go ('-':'-':as) = case break (=='=') as of- (a,'=':b) -> Just (T.pack a, \p -> VStr p $ T.pack b)- _ -> Nothing- go _ = Nothing--loadCommandLine :: MonadIO m => ParseCommandLine -> SourcePackT m ()-loadCommandLine pcl = do- args <- liftIO $ getArgs >>= pcl- modify $ load (emptyReload "commandline") args go- where- go i (k,fv) = (k, fv i)
− src/Salak/Json.hs
@@ -1,38 +0,0 @@-module Salak.Json where--import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.State-import qualified Data.Aeson as A-import qualified Data.HashMap.Strict as HM-import qualified Data.IntMap.Strict as MI-import qualified Data.Map.Strict as M-import Data.Maybe-import Data.Text (pack)-import qualified Data.Vector as V-import qualified Data.Yaml as Y-import Salak.Types-import System.Directory--loadJSON :: Reload -> A.Value -> SourcePack -> SourcePack-loadJSON name v sp = loadFile name sp $ go v- where- go (A.Object m) i s = foldl (g2 i) s $ HM.toList m- go (A.Array m) i s = foldl (g3 i) s $ zip [0..] $ V.toList m- go (A.String m) i s = insert' [] (VStr i m) s- go (A.Number m) i s = insert' [] (VNum i m) s- go (A.Bool m) i s = insert' [] (VBool i m) s- go A.Null _ s = s- g2 i (Source es p is ts) (k,v') = let s' = go v' i (fromMaybe emptySource $ M.lookup k ts) in Source es p is $ M.insert k s' ts- g3 i (Source es p is ts) (k,v') = let s' = go v' i (fromMaybe emptySource $ MI.lookup k is) in Source es p (MI.insert k s' is) ts--loadYaml :: MonadIO m => FilePath -> SourcePackT m ()-loadYaml file = do- v <- liftIO $ Y.decodeFileEither file- modify $ \sp -> case v of- Left e -> addErr' (show e) sp- Right a -> loadJSON (emptyReload $ pack file) a sp--tryLoadYaml :: MonadIO m => FilePath -> SourcePackT m ()-tryLoadYaml file = do- b <- liftIO $ doesFileExist file- when b $ loadYaml file
+ src/Salak/Load.hs view
@@ -0,0 +1,34 @@+-- |+-- Module: Salak+-- Copyright: (c) 2019 Daniel YU+-- License: BSD3+-- Maintainer: leptonyu@gmail.com+-- Stability: experimental+-- Portability: portable+--+-- This module is designed for implementating configuration file loading.+--+module Salak.Load(+ -- * Reload+ Reload(..)+ , defReload+ -- * SourcePack+ , Source+ , SourcePack+ , SourcePackT+ , addErr'+ -- * Selector+ , Selector(..)+ , simpleSelectors+ -- * Source+ , insertSource+ , updateSources+ , updateSource+ -- * Load+ , tryLoadFile+ , loadFile+ ) where++import Salak.Types+import Salak.Types.Selector+import Salak.Types.Source
+ src/Salak/Load/Dynamic.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+module Salak.Load.Dynamic where++import Control.Concurrent.MVar+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.State+import Control.Monad.Writer+import qualified Data.IntMap.Strict as MI+import Data.Text (Text)+import Salak.Prop+import Salak.Types+import Salak.Types.Source++data ReloadResult = ReloadResult+ { isError :: Bool+ , msg :: [String]+ } deriving (Eq, Show)++-- | Reloadable SourcePack+data ReloadableSourcePack = ReloadableSourcePack+ { sourcePack :: MVar SourcePack+ , reloadAll :: (SourcePack -> IO ([IO ()], [String])) -> IO ReloadResult+ }++reloadableSourcePack :: MonadIO m => SourcePack -> m ReloadableSourcePack+reloadableSourcePack sp = do+ msp <- liftIO $ newMVar sp+ return $ ReloadableSourcePack msp (reloadAll' msp)+ where+ reloadAll' v f = do+ sp' <- readMVar v+ as <- sequence $ MI.foldlWithKey' go [] (reEnv sp')+ let loadErr = concat $ fst . snd <$> as+ runWith e a = if null e then a else return $ ReloadResult True e+ runWith loadErr $ do+ let sp'' = foldl g2 sp' {errs = []} as+ modLog = errs sp''+ (ac, msErr) <- f sp''+ runWith msErr $ putMVar v sp'' >> sequence_ ac >> return (ReloadResult False modLog)+ go b i (Reload _ f) = ((i,) <$> f i) : b+ g2 :: SourcePack -> (Int, ([String], Source)) -> SourcePack+ g2 p (i, (_, s)) = let (s', e) = runWriter $ replace i s (source p) in p { source = s', errs = errs p <> e}++type ReloadableSourcePackT = StateT ReloadableSourcePack++search' :: (MonadIO m, FromProp a) => Text -> ReloadableSourcePackT m (Either String (IO a))+search' k = do+ ReloadableSourcePack{..} <- get+ sp <- liftIO $ takeMVar sourcePack+ case search k sp of+ Left e -> return (Left e)+ Right r -> do+ v <- liftIO $ newMVar r+ put (ReloadableSourcePack sourcePack (reloadAll . go v))+ return $ Right $ readMVar v+ where+ go x f sp = do+ (as,es) <- f sp+ case search k sp of+ Left e -> return (as, e:es)+ Right r -> return (putMVar x r:as, es)++reloadAction :: Monad m => ReloadableSourcePackT m (IO ReloadResult)+reloadAction = do+ ReloadableSourcePack{..} <- get+ return $ reloadAll $ \_ -> return ([], [])++runReloadable :: MonadIO m => ReloadableSourcePackT m a -> SourcePack -> m a+runReloadable r sp = reloadableSourcePack sp >>= evalStateT r+++
+ src/Salak/Load/Env.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+module Salak.Load.Env where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.State+import Data.Maybe+import qualified Data.Text as T+import Salak.Types+import Salak.Types.Value+import System.Environment++loadEnv :: MonadIO m => SourcePackT m ()+loadEnv = do+ args <- liftIO getEnvironment+ modify $ load (emptyReload "environment") args go+ where+ go p (k,v) = (g2 k, VStr p $ T.pack v)+ g2 = T.toLower . T.pack . map (\c -> if c == '_' then '.' else c)++type ParseCommandLine = [String] -> IO [(T.Text,Priority -> Value)]++defaultParseCommandLine :: ParseCommandLine+defaultParseCommandLine = return . mapMaybe go+ where+ go ('-':'-':as) = case break (=='=') as of+ (a,'=':b) -> Just (T.pack a, \p -> VStr p $ T.pack b)+ _ -> Nothing+ go _ = Nothing++loadCommandLine :: MonadIO m => ParseCommandLine -> SourcePackT m ()+loadCommandLine pcl = do+ args <- liftIO $ getArgs >>= pcl+ modify $ load (emptyReload "commandline") args go+ where+ go i (k,fv) = (k, fv i)
src/Salak/Prop.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}@@ -14,9 +15,8 @@ import Control.Applicative import Control.Monad.Reader import Data.Int-import qualified Data.IntMap.Strict as MI+import qualified Data.Map.Strict as M import Data.Menshen-import qualified Data.PQueue.Min as Q import Data.Scientific import Data.Text (Text) import qualified Data.Text as T@@ -26,6 +26,9 @@ import GHC.Generics hiding (Selector) import qualified GHC.Generics as G import Salak.Types+import Salak.Types.Selector+import Salak.Types.Source+import Salak.Types.Value import Text.Read (readMaybe) data PResult a@@ -93,7 +96,7 @@ instance {-# OVERLAPPABLE #-} (G.Selector s, GFromProp a) => GFromProp (M1 S s a) where gFromProp = local go $ M1 <$> gFromProp where- go sp = select sp (STxt $ T.pack $ selName (undefined :: t s a p))+ go sp = select sp (SStr $ T.pack $ selName (undefined :: t s a p)) instance {-# OVERLAPPABLE #-} GFromProp a => GFromProp (M1 D i a) where gFromProp = M1 <$> gFromProp@@ -120,11 +123,12 @@ instance {-# OVERLAPPABLE #-} FromProp a => FromProp [a] where fromProp = do- SourcePack ss i (Source _ _ is _) it <- ask- foldM (go ss i it) [] $ MI.toList is+ sp@SourcePack{..} <- ask+ as <- foldM (go sp) [] $ M.toList (mapValue source)+ return (reverse as) where- go xx x xt as (ix,s) = do- a <- lift $ runProp (SourcePack (SNum ix:xx) x s xt) fromProp+ go sp' as (ix,s) = do+ a <- lift $ runProp sp' { prefix = ix : prefix sp', source = s} fromProp return (a:as) instance {-# OVERLAPPABLE #-} FromEnumProp a => FromProp a where@@ -132,16 +136,15 @@ VStr _ s -> case fromEnumProp $ T.toLower s of Left e -> F ss e Right r -> O ss r- VNum _ _ -> F ss "number cannot be enum"- VBool _ _ -> F ss "bool cannot be enum"+ x -> F ss $ getType x ++ " cannot be enum" -- | ReadPrimitive value readPrimitive :: ([Selector] -> Value -> PResult a) -> Prop a readPrimitive f = do- SourcePack ss _ (Source _ q _ _) _ <- ask- case Q.getMin q of- Just v -> lift $ f ss v- _ -> lift $ N ss+ SourcePack{..}<- ask+ case getQ (value source) of+ Just v -> lift $ f prefix v+ _ -> lift $ N prefix class FromEnumProp a where fromEnumProp :: Text -> Either String a@@ -149,8 +152,8 @@ err :: String -> Prop a err e = do- SourcePack ss _ _ _ <- ask- lift $ F ss e+ sp <- ask+ lift $ F (prefix sp) e -- | Parse value readSelect :: FromProp a => Text -> Prop a@@ -168,20 +171,19 @@ fromProp = readPrimitive go where go s (VBool _ x) = O s x- go s (VNum _ _) = F s "number cannot be bool" go s (VStr _ x) = case T.toLower x of "true" -> O s True "yes" -> O s True "false" -> O s False "no" -> O s False _ -> F s "string convert bool failed"+ go s x = F s $ getType x ++ " cannot be bool" instance FromProp Text where fromProp = readPrimitive go where go s (VStr _ x) = O s x- go s (VBool _ _) = F s "boolean cannot be string"- go s (VNum _ _) = F s "number cannot be string"+ go s x = O s $ T.pack (getV x) instance FromProp TL.Text where fromProp = TL.fromStrict <$> fromProp@@ -196,7 +198,7 @@ Just v -> O s v _ -> F s "string convert number failed" go s (VNum _ x) = O s x- go s (VBool _ _) = F s "boolean cannot be number"+ go s x = F s $ getType x ++ " cannot be number" instance FromProp Float where fromProp = toRealFloat <$> fromProp
src/Salak/Types.hs view
@@ -1,204 +1,81 @@-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeSynonymInstances #-} module Salak.Types where -import Control.Applicative ((<|>)) import Control.Monad.State-import Data.Attoparsec.Text+import Control.Monad.Writer import qualified Data.IntMap.Strict as MI-import Data.List (intercalate)-import qualified Data.Map.Strict as M-import Data.Maybe-import qualified Data.PQueue.Min as Q-import Data.Scientific (Scientific) import Data.Text (Text) import qualified Data.Text as T--type Priority = Int--data Value- = VStr Priority !Text- | VNum Priority !Scientific- | VBool Priority !Bool- deriving (Eq, Show, Ord)--type QV = Q.MinQueue Value--getPriority :: Value -> Priority-getPriority (VStr p _) = p-getPriority (VNum p _) = p-getPriority (VBool p _) = p+import Salak.Types.Selector+import Salak.Types.Source+import Salak.Types.Value+import System.Directory data Reload = Reload { sourceName :: Text- , reload :: Priority -> IO Source+ , reload :: Priority -> IO ([String], Source) } instance Show Reload where show (Reload s _) = T.unpack s -emptyReload :: Text -> Reload-emptyReload s = Reload s (\_ -> return emptySource)--type PriorityEnv = MI.IntMap Reload--nullSource :: Source -> Bool-nullSource (Source _ q is ts) = Q.null q && MI.null is && M.null ts--getQ :: Source -> QV-getQ (Source _ q _ _) = q--replaceQ :: String -> Priority -> QV -> QV -> ([String], QV)-replaceQ s i nq q =- let (a,b) = Q.partition ((==i) . getPriority) q- in if a == nq then ([], q) else case Q.getMin nq of- Just v -> ([ (if Q.null a then "Add " else "Mod ") ++ s], Q.insert v b)- _ -> (if Q.null a then [] else ["Del " ++ s], b)--data Source' v = Source [String] v (MI.IntMap (Source' v)) (M.Map Text (Source' v)) deriving (Eq, Functor)--type Source = Source' QV--instance Show Source where- show = unlines . go ""- where- go p (Source _ q is ts) = (if Q.null q then [] else [ p ++ "=" ++ show q ])- ++ concat ((\(k,v) -> go (p ++ "[" ++ show k ++ "]") v) <$> MI.toList is)- ++ concat ((\(k,v) -> go (if null p then T.unpack k else p ++ "." ++ T.unpack k) v) <$> M.toList ts)--emptySource :: Source-emptySource = Source [] Q.empty MI.empty M.empty--instance Foldable Source' where- foldr f b s@(Source _ _ is ts) = foldr go (foldr go (go s b) is) ts- where- go (Source _ q _ _) = f q--foldSource :: (Value -> b -> b) -> b -> Source -> b-foldSource f = foldr (\q b -> maybe b (`f` b) $ Q.getMin q)--sizeSouce :: Source -> Int-sizeSouce = foldSource (const (+1)) 0--extractErr :: Source -> ([String], Source)-extractErr (Source es q is ts) =- let (ise, is') = MI.mapAccum go es is- (tse, ts') = M.mapAccum go ise ts- in (tse, Source [] q is' ts')- where- go e s = let (e', s') = extractErr s in (e ++ e', s')--replace = replace' []--replace' :: [Selector] -> Priority -> Source -> Source -> Source-replace' ss i (Source _ nq nis nts) (Source es q is ts) =- let (ms, q') = replaceQ (toKey ss) i nq q- (isa,isb) = MI.partition nullSource $ MI.mapWithKey (g2.SNum) $ MI.unionWithKey (go.SNum) (f 0 nis) (f 1 is)- (tsa,tsb) = M.partition nullSource $ M.mapWithKey (g2.STxt) $ M.unionWithKey (go.STxt) (f 0 nts) (f 1 ts)- in Source (g $ Source (es ++ ms) Q.empty isa tsa) q' isb tsb- where- f x = ((x::Int,) <$>)- g = fst . extractErr- go st (_, s) (_, s') = (2, replace' (st:ss) i s s')- g2 st (0, s) = replace' (st:ss) i s emptySource- g2 st (1, s) = replace' (st:ss) i emptySource s- g2 _ (_, s) = s--data Selector- = STxt !Text- | SNum !Int- deriving Eq--instance Show Selector where- show (STxt x) = T.unpack x- show (SNum i) = "[" ++ show i ++ "]"--toKey :: [Selector] -> String-toKey = intercalate "." . go . reverse- where- go (a@(STxt _):b@(SNum _):cs) = (show a ++ show b) : go cs- go (a:bs) = show a : go bs- go [] = []--selectors :: Text -> Either String [Selector]-selectors = go . parse exprs . flip T.snoc '\n'- where- go (Done i r) = if i /= "\n" then Left $ "uncomplete parse" ++ T.unpack i else Right r- go a = Left (show a)--exprs :: Parser [Selector]-exprs = concat <$> ( (expr <|> return []) `sepBy` char '.')---- xx--- xx.xx--- xx.xx[0]--- xx.xx[1].xx-expr :: Parser [Selector]-expr = do- name <- T.pack <$> do- a <- choice [letter, digit]- b <- many' (choice [letter, digit, char '-', char '_'])- return (a:b)- (paren decimal >>= \i -> return [STxt name, SNum i]) <|> return [STxt name]+defReload :: String -> SourcePackT IO () -> Reload+defReload s spt = Reload (T.pack s) (\i -> go <$> execStateT spt emptySourcePack {packId = i}) where- paren e = do- _ <- char '['- ex <- e- _ <- char ']'- return ex--addErr :: String -> Source -> Source-addErr e (Source es a b c) = Source (e:es) a b c--insert :: Text -> Value -> Source -> Source-insert k v s = case selectors k of- Left e -> addErr e s- Right k' -> insert' k' v s+ go SourcePack{..} = (errs, source) -insert' :: [Selector] -> Value -> Source -> Source-insert' [] v (Source es q is ts) = Source es (Q.insert v q) is ts-insert' (STxt n:ss) v (Source es q is ts) = Source es q is $ M.alter (Just . insert' ss v . fromMaybe emptySource) n ts-insert' (SNum i:ss) v (Source es q is ts) = Source es q (MI.alter (Just . insert' ss v . fromMaybe emptySource) i is) ts+emptyReload s = defReload s (return ()) -data SourcePack = SourcePack [Selector] Int Source PriorityEnv deriving Show+data SourcePack = SourcePack+ { prefix :: [Selector]+ , packId :: Int+ , source :: Source+ , reEnv :: MI.IntMap Reload+ , errs :: [String]+ } deriving Show -emptySourcePack = SourcePack [] 0 emptySource MI.empty+emptySourcePack = SourcePack [] 0 emptySource mempty [] mapSource :: (Source -> Source) -> SourcePack -> SourcePack-mapSource f (SourcePack ss i s it) = SourcePack ss i (f s) it+mapSource f sp = sp { source = f (source sp)} select :: SourcePack -> Selector -> SourcePack-select (SourcePack ss i (Source _ _ _ ts) it) s@(STxt n) = SourcePack (s:ss) i (fromMaybe emptySource $ M.lookup n ts) it-select (SourcePack ss i (Source _ _ is _) it) s@(SNum n) = SourcePack (s:ss) i (fromMaybe emptySource $ MI.lookup n is) it+select sp n = sp { source = selectSource n (source sp), prefix = n : prefix sp} addErr' :: String -> SourcePack -> SourcePack-addErr' e = mapSource (addErr e)+addErr' e sp = sp {errs = e : errs sp} -extractErr' :: SourcePack -> ([String], SourcePack)-extractErr' (SourcePack ss i s it) = let (es, s') = extractErr s in (es, SourcePack ss i s' it)+loadFile :: Reload -> SourcePack -> (Priority -> Source -> Writer [String] Source) -> SourcePack+loadFile name SourcePack{..} go =+ let (s', e) = runWriter $ go packId source+ in SourcePack prefix (packId+1) s' (MI.insert packId name reEnv) (errs ++ e) -loadFile :: Reload -> SourcePack -> (Priority -> Source -> Source) -> SourcePack-loadFile name (SourcePack ss i s env) go = SourcePack ss (i+1) (go i s) $ MI.insert i name env+tryLoadFile :: MonadIO m => (FilePath -> SourcePackT m ()) -> FilePath -> SourcePackT m ()+tryLoadFile f file = do+ b <- liftIO $ doesFileExist file+ when b $ do+ liftIO $ putStrLn $ "Load " <> file+ f file load- :: (Functor f, Foldable f)+ :: Foldable f => Reload -> f a -> (Priority -> a -> (Text, Value)) -> SourcePack -> SourcePack-load name fa f sp = loadFile name sp $ \i s -> foldl (go i) s fa+load name fa f sp = loadFile name sp $ \i s -> foldl (go i) (return s) fa where- go i s a = let (k,v) = f i a in insert k v s+ go i s a = s >>= \s' -> let (k,v) = f i a in insert k v s' loadMock :: Monad m => [(Text, Text)] -> SourcePackT m ()-loadMock fs = modify $ load (emptyReload "") fs (\i (k,v) -> (k, VStr i v))+loadMock fs = modify $ load (emptyReload "Mock") fs (\i (k,v) -> (k, VStr i v)) type SourcePackT = StateT SourcePack -runSourcePackT :: Monad m => SourcePackT m a -> m ([String], SourcePack)-runSourcePackT ac = extractErr' <$> execStateT ac emptySourcePack+runSourcePackT :: Monad m => SourcePackT m a -> m SourcePack+runSourcePackT ac = execStateT ac emptySourcePack
+ src/Salak/Types/Selector.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+module Salak.Types.Selector where++import Control.Applicative ((<|>))+import Data.Attoparsec.Text+import Data.List (intercalate)+import Data.Text (Text)+import qualified Data.Text as T++data Selector+ = SStr !Text+ | SNum !Int+ deriving (Eq, Ord)++isStr :: Selector -> Bool+isStr (SStr _) = True+isStr _ = False++instance Show Selector where+ show (SStr x) = T.unpack x+ show (SNum i) = "[" ++ show i ++ "]"++toKey :: [Selector] -> String+toKey = intercalate "." . go . reverse+ where+ go (a@(SStr _):cs) = let (b,c) = break isStr cs in (show a ++ concat (show <$> b)) : go c+ go (a:cs) = show a : go cs+ go [] = []++simpleSelectors :: Text -> [Selector]+simpleSelectors as = fmap SStr $ filter (not.T.null) $ T.splitOn "." as++selectors :: Text -> Either String [Selector]+selectors = go . parse exprs . flip T.snoc '\n'+ where+ go (Done i r) = if i /= "\n" then Left $ "uncomplete parse" ++ T.unpack i else Right r+ go a = Left (show a)++exprs :: Parser [Selector]+exprs = concat <$> ( (expr <|> return []) `sepBy` char '.')++-- xx+-- xx.xx+-- xx.xx[0]+-- xx.xx[1].xx+expr :: Parser [Selector]+expr = do+ name <- T.pack <$> do+ a <- choice [letter, digit]+ b <- many' (choice [letter, digit, char '-', char '_'])+ return (a:b)+ ds <- many' (paren decimal)+ return $ SStr name : (SNum <$> ds)+ where+ paren e = do+ _ <- char '['+ ex <- e+ _ <- char ']'+ return ex
+ src/Salak/Types/Source.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+module Salak.Types.Source where++import Control.Monad.Writer+import qualified Data.Map.Strict as M+import Data.Maybe+import qualified Data.Text as T+import Salak.Types.Selector+import Salak.Types.Value++data SourceT v = Source+ { value :: v+ , mapValue :: M.Map Selector (SourceT v)+ } deriving (Eq, Functor)++instance Foldable SourceT where+ foldr g b Source{..} = M.foldl (foldr g) (g value b) mapValue++type Source = SourceT QV++showKey :: String -> Selector -> String+showKey p (SStr k)+ | null p = T.unpack k+ | otherwise = p <> "." <> T.unpack k+showKey p (SNum k) = p <> "[" <> show k <> "]"++instance Show Source where+ show = unlines . go ""+ where+ go p Source{..} = concat $ M.foldrWithKey (\k v b -> go (showKey p k) v : b) [ g2 p value] mapValue+ g2 x v = if nullQ v then [] else [x <> "=" <> show v]++emptySource :: Source+emptySource = Source mempty mempty++foldSource :: (Value -> b -> b) -> b -> Source -> b+foldSource f = foldr (\q b -> maybe b (`f` b) $ getQ q)++sizeSource :: Source -> Int+sizeSource = foldSource (const (+1)) 0++nullSource :: Source -> Bool+nullSource = foldSource (\_ _ -> False) True++selectSource :: Selector -> Source -> Source+selectSource n Source{..} = fromMaybe emptySource $ M.lookup n mapValue++updateSource :: Monad m => Selector -> (Source -> m Source) -> Source -> m Source+updateSource n f ss = do+ ss' <- f $ selectSource n ss+ return $ ss { mapValue = M.insert n ss' (mapValue ss) }++updateSources :: Monad m => [Selector] -> (Source -> m Source) -> Source -> m Source+updateSources = flip (foldr updateSource)++replace = replace' []++replace' :: [Selector] -> Priority -> Source -> Source -> Writer [String] Source+replace' ss i ns os = do+ q' <- replaceQ (toKey ss) i (value ns) (value os)+ m' <- mapM snd $ M.mapWithKey g2 $ M.unionWithKey go (f 0 $ mapValue ns) (f 1 $ mapValue os)+ return (Source q' $ M.filter (not.nullSource) m')+ where+ f j m = (j :: Int,) . return <$> m+ go k (_, a) (_, b) = (2, a >>= \a' -> b >>= \b' -> replace' (k:ss) i a' b')+ g2 k (0, a) = (0, a >>= \a' -> replace' (k:ss) i a' emptySource)+ g2 k (1, a) = (1, a >>= \a' -> replace' (k:ss) i emptySource a')+ g2 _ (_, a) = (2 :: Int, a)++insert :: T.Text -> Value -> Source -> Writer [String] Source+insert k v s = case selectors k of+ Left e -> tell [e] >> return s+ Right k' -> return (insert' k' v s)++insert' :: [Selector] -> Value -> Source -> Source+insert' ns v = foldr go (insertSource v) ns+ where+ go n f s = s { mapValue = M.alter (Just . f . fromMaybe emptySource) n $ mapValue s}++insertSource :: Value -> Source -> Source+insertSource v s = s { value = insertQ v $ value s}
+ src/Salak/Types/Value.hs view
@@ -0,0 +1,68 @@+module Salak.Types.Value where++import Control.Monad.Writer+import qualified Data.PQueue.Min as Q+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Time++type Priority = Int++data Value+ = VStr !Priority !Text+ | VNum !Priority !Scientific+ | VBool !Priority !Bool+ | VZTime !Priority !TimeZone !LocalTime+ | VLTime !Priority !LocalTime+ | VDay !Priority !Day+ | VHour !Priority !TimeOfDay+ deriving Eq++instance Ord Value where+ compare a b = compare (getPriority a) (getPriority b)++instance Show Value where+ show v = let (a,b,c) = typeOfV v in c <> ":" <> b <> "#" <> show a++typeOfV :: Value -> (Priority, String, String)+typeOfV (VStr a b) = (a, "Str", show b)+typeOfV (VNum a b) = (a, "Num", show b)+typeOfV (VBool a b) = (a, "Bool", show b)+typeOfV (VZTime a b c) = (a, "ZonedTime", show (ZonedTime c b))+typeOfV (VLTime a b) = (a, "LocalTime", show b)+typeOfV (VDay a b) = (a, "Day", show b)+typeOfV (VHour a b) = (a, "TimeOfDay", show b)++getPriority :: Value -> Priority+getPriority x = let (a,_,_) = typeOfV x in a++getType :: Value -> String+getType x = let (_,b,_) = typeOfV x in b++getV :: Value -> String+getV x = let (_,_,b) = typeOfV x in b++type QV = Q.MinQueue Value++getQ :: QV -> Maybe Value+getQ = Q.getMin++nullQ :: QV -> Bool+nullQ = Q.null++insertQ :: Value -> QV -> QV+insertQ = Q.insert++replaceQ :: Monad m => String -> Priority -> QV -> QV -> WriterT [String] m QV+replaceQ s i nq q = do+ let (a,b) = Q.partition ((==i) . getPriority) q+ go v = tell $ (\vi -> "#" <> show i <> " " <> vi) <$> v+ if a == nq+ then return q+ else case getQ nq of+ Just v -> do+ go [(if Q.null a then "Add " else "Mod ") ++ s]+ return $ Q.insert v b+ _ -> do+ unless (Q.null a) $ go ["Del " ++ s]+ return b
test/Spec.hs view
@@ -6,13 +6,18 @@ module Main where +import Control.Monad.Reader+import Control.Monad.Writer import Data.Either-import Data.List (intercalate)-import Data.Text (Text, pack, unpack)+import Data.List (intercalate)+import Data.Menshen+import Data.Text (Text, pack, unpack) import GHC.Generics import Salak import Salak.Prop import Salak.Types+import Salak.Types.Selector+import Salak.Types.Source import Test.Hspec import Test.QuickCheck @@ -47,55 +52,66 @@ { hello :: String } deriving (Eq, Show, Generic) instance FromProp SubConf where- fromProp = SubConf <$> "hello" .?= "yyy"+ fromProp = SubConf <$> "hello" .?= "yyy" ? pattern "[a-z]{3,16}" instance FromProp Conf specProperty = do context "selectors" $ do it "normal" $ do- selectors "" `shouldBe` Right []- selectors "." `shouldBe` Right []- selectors ".." `shouldBe` Right []- selectors "xx" `shouldBe` Right [STxt "xx"]- selectors "xx[0]" `shouldBe` Right [STxt "xx", SNum 0]- selectors "xx.yy" `shouldBe` Right [STxt "xx", STxt "yy"]+ selectors "" `shouldBe` Right []+ selectors "." `shouldBe` Right []+ selectors ".." `shouldBe` Right []+ selectors "xx" `shouldBe` Right [SStr "xx"]+ selectors "xx[0]" `shouldBe` Right [SStr "xx", SNum 0]+ selectors "xx.yy" `shouldBe` Right [SStr "xx", SStr "yy"]+ selectors "xx[0][1]" `shouldBe` Right [SStr "xx", SNum 0, SNum 1]+ toKey (reverse $ SStr "x" : (SNum <$> [0..9])) `shouldBe` "x[0][1][2][3][4][5][6][7][8][9]" it "QuickCheck" $ do quickCheck $ \s -> let s' = unKey s in (toKey . reverse <$> selectors s') `shouldBe` Right (unpack s') context "source" $ do it "normal" $ do- nullSource emptySource `shouldBe` True- sizeSouce emptySource `shouldBe` 0+ sizeSource emptySource `shouldBe` 0 it "normal - 2" $ do- let s1 = insert "hello" (VStr 0 "world") emptySource- sizeSouce s1 `shouldBe` 1- let s2 = insert "1" (VStr 0 "world") emptySource- sizeSouce s2 `shouldBe` 1- let (es,_) = extractErr s2- length es `shouldBe` 0- it "merge" $ do- let s = insert "hello" (VStr 0 "world") emptySource- s1 = insert "hello" (VStr 0 "xxxxx") emptySource- (e2, s2) = extractErr $ replace 0 emptySource s+ let (s1,e1) = runWriter $ insert "hello" (VStr 0 "world") emptySource+ sizeSource s1 `shouldBe` 1+ length e1 `shouldBe` 0+ it "normal - 3" $ do+ let (s2,e2) = runWriter $ insert "1" (VStr 0 "world") emptySource+ sizeSource s2 `shouldBe` 1+ length e2 `shouldBe` 00+ it "normal - 4" $ do+ let (s3,e3) = runWriter $ insert "a.b" (VStr 0 "world") emptySource+ print s3+ sizeSource s3 `shouldBe` 1+ length e3 `shouldBe` 0+ context "source - merge" $ do+ let s = fst $ runWriter $ insert "hello" (VStr 0 "world") emptySource+ s1 = fst $ runWriter $ insert "hello" (VStr 0 "xxxxx") emptySource+ it "merge - del" $ do+ let (s2,e2) = runWriter $ replace 0 emptySource s s2 `shouldBe` emptySource- e2 `shouldBe` ["Del hello"]- let (e3, s3) = extractErr $ replace 0 s1 s- e3 `shouldBe` ["Mod hello"]+ e2 `shouldBe` ["#0 Del hello"]+ it "merge - mod" $ do+ let (s3,e3) = runWriter $ replace 0 s1 s+ e3 `shouldBe` ["#0 Mod hello"] s3 `shouldBe` s1- let (e4, s4) = extractErr $ replace 0 s emptySource- e4 `shouldBe` ["Add hello"]+ it "merge - add" $ do+ let (s4,e4) = runWriter $ replace 0 s emptySource+ e4 `shouldBe` ["#0 Add hello"] s4 `shouldBe` s- let (e5, s5) = extractErr $ replace 0 s s+ it "merge - unchange" $ do+ let (s5,e5) = runWriter $ replace 0 s s e5 `shouldBe` [] s5 `shouldBe` s context "Generic" $ do it "conf" $ do- (e, sp) <- runSourcePackT $ loadMock+ sp <- runSourcePackT $ loadMock [ ("name", "Daniel") , ("age", "18") , ("male", "yes") ]- e `shouldBe` []+ errs sp `shouldBe` [] let a = search "" sp :: Either String Conf print a isRight a `shouldBe` True
− test/salak.yml
@@ -1,9 +0,0 @@-array:- - a- - b-hello:- world--config:- name: hello- dir: /root