summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorleptonyu <>2019-07-11 01:57:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-07-11 01:57:00 (GMT)
commit200b1cf87e8c27ce2a8366c640cdf4bc5b8cb18f (patch)
tree9d3729c310543a4cd399cd995279432ffba302b8
parent59e63282841132c72bc1b4da64b6aad7375d6fdc (diff)
version 0.2.100.2.10
-rw-r--r--salak.cabal9
-rw-r--r--src/Salak.hs1
-rw-r--r--src/Salak/Load.hs5
-rw-r--r--src/Salak/Load/Dynamic.hs4
-rw-r--r--src/Salak/Load/Env.hs4
-rw-r--r--src/Salak/Types.hs55
-rw-r--r--src/Salak/Types/Source.hs4
-rw-r--r--test/Spec.hs22
8 files changed, 76 insertions, 28 deletions
diff --git a/salak.cabal b/salak.cabal
index b0251e3..f98cb62 100644
--- 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 @@ library
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 @@ test-suite spec
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 @@ test-suite spec
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
index 50a3b23..84ba019 100644
--- a/src/Salak.hs
+++ b/src/Salak.hs
@@ -32,6 +32,7 @@ module Salak(
, defaultParseCommandLine
, loadEnv
, loadMock
+ , loadOnceMock
-- ** Load Extensions
, ExtLoad
, loadByExt
diff --git a/src/Salak/Load.hs b/src/Salak/Load.hs
index 0481601..ce3e342 100644
--- a/src/Salak/Load.hs
+++ b/src/Salak/Load.hs
@@ -26,11 +26,12 @@ module Salak.Load(
, 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
index 49780a4..5cf9711 100644
--- a/src/Salak/Load/Dynamic.hs
+++ b/src/Salak/Load/Dynamic.hs
@@ -34,7 +34,7 @@ reloadableSourcePack sp = do
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 @@ reloadableSourcePack sp = do
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
index ea77714..00adb21 100644
--- a/src/Salak/Load/Env.hs
+++ b/src/Salak/Load/Env.hs
@@ -12,7 +12,7 @@ import System.Environment
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 @@ defaultParseCommandLine = return . mapMaybe go
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
index 2b1b68d..8d8fee3 100644
--- 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 @@ import System.Directory
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 @@ loadInternal file go = LoadSalakT $ do
(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 @@ tryLoadFile f file = do
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
index 2bfdbf1..7af35cb 100644
--- a/src/Salak/Types/Source.hs
+++ b/src/Salak/Types/Source.hs
@@ -85,3 +85,7 @@ insert' ns v = foldr go (insertSource v) ns
insertSource :: Value -> Source -> Source
insertSource v s = s { value = insertQ v $ value s}
+
+
+
+
diff --git a/test/Spec.hs b/test/Spec.hs
index fb1403b..a99fd13 100644
--- 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.Menshen
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 @@ specProperty = do
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 @@ specProperty = do
, ("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 @@ specProperty = do
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