salak 0.1.9 → 0.1.10

raw patch · 16 files changed

+153/−745 lines, 16 filesdep −menshendep −stmPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: menshen, stm

API changes (from Hackage documentation)

Files

• README.md +1/−1
• salak.cabal +1/−23
• src/Data/Salak.hs +0/−155
• src/Data/Salak/Aeson.hs +0/−44
• src/Data/Salak/CommandLine.hs +0/−47
• src/Data/Salak/Dynamic.hs +0/−56
• src/Data/Salak/Environment.hs +0/−26
• src/Data/Salak/Operation.hs +0/−39
• src/Data/Salak/Types.hs +0/−260
• src/Data/Salak/Yaml.hs +0/−38
• src/Salak.hs +103/−31
• src/Salak/Dynamic.hs +18/−10
• src/Salak/Json.hs +7/−1
• src/Salak/Prop.hs +17/−9
• src/Salak/Types.hs +5/−5
• test/Spec.hs +1/−0

@@ -6,7 +6,7 @@ [![Build Status](https://travis-ci.org/leptonyu/salak.svg?branch=master)](https://travis-ci.org/leptonyu/salak)  -Configuration Loader for Production in Haskell.+Configuration Loader in Haskell.  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

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: salak-version: 0.1.9+version: 0.1.10 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU@@ -8,8 +8,6 @@ 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:@@ -19,7 +17,6 @@ library     exposed-modules:         Salak-        Data.Salak     hs-source-dirs: src     other-modules:         Salak.Types@@ -27,13 +24,6 @@         Salak.Json         Salak.Prop         Salak.Dynamic-        Data.Salak.Types-        Data.Salak.Environment-        Data.Salak.CommandLine-        Data.Salak.Aeson-        Data.Salak.Yaml-        Data.Salak.Operation-        Data.Salak.Dynamic     default-language: Haskell2010     ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures     build-depends:@@ -44,11 +34,9 @@         data-default <0.8,         directory <1.4,         filepath <1.5,-        menshen <0.1,         mtl <2.3,         pqueue <1.5,         scientific <0.4,-        stm <2.6,         text <1.3,         transformers <0.6,         unordered-containers <0.3,@@ -60,14 +48,6 @@     main-is: Spec.hs     hs-source-dirs: test src     other-modules:-        Data.Salak-        Data.Salak.Aeson-        Data.Salak.CommandLine-        Data.Salak.Dynamic-        Data.Salak.Environment-        Data.Salak.Operation-        Data.Salak.Types-        Data.Salak.Yaml         Salak         Salak.Dynamic         Salak.Env@@ -87,11 +67,9 @@         directory <1.4,         filepath <1.5,         hspec ==2.*,-        menshen <0.1,         mtl <2.3,         pqueue <1.5,         scientific <0.4,-        stm <2.6,         text <1.3,         transformers <0.6,         unordered-containers <0.3,

@@ -1,155 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--- |--- Module:      Data.Salak--- Copyright:   (c) 2018 Daniel YU--- License:     BSD3--- Maintainer:  Daniel YU <leptonyu@gmail.com>--- Stability:   experimental--- Portability: portable------ Configuration Loader for Production in Haskell.----module Data.Salak(-  -- * How to use this library-  -- $use--  -- * Properties Loader-    LoadProperties-  , runLoad-  , askProperties-  , setValue-  , loadCommandLine-  , loadEnvironment-  , loadJSON-  , loadYaml-  , loadYamlIfExists-  -- ** Predefined Loaders-  , defaultProperties-  , defaultProperties'-  , defaultPropertiesWithFile-  , defaultPropertiesWithFile'-  , empty-  -- * Lookup Properties-  , lookup-  , toKeys-  -- * Types-  , Property(..)-  , Properties(..)-  , FromProperties(..)-  , Return-  -- * Properties Loader Helper-  , insert-  , defaultParseCommandLine-  , ParseCommandLine-  , 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-import           Data.Salak.Yaml-import           Data.Text                 (pack)-import           Prelude                   hiding (lookup)-import           System.Directory-import           System.FilePath           ((</>))---- | Initialize default properties from `CommandLine` and `Environment`.--- `CommandLine` use default parser.-defaultProperties :: IO Properties-defaultProperties = defaultProperties' defaultParseCommandLine---- | Initialize default properties from `CommandLine` and `Environment`.-defaultProperties' :: ParseCommandLine -> IO Properties-defaultProperties' dpc = runLoad $ do-  loadCommandLine dpc-  loadEnvironment---- | Yaml file name.-type FileName = String---- | 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`.-  -> IO Properties-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 = 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------ | 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 `Properties`. Earler property source has higher order--- to load property. For example:------ > CommandLine:  --package.a.enabled=true--- > Environment: PACKAGE_A_ENABLED: false------ > lookup "package.a.enabled" properties => Just True------ `CommandLine` has higher order then `Environment`, for the former load properties earler then later.------ Usage:------ > data Config = Config--- >   { name :: Text--- >   , dir  :: Maybe Text--- >   , ext  :: Int--- >   } deriving (Eq, Show)--- >--- > instance FromProperties Config where--- >   fromProperties v = Config--- >         <$> v .?> "name"--- >         <*> v .?> "dir"--- >         <*> v .?> "ext" .?= 1------ > main = do--- >   p <- defaultPropertiesWithFile "salak.yml"--- >   let config  = p .>> "salak.config"  :: Config--- >       enabled = p .?> "salak.enabled" .|= True--- >   print config--- >   print enabled-

@@ -1,44 +0,0 @@-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE UndecidableInstances #-}--module Data.Salak.Aeson where--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)---- | Load `Properties` from JSON `Value`-makePropertiesFromJson :: Value -> Properties -> Properties-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  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 _) p = p--jsonToProperties :: Value -> Properties-jsonToProperties = (`makePropertiesFromJson` empty)--instance HasValid Parser where-  invalid = fail . toI18n--fromArray v = foldl g3 ([],[]) $ go . jsonToProperties <$> toList v-  where-    go (Properties ps ms) = (g2 ps,g2 ms)-    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

@@ -1,47 +0,0 @@-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           System.Environment---- | CommandLine parser. Parse command line into property key values.-type ParseCommandLine = [String] -> IO [(String,Property)]---- | Default command line parsers.---   Use format:------ > --KEY=VALUE------ For example:------ > --salak.config.name=test.yml => ("salak.config.name", PStr "test.yml")----defaultParseCommandLine :: ParseCommandLine-defaultParseCommandLine = return . mapMaybe go-  where-    go ('-':'-':as) = case break (=='=') as of-      (a,'=':b) -> Just (a,PStr $ pack b)-      _         -> Nothing-    go _ = Nothing---- | Load `Properties` from 'CommandLine'-makePropertiesFromCommandLine :: ParseCommandLine -> Properties -> IO Properties-makePropertiesFromCommandLine parser p = getArgs >>= (\a -> makePropertiesFromCommandLine' a parser p)--makePropertiesFromCommandLine' :: [String] -> ParseCommandLine -> Properties -> IO Properties-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

@@ -1,56 +0,0 @@-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

@@ -1,26 +0,0 @@-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           System.Environment---- | Load `Properties` from 'Environment'-makePropertiesFromEnvironment :: Properties -> IO Properties-makePropertiesFromEnvironment p = getEnvironment >>= (\v -> return $ makePropertiesFromEnvironment' v p)---makePropertiesFromEnvironment' :: [(String,String)] -> Properties -> Properties-makePropertiesFromEnvironment' vs = makeProperties $ go <$> vs-  where-    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

@@ -1,39 +0,0 @@-module Data.Salak.Operation where--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 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 $ "property " ++ unpack k ++ " not set"-  Left (Fail e)     -> error e

@@ -1,260 +0,0 @@-{-# LANGUAGE CPP                  #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeSynonymInstances #-}--module Data.Salak.Types where--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)-import qualified Data.Text           as T-import           Data.Word-import           System.Directory-import           Text.Read           (readMaybe)-#if __GLASGOW_HASKELL__ <= 802-import           Data.Monoid         ((<>))-#endif--- | Property key-type Key = Text---- | A Property value represented as a Haskell value.-data Property-  = PNum  !Scientific -- ^ Numeric Property-  | PStr  !Text       -- ^ String  Property-  | PBool !Bool       -- ^ Bool    Property-  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 #-}-      {-# 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 = 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 :: 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  [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.-lookup :: FromProperties a => Text -> Properties -> Return a-lookup k = go (toKeys k)-  where-    {-# INLINE go #-}-    go [] p                      = fromProperties p-    go (a:as) (Properties _ ms) = case go as $ fromMaybe empty $ select a ms of-        Left (EmptyKey ke) -> Left $ EmptyKey $ joinKey a ke-        v                  -> v-    select _ []  = Nothing-    select a [m] = M.lookup a m-    select _ _   = Nothing---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)-  where-    go m (k,v) = insert (toKeys k) v m---- | 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-  fromProperties :: Properties -> Return a--instance FromProperties Property where-  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--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-      go (PNum a) = Right a-      go (PStr a) = to readMaybe $ T.unpack a-      go _        = Left $ Fail "bool cannot convert to number"--instance FromProperties String where-  fromProperties a = T.unpack <$> fromProperties a--instance FromProperties Text where-  fromProperties = fromProperties >=> go-    where-      go (PStr a) = Right a-      go a        = Right $ T.pack $ show a--instance FromProperties Float where-  fromProperties a = toRealFloat <$> fromProperties a--instance FromProperties Double where-  fromProperties a = toRealFloat <$> fromProperties a--instance FromProperties Int where-  fromProperties = toNumeric--instance FromProperties Int8 where-  fromProperties = toNumeric--instance FromProperties Int16 where-  fromProperties = toNumeric--instance FromProperties Int32 where-  fromProperties = toNumeric--instance FromProperties Int64 where-  fromProperties = toNumeric--instance FromProperties Word where-  fromProperties = toNumeric--instance FromProperties Word8 where-  fromProperties = toNumeric--instance FromProperties Word16 where-  fromProperties = toNumeric--instance FromProperties Word32 where-  fromProperties = toNumeric--instance FromProperties Word64 where-  fromProperties = toNumeric--toNumeric :: (Bounded i, Integral i) => Properties -> Return i-toNumeric = fromProperties >=> to toBoundedInteger--to :: (b -> Maybe a) -> b -> Return a-to v b = case v b of-  Just a  -> Right a-  Nothing -> Left $ Fail "number convert failed"--instance FromProperties Bool where-  fromProperties = fromProperties >=> go-    where-      go (PBool a) = Right a-      go (PStr  a) = g2 $ T.toLower a-      go _         = Left $ Fail "number cannot convert to bool"-      g2 :: Text -> Return 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  = Left  $ EmptyKey ""-        | 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 ()

@@ -1,38 +0,0 @@-{-# 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---- | 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

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes        #-} {-# LANGUAGE RecordWildCards   #-} -- |@@ -15,36 +16,44 @@   -- * How to use this library   -- $use -  -- * Source-    Selector-  , SourcePack-  , SourcePackT-  , Reload(..)-  , load-  , loadJSON-  , loadYaml-  , loadEnv   -- * Salak-  , defaultLoadSalak+    defaultLoadSalak   , loadSalak   , PropConfig(..)+  -- * Static Load   , HasSourcePack(..)   , fetch   , require-  -- * Utilities+  -- * Dynamic Load   , ReloadableSourcePack-  , runReloadable+  , ReloadableSourcePackT+  , ReloadResult(..)+  , reloadable+  , fetchD+  , requireD+  -- * Prop Parser   , Prop   , FromProp(..)-  , PResult(..)-  , readPrimitive-  , readSelect-  , err+  , FromEnumProp(..)+  , (.?=)+  -- * SourcePack+  , SourcePack+  , SourcePackT+  , loadYaml+  , loadCommandLine+  , loadEnv+  , loadMock+  , defaultParseCommandLine+  , ParseCommandLine+  , Priority+  , Value(..)   ) where +import           Control.Applicative import           Control.Monad          (unless) import           Control.Monad.IO.Class (MonadIO) import           Control.Monad.Reader+import           Control.Monad.State import           Data.Default import           Data.Text              (Text) import           Salak.Dynamic@@ -52,47 +61,110 @@ import           Salak.Json import           Salak.Prop import           Salak.Types+import           System.Directory+import           System.FilePath        ((</>)) +-- | Prop load configuration data PropConfig = PropConfig-  { configFileKey :: Maybe String-  , commandLine   :: ParseCommandLine+  { configName    :: Maybe String  -- ^ Config name+  , configDirKey  :: Text          -- ^ Specify config dir+  , searchCurrent :: Bool          -- ^ Search current directory, default true+  , searchHome    :: Bool          -- ^ Search home directory, default false.+  , commandLine   :: ParseCommandLine -- ^ How to parse commandline   }  instance Default PropConfig where-  def = PropConfig Nothing defaultParseCommandLine+  def = PropConfig Nothing "salak.conf" True False defaultParseCommandLine -loadSalak :: Monad m => ReaderT SourcePack m a -> SourcePackT m () -> m a+-- | Load salak `SourcePack` and fetch properties.+loadSalak+  :: Monad m+  => ReaderT SourcePack m a -- ^ Fetch properties monad.+  -> SourcePackT m ()       -- ^ Load properties monad.+  -> m a loadSalak a spm = do   (es, sp) <- runSourcePackT spm-  unless (null es) $ do-    fail (head es)+  unless (null es) $ fail (head es)   runReaderT a sp +-- | Default load salak.+-- All these configuration sources has orders, from highest order to lowest order:+--+-- > 1. CommandLine+-- > 2. Environment+-- > 3. Specified Yaml file(file in `configDirKey`)+-- > 4. Yaml file in current directory+-- > 5. Yaml file in home directory+-- defaultLoadSalak :: MonadIO m => PropConfig -> ReaderT SourcePack m a -> m a defaultLoadSalak PropConfig{..} a = loadSalak a $ do   loadCommandLine commandLine   loadEnv-  go configFileKey+  cf <- fetch configDirKey+  maybe (return ()) (go cf) configName   where-    go (Just file) = loadYaml file-    go _           = return ()+    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  class Monad m => HasSourcePack m where   askSourcePack :: m SourcePack -fetch :: (HasSourcePack m, FromProp a) => Text -> m (Either String a)-fetch key = askSourcePack >>= return . search key+instance Monad m => HasSourcePack (ReaderT SourcePack m) where+  askSourcePack = ask+instance Monad m => HasSourcePack (StateT SourcePack m) where+  askSourcePack = get -require :: (HasSourcePack m, FromProp a) => Text -> m a+-- | Try fetch properties from `SourcePack`+fetch+  :: (HasSourcePack m, FromProp a)+  => Text -- ^ Properties key+  -> m (Either String a)+fetch key = search key <$> askSourcePack++-- | Fetch properties from `SourcePack`, or throw fail+require+  :: (HasSourcePack m, FromProp a)+  => Text -- ^ Properties key+  -> m a require k = do   x <- fetch k   case x of     Left  e -> fail e     Right v -> return v -instance Monad m => HasSourcePack (ReaderT SourcePack m) where-  askSourcePack = ask+-- | Fetch dynamic properties from `SourcePack`, or throw fail+requireD+  :: (MonadIO m, HasSourcePack m, FromProp a)+  => Text -- ^ Properties key+  -> ReloadableSourcePackT m (IO a)+requireD k = do+  x <- fetchD k+  case x of+    Left  e -> fail e+    Right v -> return v +-- | Try fetch dynamic properties from `SourcePack`+fetchD+  :: (MonadIO m, HasSourcePack m, FromProp a)+  => Text -- ^ Properties key+  -> ReloadableSourcePackT m (Either String (IO a))+fetchD = search'++-- | Lift to reloadable environment for dynamic properties.+reloadable :: (MonadIO m, HasSourcePack m) => ReloadableSourcePackT m a -> m a+reloadable f = askSourcePack >>= runReloadable f++-- | Optional value.+infixl 5 .?=+(.?=) :: Alternative f => f a -> a -> f a+(.?=) a b = a <|> pure b+ -- $use -- -- | This library default a standard configuration load process. It can load properties from `CommandLine`, `Environment`,@@ -123,6 +195,6 @@ -- > main = do -- >   c :: Config <- defaultLoadSalak def $ require "" -- >   print c--- +-- -- > λ> c -- > Config {name = "daniel", dir = Nothing, ext = 1}

@@ -10,9 +10,15 @@ 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 (Bool, [String])+  , reloadAll  :: (SourcePack -> IO ([IO ()], [String])) -> IO ReloadResult   }  reloadableSourcePack :: MonadIO m => SourcePack -> m ReloadableSourcePack@@ -22,15 +28,15 @@   where     reloadAll' v f = do       sp'@(SourcePack _ _ _ it) <- readMVar v-      as <- filter (not . nullSource . snd) <$> (mapM go $ MI.toList it)+      as <- filter (not . nullSource . snd) <$> mapM go (MI.toList it)       if null as-        then return (True, [])+        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 (True, es)-            else return (False, 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 @@ -53,11 +59,13 @@         Left  e -> return (as, e:es)         Right r -> return (putMVar x r:as, es) -runReloadable :: MonadIO m => SourcePack -> ReloadableSourcePackT m a -> m (a, IO (Bool, [String]))-runReloadable sp r = do-  rsp <- reloadableSourcePack sp-  (a, ReloadableSourcePack{..}) <- runStateT r rsp-  return (a, reloadAll (\_ -> return ([],[])))+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   

@@ -11,12 +11,13 @@ 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 $ zipWith (,) [0..] $ V.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@@ -30,3 +31,8 @@   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

@@ -2,11 +2,11 @@ {-# LANGUAGE DeriveFunctor        #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE KindSignatures       #-} {-# LANGUAGE OverloadedStrings    #-} {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE TypeOperators        #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-} module Salak.Prop where  import           Control.Applicative@@ -26,9 +26,9 @@ import           Text.Read            (readMaybe)  data PResult a-  = O [Selector] a-  | N [Selector]-  | F [Selector] String+  = O [Selector] a      -- ^ Succeed value+  | N [Selector]        -- ^ Empty value+  | F [Selector] String -- ^ Fail value   deriving (Eq, Show, Functor)  instance Applicative PResult where@@ -52,10 +52,6 @@  type Prop a = ReaderT SourcePack PResult a -infixl 5 .?=-(.?=) :: Prop a -> a -> Prop a-(.?=) a b = a <|> pure b- instance FromProp a => IsString (Prop a) where   fromString = readSelect . T.pack @@ -71,7 +67,7 @@     gFromProp       | conIsRecord m = fmap M1 gFromProp       | otherwise     = fmap M1 $ gEnum $ T.pack (conName m)-      where m = (undefined :: t c a x)+      where m = undefined :: t c a x  gEnum va = do   o <- gFromProp@@ -116,6 +112,14 @@         a <- lift $ runReaderT fromProp (SourcePack (SNum ix:xx) x s xt)         return (a:as) +instance {-# OVERLAPPABLE #-} FromEnumProp a => FromProp a where+  fromProp = readPrimitive $ \ss v -> case v of+    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"+ -- | ReadPrimitive value readPrimitive :: ([Selector] -> Value -> PResult a) -> Prop a readPrimitive f = do@@ -123,6 +127,10 @@   case Q.getMin q of     Just v -> lift $ f ss v     _      -> lift $ N ss++class FromEnumProp a where+  fromEnumProp :: Text -> Either String a+  {-# MINIMAL fromEnumProp #-}  err :: String -> Prop a err e = do

@@ -78,10 +78,10 @@       go (Source _ q _ _) = f q  foldSource :: (Value -> b -> b) -> b -> Source -> b-foldSource f = foldr (\q b -> fromMaybe b $ (\a -> f a b) <$> Q.getMin q)+foldSource f = foldr (\q b -> maybe b (`f` b) $ Q.getMin q)  sizeSouce :: Source -> Int-sizeSouce = foldSource (\_ -> (+1)) 0+sizeSouce = foldSource (const (+1)) 0  extractErr :: Source -> ([String], Source) extractErr (Source es q is ts) =@@ -91,7 +91,7 @@   where     go e s = let (e', s') = extractErr s in (e ++ e', s') -replace a b c = replace' [] a b c+replace = replace' []  replace' :: [Selector] -> Priority -> Source -> Source -> Source replace' ss i (Source _ nq nis nts) (Source es q is ts) =@@ -160,8 +160,8 @@  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+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  data SourcePack = SourcePack [Selector] Int Source PriorityEnv deriving Show 

@@ -10,6 +10,7 @@ import           Data.List       (intercalate) import           Data.Text       (Text, pack, unpack) import           GHC.Generics+import           Salak import           Salak.Prop import           Salak.Types import           Test.Hspec