packages feed

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 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 #-}