salak 0.3.4.1 → 0.3.5
raw patch · 12 files changed
+176/−160 lines, 12 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Salak: PropException :: String -> SalakException
- Salak: NullException :: SalakException
+ Salak: NullException :: Keys -> SalakException
- Salak: SalakException :: String -> SomeException -> SalakException
+ Salak: SalakException :: Keys -> String -> SalakException
- Salak: fromProp :: (FromProp m a, Generic a, GFromProp m (Rep a), Monad m) => Prop m a
+ Salak: fromProp :: (FromProp m a, Generic a, GFromProp m (Rep a), MonadIO m) => Prop m a
- Salak: logSalak :: (MonadSalak m, MonadIO m) => String -> m ()
+ Salak: logSalak :: (MonadSalak m, HasCallStack, MonadIO m) => Text -> m ()
- Salak: readEnum :: Monad m => (Text -> Either String a) -> Prop m a
+ Salak: readEnum :: MonadIO m => (Text -> Either String a) -> Prop m a
- Salak: readPrimitive :: Monad m => (Value -> Either String a) -> Prop m a
+ Salak: readPrimitive :: MonadIO m => (Value -> Either String a) -> Prop m a
- Salak: require :: (MonadSalak m, MonadThrow m, FromProp m a) => Text -> m a
+ Salak: require :: (MonadSalak m, MonadThrow m, MonadIO m, FromProp m a) => Text -> m a
- Salak: setLogF :: (MonadSalak m, MonadIO m) => (String -> IO ()) -> m ()
+ Salak: setLogF :: (MonadSalak m, MonadIO m) => (CallStack -> Text -> IO ()) -> m ()
- Salak.Internal: logSalak :: (MonadSalak m, MonadIO m) => String -> m ()
+ Salak.Internal: logSalak :: (MonadSalak m, HasCallStack, MonadIO m) => Text -> m ()
- Salak.Internal: require :: (MonadSalak m, MonadThrow m, FromProp m a) => Text -> m a
+ Salak.Internal: require :: (MonadSalak m, MonadThrow m, MonadIO m, FromProp m a) => Text -> m a
- Salak.Internal: setLogF :: (MonadSalak m, MonadIO m) => (String -> IO ()) -> m ()
+ Salak.Internal: setLogF :: (MonadSalak m, MonadIO m) => (CallStack -> Text -> IO ()) -> m ()
Files
- bench/SalakBench.hs +1/−1
- salak.cabal +20/−14
- src/Salak.hs +1/−9
- src/Salak/Internal.hs +15/−23
- src/Salak/Internal/Key.hs +20/−11
- src/Salak/Internal/Prop.hs +70/−88
- src/Salak/Internal/Source.hs +6/−5
- src/Salak/Internal/Val.hs +0/−4
- src/Salak/Trie.hs +2/−2
- test/Salak/Internal/SourceSpec.hs +39/−1
- test/SalakSpec.hs +0/−2
- test/Spec.hs +2/−0
bench/SalakBench.hs view
@@ -1,4 +1,4 @@-module SalakBench(main) where+module Main(main) where import Control.Monad.Reader import Criterion.Main
salak.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: salak-version: 0.3.4.1+version: 0.3.5 license: MIT license-file: LICENSE copyright: 2019 Daniel YU@@ -26,9 +26,11 @@ Salak.Internal.Prop Salak.Internal.Writable default-language: Haskell2010- default-extensions: RecordWildCards TupleSections OverloadedStrings- NoOverloadedLists ScopedTypeVariables FlexibleInstances- MultiParamTypeClasses DeriveGeneric FlexibleContexts RankNTypes+ default-extensions: BangPatterns CPP DefaultSignatures+ DeriveFunctor DeriveGeneric FlexibleContexts FlexibleInstances+ GeneralizedNewtypeDeriving MultiParamTypeClasses NoOverloadedLists+ OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables+ TupleSections TypeOperators ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures build-depends: base >=4.10 && <5,@@ -50,9 +52,9 @@ unliftio-core >=0.1.2.0 && <0.2, unordered-containers >=0.2.10.0 && <0.3 -test-suite salak-spec+test-suite salak-test type: exitcode-stdio-1.0- main-is: SalakSpec.hs+ main-is: Spec.hs build-tool-depends: hspec-discover:hspec-discover -any hs-source-dirs: test src other-modules:@@ -70,11 +72,13 @@ Salak.Trie Paths_salak default-language: Haskell2010- default-extensions: RecordWildCards TupleSections OverloadedStrings- NoOverloadedLists ScopedTypeVariables FlexibleInstances- MultiParamTypeClasses DeriveGeneric FlexibleContexts RankNTypes+ default-extensions: BangPatterns CPP DefaultSignatures+ DeriveFunctor DeriveGeneric FlexibleContexts FlexibleInstances+ GeneralizedNewtypeDeriving MultiParamTypeClasses NoOverloadedLists+ OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables+ TupleSections TypeOperators ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures- -main-is SalakSpec.main -rtsopts -threaded -with-rtsopts=-K1K+ -rtsopts -threaded -with-rtsopts=-K1K build-depends: QuickCheck >=2.13.2 && <2.14, base >=4.10 && <5,@@ -105,11 +109,13 @@ other-modules: Paths_salak default-language: Haskell2010- default-extensions: RecordWildCards TupleSections OverloadedStrings- NoOverloadedLists ScopedTypeVariables FlexibleInstances- MultiParamTypeClasses DeriveGeneric FlexibleContexts RankNTypes+ default-extensions: BangPatterns CPP DefaultSignatures+ DeriveFunctor DeriveGeneric FlexibleContexts FlexibleInstances+ GeneralizedNewtypeDeriving MultiParamTypeClasses NoOverloadedLists+ OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables+ TupleSections TypeOperators ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures- -main-is SalakBench.main -rtsopts -threaded -with-rtsopts=-K1K+ -rtsopts -threaded -with-rtsopts=-K1K build-depends: base >=4.10 && <5, bytestring >=0.10.8.2 && <0.11,
src/Salak.hs view
@@ -1,11 +1,3 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NoOverloadedLists #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-} -- | -- Module: Salak -- Copyright: 2019 Daniel YU@@ -100,7 +92,7 @@ True False defaultParseCommandLine- (\_ -> return ())+ (\_ _ -> return ()) (\_ -> return ()) data FileConfig = FileConfig
src/Salak/Internal.hs view
@@ -1,17 +1,4 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NoOverloadedLists #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-} -- | -- Module: Salak.Internal -- Copyright: 2019 Daniel YU@@ -69,8 +56,10 @@ import qualified Data.HashMap.Strict as HM import Data.Maybe import qualified Data.Set as S+import Data.String import Data.Text (Text, pack) import qualified Data.Text as TT+import GHC.Stack import Salak.Internal.Key import Salak.Internal.Prop import Salak.Internal.Source@@ -112,9 +101,10 @@ liftIO $ void $ swapMVar lfunc f logSalak msg = do UpdateSource{..} <- MS.get- liftIO $ readMVar lfunc >>= ($ msg)+ liftIO $ readMVar lfunc >>= \lf -> lf callStack msg instance (MonadThrow m, IU.MonadUnliftIO m) => IU.MonadUnliftIO (LoadSalakT m) where+ {-# INLINE askUnliftIO #-} askUnliftIO = do ut <- MS.get lift $ IU.withUnliftIO $ \u -> return (IU.UnliftIO (IU.unliftIO u . flip runLoad ut))@@ -127,9 +117,11 @@ type RunSalak = RunSalakT IO instance MonadIO m => MonadSalak (RunSalakT m) where+ {-# INLINE askSourcePack #-} askSourcePack = ask instance (MonadThrow m, IU.MonadUnliftIO m) => IU.MonadUnliftIO (RunSalakT m) where+ {-# INLINE askUnliftIO #-} askUnliftIO = do ut <- ask lift $ IU.withUnliftIO $ \u -> return (IU.UnliftIO (IU.unliftIO u . flip runReaderT ut . runSalakT))@@ -137,7 +129,7 @@ -- | Basic loader loadTrie :: (MonadThrow m, MonadIO m) => Bool -> String -> (Int -> IO TraceSource) -> LoadSalakT m () loadTrie !canReload !name f = do- logSalak $ "Loading " ++ (if canReload then "[reloadable]" else "") ++ name+ logSalak $ "Loading " <> (if canReload then "[reloadable]" else "") <> fromString name UpdateSource{..} <- MS.get (MS.put=<<) $ liftIO $ do v <- readMVar ref@@ -147,8 +139,8 @@ then do modifyMVar_ update $ go ts refNo _ <- swapMVar ref t- return $ UpdateSource ref (refNo + 1) (HM.insert refNo name refMap) lfunc qfunc update- else throwM $ PropException $ unlines es+ return $ UpdateSource{ refNo = refNo + 1, refMap = HM.insert refNo name refMap, .. }+ else fail $ unlines es where {-# INLINE go #-} go ts n ud = return $ do@@ -173,9 +165,9 @@ load lm = do us <- liftIO $ do r <- newMVar T.empty- q <- newMVar $ \s -> Right $ void $ swapMVar r s+ q <- newMVar $ return . void . swapMVar r u <- newMVar $ return (T.empty, return ())- l <- newMVar $ \_ -> return ()+ l <- newMVar $ \_ _ -> return () return $ UpdateSource r 0 HM.empty l q u runLoad (lm >> MS.get) us >>= toSourcePack @@ -191,9 +183,9 @@ let (t1,cs,es) = extract t ts f <- readMVar qfunc if null es- then case f t1 of- Left e -> return (ReloadResult True $ lines e)- Right a -> ac >> a >> return (ReloadResult False $ lines $ show cs)+ then flip catch (\e -> return . ReloadResult True . lines . show $ (e :: SomeException)) $ do+ a <- f t1+ ac >> a >> return (ReloadResult False $ lines $ show cs) else return (ReloadResult True es) -- | Load mock variables into `Source`@@ -239,5 +231,5 @@ b <- liftIO $ doesFileExist file if b then f file- else logSalak $ "File does not exist, ignore load " ++ file+ else logSalak $ "File does not exist, ignore load " <> fromString file
src/Salak/Internal/Key.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE NoOverloadedLists #-}-{-# LANGUAGE OverloadedStrings #-} module Salak.Internal.Key( Key(..) , Keys(..)@@ -10,16 +6,17 @@ , singletonKey , fromKeys , toKeyList+ , showKey , ToKeys(..) , isNum , isStr , keyExpr , Parser+ , (<>) ) where import qualified Data.DList as D import Data.Hashable-import Data.List (intercalate) import Data.String import Data.Text (Text) import qualified Data.Text as T@@ -75,12 +72,24 @@ instance Show Keys where {-# INLINE show #-}- show = intercalate "." . go . toKeyList- where- {-# INLINE go #-}- go (a@(KT _):cs) = let (b,c) = break isStr cs in (show a ++ concat (show <$> b)) : go c- go (a:cs) = show a : go cs- go [] = []+ show = T.unpack . showKey++{-# INLINE showKey #-}+showKey :: Keys -> Text+showKey = T.intercalate "." . go . toKeyList+ where+ {-# INLINE go #-}+ go (KT a : as) = let (b,cs) = break isStr as in a <> g2 b : go cs+ go (a:as) = let (b,cs) = break isStr as in g2 (a:b) : go cs+ go [] = []+ {-# INLINE g2 #-}+ g2 = T.concat . fmap g3+ {-# INLINE g3 #-}+ g3 (KI a) = "[" <> fromString (show a) <> "]"+ g3 (KT a) = a++ -- go (KI a) = "[" <> fromString (show a) <> "]"+ isStr :: Key -> Bool isStr (KT _) = True
src/Salak/Internal/Prop.hs view
@@ -1,15 +1,4 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-} module Salak.Internal.Prop where import Control.Applicative ((<|>))@@ -35,7 +24,7 @@ import Data.Scientific import Data.Semigroup import qualified Data.Set as S-import Data.Text (Text, unpack)+import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TB import qualified Data.Text.Lazy as TL@@ -45,6 +34,7 @@ import Foreign.C import GHC.Exts import GHC.Generics+import GHC.Stack import Salak.Internal.Key import Salak.Internal.Source import Salak.Internal.Val@@ -64,16 +54,16 @@ askReload = reload <$> askSourcePack {-# INLINE setLogF #-}- setLogF :: MonadIO m => (String -> IO ()) -> m ()+ setLogF :: MonadIO m => (CallStack -> Text -> IO ()) -> m () setLogF f = do SourcePack{..} <- askSourcePack liftIO $ void $ swapMVar lref f {-# INLINE logSalak #-}- logSalak :: MonadIO m => String -> m ()+ logSalak :: (HasCallStack, MonadIO m) => Text -> m () logSalak msg = do SourcePack{..} <- askSourcePack- liftIO $ readMVar lref >>= ($ msg)+ liftIO $ readMVar lref >>= \lf -> lf callStack msg -- | Parse properties using `FromProp`. For example: --@@ -84,11 +74,11 @@ -- -- `require` supports parse `IO` values, which actually wrap a 'MVar' variable and can be reseted by reloading configurations. -- Normal value will not be affected by reloading configurations.- require :: (MonadThrow m, FromProp m a) => Text -> m a+ require :: (MonadThrow m, MonadIO m, FromProp m a) => Text -> m a require ks = do- s <- askSourcePack+ s@SourcePack{..} <- askSourcePack runProp s $ case toKeys ks of- Left e -> failKey (unpack ks) (PropException e)+ Left e -> failKey ks e Right k -> withKeys k fromProp instance Monad m => MonadSalak (ReaderT SourcePack m) where@@ -100,64 +90,22 @@ = Prop { unProp :: ReaderT SourcePack (ExceptT SomeException m) a } deriving (Functor, Applicative, Monad, MonadReader SourcePack, MonadIO) -{-# INLINE runProp #-}-runProp :: MonadThrow m => SourcePack -> Prop m a -> m a-runProp sp (Prop p) = do- v <- runExceptT (runReaderT p sp)- case v of- Left e -> throwM e- Right x -> return x--{-# INLINE withProp #-}-withProp :: (SourcePack -> SourcePack) -> Prop m a -> Prop m a-withProp = unsafeCoerce withReaderT--{-# INLINE withKey #-}-withKey :: Key -> Prop m a -> Prop m a-withKey = withKeys . singletonKey--{-# INLINE withKeys #-}-withKeys :: Keys -> Prop m a -> Prop m a-withKeys key = withProp- $ \SourcePack{..} ->- SourcePack{pref = pref <> key, source = TR.subTries key source, ..}--data SalakException- = PropException String -- ^ Parse failed- | NullException -- ^ Not found- | SalakException String SomeException- deriving Show--instance Exception SalakException--{-# INLINE failKey #-}-failKey :: Monad m => String -> SalakException -> Prop m a-failKey ks e = do- SourcePack{..} <- ask- throwM- $ SalakException (go (show pref) ks)- $ toException e- where- {-# INLINE go #-}- go "" a = a- go a "" = a- go a b = a <> "." <> b- -- | Automatic convert literal string into an instance of `Prop` @m@ @a@.-instance (Monad m, FromProp m a) => IsString (Prop m a) where+instance (MonadIO m, FromProp m a) => IsString (Prop m a) where {-# INLINE fromString #-} fromString ks = case toKeys ks of- Left e -> failKey ks (PropException e)+ Left e -> failKey (fromString ks) e Right k -> withKeys k fromProp - instance MonadTrans Prop where {-# INLINE lift #-} lift = Prop . lift . lift instance Monad m => A.Alternative (Prop m) where {-# INLINE empty #-}- empty = failKey "" NullException+ empty = do+ SourcePack{..} <- ask+ throwM $ NullException pref {-# INLINE (<|>) #-} a <|> b = do@@ -184,14 +132,53 @@ instance Monad m => MonadFail (Prop m) where {-# INLINE fail #-}- fail = failKey "" . PropException+ fail = failKey "" ++{-# INLINE runProp #-}+runProp :: MonadThrow m => SourcePack -> Prop m a -> m a+runProp sp (Prop p) = do+ v <- runExceptT (runReaderT p sp)+ case v of+ Left e -> throwM e+ Right x -> return x++{-# INLINE withProp #-}+withProp :: (SourcePack -> SourcePack) -> Prop m a -> Prop m a+withProp = unsafeCoerce withReaderT++{-# INLINE withKey #-}+withKey :: Key -> Prop m a -> Prop m a+withKey = withKeys . singletonKey++{-# INLINE withKeys #-}+withKeys :: Keys -> Prop m a -> Prop m a+withKeys key = withProp+ $ \SourcePack{..} ->+ SourcePack{pref = pref <> key, source = TR.subTries key source, ..}++-- | Exception+data SalakException+ = SalakException Keys String -- ^ Parse failed+ | NullException Keys -- ^ Not found+ deriving Show++instance Exception SalakException++{-# INLINE failKey #-}+failKey :: Monad m => Text -> String -> Prop m a+failKey ks e = do+ SourcePack{..} <- ask+ throwM+ $ SalakException (pref <> singletonKey (KT ks)) e++ -- | Type class used to parse properties. class FromProp m a where -- | Parse properties from `Value`.- fromProp :: Monad m => Prop m a- default fromProp :: (Generic a, GFromProp m (Rep a), Monad m) => Prop m a+ fromProp :: MonadIO m => Prop m a+ default fromProp :: (Generic a, GFromProp m (Rep a), MonadIO m) => Prop m a {-# INLINE fromProp #-} fromProp = fmap to gFromProp @@ -201,11 +188,8 @@ v <- try fromProp case v of Left e -> case fromException e of- Just NullException -> return Nothing- Just (SalakException _ e2) -> case fromException e2 of- Just NullException -> return Nothing- _ -> throwM e- _ -> throwM e+ Just (NullException _) -> return Nothing+ _ -> throwM e Right a -> return (Just a) instance FromProp m a => FromProp m (Either String a) where@@ -239,7 +223,7 @@ fromProp = M.fromList <$> fromProp -- | Supports for parsing `IO` value.-instance {-# OVERLAPPABLE #-} (MonadIO m, FromProp (Either SomeException) a, FromProp m a) => FromProp m (IO a) where+instance {-# OVERLAPPABLE #-} (MonadIO m, FromProp IO a, FromProp m a) => FromProp m (IO a) where {-# INLINE fromProp #-} fromProp = do sp <- ask@@ -247,16 +231,13 @@ buildIO sp a {-# INLINE buildIO #-}-buildIO :: (MonadIO m, FromProp (Either SomeException) a) => SourcePack -> a -> m (IO a)+buildIO :: (MonadIO m, FromProp IO a) => SourcePack -> a -> m (IO a) buildIO sp a = liftIO $ do aref <- newMVar a- modifyMVar_ (qref sp) $ \f -> return $ \s ->- case runProp sp {source = s} $ withKeys (pref sp) fromProp of- Left e -> Left $ show e- Right v -> do- vb <- v- io <- f s- return (swapMVar aref (fromMaybe a vb) >> io)+ modifyMVar_ (qref sp) $ \f -> return $ \s -> do+ v <- runProp sp {source = s} $ withKeys (pref sp) fromProp+ io <- f s+ return $ swapMVar aref (fromMaybe a v) >> io return (readMVar aref) @@ -298,7 +279,7 @@ (.?=) a b = a A.<|> pure b -- | Support for setting default `IO` value.-instance (MonadIO m, FromProp (Either SomeException) a) => PropOp (Prop m) (IO a) where+instance (MonadIO m, FromProp IO a) => PropOp (Prop m) (IO a) where {-# INLINE (.?=) #-} (.?=) ma a = do sp <- ask@@ -312,9 +293,10 @@ invalid = Control.Monad.Fail.fail . toI18n {-# INLINE readPrimitive' #-}-readPrimitive' :: Monad m => (Value -> Either String a) -> Prop m (Maybe a)+readPrimitive' :: (HasCallStack, MonadIO m) => (Value -> Either String a) -> Prop m (Maybe a) readPrimitive' f = do SourcePack{..} <- ask+ liftIO $ readMVar lref >>= \lf -> lf callStack ("require: " <> showKey pref) let {-# INLINE go #-} go [VRT t] = return t go (VRT t : as) = (t <>) <$> go as@@ -344,12 +326,12 @@ -- | Parse primitive value from `Value` {-# INLINE readPrimitive #-}-readPrimitive :: Monad m => (Value -> Either String a) -> Prop m a+readPrimitive :: MonadIO m => (Value -> Either String a) -> Prop m a readPrimitive f = readPrimitive' f >>= maybe A.empty return -- | Parse enum value from `Text` {-# INLINE readEnum #-}-readEnum :: Monad m => (Text -> Either String a) -> Prop m a+readEnum :: MonadIO m => (Text -> Either String a) -> Prop m a readEnum = readPrimitive . go where {-# INLINE go #-}@@ -358,7 +340,7 @@ class GFromProp m f where- gFromProp :: Monad m => Prop m (f a)+ gFromProp :: MonadIO m => Prop m (f a) instance {-# OVERLAPPABLE #-} (Constructor c, GFromProp m a) => GFromProp m (M1 C c a) where {-# INLINE gFromProp #-}@@ -368,7 +350,7 @@ where m = undefined :: t c a x {-# INLINE gEnum #-}-gEnum :: (GFromProp m f, Monad m) => Text -> Prop m (f a)+gEnum :: (GFromProp m f, MonadIO m) => Text -> Prop m (f a) gEnum va = do o <- gFromProp readEnum $ \x -> if x==va then Right o else Left "enum invalid"
src/Salak/Internal/Source.hs view
@@ -1,12 +1,11 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE NoOverloadedLists #-} module Salak.Internal.Source where import Control.Concurrent.MVar import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import qualified Data.Set as S+import Data.Text (Text)+import GHC.Stack (CallStack) import Salak.Internal.Key import Salak.Internal.Val import qualified Salak.Trie as T@@ -21,9 +20,9 @@ , msgs :: ![String] -- ^ If hasError then this show error messages, else this show change logs. } deriving Show -type QFunc = Source -> Either String (IO ())+type QFunc = Source -> IO (IO ()) -type LFunc = String -> IO ()+type LFunc = CallStack -> Text -> IO () data SourcePack = SourcePack { source :: !Source@@ -57,7 +56,9 @@ , diff t1 o , concatMap (\(k,v)-> fmap (k++) v) list) where+ {-# INLINE t1 #-} t1 = fmap snd t+ {-# INLINE list #-} list = fmap (\(k,v)->(show k,v)) $ T.toList $ fmap fst t gen :: (Foldable f, ToKeys k, ToValue v) => Int -> f (k,v) -> TraceSource
src/Salak/Internal/Val.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}- module Salak.Internal.Val where import Control.Applicative ((<|>))
src/Salak/Trie.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE NoImplicitPrelude #-} -- | -- Module: Salak.Internal@@ -61,6 +60,7 @@ } deriving (Eq, Functor) instance Show v => Show (Trie v) where+ {-# INLINE show #-} show t = intercalate "\n" $ map (\(k,v)-> show k ++ ":" ++ show v) $ Salak.Trie.toList t instance Foldable Trie where@@ -106,7 +106,7 @@ {-# INLINE subTries #-} subTries :: Keys -> Trie v -> Trie v-subTries = flip (foldl' $ flip subTrie) . toKeyList+subTries = flip (foldl' (flip subTrie)) . toKeyList -- | /O(log (n+m))/. Return the primitive value to which the specified key is mapped, -- or Nothing if this trie contains no mapping for the key.
test/Salak/Internal/SourceSpec.hs view
@@ -10,6 +10,7 @@ import System.Random (randomIO) import Test.Hspec import Test.QuickCheck+import Control.Concurrent.MVar data Config = Config@@ -46,7 +47,7 @@ length c `shouldBe` 0 length (T.toList b) `shouldBe` 1 context "Reload test" $ do- it "reload" $ do+ it "reload - random" $ do loadAndRunSalak (loadRandom "hello") $ do Hello{..} <- require "" Config{..} <- require ""@@ -64,3 +65,40 @@ x `shouldNotBe` y q2 <- level q1 `shouldBe` q2+ it "reload - error" $ do+ io <- newMVar [("hello", "10")]+ loadAndRunSalak (loadList True "test" (readMVar io :: IO [(Text, Text)])) $ do+ vio <- require "hello"+ rl <- askReload+ lift $ do+ v <- vio :: IO Int+ v `shouldBe` 10+ lift $ do+ void $ swapMVar io [("hello", "text")]+ ReloadResult{..} <- rl+ hasError `shouldBe` True+ v <- vio+ v `shouldBe` 10+ lift $ do+ void $ swapMVar io [("hello", "5")]+ ReloadResult{..} <- rl+ hasError `shouldBe` False+ msgs `shouldBe` ["hello:Mod"]+ v <- vio+ v `shouldBe` 5+ lift $ do+ void $ swapMVar io []+ ReloadResult{..} <- rl+ hasError `shouldBe` False+ msgs `shouldBe` ["hello:Del"]+ v <- vio+ v `shouldBe` 10+ lift $ do+ void $ swapMVar io [("hello", "8")]+ ReloadResult{..} <- rl+ hasError `shouldBe` False+ msgs `shouldBe` ["hello:Add"]+ v <- vio+ v `shouldBe` 8++
− test/SalakSpec.hs
@@ -1,2 +0,0 @@--- file test/Spec.hs-{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=SalakSpec #-}
+ test/Spec.hs view
@@ -0,0 +1,2 @@+-- file test/Spec.hs+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}