boots 0.1.1 → 0.2

raw patch · 7 files changed

+234/−218 lines, 7 filesdep +bootsPVP ok

version bump matches the API change (PVP)

Dependencies added: boots

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• README.md +8/−15
• boots.cabal +10/−9
• src/Boots/Factory.hs +0/−179
• src/Control/Monad/Factory.hs +150/−0
• src/Control/Monad/Factory/Class.hs +53/−0
• test/Spec.hs +10/−15

@@ -0,0 +1,3 @@+0.2 [2019.08.28]+-------------------+* Release use `Control.Monad.Factory`.

@@ -5,9 +5,17 @@ [![stackage LTS package](http://stackage.org/package/boots/badge/lts)](http://stackage.org/lts/package/boots) [![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)+![Hackage-Deps](https://img.shields.io/hackage-deps/v/boots)  IoC Monad in Haskell. +### Packages based on boots++- [![Hackage](https://img.shields.io/badge/boots-app-orange)](https://hackage.haskell.org/package/boots-app) Factory for quickly building an application.+- [![Hackage](https://img.shields.io/badge/boots-web-orange)](https://hackage.haskell.org/package/boots-web) Factory for quickly building a web application.+- [![Hackage](https://img.shields.io/badge/boots-cloud-orange)](https://hackage.haskell.org/package/boots-cloud) Factory for quickly building a microservice.++ ### Motivation  Simplify to create an application in Haskell.@@ -17,18 +25,3 @@ ## A Project Use boots to Build  Refer to [鬼谷子](https://github.com/leptonyu/guiguzi)--### Have a Try--```Haskell-factory = do-  log  <-  logFactory-  conf <- confFactory-  within (log, conf) $ do-    a <- withFactory fst aFactory-    b <- withFactory snd bFactory-    polish AB{..}-      [ xFactory-      , yFactory-      ] >>> bootFactory-```

@@ -4,13 +4,13 @@ -- -- see: https://github.com/sol/hpack ----- hash: 07ea4190e76748290f6abd6bd660c00f0d6ba2c91a51c3021fb010274bb510ac+-- hash: f2aa610e1c0d974992d89103041429343b5aa10e47a821783039d97408d2ee7f  name:           boots-version:        0.1.1+version:        0.2 synopsis:       IoC Monad in Haskell-description:    Inverse of control monad used in building large application.-category:       Library, Application+description:    Monad used to encapsulate components, similiar to an IoC container.+category:       Library, Application, Monad, Factory, IoC homepage:       https://github.com/leptonyu/boots#readme author:         Daniel YU maintainer:     leptonyu@gmail.com@@ -20,15 +20,17 @@ build-type:     Simple extra-source-files:     README.md+    CHANGELOG.md  library   exposed-modules:-      Boots.Factory+      Control.Monad.Factory+      Control.Monad.Factory.Class   other-modules:       Paths_boots   hs-source-dirs:       src-  default-extensions: FlexibleInstances MultiParamTypeClasses GeneralizedNewtypeDeriving OverloadedStrings RecordWildCards FlexibleContexts RankNTypes ScopedTypeVariables FunctionalDependencies ConstraintKinds+  default-extensions: RecordWildCards ScopedTypeVariables   ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures   build-depends:       base >=4.10 && <5@@ -40,15 +42,14 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Boots.Factory       Paths_boots   hs-source-dirs:       test-      src-  default-extensions: FlexibleInstances MultiParamTypeClasses GeneralizedNewtypeDeriving OverloadedStrings RecordWildCards FlexibleContexts RankNTypes ScopedTypeVariables FunctionalDependencies ConstraintKinds+  default-extensions: RecordWildCards ScopedTypeVariables   ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures   build-depends:       base >=4.10 && <5+    , boots     , exceptions >=0.10.2 && <0.11     , hspec     , mtl >=2.2.2 && <2.3

@@ -1,179 +0,0 @@-{-# 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-  {-# INLINE throwM #-}-  throwM = offer . throwM--instance Monad m => MonadCont (Factory m env) where-  {-# INLINE callCC #-}-  callCC a = do-    env <- ask-    wrap . running env $ callCC a--instance Semigroup (Factory m env env) where-  {-# INLINE (<>) #-}-  a <> b = a >>= (`within` b)--instance Monoid (Factory m env env) where-  {-# INLINE mempty #-}-  mempty = ask-  {-# INLINE mappend #-}-  mappend = (<>)--instance C.Category (Factory m) where-  {-# INLINE id #-}-  id  = ask-  {-# INLINE (.) #-}-  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)-{-# INLINE running #-}---- | 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-{-# INLINE withFactory #-}---- | Construct factory under @env@, and adapt it to fit another @env'@.-within :: env -> Factory m env component -> Factory m env' component-within = withFactory . const-{-# INLINE within #-}---- | 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-{-# INLINE polish #-}---- | 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)-{-# INLINE natTrans #-}---- | Wrap raw procedure into a 'Factory'.-wrap :: ((c -> m ()) -> m ()) -> Factory m env c-wrap = Factory . lift . ContT-{-# INLINE wrap #-}---- | 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 ()-    {-# INLINE go #-}-{-# INLINE bracket #-}---- | Lift a monad @m@ into a 'Factory'.-offer :: Monad m => m a -> Factory m env a-offer ma = wrap (ma >>=)-{-# INLINE offer #-}---- | 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)-{-# INLINE delay #-}

@@ -0,0 +1,150 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+-- |+-- Module:      Control.Monad.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'.+--+--+module Control.Monad.Factory(+  -- * Monad+    MonadFactory(..)+  , defer+  , asksEnv+  , modifyEnv+  , withEnv+  , runEnv+  -- * Monad Instance+  , Factory(..)+  -- ** Run functions+  , running+  , boot+  -- ** With+  , within+  , withFactory+  , wrap+  , liftFT+  , natTrans+  , tryBuild+  -- * Reexport Function+  -- ** Category Arrow+  , (C.>>>)+  , (C.<<<)+  -- ** Monoid Join+  , (<>)+  -- ** Other+  , MonadThrow(..)+  , MonadCatch+  , MonadMask+  , MonadIO(..)+  , lift+  ) where++import qualified Control.Category            as C+import           Control.Monad.Catch+import           Control.Monad.Cont+import           Control.Monad.Factory.Class+import           Control.Monad.State+#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 :: StateT env (ContT () m) component }+  deriving (Functor, Applicative, Monad, MonadState env, MonadIO)++instance MonadThrow m => MonadThrow (Factory m env) where+  {-# INLINE throwM #-}+  throwM = liftFT . throwM++instance Monad m => MonadCont (Factory m env) where+  {-# INLINE callCC #-}+  callCC a = do+    env <- get+    wrap . running env $ callCC a++instance C.Category (Factory m) where+  {-# INLINE id #-}+  id  = get+  {-# INLINE (.) #-}+  a . b = b >>= (`within` a)++instance MonadMask m => MonadFactory env m (Factory m env) where+  getEnv = get+  putEnv = put+  produce o = wrap . bracket o++-- | Running the factory.+running :: env -> Factory m env c -> (c -> m ()) -> m ()+running env pma = runContT (evalStateT (unFactory pma) env)+{-# INLINE running #-}++-- | Run the application using a specified factory.+boot :: Monad m => Factory m () (m ()) -> m ()+boot factory = running () factory id++-- | Construct factory under @env@, and adapt it to fit another @env'@.+within :: env -> Factory m env component -> Factory m env' component+within env = Factory . lift . (`evalStateT` env) . unFactory+{-# INLINE within #-}++-- | Construct factory under @env@, and adapt it to fit another @env'@.+withFactory :: (env' -> env) -> Factory m env component -> Factory m env' component+withFactory f (Factory ma) = do+  env <- get+  Factory (lift $ evalStateT ma (f env))+{-# INLINE withFactory #-}++-- | Wrap raw procedure into a 'Factory'.+wrap :: ((c -> m ()) -> m ()) -> Factory m env c+wrap = Factory . lift . ContT+{-# INLINE wrap #-}++-- | Lift a monad @m@ into a 'Factory'.+liftFT :: Monad m => m a -> Factory m env a+liftFT ma = wrap (ma >>=)+{-# INLINE liftFT #-}++-- | 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 <- get+  wrap $ \fm -> fnm $ running env fac (fmn . fm)+{-# INLINE natTrans #-}++{-# INLINE tryBuild #-}+tryBuild :: Bool -> Factory n env () -> Factory n env ()+tryBuild b p = if b then p else return ()

@@ -0,0 +1,53 @@+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+-- |+-- Module:      Control.Monad.Factory.Class+-- Copyright:   2019 Daniel YU+-- License:     MIT+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+module Control.Monad.Factory.Class(+    MonadFactory(..)+  , defer+  , asksEnv+  , withEnv+  , modifyEnv+  , runEnv+  ) where++-- | Monads which allow to produce @component@ under @env@, and @env@ can be changed by this procedure.+class (Monad m, Monad n) => MonadFactory env n m | m -> env n where+  -- | Return the environment of the monad.+  getEnv  :: m env+  -- | Replace the environment inside the monad.+  putEnv  :: env -> m ()+  -- | Produce a resource component, with open and close.+  produce+    :: n component -- ^ Open resource+    -> (component -> n ()) -- ^ Close resource+    -> m component++-- | Asks sub value of env.+asksEnv :: MonadFactory env n m => (env -> a) -> m a+asksEnv f = f <$> getEnv++-- | Defer to run side effect when closeing resource.+defer :: MonadFactory env n m => n () -> m ()+defer = produce (return ()) . const++-- | Change environment @env@.+withEnv :: MonadFactory env n m => (env -> m env) -> m ()+withEnv f = getEnv >>= f >>= putEnv++-- | Modify environment @env@.+modifyEnv :: MonadFactory env n m => (env -> env) -> m ()+modifyEnv f = getEnv >>= putEnv . f++-- | Run factory, return component @c@ and updated environment @env@.+runEnv :: MonadFactory env n m => m c -> m (env, c)+runEnv ma = do+  a <- ma+  e <- getEnv+  return (e, a)

@@ -1,14 +1,14 @@ module Main where -import           Boots.Factory import           Control.Concurrent.MVar import           Control.Exception       (Exception)+import           Control.Monad.Factory import           Control.Monad.Identity import           Test.Hspec   main = hspec $ do-  describe "Boots.Factory" specProperty+  describe "Control.Monad.Factory" specProperty   data TestExp = Failure deriving Show@@ -27,20 +27,15 @@       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)+      running () (within 'A' $ getEnv >>= \a -> liftFT (a `shouldBe` 'A')) return+    it "modify" $ do+      running () (within 'A' $ putEnv 'B' >> getEnv >>= \a -> liftFT (a `shouldBe` 'B')) return   context "natTrans" $ do     it "natTrans" $ do       running () (natTrans runIdentityT IdentityT $ return ()) return `shouldBe` Just ()   context "Resource" $ do-    it "bracket" $ do+    it "produce" $ do       ref <- newMVar (0 :: Int)       let         open = do@@ -54,8 +49,8 @@           b `shouldBe` 2           return ()       boot $ do-        a <- bracket open close-        offer $ do+        a <- produce open close+        liftFT $ do           a `shouldBe` 0           b <- swapMVar ref 2           b `shouldBe` 1@@ -63,8 +58,8 @@     it "bracket - error" $ do       ref <- newMVar (0 :: Int)       (`shouldThrow` anyException) $ boot $ do-        a <- bracket (readMVar ref) (\_ -> throwM Failure)-        _ <- offer $ do+        a <- produce (readMVar ref) (\_ -> throwM Failure)+        _ <- liftFT $ do           a `shouldBe` 0           swapMVar ref 1         return (return ())