diff --git a/salak.cabal b/salak.cabal --- a/salak.cabal +++ b/salak.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: salak -version: 0.2.9.3 +version: 0.2.10 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU @@ -36,7 +36,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, + menshen >=0.0.3 && <0.1, mtl >=2.2.2 && <2.3, pqueue >=1.4.1.2 && <1.5, scientific >=0.3.6.2 && <0.4, @@ -62,7 +62,7 @@ default-language: Haskell2010 ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures build-depends: - QuickCheck >=2.12.6.1 && <2.14, + QuickCheck >=2.13.2 && <2.14, attoparsec >=0.13.2.2 && <0.14, base >=4.10 && <5, bytestring >=0.10.8.2 && <0.11, @@ -71,9 +71,10 @@ directory >=1.3.3.0 && <1.4, filepath >=1.4.2.1 && <1.5, hspec ==2.*, - menshen >=0.0.2 && <0.1, + menshen >=0.0.3 && <0.1, mtl >=2.2.2 && <2.3, pqueue >=1.4.1.2 && <1.5, + random ==1.1.*, scientific >=0.3.6.2 && <0.4, text >=1.2.3.1 && <1.3, time >=1.8.0.2 && <1.9, diff --git a/src/Salak.hs b/src/Salak.hs --- a/src/Salak.hs +++ b/src/Salak.hs @@ -32,6 +32,7 @@ , defaultParseCommandLine , loadEnv , loadMock + , loadOnceMock -- ** Load Extensions , ExtLoad , loadByExt diff --git a/src/Salak/Load.hs b/src/Salak/Load.hs --- a/src/Salak/Load.hs +++ b/src/Salak/Load.hs @@ -26,11 +26,12 @@ , updateSource -- * Load , tryLoadFile - , loadFile - , loading + , load + , loadOnce ) where import Salak.Types import Salak.Types.Selector import Salak.Types.Source import Salak.Types.Value + diff --git a/src/Salak/Load/Dynamic.hs b/src/Salak/Load/Dynamic.hs --- a/src/Salak/Load/Dynamic.hs +++ b/src/Salak/Load/Dynamic.hs @@ -34,7 +34,7 @@ where reloadAll' v f = do sp' <- readMVar v - as <- sequence $ MI.foldlWithKey' go [] (reEnv sp') + as <- sequence $ MI.foldlWithKey' runReload [] (reEnv sp') let loadErr = concat $ fst . snd <$> as runWith e a = if null e then a else return $ ReloadResult True e runWith loadErr $ do @@ -42,8 +42,6 @@ modLog = errs sp'' (ac, msErr) <- f sp'' runWith msErr $ swapMVar v sp'' >> sequence_ ac >> return (ReloadResult False modLog) - go b i (Reload _ True f) = ((i,) <$> f i) : b - go b _ _ = 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} diff --git a/src/Salak/Load/Env.hs b/src/Salak/Load/Env.hs --- a/src/Salak/Load/Env.hs +++ b/src/Salak/Load/Env.hs @@ -12,7 +12,7 @@ loadEnv :: MonadIO m => LoadSalakT m () loadEnv = do args <- liftIO getEnvironment - loading "environment" args go + loadOnce "environment" args go where go p (k,v) = return (g2 k, newVStr (T.pack v) p) g2 = T.toLower . T.pack . map (\c -> if c == '_' then '.' else c) @@ -33,6 +33,6 @@ loadCommandLine :: MonadIO m => ParseCommandLine -> LoadSalakT m () loadCommandLine pcl = do args <- liftIO $ getArgs >>= pcl - loading "commandline" args go + loadOnce "commandline" args go where go i (k,fv) = return (k, fv i) diff --git a/src/Salak/Types.hs b/src/Salak/Types.hs --- a/src/Salak/Types.hs +++ b/src/Salak/Types.hs @@ -2,7 +2,23 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Salak.Types where +{-# LANGUAGE TupleSections #-} +module Salak.Types( + SourcePack(..) + , emptySourcePack + , mapSource + , select + , addErr + , tryLoadFile + , load + , loadOnce + , loadMock + , loadOnceMock + , runLoadT + , LoadSalakT(..) + , jump + , runReload + ) where import Control.Monad.State import Control.Monad.Writer @@ -18,9 +34,12 @@ data Reload = Reload { sourceName :: Text , canReload :: Bool - , reload :: Priority -> IO ([String], Source) + , reloadS :: Priority -> IO ([String], Source) } +runReload :: [IO (Priority, ([String], Source))] -> Priority -> Reload -> [IO (Priority, ([String], Source))] +runReload b i Reload{..} = if canReload then ((i,) <$> reloadS i) : b else b + instance Show Reload where show (Reload s _ _) = T.unpack s @@ -63,12 +82,13 @@ (s', e) <- lift $ runWriterT $ go packId source put $ SourcePack prefix (packId+1) s' (MI.insert packId file reEnv) (errs ++ e) -loadFile +-- ^ Load properties, supports reload when triggered. +load :: MonadIO m - => String - -> (Priority -> Source -> WriterT [String] IO Source) + => String -- ^ Loading name + -> (Priority -> Source -> WriterT [String] IO Source) -- ^ Convert properties -> LoadSalakT m () -loadFile file go = loadInternal (defReload True file $ loadFile file go) (\i -> x . go i) +load file go = loadInternal (defReload True file $ load file go) (\i -> x . go i) where x a = do (s, w) <- liftIO $ runWriterT a @@ -82,21 +102,30 @@ liftIO $ putStrLn $ "Load " <> file f file -loading +-- | Load properties only once +loadOnce :: (Foldable f, Monad m) - => String - -> f a - -> (Priority -> a -> m (Text, Value)) + => String -- ^ Loading name + -> f a -- ^ Properties + -> (Priority -> a -> m (Text, Value)) -- ^ Convert properties to Value -> LoadSalakT m () -loading name fa f = loadInternal (emptyReload name) $ \i s -> foldM (go i) s fa +loadOnce name fa f = loadInternal (emptyReload name) $ \i s -> foldM (go i) s fa where go i s a = do (k, v) <- lift $ f i a insert k v s -- | 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)) +loadOnceMock :: Monad m => [(Text, Text)] -> LoadSalakT m () +loadOnceMock fs = loadOnce "Mock" fs (\i (k,v) -> return (k, newVStr v i)) + +loadMock :: MonadIO m => [(Text, IO Text)] -> LoadSalakT m () +loadMock fs = load "Mock" $ \i s -> foldM (go i) s fs + where + go :: Priority -> Source -> (Text, IO Text) -> WriterT [String] IO Source + go i s (k, iov) = do + v <- lift iov + insert k (VStr i v) s runLoadT :: Monad m => Maybe Priority -> LoadSalakT m a -> m SourcePack runLoadT i (LoadSalakT ac) = execStateT ac emptySourcePack { packId = fromMaybe 0 i } diff --git a/src/Salak/Types/Source.hs b/src/Salak/Types/Source.hs --- a/src/Salak/Types/Source.hs +++ b/src/Salak/Types/Source.hs @@ -85,3 +85,7 @@ insertSource :: Value -> Source -> Source insertSource v s = s { value = insertQ v $ value s} + + + + diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where @@ -13,11 +14,13 @@ import Data.Text (Text, pack, unpack) import GHC.Generics import Salak +import Salak.Load.Dynamic import Salak.Prop import Salak.Types import Salak.Types.Selector import Salak.Types.Source import Salak.Types.Value +import System.Random (randomIO) import Test.Hspec import Test.QuickCheck @@ -134,7 +137,7 @@ s5 `shouldBe` s context "Generic" $ do it "conf" $ do - sp <- runLoadT Nothing $ loadMock + sp <- runLoadT Nothing $ loadOnceMock [ ("name", "Daniel") , ("age", "18") , ("male", "yes") @@ -152,7 +155,7 @@ , ("y", "${z}") , ("z", "Hey! you") ] - loadAndRunSalak (loadMock xs) $ do + loadAndRunSalak (loadOnceMock xs) $ do a <- require "name" b <- require "user" x <- require "x" @@ -160,9 +163,20 @@ lift $ do a `shouldBe` (b :: Text) x `shouldBe` (z :: Text) - let x = loadAndRunSalak (loadMock xs) (require "a") :: IO Text + let x = loadAndRunSalak (loadOnceMock xs) (require "a") :: IO Text x `shouldThrow` anyErrorCall - + context "Reload test" $ do + it "reload" $ do + (x :: IO Int,r) <- loadAndRunSalak (loadMock [("hello", pack . show <$> (randomIO :: IO Int))]) $ do + v <- requireD "hello" + a <- reloadAction + return (v,a) + a <- x + ReloadResult{..} <- r + isError `shouldBe` False + mapM_ print msg + b <- x + a `shouldNotBe` b