dep-t 0.6.6.0 → 0.6.7.0

raw patch · 7 files changed

+213/−73 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−2
• README.md +1/−1
• dep-t.cabal +1/−1
• lib/Dep/Env.hs +19/−6
• lib/Dep/Has.hs +134/−51
• lib/Dep/Injects.hs +36/−12
• test/tests_has.hs +13/−0

@@ -1,11 +1,18 @@ # Revision history for dep-t +## 0.6.7 +* Deprecated `HasAll`.++* Added `Call` pattern synonym to `Dep.Has`.++* Added tuple instances for `Has` and `Injects`.+ ## 0.6.6 -* Added Dep.Phases. +* Added `Dep.Phases`.  -* Added Dep.Injects.+* Added `Dep.Injects`.  ## 0.6.5 

@@ -53,7 +53,7 @@ environment. Usually, component implementations import this module. - __Dep.Env__ complements __Dep.Has__ with helpers for building dependency injection environments. Usually, only the [composition root](https://stackoverflow.com/questions/6277771/what-is-a-composition-root-in-the-context-of-dependency-injection) of the application imports this module. - __Dep.Tagged__ is a helper for disambiguating dependencies in __Dep.Env__ environments.-- __Dep.Constructor__ enables fixpoint-based dependency injection in __Dep.Env__ environments.+- __Dep.Constructor__ enables fixpoint-based dependency injection in __Dep.Env__ environments. See [this thread in the Haskell Discourse](https://discourse.haskell.org/t/dependency-injection-fixed-points-and-monoidal-accumulators/5557) for an example. - __Control.Monad.Dep__ provides the `DepT` monad transformer, a variant of `ReaderT`. You either want to use this or __Dep.Constructor__ in your composition root, but not both. - __Control.Monad.Dep.Class__ is an extension of `MonadReader`, useful to program against both `ReaderT` and `DepT`. 

@@ -1,7 +1,7 @@ cabal-version:       3.0  name:                dep-t-version:             0.6.6.0+version:             0.6.7.0 synopsis:            Dependency injection for records-of-functions. description:         Put all your functions in the environment record! Let all                      your functions read from the environment record! No favorites!

@@ -741,12 +741,25 @@ -- components into functions that take their dependencies as separate -- positional parameters. ----- > makeController :: (Monad m, Has Logger m env, Has Repository m env) => env -> Controller m--- > makeController = undefined--- > makeControllerPositional :: Monad m => Logger m -> Repository m -> Controller m--- > makeControllerPositional a b = makeController $ addDep @Logger a $ addDep @Repository b $ emptyEnv--- > makeController' :: (Monad m, Has Logger m env, Has Repository m env) => env -> Controller m--- > makeController' env = makeControllerPositional (dep env) (dep env)+-- >>> :{+-- data Logger d = Logger { }+-- data Repository d = Repository { }+-- data Controller d = Controller  { }+-- makeController :: (Monad m, Has Logger m deps, Has Repository m deps) => deps -> Controller m+-- makeController = undefined+-- makeControllerPositional :: Monad m => Logger m -> Repository m -> Controller m+-- makeControllerPositional a b = makeController $ addDep @Logger a $ addDep @Repository b $ emptyEnv+-- makeController' :: (Monad m, Has Logger m deps, Has Repository m deps) => deps -> Controller m+-- makeController' deps = makeControllerPositional (dep deps) (dep deps)+-- :}+--+-- Although, for small numbers of components, we can simply use a tuple as the environment:+--+-- >>> :{+-- makeControllerPositional' :: Monad m => Logger m -> Repository m -> Controller m+-- makeControllerPositional' a b = makeController (a,b)+-- :}+-- data InductiveEnv (rs :: [(Type -> Type) -> Type]) (h :: Type -> Type) (m :: Type -> Type) where   AddDep :: forall r_ m rs h. Typeable r_ => h (r_ m) -> InductiveEnv rs h m -> InductiveEnv (r_ : rs) h m   EmptyEnv :: forall m h. InductiveEnv '[] h m

@@ -2,19 +2,20 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE TypeOperators #-}  -- | This module provides a general-purpose 'Has' class favoring a style in -- which the components of the environment, instead of being bare functions,@@ -40,23 +41,23 @@ --  instance Dep Controller where --    type DefaultFieldName Controller = "controller" --  -----  type Env :: (Type -> Type) -> Type---  data Env m = Env+--  type Deps :: (Type -> Type) -> Type+--  data Deps m = Deps --    { logger :: Logger m, --      repository :: Repository m, --      controller :: Controller m --    }---  instance Has Logger m (Env m)---  instance Has Repository m (Env m)---  instance Has Controller m (Env m)+--  instance Has Logger m (Deps m)+--  instance Has Repository m (Deps m)+--  instance Has Controller m (Deps m) --  :}---  +-- -- 'Has' can be used in combination with 'MonadDep', like this: -- -- >>> :{ --  mkController :: MonadDep [Has Logger, Has Repository] d env m => Controller m --  mkController =---    Controller \url -> +--    Controller \url -> --      useEnv \(asCall -> call) -> do --        call log "I'm going to insert in the db!" --        call select "select * from ..."@@ -69,7 +70,7 @@ -- doesn't have any constraint other than 'Monad': -- -- >>> :{---  mkController' :: (Monad m, Has Logger m env, Has Repository m env) => env -> Controller m+--  mkController' :: (Monad m, Has Logger m deps, Has Repository m deps) => deps -> Controller m --  mkController' (asCall -> call) = --    Controller \url -> do --      call log "I'm going to insert in the db!"@@ -77,72 +78,111 @@ --      call insert [1, 2, 3, 4] --      return "view" -- :}-------module Dep.Has (-      -- * A general-purpose Has-      Has (..)-    , HasAll-      -- * call helper-    , asCall-      -- * Component defaults-    , Dep (..)-    ) where+module Dep.Has+  ( -- * A general-purpose Has+    Has (..),+    HasAll, +    -- * call helpers+    asCall,+    pattern Call,+    -- , pattern Dep++    -- * Component defaults+    Dep (..),+  )+where++import Data.Coerce import Data.Kind import GHC.Records import GHC.TypeLits-import Data.Coerce+ -- import Control.Monad.Reader -- import Control.Monad.Dep.Class  -- | A generic \"Has\" class. When partially applied to a parametrizable--- record-of-functions @r_@, produces a 2-place constraint ---  saying that the environment @e@ has the record @r_@ with effect monad @m@.+-- record-of-functions @r_@, produces a 2-place constraint+-- saying that the environment @deps@ has the record @r_@ with effect monad @m@. -- -- The constraint can be used on its own, or with "Control.Monad.Dep.Class". type Has :: ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Constraint-class Has r_ (m :: Type -> Type) (env :: Type) | env -> m where-  -- |  Given an environment @env@, produce a record-of-functions parameterized by the environment's effect monad @m@.+class Has (r_ :: (Type -> Type) -> Type) (m :: Type -> Type) (deps :: Type) | deps -> m where+  -- |  Given an environment @deps@, produce a record-of-functions parameterized by the environment's effect monad @m@.   --   -- The hope is that using a selector function on the resulting record will   -- fix the record's type without the need for type annotations.   ---  -- (This will likely not play well with RecordDotSyntax. See also <https://chrisdone.com/posts/import-aliases-field-names/ this import alias trick for avoiding name collisions>.)-  dep :: env -> r_ m-  default dep :: (Dep r_, HasField (DefaultFieldName r_) env u, Coercible u (r_ m)) => env -> r_ m-  dep env = coerce . getField @(DefaultFieldName r_) $ env+  -- See also <https://chrisdone.com/posts/import-aliases-field-names/ this import alias trick for avoiding name collisions>.+  dep :: deps -> r_ m+  default dep :: (Dep r_, HasField (DefaultFieldName r_) deps u, Coercible u (r_ m)) => deps -> r_ m+  dep deps = coerce . getField @(DefaultFieldName r_) $ deps --- | When partially applied to a type-level list @rs_@ of parametrizable records-of-functions, +-- | When partially applied to a type-level list @rs_@ of parametrizable records-of-functions, -- produces a 2-place constraint saying that the environment @e@ has all the -- records @rs_@ with effect monad @m@.+{-# DEPRECATED HasAll "Use All from sop-core along with separate Has applications" #-}+ type HasAll :: [(Type -> Type) -> Type] -> (Type -> Type) -> Type -> Constraint type family HasAll rs_ m e where   HasAll '[] m e = ()   HasAll (r_ : rs_) m e = (Has r_ m e, HasAll rs_ m e) --- | Transforms an environment with suitable 'Has' instances into a \"helper\"---   function that looks in the environment for the arguments of other functions.---   Typically, the \"helped\" functions will be record field selectors:+instance Has r_ m (r_ m, b) where+  dep (r, _) = r++instance Has r_ m (a, r_ m) where+  dep (_, r) = r++instance Has r_ m (r_ m, b, c) where+  dep (r, _, _) = r++instance Has r_ m (a, r_ m, c) where+  dep (_, r, _) = r++instance Has r_ m (a, b, r_ m) where+  dep (_, _, r) = r++instance Has r_ m (r_ m, b, c, d) where+  dep (r, _, _, _) = r++instance Has r_ m (a, r_ m, c, d) where+  dep (_, r, _, _) = r++instance Has r_ m (a, b, r_ m, d) where+  dep (_, _, r, _) = r++instance Has r_ m (a, b, c, r_ m) where+  dep (_, _, _, r) = r++-- | A record-of-functions @r_@ might play the role of a \"component\"+-- taking part in dependency injection. --+-- Each function field is then a \"method\". And the record field selectors are functions+-- which take the component and return the method corresponding to that field.+--+-- Given a dependency injection context, 'asCall' produces a reusable helper+-- that returns the the method corresponding to a field selector, on the condition that+-- the required 'Has' instance exists for the selectors' record.+-- -- >>> :{ --  data SomeRecord m = SomeRecord { someSelector :: String -> m () }---  data Env m = Env+--  data Deps m = Deps --    { someRecord :: SomeRecord m --    }---  instance Has SomeRecord m (Env m) where---    dep (Env{someRecord}) = someRecord+--  instance Has SomeRecord m (Deps m) where+--    dep (Deps {someRecord}) = someRecord --  :} -----   In practice, this means that you can write @call someSelector@ instead of @someSelector (dep---   env)@:+--   In practice, this just means that you can write @call someSelector@ instead of+--   @someSelector (dep deps)@: -- -- >>> :{---    twoInvocations :: (IO (), IO ()) ---    twoInvocations = ---      let env :: Env IO = Env { someRecord = SomeRecord { someSelector = putStrLn } }---          call = asCall env---       in (someSelector (dep env) "foo", call someSelector "foo")  +--    twoInvocations :: (IO (), IO ())+--    twoInvocations =+--      let deps :: Deps IO = Deps { someRecord = SomeRecord { someSelector = putStrLn } }+--          call = asCall deps+--       in (someSelector (dep deps) "foo", call someSelector "foo") -- :} -- --   Using 'asCall' in a view pattern avoids having to name the@@ -150,13 +190,56 @@ -- -- -- >>> :{---    functionThatCalls :: Has SomeRecord m e => e -> m ()+--    functionThatCalls :: Has SomeRecord m deps => deps -> m () --    functionThatCalls (asCall -> call) = call someSelector "foo" -- :}+asCall ::+  forall deps m.+  -- | Dependency injection context that contains the components.+  deps ->+  forall r_ method.+  Has r_ m deps =>+  -- | Field selector function that extracts a method from a component.+  (r_ m -> method) ->+  method+asCall deps = \f -> f (dep deps)++-- | Pattern synonym version of 'asCall'. Slightly more succinct and doesn't+-- require @-XViewPatterns@. The synonym is unidirectional: it can only be used for+-- matching. ---asCall :: forall env m . env -> forall r_ x. Has r_ m env => (r_ m -> x) -> x-asCall env = \f -> f (dep env)+-- >>> :{+--  data SomeRecord m = SomeRecord { someSelector :: String -> m () }+--  data Deps m = Deps+--    { someRecord :: SomeRecord m+--    }+--  instance Has SomeRecord m (Deps m) where+--    dep (Deps {someRecord}) = someRecord+--  functionThatCalls :: Has SomeRecord m deps => deps -> m ()+--  functionThatCalls (Call call) = call someSelector "foo"+-- :}+pattern Call ::+  forall deps m.+  ( forall r_ method.+    Has r_ m deps =>+    (r_ m -> method) ->+    method+  ) ->+  -- | The dependency injection context that we want to match.+  deps+pattern Call call <- (asCall -> call) +{-# COMPLETE Call #-}++{-# INLINEABLE Call #-}++-- The deprecated Dep typeclass causes trouble here.+-- -- | The @δ@ should be the first argument of the functions we want to invoke.+-- pattern Dep :: forall env m . (forall r_ . Has r_ m env => r_ m) -> env+-- pattern Dep δ <- ((dep :: env -> forall r_ . Has r_ m env => r_ m) -> δ)+-- {-# COMPLETE Dep #-}+-- {-# INLINABLE Dep #-}+ -- | Parametrizable records-of-functions can be given an instance of this -- typeclass to specify the default field name 'Has' expects for the component -- in the environment record.@@ -164,7 +247,9 @@ -- This allows defining 'Has' instances with empty bodies, thanks to -- @DefaultSignatures@. type Dep :: ((Type -> Type) -> Type) -> Constraint+ {-# DEPRECATED Dep "more intrusive than useful" #-}+ class Dep r_ where   -- The Char kind would be useful here, to lowercase the first letter of the   -- k type and use it as the default preferred field name.@@ -190,5 +275,3 @@ -- >>> import Data.Kind -- >>> import Control.Monad.Dep -- >>> import GHC.Generics (Generic)----

@@ -2,30 +2,31 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE TypeOperators #-}  -- | Inject values into accumulators.-module Dep.Injects (-    -- * General-purpose injector.-    Injects (..)-    ) where+module Dep.Injects+  ( -- * General-purpose injector.+    Injects (..),+  )+where +import Data.Coerce import Data.Kind import GHC.Records import GHC.TypeLits-import Data.Coerce  -- | Mirror image of 'Dep.Has.Has'. --@@ -34,10 +35,33 @@ -- all components. type Injects :: ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Constraint class Injects r_ (m :: Type -> Type) (accum :: Type) | accum -> m where-    -- | Given a value parameterized by the accumulator's effect monad @m@,-    -- produce an accumulator.-    inject :: r_ m -> accum+  -- | Given a value parameterized by the accumulator's effect monad @m@,+  -- produce an accumulator.+  inject :: r_ m -> accum +instance (Monoid b) => Injects r_ m (r_ m, b) where+  inject r = (r, mempty) +instance (Monoid a) => Injects r_ m (a, r_ m) where+  inject r = (mempty, r) +instance (Monoid b, Monoid c) => Injects r_ m (r_ m, b, c) where+  inject r = (r, mempty, mempty) +instance (Monoid a, Monoid c) => Injects r_ m (a, r_ m, c) where+  inject r = (mempty, r, mempty)++instance (Monoid a, Monoid b) => Injects r_ m (a, b, r_ m) where+  inject r = (mempty, mempty, r)++instance (Monoid b, Monoid c, Monoid d) => Injects r_ m (r_ m, b, c, d) where+  inject r = (r, mempty, mempty, mempty)++instance (Monoid a, Monoid c, Monoid d) => Injects r_ m (a, r_ m, c, d) where+  inject r = (mempty, r, mempty, mempty)++instance (Monoid a, Monoid b, Monoid d) => Injects r_ m (a, b, r_ m, d) where+  inject r = (mempty, mempty, r, mempty)++instance (Monoid a, Monoid b, Monoid c) => Injects r_ m (a, b, c, r_ m) where+  inject r = (mempty, mempty, mempty, r)

@@ -56,6 +56,8 @@ import System.IO import Dep.Tagged import Data.Function+import Dep.Injects+import Data.Functor.Constant  -- https://stackoverflow.com/questions/53498707/cant-derive-generic-for-this-type/53499091#53499091 -- There are indeed some higher kinded types for which GHC can currently derive Generic1 instances, but the feature is so limited it's hardly worth mentioning. This is mostly an artifact of taking the original implementation of Generic1 intended for * -> * (which already has serious limitations), turning on PolyKinds, and keeping whatever sticks, which is not much.@@ -362,6 +364,17 @@     runContT (pullPhase @Allocator envInductive) \env -> do         let r = execWriter $ runDepT (do env <- ask; serve (dep env) 7) env         assertEqual "" (["I'm going to insert in the db!","I'm going to select an entity","I'm going to write the entity!", "Logged again from secondary logger."],[1,2,3,4]) r++newtype Activities m = Activities [ContT () m ()]+  deriving newtype (Semigroup, Monoid)++type Accumulator m = (Activities m, Constant () m)++acc1 :: Accumulator IO +acc1 = inject (Activities [])++acc2 :: Accumulator IO +acc2 = inject (Constant ())  -- --