salak 0.2.8 → 0.2.9
raw patch · 12 files changed
+325/−192 lines, 12 files
Files
- README.md +5/−5
- salak.cabal +3/−1
- src/Salak.hs +49/−97
- src/Salak/Load.hs +8/−6
- src/Salak/Load/Dynamic.hs +27/−16
- src/Salak/Load/Env.hs +11/−8
- src/Salak/Prop.hs +61/−17
- src/Salak/Types.hs +60/−26
- src/Salak/Types/Selector.hs +12/−9
- src/Salak/Types/Source.hs +1/−1
- src/Salak/Types/Value.hs +40/−3
- test/Spec.hs +48/−3
README.md view
@@ -75,7 +75,7 @@ <*> "pwd" <*> "ext" .?= 1 -main = runSalak def { configName = Just "salak", loadExt = loadByExt $ YAML :|: TOML } $ do+main = runSalakWith "salak" (YAML :|: TOML) $ do c :: Config <- require "test.config" lift $ print c ```@@ -83,16 +83,16 @@ GHCi play ```Haskell λ> import Salak-λ> import Salak.Load.YAML-λ> import Salak.Load.TOML+λ> import Salak.Yaml+λ> import Salak.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 = runSalakWith "salak" (YAML :|: TOML) λ> f (require "") >>= print @Config Config {name = "daniel", dir = Just "ls", ext = 2} ``` - TODO: - Add git pull support.+- Add automatic reloading.
salak.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: salak-version: 0.2.8+version: 0.2.9 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU@@ -27,6 +27,7 @@ Salak.Load.Dynamic Salak.Prop default-language: Haskell2010+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures build-depends: attoparsec >=0.13.2.2 && <0.14, base >=4.10 && <5,@@ -57,6 +58,7 @@ Salak.Types.Value Paths_salak default-language: Haskell2010+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures build-depends: QuickCheck >=2.12.6.1 && <2.14, attoparsec >=0.13.2.2 && <0.14,
src/Salak.hs view
@@ -18,49 +18,44 @@ -- * How to use this library -- $use - -- * Salak+ -- * Salak Main Functions loadAndRunSalak , runSalak+ , runSalakWith , PropConfig(..)- -- * Static Get Properties+ -- * Load Salak+ , LoadSalakT+ , loadCommandLine+ , ParseCommandLine+ , defaultParseCommandLine+ , loadEnv+ , loadMock+ -- ** Load Extensions+ , ExtLoad+ , loadByExt+ , HasLoad(..)+ , (:|:)(..)+ -- * Run Salak+ , RunSalakT+ -- ** Get Static Properties , HasSourcePack(..) , fetch , require- -- * Dynamic Get Properties- , ReloadableSourcePack- , ReloadableSourcePackT+ -- ** Dynamic Get Properties , ReloadResult(..)- , reloadable- , reloadAction- , fetchD+ , exec , requireD- -- * Prop Parser+ -- ** Parse properties+ , SourcePack+ , Priority+ , Value(..) , Prop , FromProp(..) , FromEnumProp(..) , (.?=) , (.?:)- -- * SourcePack- , SourcePack- , SourcePackT- -- * Load configurations- , loadCommandLine- , loadEnv- , loadMock- -- ** Load By Extension- , ExtLoad- , loadByExt- , HasLoad(..)- , (:|:)(..)- -- * Other- , ParseCommandLine- , defaultParseCommandLine- , Priority- , Value(..)- , defaultLoadSalak ) where -import Control.Applicative import Control.Monad (unless) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader@@ -82,7 +77,7 @@ , searchCurrent :: Bool -- ^ Search current directory, default true , searchHome :: Bool -- ^ Search home directory, default false. , commandLine :: ParseCommandLine -- ^ How to parse commandline- , loadExt :: FilePath -> SourcePackT IO ()+ , loadExt :: FilePath -> LoadSalakT IO () } instance Default PropConfig where@@ -96,19 +91,19 @@ -- | Load and run salak `SourcePack` and fetch properties. loadAndRunSalak- :: Monad m- => SourcePackT m () -- ^ Load properties monad.- -> ReaderT SourcePack m a -- ^ Fetch properties monad.+ :: MonadIO m+ => LoadSalakT m () -- ^ Load properties monad.+ -> RunSalakT m a -- ^ Fetch properties monad. -> m a loadAndRunSalak spm a = do- sp <- runSourcePackT spm+ sp <- runLoadT Nothing spm let es = errs sp unless (null es) $ fail (head es)- runReaderT a sp+ runT a sp -- | Load file by extension-type ExtLoad = (String, FilePath -> SourcePackT IO ())+type ExtLoad = (String, FilePath -> LoadSalakT IO ()) class HasLoad a where loaders :: a -> [ExtLoad]@@ -119,15 +114,12 @@ 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 :: (HasLoad a, MonadIO m) => a -> FilePath -> LoadSalakT 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.+-- | Default run salak. -- All these configuration sources has orders, from highest priority to lowest priority: -- -- > 1. loadCommandLine@@ -138,7 +130,7 @@ -- > 6. load file from home folder if enabled -- > 7. file extension matching, support yaml or toml or any other loader. ---runSalak :: MonadIO m => PropConfig -> ReaderT SourcePack m a -> m a+runSalak :: MonadIO m => PropConfig -> RunSalakT m a -> m a runSalak PropConfig{..} = loadAndRunSalak $ do loadCommandLine commandLine loadEnv@@ -152,31 +144,20 @@ 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+-- | Simplified run salak, should specified code name and file format.+runSalakWith :: (HasLoad file, MonadIO m) => String -> file -> RunSalakT m a -> m a+runSalakWith name a = runSalak def { configName = Just name, loadExt = loadByExt a} +-- | Monad that can fetch properties. class Monad m => HasSourcePack m where askSourcePack :: m SourcePack -instance Monad m => HasSourcePack (ReaderT SourcePack m) where- askSourcePack = ask-instance Monad m => HasSourcePack (StateT SourcePack m) where- askSourcePack = get+instance MonadIO m => HasSourcePack (RunSalakT m) where+ askSourcePack = askRSP +instance Monad m => HasSourcePack (LoadSalakT m) where+ askSourcePack = LoadSalakT get+ -- | Try fetch properties from `SourcePack` fetch :: (HasSourcePack m, FromProp a)@@ -189,43 +170,14 @@ :: (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+require k = fetch k >>= either error return -- | Fetch dynamic properties from `SourcePack`, or throw fail requireD :: (MonadIO 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, 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---- | Default value.-infixl 5 .?:-(.?:) :: (Alternative f, Default b) => f a -> (b -> a) -> f a-(.?:) fa b = fa .?= b def+ -> RunSalakT m (IO a)+requireD k = search' k >>= either error return -- $use --@@ -277,18 +229,18 @@ -- > <*> "pwd" -- > <*> "ext" .?= 1 -- >--- > main = runSalak def { configName = Just "salak", loadExt = loadByExt $ YAML :|: TOML } $ do+-- > main = runSalakWith "salak" (YAML :|: TOML) $ do -- > c :: Config <- require "test.config" -- > lift $ print c -- -- GHCi play -- -- > λ> import Salak--- > λ> import Salak.Load.YAML--- > λ> import Salak.Load.TOML+-- > λ> import Salak.YAML+-- > λ> import Salak.TOML -- > λ> :set -XTypeApplications -- > λ> instance FromProp Config where fromProp = Config <$> "user" <*> "dir" <*> "ext" .?= 1--- > λ> f = runSalak def { configName = Just "salak", loadExt = loadByExt $ YAML :|: TOML }+-- > λ> f = runSalakWith "salak" (YAML :|: TOML) -- > λ> f (require "") >>= print @Config -- > Config {name = "daniel", dir = Just "ls", ext = 2} --
src/Salak/Load.hs view
@@ -7,28 +7,30 @@ -- Portability: portable -- -- This module is designed for implementating configuration file loading.+-- Please don't use if you are not implemanting a new configuration file. -- module Salak.Load(- -- * Reload- Reload(..)- , defReload -- * SourcePack- , Source+ Source , SourcePack- , SourcePackT- , addErr'+ , addErr+ , newVStr -- * Selector , Selector(..) , simpleSelectors -- * Source+ , emptySource+ , nullSource , insertSource , updateSources , updateSource -- * Load , tryLoadFile , loadFile+ , loading ) where import Salak.Types import Salak.Types.Selector import Salak.Types.Source+import Salak.Types.Value
src/Salak/Load/Dynamic.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-} module Salak.Load.Dynamic where import Control.Concurrent.MVar@@ -13,8 +14,8 @@ import Salak.Types.Source data ReloadResult = ReloadResult- { isError :: Bool- , msg :: [String]+ { isError :: Bool -- ^ msg stands for properties changing record if true, otherwise msg means reload error.+ , msg :: [String] -- ^ message log } deriving (Eq, Show) -- | Reloadable SourcePack@@ -42,17 +43,26 @@ 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+-- | RunSalak Monad Transfer+newtype RunSalakT m a = RunSalakT { unRun :: StateT ReloadableSourcePack m a }+ deriving (Functor, Applicative, Monad, MonadTrans) -search' :: (MonadIO m, FromProp a) => Text -> ReloadableSourcePackT m (Either String (IO a))-search' k = do- ReloadableSourcePack{..} <- get- sp <- liftIO $ takeMVar sourcePack+instance MonadIO m => MonadIO (RunSalakT m) where+ liftIO = lift . liftIO++askRSP :: MonadIO m => RunSalakT m SourcePack+askRSP = RunSalakT $ do+ ReloadableSourcePack{..} <- get+ liftIO $ readMVar sourcePack++search' :: (MonadIO m, FromProp a) => Text -> RunSalakT m (Either String (IO a))+search' k = RunSalakT $ do+ sp <- unRun askRSP case search k sp of Left e -> return (Left e) Right r -> do v <- liftIO $ newMVar r- put (ReloadableSourcePack sourcePack (reloadAll . go v))+ modify $ \rsp -> rsp { reloadAll = reloadAll rsp . go v} return $ Right $ readMVar v where go x f sp = do@@ -61,13 +71,14 @@ Left e -> return (as, e:es) Right r -> return (putMVar x r:as, es) -reloadAction :: Monad m => ReloadableSourcePackT m (IO ReloadResult)-reloadAction = do+reloadAction :: Monad m => RunSalakT m (IO ReloadResult)+reloadAction = RunSalakT $ do ReloadableSourcePack{..} <- get return $ reloadAll $ \_ -> return ([], []) -runReloadable :: MonadIO m => ReloadableSourcePackT m a -> SourcePack -> m a-runReloadable r sp = reloadableSourcePack sp >>= evalStateT r--+runT :: MonadIO m => RunSalakT m a -> SourcePack -> m a+runT (RunSalakT a) sp = reloadableSourcePack sp >>= evalStateT a +-- | Run action in `RunSalakT`, `IO` `ReloadResult` is reloadable action.+exec :: MonadIO m => (IO ReloadResult -> IO a) -> RunSalakT m a+exec fa = reloadAction >>= lift . liftIO . fa
src/Salak/Load/Env.hs view
@@ -2,34 +2,37 @@ 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 ()+-- | Load environment variables into `SourcePack`+loadEnv :: MonadIO m => LoadSalakT m () loadEnv = do args <- liftIO getEnvironment- modify $ load (emptyReload "environment") args go+ loading "environment" args go where- go p (k,v) = (g2 k, VStr p $ T.pack v)+ go p (k,v) = return (g2 k, newVStr (T.pack v) p) g2 = T.toLower . T.pack . map (\c -> if c == '_' then '.' else c) +-- | Convert arguments to properties type ParseCommandLine = [String] -> IO [(T.Text,Priority -> Value)] +-- | Default way to parse command line arguments 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)+ (a,'=':b) -> Just (T.pack a, newVStr (T.pack b)) _ -> Nothing go _ = Nothing -loadCommandLine :: MonadIO m => ParseCommandLine -> SourcePackT m ()+-- | Load command line arguments into `SourcePack`+loadCommandLine :: MonadIO m => ParseCommandLine -> LoadSalakT m () loadCommandLine pcl = do args <- liftIO $ getArgs >>= pcl- modify $ load (emptyReload "commandline") args go+ loading "commandline" args go where- go i (k,fv) = (k, fv i)+ go i (k,fv) = return (k, fv i)
src/Salak/Prop.hs view
@@ -14,6 +14,7 @@ import Control.Applicative import Control.Monad.Reader+import Data.Default import Data.Int import qualified Data.Map.Strict as M import Data.Menshen@@ -56,16 +57,41 @@ (N s ) >>= _ = N s (F s e) >>= _ = F s e -newtype PropT m a = Prop { unProp :: ReaderT SourcePack m a }+data PropSource = PropSource+ { originSP :: SourcePack+ , currSP :: SourcePack+ , cacheRef :: M.Map [Selector] Bool+ }++newtype PropT m a = Prop { unProp :: ReaderT PropSource m a } deriving (Functor, Applicative, Monad, MonadTrans, Alternative) +-- | Optional value.+infixl 5 .?=+(.?=) :: Alternative f => f a -> a -> f a+(.?=) a b = a <|> pure b++-- | Default value.+infixl 5 .?:+(.?:) :: (Alternative f, Default b) => f a -> (b -> a) -> f a+(.?:) fa b = fa .?= b def++-- | Monad used to parse properties to destination type. type Prop = PropT PResult runProp sp a = runReaderT (unProp a) sp +askSub :: (SourcePack -> SourcePack) -> Prop PropSource+askSub f = do+ ps <- Prop ask+ return ps { currSP = f (currSP ps) }++askOrigin :: Prop SourcePack+askOrigin = originSP <$> Prop ask+ instance MonadReader SourcePack Prop where- ask = Prop ask- local f (Prop a) = Prop (local f a)+ ask = currSP <$> Prop ask+ local f (Prop a) = Prop (local (\sp -> sp { currSP = f (currSP sp) }) a) instance HasValid Prop where invalid = err . toI18n@@ -115,8 +141,8 @@ instance FromProp a => FromProp (Maybe a) where fromProp = do- sp <- ask- lift $ case runProp sp (fromProp :: Prop a) of+ fps <- askSub id+ lift $ case runProp fps (fromProp :: Prop a) of O s a -> O s $ Just a N s -> O s Nothing F s e -> F s e@@ -128,22 +154,35 @@ return (reverse as) where go sp' as (ix,s) = do- a <- lift $ runProp sp' { prefix = ix : prefix sp', source = s} fromProp+ so <- askSub $ \_ -> sp' { prefix = ix : prefix sp', source = s}+ a <- lift $ runProp so fromProp 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+ VStr _ s -> either (F ss) (O ss) $ fromEnumProp $ T.toLower s x -> F ss $ getType x ++ " cannot be enum" +evalV :: [Selector] -> Value -> Prop Value+evalV x (VRef i rs) = do+ sp <- askOrigin+ ps <- askSub (\_ -> sp)+ if M.member x (cacheRef ps)+ then lift $ F x "self reference"+ else lift $ VStr i <$> foldM (go ps { cacheRef = M.insert x True $ cacheRef ps} ) "" rs+ where+ go _ a (RVal b) = return (T.append a b)+ go ps a (RRef f) = case convert $ runProp ps (selectP f) of+ Right b -> return (T.append a b)+ Left e -> F f e+evalV _ v = return v+ -- | ReadPrimitive value readPrimitive :: ([Selector] -> Value -> PResult a) -> Prop a readPrimitive f = do- SourcePack{..}<- ask+ SourcePack{..} <- ask case getQ (value source) of- Just v -> lift $ f prefix v+ Just v -> evalV prefix v >>= lift . f prefix _ -> lift $ N prefix class FromEnumProp a where@@ -159,14 +198,19 @@ readSelect :: FromProp a => Text -> Prop a readSelect key = case selectors key of Left e -> err e- Right s -> local (\sp -> foldl select sp s) fromProp+ Right s -> selectP s +selectP :: FromProp a => [Selector] -> Prop a+selectP s = local (\sp -> foldl select sp s) fromProp+ search :: FromProp a => Text -> SourcePack -> Either String a-search key sp = case runProp sp (readSelect key) of- O _ x -> Right x- N s -> Left $ "key " ++ toKey s ++ " not found"- F s e -> Left $ "key " ++ toKey s ++ " : " ++ e+search key sp = convert $ runProp (PropSource sp sp M.empty) (readSelect key) +convert :: PResult a -> Either String a+convert (O _ x) = Right x+convert (N s ) = Left $ "key " ++ toKey s ++ " not found"+convert (F s e) = Left $ "key " ++ toKey s ++ " : " ++ e+ instance FromProp Bool where fromProp = readPrimitive go where@@ -177,7 +221,7 @@ "false" -> O s False "no" -> O s False _ -> F s "string convert bool failed"- go s x = F s $ getType x ++ " cannot be bool"+ go s x = F s $ getType x ++ " cannot be bool" instance FromProp Text where fromProp = readPrimitive go
src/Salak/Types.hs view
@@ -1,12 +1,14 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeSynonymInstances #-} module Salak.Types where import Control.Monad.State import Control.Monad.Writer import qualified Data.IntMap.Strict as MI+import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import Salak.Types.Selector@@ -22,13 +24,14 @@ instance Show Reload where show (Reload s _) = T.unpack s -defReload :: String -> SourcePackT IO () -> Reload-defReload s spt = Reload (T.pack s) (\i -> go <$> execStateT spt emptySourcePack {packId = i})+defReload :: String -> LoadSalakT IO () -> Reload+defReload s spt = Reload (T.pack s) (\i -> go <$> runLoadT (Just i) spt) where go SourcePack{..} = (errs, source) emptyReload s = defReload s (return ()) +-- | Source package, used to store all properties. data SourcePack = SourcePack { prefix :: [Selector] , packId :: Int@@ -45,37 +48,68 @@ select :: SourcePack -> Selector -> SourcePack select sp n = sp { source = selectSource n (source sp), prefix = n : prefix sp} -addErr' :: String -> SourcePack -> SourcePack-addErr' e sp = sp {errs = e : errs sp}+addErr :: Monad m => String -> LoadSalakT m ()+addErr e = LoadSalakT $ get >>= (\sp -> return sp {errs = e : errs sp}) >>= put -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)+loadInternal+ :: Monad m+ => Reload+ -> (Priority -> Source -> WriterT [String] m Source)+ -> LoadSalakT m ()+loadInternal file go = LoadSalakT $ do+ SourcePack{..} <- get+ (s', e) <- lift $ runWriterT $ go packId source+ put $ SourcePack prefix (packId+1) s' (MI.insert packId file reEnv) (errs ++ e) -tryLoadFile :: MonadIO m => (FilePath -> SourcePackT m ()) -> FilePath -> SourcePackT m ()+loadFile+ :: MonadIO m+ => String+ -> (Priority -> Source -> WriterT [String] IO Source)+ -> LoadSalakT m ()+loadFile file go = loadInternal (defReload file $ loadFile file go) (\i -> x . go i)+ where+ x a = do+ (s, w) <- liftIO $ runWriterT a+ tell w+ return s++tryLoadFile :: MonadIO m => (FilePath -> LoadSalakT m ()) -> FilePath -> LoadSalakT m () tryLoadFile f file = do b <- liftIO $ doesFileExist file when b $ do liftIO $ putStrLn $ "Load " <> file f file -load- :: Foldable f- => Reload+loading+ :: (Foldable f, Monad m)+ => String -> f a- -> (Priority -> a -> (Text, Value))- -> SourcePack- -> SourcePack-load name fa f sp = loadFile name sp $ \i s -> foldl (go i) (return s) fa+ -> (Priority -> a -> m (Text, Value))+ -> LoadSalakT m ()+loading name fa f = loadInternal (emptyReload name) $ \i s -> foldM (go i) s fa where- go i s a = s >>= \s' -> let (k,v) = f i a in insert k v s'+ go i s a = do+ (k, v) <- lift $ f i a+ insert k v s -loadMock :: Monad m => [(Text, Text)] -> SourcePackT m ()-loadMock fs = modify $ load (emptyReload "Mock") fs (\i (k,v) -> (k, VStr i v))+-- | Put key value pairs into `SourcePack`+loadMock :: Monad m => [(Text, Text)] -> LoadSalakT m ()+loadMock fs = loading "Mock" fs (\i (k,v) -> return (k, newVStr v i)) -type SourcePackT = StateT SourcePack+runLoadT :: Monad m => Maybe Priority -> LoadSalakT m a -> m SourcePack+runLoadT i (LoadSalakT ac) = execStateT ac emptySourcePack { packId = fromMaybe 0 i } -runSourcePackT :: Monad m => SourcePackT m a -> m SourcePack-runSourcePackT ac = execStateT ac emptySourcePack+-- | Load Salak Monad Transfer+newtype LoadSalakT m a = LoadSalakT { unLoad :: StateT SourcePack m a } deriving (Functor, Applicative, Monad, MonadTrans)++instance MonadIO m => MonadIO (LoadSalakT m) where+ liftIO = lift . liftIO++jump :: MonadIO m => LoadSalakT IO a -> LoadSalakT m a+jump (LoadSalakT a) = LoadSalakT $ do+ (a', sp) <- get >>= liftIO . runStateT a+ put sp+ return a'++
src/Salak/Types/Selector.hs view
@@ -39,21 +39,24 @@ 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+sName :: Parser Selector+sName = SStr . 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)++sNum :: Parser Selector+sNum = SNum <$> paren decimal where paren e = do _ <- char '[' ex <- e _ <- char ']' return ex++-- xx+-- xx.xx+-- xx.xx[0]+-- xx.xx[1].xx+expr :: Parser [Selector]+expr = (:) <$> sName <*> many' sNum
src/Salak/Types/Source.hs view
@@ -72,7 +72,7 @@ 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 :: Monad m => T.Text -> Value -> Source -> WriterT [String] m Source insert k v s = case selectors k of Left e -> tell [e] >> return s Right k' -> return (insert' k' v s)
src/Salak/Types/Value.hs view
@@ -1,15 +1,25 @@+{-# LANGUAGE OverloadedStrings #-} module Salak.Types.Value where import Control.Monad.Writer+import Data.Attoparsec.Text import qualified Data.PQueue.Min as Q import Data.Scientific (Scientific) import Data.Text (Text)+import qualified Data.Text as T import Data.Time+import Salak.Types.Selector type Priority = Int +data RefText+ = RRef [Selector]+ | RVal !Text+ deriving (Eq, Show)+ data Value = VStr !Priority !Text+ | VRef !Priority ![RefText] | VNum !Priority !Scientific | VBool !Priority !Bool | VZTime !Priority !TimeZone !LocalTime@@ -24,8 +34,34 @@ instance Show Value where show v = let (a,b,c) = typeOfV v in c <> ":" <> b <> "#" <> show a +newVStr :: Text -> Priority -> Value+newVStr v i = g4 $ g3 $ go v+ where+ go v' =+ let (a,b) = T.break (=='$') v'+ in if T.null b+ then [RVal a]+ else RVal a : g2 b (parse ref b)+ g2 _ (Done x r) = r : go x+ g2 b _ = [RVal b]+ g3 (RVal a:RVal b:cs) = g3 $ RVal (a <> b) :cs+ g3 (RVal a:bs) = if T.null a then g3 bs else RVal a: g3 bs+ g3 (RRef a:bs) = RRef a : g3 bs+ g3 [] = []+ g4 [RVal a] = VStr i a+ g4 x = VRef i x++ref :: Parser RefText+ref = RRef <$> do+ _ <- char '$'+ _ <- char '{'+ r <- exprs+ _ <- char '}'+ return r+ typeOfV :: Value -> (Priority, String, String) typeOfV (VStr a b) = (a, "Str", show b)+typeOfV (VRef a b) = (a, "Ref", 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))@@ -55,11 +91,12 @@ 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+ let nq' = Q.filter ((==i) . getPriority) nq+ (a,b) = Q.partition ((==i) . getPriority) q go v = tell $ (\vi -> "#" <> show i <> " " <> vi) <$> v- if a == nq+ if a == nq' then return q- else case getQ nq of+ else case getQ nq' of Just v -> do go [(if Q.null a then "Add " else "Mod ") ++ s] return $ Q.insert v b
test/Spec.hs view
@@ -6,7 +6,6 @@ module Main where -import Control.Monad.Reader import Control.Monad.Writer import Data.Either import Data.List (intercalate)@@ -18,6 +17,7 @@ import Salak.Types import Salak.Types.Selector import Salak.Types.Source+import Salak.Types.Value import Test.Hspec import Test.QuickCheck @@ -69,6 +69,17 @@ 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 "value" $ do+ it "basic" $ do+ newVStr "xxxx" 0 `shouldBe` VStr 0 "xxxx"+ newVStr "{x.y}" 0 `shouldBe` VStr 0 "{x.y}"+ newVStr "${x*}" 0 `shouldBe` VStr 0 "${x*}"+ newVStr "${x}" 0 `shouldBe` VRef 0 [RRef [SStr "x"]]+ newVStr "${x.y}" 0 `shouldBe` VRef 0 [RRef [SStr "x", SStr "y"]]+ newVStr "${x${y}}" 0 `shouldBe` VStr 0 "${x${y}}"+ newVStr "a${x}b" 0 `shouldBe` VRef 0 [RVal "a", RRef [SStr "x"], RVal "b"]+ newVStr "a${x}b${" 0 `shouldBe` VRef 0 [RVal "a", RRef [SStr "x"], RVal "b${"]+ newVStr "a${x}b${c}" 0 `shouldBe` VRef 0 [RVal "a", RRef [SStr "x"], RVal "b", RRef [SStr "c"]] context "source" $ do it "normal" $ do sizeSource emptySource `shouldBe` 0@@ -79,7 +90,7 @@ it "normal - 3" $ do let (s2,e2) = runWriter $ insert "1" (VStr 0 "world") emptySource sizeSource s2 `shouldBe` 1- length e2 `shouldBe` 00+ length e2 `shouldBe` 0 it "normal - 4" $ do let (s3,e3) = runWriter $ insert "a.b" (VStr 0 "world") emptySource print s3@@ -87,26 +98,41 @@ length e3 `shouldBe` 0 context "source - merge" $ do let s = fst $ runWriter $ insert "hello" (VStr 0 "world") emptySource+ so = fst $ runWriter $ insert "hello" (VStr 1 "yyyyy") 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` ["#0 Del hello"]+ let (s3,e3) = runWriter $ replace 1 emptySource s+ s3 `shouldBe` s+ e3 `shouldBe` [] it "merge - mod" $ do let (s3,e3) = runWriter $ replace 0 s1 s e3 `shouldBe` ["#0 Mod hello"] s3 `shouldBe` s1+ let (s2,e2) = runWriter $ replace 1 s1 s+ e2 `shouldBe` []+ s2 `shouldBe` s+ let (_,e4) = runWriter $ replace 1 so s+ e4 `shouldBe` ["#1 Add hello"] it "merge - add" $ do let (s4,e4) = runWriter $ replace 0 s emptySource e4 `shouldBe` ["#0 Add hello"] s4 `shouldBe` s+ let (s2,e2) = runWriter $ replace 1 s emptySource+ s2 `shouldBe` emptySource+ e2 `shouldBe` []+ let (s3,e3) = runWriter $ replace 1 so emptySource+ e3 `shouldBe` ["#1 Add hello"]+ s3 `shouldBe` so it "merge - unchange" $ do let (s5,e5) = runWriter $ replace 0 s s e5 `shouldBe` [] s5 `shouldBe` s context "Generic" $ do it "conf" $ do- sp <- runSourcePackT $ loadMock+ sp <- runLoadT Nothing $ loadMock [ ("name", "Daniel") , ("age", "18") , ("male", "yes")@@ -115,6 +141,25 @@ let a = search "" sp :: Either String Conf print a isRight a `shouldBe` True+ it "placeholder" $ do+ let xs = [ ("name", "daniel")+ , ("user", "${name}")+ , ("a","${b}")+ , ("b","${a}")+ , ("x", "${y}")+ , ("y", "${z}")+ , ("z", "Hey! you")+ ]+ loadAndRunSalak (loadMock xs) $ do+ a <- require "name"+ b <- require "user"+ x <- require "x"+ z <- require "z"+ lift $ do+ a `shouldBe` (b :: Text)+ x `shouldBe` (z :: Text)+ let x = loadAndRunSalak (loadMock xs) (require "a") :: IO Text+ x `shouldThrow` anyErrorCall