boots 0.0.3 → 0.0.100

raw patch · 12 files changed

+257/−511 lines, 12 filesdep −data-defaultdep −fast-loggerdep −microlensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: data-default, fast-logger, microlens, monad-logger, salak, salak-yaml, text, unliftio-core

API changes (from Hackage documentation)

Files

• README.md +12/−10
• boots.cabal +13/−38
• src/Boots.hs +0/−51
• src/Boots/Factory.hs +162/−0
• src/Boots/Internal.hs +0/−25
• src/Boots/Internal/App.hs +0/−45
• src/Boots/Internal/Plugin.hs +0/−100
• src/Boots/Plugin.hs +0/−15
• src/Boots/Plugin/Logger.hs +0/−130
• src/Boots/Plugin/Salak.hs +0/−43
• src/Boots/Plugin/Simple.hs +0/−53
• test/Spec.hs +70/−1

@@ -6,13 +6,13 @@ [![stackage Nightly package](http://stackage.org/package/boots/badge/nightly)](http://stackage.org/nightly/package/boots) [![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](https://github.com/leptonyu/boots/blob/master/LICENSE) -Boot applications by using plugins.+IoC Monad in Haskell.  ### Motivation  Simplify to create an application in Haskell. -When we decide to create an application using Haskell. We may need using configurations, loggers as basic functions. If this application needs storages, caches, etc., then we have to weaving the management of connection of these facilities into the application. Connections need to be created before and be destroyed after using them. There is a common strategy to manage connections, that is using `Control.Monad.Cont`. Then we can encapsulate the management of connections separately. For example, we can write a database plugin `Plugin cxt m DBConnection`, which can manage the database connections in monad `m` with context `cxt`. Context `cxt` may be requested for configurations or logging functions. When all the components of application are encapsulated by plugins, then building an application will be simplified.+When we decide to create an application using Haskell. We may need using configurations, loggers as basic functions. If this application needs storages, caches, etc., then we have to weaving the management of connection of these facilities into the application. Connections need to be created before and be destroyed after using them. There is a common strategy to manage connections, that is using `Control.Monad.Cont`. Then we can encapsulate the management of connections separately. For example, we can write a database factory `Factory m cxt DBConnection`, which can manage the database connections in monad `m` with context `cxt`. Context `cxt` may be requested for configurations or logging functions. When all the components of application are encapsulated by plugins, then building an application will be simplified.  ## A Project Use boots to Build @@ -20,13 +20,15 @@  ### Have a Try - ```Haskell-main :: IO ()-main = bootApp (pluginSimple "application") go-  where-    go = forever $ do-      user <- require "user"              -- Request for configuration.-      logInfo $ "Hello, " <> user <> "!"  -- Request for logging.-      liftIO $ threadDelay 1000000+factory = do+  log  <-  logFactory+  conf <- confFactory+  within (log, conf) $ do+    a <- withFactory fst aFactory+    b <- withFactory snd bFactory+    polish AB{..}+      [ xFactory+      , yFactory+      ] >>> bootFactory ```

@@ -1,77 +1,52 @@ cabal-version: 1.12 name: boots-version: 0.0.3+version: 0.0.100 license: MIT license-file: LICENSE copyright: 2019 Daniel YU maintainer: leptonyu@gmail.com author: Daniel YU homepage: https://github.com/leptonyu/boots#readme-synopsis: Boot application by plugins+synopsis: IoC Monad in Haskell description:-    Boot application by using plugins.-category: Library+    Inverse of control monad used in building large application.+category: Library, Application build-type: Simple extra-source-files:     README.md  library     exposed-modules:-        Boots-        Boots.Plugin-        Boots.Plugin.Simple-        Boots.Plugin.Salak-        Boots.Plugin.Logger+        Boots.Factory     hs-source-dirs: src     other-modules:-        Boots.Internal-        Boots.Internal.App-        Boots.Internal.Plugin+        Paths_boots     default-language: Haskell2010     default-extensions: FlexibleInstances MultiParamTypeClasses                         GeneralizedNewtypeDeriving OverloadedStrings RecordWildCards                         FlexibleContexts RankNTypes ScopedTypeVariables+                        FunctionalDependencies ConstraintKinds+    ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures     build-depends:         base >=4.10 && <5,-        data-default >=0.7.1.1 && <0.8,         exceptions >=0.10.2 && <0.11,-        fast-logger >=2.4.16 && <2.5,-        microlens >=0.4.10 && <0.5,-        monad-logger >=0.3.30 && <0.4,-        mtl >=2.2.2 && <2.3,-        salak >=0.3.1 && <0.4,-        salak-yaml >=0.3.1 && <0.4,-        text >=1.2.3.1 && <1.3,-        unliftio-core >=0.1.2.0 && <0.2+        mtl >=2.2.2 && <2.3  test-suite spec     type: exitcode-stdio-1.0     main-is: Spec.hs     hs-source-dirs: test src     other-modules:-        Boots-        Boots.Internal-        Boots.Internal.App-        Boots.Internal.Plugin-        Boots.Plugin-        Boots.Plugin.Logger-        Boots.Plugin.Salak-        Boots.Plugin.Simple+        Boots.Factory         Paths_boots     default-language: Haskell2010     default-extensions: FlexibleInstances MultiParamTypeClasses                         GeneralizedNewtypeDeriving OverloadedStrings RecordWildCards                         FlexibleContexts RankNTypes ScopedTypeVariables+                        FunctionalDependencies ConstraintKinds+    ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures     build-depends:         base >=4.10 && <5,-        data-default >=0.7.1.1 && <0.8,         exceptions >=0.10.2 && <0.11,-        fast-logger >=2.4.16 && <2.5,         hspec ==2.*,-        microlens >=0.4.10 && <0.5,-        monad-logger >=0.3.30 && <0.4,-        mtl >=2.2.2 && <2.3,-        salak >=0.3.1 && <0.4,-        salak-yaml >=0.3.1 && <0.4,-        text >=1.2.3.1 && <1.3,-        unliftio-core >=0.1.2.0 && <0.2+        mtl >=2.2.2 && <2.3

@@ -1,51 +0,0 @@--- |--- Module:      Boots--- Copyright:   2019 Daniel YU--- License:     BSD3--- Maintainer:  leptonyu@gmail.com--- Stability:   experimental--- Portability: portable------ Boot application by using plugins.------ * Motivation------ Simplify to create an application in Haskell.------ When we decide to create an application using Haskell.--- We may need using configurations, loggers as basic functions.--- If this application needs storages, caches, etc.,--- then we have to weaving the management of connection of these facilities into the application.--- Connections need to be created before and be destroyed after using them.--- There is a common strategy to manage connections, that is using `Control.Monad.Cont`.--- Then we can encapsulate the management of connections separately.--- For example, we can write a database plugin `Plugin` @cxt@ @m@ @DBConnection@,--- which can manage the database connections in monad @m@ with context @cxt@.--- Context @cxt@ may be requested for getting configurations or logging functions.--- When all the components of application are encapsulated by plugins, then building an application will be simplified.------ * Have a Try------ >>> booting (pluginSimple "application") (logInfo "hello")--- 2019-07-27 19:35:30  INFO [application] Ghci1 - hello--- >>> booting (pluginSimple "application") (require "user" >>= logInfo)--- 2019-07-27 19:37:45  INFO [application] Ghci2 - daniel------ Main------ > main :: IO ()--- > main = bootApp (pluginSimple "application") go--- >   where--- >     go = forever $ do--- >       user <- require "user"              -- Request for configuration.--- >       logInfo $ "Hello, " <> user <> "!"  -- Request for logging.--- >       liftIO $ threadDelay 1000000-----module Boots(-    module Boots.Internal-  , module Boots.Plugin.Simple-  ) where--import           Boots.Internal-import           Boots.Plugin.Simple

@@ -0,0 +1,162 @@+{-# LANGUAGE CPP #-}+-- |+-- Module:      Boots.Factory+-- Copyright:   2019 Daniel YU+-- License:     MIT+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- IoC Monad in Haskell.+--+-- * Motivation+--+-- Simplify to create an application in Haskell.+--+-- When we decide to create an application using Haskell.+-- We may need using configurations, loggers as basic functions.+-- If this application needs storages, caches, etc.,+-- then we have to weaving the management of connection of these facilities into the application.+-- Connections need to be created before and be destroyed after using them.+-- There is a common strategy to manage connections, that is using `Control.Monad.Cont`.+-- Then we can encapsulate the management of connections separately.+-- For example, we can write a database plugin `Factory` @m@ @cxt@ @DBConnection@,+-- which can manage the database connections in monad @m@ with context @cxt@.+-- Context @cxt@ may be requested for getting configurations or logging functions.+-- When all the components of application are encapsulated by plugins, then running an application will be simplified.+--+-- * Factory+--+-- 'Factory' has an environment @env@, which provides anything needs by the factory. @component@ is the production of+-- the factory, it will be used by other 'Factory'. Finally to build a complete 'Factory' m () (m ()), which can be 'boot'.+--+-- For example:+--+-- > factory = do+-- >   log  <-  logFactory+-- >   conf <- confFactory+-- >   within (log, conf) $ do+-- >     a <- withFactory fst aFactory+-- >     b <- withFactory snd bFactory+-- >     polish AB{..}+-- >       [ xFactory+-- >       , yFactory+-- >       ] >>> bootFactory+module Boots.Factory(+  -- * Definition+    Factory+  -- ** Run functions+  , running+  , boot+  -- * Factory Construction+  -- ** With+  , withFactory+  , within+  -- ** Polish+  , polish+  -- ** Nature Transformation+  , natTrans+  -- ** Resource+  , wrap+  , bracket+  , offer+  , delay+  -- * Reexport Function+  -- ** Category Arrow+  , (C.>>>)+  , (C.<<<)+  -- ** Monoid Join+  , (<>)+  -- ** Other+  , MonadThrow(..)+  , MonadCatch+  , MonadReader(..)+  , asks+  , MonadIO(..)+  , lift+  ) where++import qualified Control.Category     as C+import           Control.Monad.Catch  hiding (bracket)+import           Control.Monad.Cont+import           Control.Monad.Reader+import           Unsafe.Coerce        (unsafeCoerce)+#if __GLASGOW_HASKELL__ < 804+import           Data.Semigroup+#endif++-- | Factory defines how to generate a @component@ under the environment @env@ in monad @m@.+-- It is similar to IoC container in oop, @env@ will provide anything to be wanted to generate @component@.+--+newtype Factory m env component+  = Factory { unFactory :: ReaderT env (ContT () m) component }+  deriving (Functor, Applicative, Monad, MonadReader env, MonadIO)++instance MonadThrow m => MonadThrow (Factory m env) where+  throwM = offer . throwM++instance Monad m => MonadCont (Factory m env) where+  callCC a = do+    env <- ask+    wrap . running env $ callCC a++instance Semigroup (Factory m env env) where+  a <> b = a >>= (`within` b)++instance Monoid (Factory m env env) where+  mempty = ask+  mappend = (<>)++instance C.Category (Factory m) where+  id  = ask+  a . b = b >>= (`within` a)++-- | Running the factory.+running :: env -> Factory m env c -> (c -> m ()) -> m ()+running env pma = runContT (runReaderT (unFactory pma) env)++-- | Run the application using a specified factory.+boot :: Monad m => Factory m () (m ()) -> m ()+boot factory = running () factory id++-- | Switch factory environment.+withFactory :: (env' -> env) -> Factory m env component -> Factory m env' component+withFactory = unsafeCoerce withReaderT++-- | Construct factory under @env@, and adapt it to fit another @env'@.+within :: env -> Factory m env component -> Factory m env' component+within = withFactory . const++-- | Polish @component@ by a sequence of 'Factory', and construct a unified one.+polish :: component -> [Factory m component component] -> Factory m env' component+polish env = within env . mconcat++-- | Nature transform of one 'Factory' with monad @n@ into another with monad @m@.+natTrans :: (n () -> m ()) -> (m () -> n ()) -> Factory n env component -> Factory m env component+natTrans fnm fmn fac = do+  env <- ask+  wrap $ \fm -> fnm $ running env fac (fmn . fm)++-- | Wrap raw procedure into a 'Factory'.+wrap :: ((c -> m ()) -> m ()) -> Factory m env c+wrap = Factory . lift . ContT++-- | Construct open-close resource into a 'Factory'.+bracket :: MonadCatch m => m res -> (res -> m ()) -> Factory m env res+bracket open close = wrap $ \f -> do+  res <- open+  a   <- try $ f res+  b   <- try $ close res+  go a b+  where+    go (Left e) _ = throwM (e :: SomeException)+    go _ (Left e) = throwM (e :: SomeException)+    go _ _        = return ()++-- | Lift a monad @m@ into a 'Factory'.+offer :: Monad m => m a -> Factory m env a+offer ma = wrap (ma >>=)++-- | Put a delay action into 'Factory', it will run at close phase.+delay :: MonadCatch m => m () -> Factory m env ()+delay ma = bracket (return ()) (const ma)

@@ -1,25 +0,0 @@--- |--- Module:      Boots.Internal--- Copyright:   2019 Daniel YU--- License:     BSD3--- Maintainer:  leptonyu@gmail.com--- Stability:   experimental--- Portability: portable------ Boot plugin and application.----module Boots.Internal(-  -- * Plugin-    module Boots.Internal.Plugin-  -- * Application-  , bootApp-  , module Boots.Internal.App-  ) where--import           Boots.Internal.App-import           Boots.Internal.Plugin---- | Run application in context with the help of plugin. Context @cxt@ can't escape from @m@.---  If you want to define your own `AppT` then please use 'boot' or 'runPlugin'.-bootApp :: Plugin () m cxt -> AppT cxt m () -> m ()-bootApp plugin app = runPlugin () plugin (`runAppT` app)

@@ -1,45 +0,0 @@--- |--- Module:      Boots.Internal.Plugin--- Copyright:   2019 Daniel YU--- License:     BSD3--- Maintainer:  leptonyu@gmail.com--- Stability:   experimental--- Portability: portable------ This module defines a generic application monad transformation.----module Boots.Internal.App(-    AppT-  , App-  , runAppT-  , liftIO-  , ask-  , lift-  , throwM-  ) where--import           Control.Monad.Catch-import           Control.Monad.IO.Unlift-import           Control.Monad.Reader---- | Application monad transformation.-newtype AppT cxt m a = AppT { unAppT :: ReaderT cxt m a }-  deriving (Functor, Applicative, Monad, MonadTrans, MonadReader cxt, MonadIO, MonadThrow, MonadCatch, MonadMask)---- | Simple IO monad.-type App cxt = AppT cxt IO---- | Run application monad transformation.-runAppT :: cxt -> AppT cxt m a -> m a-runAppT cxt ma = runReaderT (unAppT ma) cxt--instance MonadUnliftIO m => MonadUnliftIO (AppT cxt m) where-  {-# INLINE askUnliftIO #-}-  askUnliftIO = AppT $ ReaderT $ \r ->-                withUnliftIO $ \u ->-                return (UnliftIO (unliftIO u . runAppT r))-  {-# INLINE withRunInIO #-}-  withRunInIO inner =-    AppT $ ReaderT $ \r ->-    withRunInIO $ \run ->-    inner (run . runAppT r)

@@ -1,100 +0,0 @@--- |--- Module:      Boots.Internal.Plugin--- Copyright:   2019 Daniel YU--- License:     BSD3--- Maintainer:  leptonyu@gmail.com--- Stability:   experimental--- Portability: portable------ This module defines a generic application plugin used when booting application.----module Boots.Internal.Plugin(-    boot-  , Plugin-  , runPlugin-  , promote-  , combine-  , withPlugin-  , mapPlugin-  , isoPlugin-  , bracketP-  , wrapP-  ) where--import           Control.Monad.Catch-import           Control.Monad.Cont-import           Control.Monad.Reader---- | Plugin generates component @u@ with the context of component @i@ running in monad @m@.-newtype Plugin i m u = Plugin { unPlugin :: ReaderT i (ContT () m) u }-  deriving (Functor, Applicative, Monad, MonadReader i, MonadIO)---- | Run plugin in given context @i@.-runPlugin :: i -> Plugin i m u -> (u -> m ()) -> m ()-runPlugin i pma = runContT (runReaderT (unPlugin pma) i)---- | Run application only in plugin.-boot :: Monad m => Plugin () m (m ()) -> m ()-boot plugin = runPlugin () plugin id--instance MonadTrans (Plugin i) where-  lift = Plugin . lift . lift--instance MonadThrow m => MonadThrow (Plugin i m) where-  throwM = lift . throwM--instance Monad m => MonadCont (Plugin i m) where-  callCC a = do-    i <- ask-    Plugin . lift . ContT . runPlugin i $ callCC a---- | Promote a plugin into another.-promote :: i -> Plugin i m u -> Plugin x m u-promote i pimu = Plugin $ lift $ ContT (runPlugin i pimu)---- | Combines plugins into one.-combine :: [Plugin i m i] -> Plugin i m i-combine = foldl (\b a -> b >>= \i -> promote i a) ask---- | Convert a plugin into another.-withPlugin :: (i -> j) -> Plugin j m u -> Plugin i m u-withPlugin f = Plugin . withReaderT f . unPlugin---- | Transform a plugin with monad @n@ to a plugin with monad @m@.-isoPlugin :: (m () -> n ()) -> (n () -> m ()) -> Plugin i n u -> Plugin i m u-isoPlugin f g = Plugin . mapReaderT go . unPlugin-  where-    go (ContT fnc) = ContT $ \mc -> g $ fnc (f . mc)---- | Apply a function to transform the result of a continuation-passing computation.-mapPlugin :: (m () -> m ()) -> Plugin i m u -> Plugin i m u-mapPlugin f = Plugin . mapReaderT (mapContT f) . unPlugin----- | Warp plugin.-wrapP :: ((u -> m ()) -> m ()) -> Plugin i m u-wrapP = Plugin . lift . ContT---- | Create bracket style plugin, used for manage resources, which need to open and close.------ A simple example:------ >>> res = bracketP (putStrLn "open") (const $ putStrLn "close")--- >>> runPlugin () res (const $ putStrLn "using")--- open--- using--- close-bracketP-  :: forall m i u. MonadCatch m-  => m u          -- ^ Open resource.-  -> (u -> m ())  -- ^ Close resource.-  -> Plugin i m u -- ^ Resource plugin.-bracketP op cl = Plugin $ lift $ withContT go (lift op)-  where-    {-# INLINE go #-}-    go f u = do-      v <- try $ f u-      _ <- try $ cl u :: m (Either SomeException ())-      case v of-        Left  e -> throwM (e :: SomeException)-        Right x -> return x

@@ -1,15 +0,0 @@--- |--- Module:      Boots.Plugin--- Copyright:   2019 Daniel YU--- License:     BSD3--- Maintainer:  leptonyu@gmail.com--- Stability:   experimental--- Portability: portable------ Boot plugin.----module Boots.Plugin(-    module Boots.Internal.Plugin-  ) where--import           Boots.Internal.Plugin

@@ -1,130 +0,0 @@--- |--- Module:      Boots.Plugin.Logger--- Copyright:   2019 Daniel YU--- License:     BSD3--- Maintainer:  leptonyu@gmail.com--- Stability:   experimental--- Portability: portable------ This module wrap a logging function into a plugin.----module Boots.Plugin.Logger(-    HasLogger(..)-  , LogConfig(..)-  , LogFunc-  , addTrace-  , pluginLogger-  -- ** Logger functions-  , logInfo-  , logDebug-  , logWarn-  , logError-  , logOther-  ) where--import           Boots.Internal-import           Boots.Plugin.Salak-import           Control.Monad-import           Control.Monad.Logger.CallStack-import           Control.Monad.Reader-import           Data.Default-import           Data.Monoid                    ((<>))-import           Data.Text                      (Text, toLower, unpack)-import           Data.Word-import           Lens.Micro-import           Lens.Micro.Extras-import           Salak-import           System.Log.FastLogger---- | Environment providing a logging function.-class HasLogger cxt where-  askLogger :: Lens' cxt LogFunc--instance HasLogger LogFunc where-  askLogger = id--instance (MonadIO m, HasLogger cxt) => MonadLogger (Plugin cxt m) where-  monadLoggerLog a b c d = do-    LogFunc{..} <- asks (view askLogger)-    liftIO $ logfunc a b c (toLogStr d)--instance (MonadIO m, HasLogger cxt) => MonadLogger (AppT cxt m) where-  monadLoggerLog a b c d = do-    LogFunc{..} <- asks (view askLogger)-    liftIO $ logfunc a b c (toLogStr d)--instance (MonadIO m, HasLogger cxt) => MonadLoggerIO (Plugin cxt m) where-  askLoggerIO = logfunc <$> asks (view askLogger)--instance (MonadIO m, HasLogger cxt) => MonadLoggerIO (AppT cxt m) where-  askLoggerIO = logfunc <$> asks (view askLogger)--instance Monad m => FromProp m LogLevel where-  fromProp = readEnum (fromEnumProp.toLower)-    where-      fromEnumProp "debug" = Right   LevelDebug-      fromEnumProp "info"  = Right   LevelInfo-      fromEnumProp "warn"  = Right   LevelWarn-      fromEnumProp "error" = Right   LevelError-      fromEnumProp u       = Left $ "unknown level: " ++ unpack u--{-# INLINE toStr #-}-toStr :: LogLevel -> LogStr-toStr LevelDebug     = "DEBUG"-toStr LevelInfo      = " INFO"-toStr LevelWarn      = " WARN"-toStr LevelError     = "ERROR"-toStr (LevelOther l) = toLogStr l---- | Logger config.-data LogConfig = LogConfig-  { bufferSize    :: Word16         -- ^ Logger buffer size.-  , file          :: Maybe FilePath -- ^ Logger file path.-  , maxSize       :: Word32         -- ^ Max logger file size.-  , rotateHistory :: Word16         -- ^ Max number of logger files should be reserved.-  , level         :: IO LogLevel    -- ^ Log level to show.-  }-instance Default LogConfig where-  def = LogConfig 4096 Nothing 10485760 256 (return LevelInfo)--instance MonadIO m => FromProp m LogConfig where-  fromProp = LogConfig-    <$> "buffer-size" .?: bufferSize-    <*> "file"        .?: file-    <*> "max-size"    .?: maxSize-    <*> "max-history" .?: rotateHistory-    <*> "level"       .?: level--data LogFunc = LogFunc-  { logfunc :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()-  , logend  :: IO ()-  }--newLogger :: Text -> LogConfig -> IO LogFunc-newLogger name LogConfig{..} = do-  tc            <- newTimeCache "%Y-%m-%d %T"-  let ln = " [" <> toLogStr name <> "] "-      ft = case file of-        Just f -> LogFile (FileLogSpec f (toInteger maxSize) (fromIntegral rotateHistory)) $ fromIntegral bufferSize-        _      -> LogStdout $ fromIntegral bufferSize-  (l,close) <- newTimedFastLogger tc ft-  return (LogFunc (toLogger ln l) close)-  where-    toLogger xn f Loc{..} _ ll s = do-      lc <- level-      when (lc <= ll) $ f $ \t ->-        let locate = if ll /= LevelError then "" else " @" <> toLogStr loc_filename <> toLogStr (show loc_start)-        in toLogStr t <> " " <> toStr ll <> xn <> toLogStr loc_module <> locate <> " - " <> s <> "\n"---- | Add additional trace info into log.-addTrace :: Text -> LogFunc -> LogFunc-addTrace trace lf = lf { logfunc = \a b c d -> let p = "[" <> toLogStr trace <> "] " in logfunc lf a b c (p <> d) }---- | Plugin providing a logging function.-pluginLogger-  :: (MonadIO m, MonadCatch m, HasSalak cxt)-  => Text -- ^ Application name will be logged in log.-  -> Plugin cxt m LogFunc-pluginLogger name = do-  lc <- require "logging"-  bracketP (liftIO $ newLogger name lc) (\LogFunc{..} -> liftIO logend)

@@ -1,43 +0,0 @@--- |--- Module:      Boots.Plugin.Salak--- Copyright:   2019 Daniel YU--- License:     BSD3--- Maintainer:  leptonyu@gmail.com--- Stability:   experimental--- Portability: portable------ This module wrap 'salak' into a plugin.----module Boots.Plugin.Salak(-    HasSalak(..)-  , pluginSalak-  -- ** Configuration Functions-  , MonadSalak(..)-  ) where--import           Boots.Internal-import           Control.Monad.Reader-import           Lens.Micro-import           Lens.Micro.Extras-import           Salak-import           Salak.Yaml---- | Environment providing a configuration parser.-class HasSalak cxt where-  askSourcePack :: Lens' cxt SourcePack--instance HasSalak SourcePack where-  askSourcePack = id--instance HasSalak cxt => MonadSalak (Plugin cxt m) where-  askSalak = asks (view askSourcePack)--instance (Monad m, HasSalak cxt) => MonadSalak (AppT cxt m) where-  askSalak = asks (view askSourcePack)---- | Plugin used for parse properties.-pluginSalak-  :: (MonadIO m, MonadCatch m)-  => String -- ^ Configuration file name.-  -> Plugin () m SourcePack-pluginSalak name = lift $ runSalakWithYaml name askSalak

@@ -1,53 +0,0 @@--- |--- Module:      Boots.Plugin.Simple--- Copyright:   2019 Daniel YU--- License:     BSD3--- Maintainer:  leptonyu@gmail.com--- Stability:   experimental--- Portability: portable------ This module defines simple application plugin.----module Boots.Plugin.Simple(-    Simple(..)-  , HasSimple(..)-  , pluginSimple-  , module Boots.Plugin.Salak-  , module Boots.Plugin.Logger-  ) where--import           Boots.Internal-import           Boots.Plugin.Logger-import           Boots.Plugin.Salak-import           Data.Text           (Text, unpack)-import           Lens.Micro-import           Salak---- | Simple plugin initialized both configurations 'pluginSalak' and logger 'pluginLogger'.-data Simple = Simple-  { sourcePack :: SourcePack-  , logFunc    :: LogFunc-  }---- | Environment values with a configuration parser and logging function.-class HasSimple cxt where-  askSimple :: Lens' cxt Simple--instance HasSimple Simple where-  askSimple = id--instance HasLogger Simple where-  askLogger = lens logFunc (\x y -> x { logFunc = y})--instance HasSalak Simple where-  askSourcePack = lens sourcePack (\x y -> x {sourcePack = y})---- | Simple plugin provides a configuration parser and logging function.-pluginSimple-  :: (MonadCatch m, MonadIO m)-  => Text -- ^ Application name and configuration file name.-  -> Plugin () m Simple-pluginSimple application = do-  sourcePack <- pluginSalak $ unpack application-  logFunc    <- promote sourcePack $ pluginLogger application-  return Simple{..}

@@ -1,4 +1,73 @@ module Main where +import           Boots.Factory+import           Control.Concurrent.MVar+import           Control.Exception       (Exception)+import           Control.Monad.Identity+import           Test.Hspec -main = putStrLn "No tests"++main = hspec $ do+  describe "Boots.Factory" specProperty+++data TestExp = Failure deriving Show++instance Exception TestExp++specProperty :: SpecWith ()+specProperty = do+  context "Definition" $ do+    it "running" $ do+      running () (return ()) return      `shouldBe` Just ()+    it "running - Error" $ do+      running () (throwM Failure) return              `shouldBe` Nothing+      running () (return ()) (const $ throwM Failure) `shouldBe` Nothing+    it "boot" $ do+      boot (return $ return ()) `shouldBe` Just ()+    it "boot - Error " $ do+      boot (return $ throwM Failure) `shouldBe` Nothing+  context "With" $ do+    it "withFactory" $ do+      running ('A', True) (withFactory fst $ ask >>= \a -> offer (a `shouldBe` 'A'))  return+      running ('A', True) (withFactory snd $ ask >>= \a -> offer (a `shouldBe` True)) return+    it "within" $ do+      running () (within 'A' $ ask >>= \a -> offer (a `shouldBe` 'A')) return+  context "Polish" $ do+    it "polish" $ do+      running () (polish (0 :: Int) (replicate 10 $ withFactory (+1) ask)) (shouldBe 10)+  context "natTrans" $ do+    it "natTrans" $ do+      running () (natTrans runIdentityT IdentityT $ return ()) return `shouldBe` Just ()+  context "Resource" $ do+    it "bracket" $ do+      ref <- newMVar (0 :: Int)+      let+        open = do+          a <- swapMVar ref 1+          a `shouldBe` 0+          return a+      let+        close a = do+          a `shouldBe` 0+          b <- swapMVar ref 3+          b `shouldBe` 2+          return ()+      boot $ do+        a <- bracket open close+        offer $ do+          a `shouldBe` 0+          b <- swapMVar ref 2+          b `shouldBe` 1+        return (return ())+    it "bracket - error" $ do+      ref <- newMVar (0 :: Int)+      (`shouldThrow` anyException) $ boot $ do+        a <- bracket (readMVar ref) (\_ -> throwM Failure)+        _ <- offer $ do+          a `shouldBe` 0+          swapMVar ref 1+        return (return ())+      v  <- readMVar ref+      v `shouldBe` 1+