dep-t 0.4.0.2 → 0.4.4.0

raw patch · 8 files changed

+344/−2 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +12/−0
• dep-t.cabal +16/−1
• lib/Control/Monad/Dep.hs +5/−0
• lib/Control/Monad/Dep/Class.hs +9/−0
• lib/Control/Monad/Dep/Has.hs +132/−0
• test/doctests.hs +1/−1
• test/tests_has.hs +162/−0

@@ -1,5 +1,12 @@ # Revision history for dep-t
 
+## 0.4.4.0
+
+* added Control.Monad.Dep.Has, a generic "Has" typeclass which favors a style in which
+  the components come wrapped in records or newtypes.
+
+* added "useEnv" to Control.Monad.Dep.Class.
+
 ## 0.4.0.0
 
 Actually no breaking changes here, but a change in the recommended structure of

@@ -281,6 +281,18 @@ > can be lifted by composing the van Laarhoven free monad with suitable
 > projection functions that pick out the requisite primitive operations. 
 
+- [Interesting SO response](https://stackoverflow.com/a/634754/1364288) (from
+  2009) about the benefits of autowiring in Spring. The record-of-functions
+  approach in Haskell can't be said to provide true autowiring. You still need
+  to assemble the record manually, and field names in the record play the part
+  of Spring bean names. 
+
+> Right now I think the most important reason for using autowiring is that
+> there's one less abstraction in your system to keep track of. The "bean name"
+> is effectively gone. It turns out the bean name only exists because of xml. So
+> a full layer of abstract indirections (where you would wire bean-name "foo"
+> into bean "bar") is gone
+
 - [registry](http://hackage.haskell.org/package/registry) is a package that
   implements an alternative approach to dependency injection, one different
   from the `ReaderT`-based one. 

@@ -1,7 +1,7 @@ cabal-version:       3.0
 
 name:                dep-t
-version:             0.4.0.2
+version:             0.4.4.0
 synopsis:            Reader-like monad transformer for dependency injection.
 description:         Put all your functions in the environment record! Let all
                      your functions read from the environment record! No favorites!
@@ -28,6 +28,7 @@   import: common
   exposed-modules:     Control.Monad.Dep
                        Control.Monad.Dep.Class
+                       Control.Monad.Dep.Has
   hs-source-dirs:      lib 
 
 test-suite dep-t-test
@@ -54,6 +55,20 @@     tasty              >=  1.3.1,
     tasty-hunit        >=  0.10.0.2,
     sop-core           ^>= 0.5.0.0,
+
+test-suite dep-t-test-has
+  import: common
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             tests_has.hs
+  build-depends:       
+    dep-t, 
+    rank2classes       ^>= 1.4.1,
+    template-haskell,
+    tasty              >=  1.3.1,
+    tasty-hunit        >=  0.10.0.2,
+    sop-core           ^>= 0.5.0.0,
+
 
 -- VERY IMPORTANT for doctests to work: https://stackoverflow.com/a/58027909/1364288
 -- http://hackage.haskell.org/package/cabal-doctest

@@ -196,6 +196,11 @@ --     }
 -- :}
 --
+-- __However__, this is only needed when the monad of the smaller environment
+-- is already \"fixed\" before inserting it in the bigger one—which I expect
+-- to be an infrequent case. When the concrete monad is selected after nesting
+-- the environments, 'zoomEnv' shouldn't be necessary.
+--
 {-# NOINLINE zoomEnv #-}
 -- For the reason for not inlining, see https://twitter.com/DiazCarrete/status/1350116413445439493
 zoomEnv ::

@@ -65,6 +65,8 @@ 
     -- * Lifting effects from dependencies
     LiftDep (..),
+    -- * Helpers
+    useEnv
   )
 where
 
@@ -136,3 +138,10 @@ type family MonadDep dependencies d e m where
   MonadDep '[] d e m = (LiftDep d m, MonadReader e m)
   MonadDep (dependency ': dependencies) d e m = (dependency d e, MonadDep dependencies d e m)
+
+-- | Avoids repeated calls to 'liftD' when all the effects in a function come from the environment.
+useEnv :: forall d e m r. (LiftDep d m, MonadReader e m) => (e -> d r) -> m r
+useEnv f = do
+  e <- ask
+  liftD (f e)
+

@@ -0,0 +1,132 @@+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+-- | This module provides a generic \"Has\" class favoring a style in which the
+-- components of the environment come wrapped in records or newtypes, instead
+-- of being bare functions.
+--
+-- >>> :{
+--  type Logger :: (Type -> Type) -> Type
+--  newtype Logger d = Logger {log :: String -> d ()} deriving Generic
+--  instance Dep Logger where
+--    type DefaultFieldName Logger = "logger"
+--  data Repository d = Repository
+--    { select :: String -> d [Int],
+--      insert :: [Int] -> d ()
+--    } deriving Generic
+--  instance Dep Repository where
+--    type DefaultFieldName Repository = "repository"
+--  newtype Controller d = Controller {serve :: Int -> d String} deriving Generic
+--  instance Dep Controller where
+--    type DefaultFieldName Controller = "controller"
+--  type Env :: (Type -> Type) -> Type
+--  data Env m = Env
+--    { 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)
+--  mkController :: forall d e m. MonadDep [Has Logger, Has Repository] d e m => Controller m
+--  mkController =
+--    Controller \url -> do
+--      e <- ask
+--      liftD $ log (dep e) "I'm going to insert in the db!"
+--      liftD $ select (dep e) "select * from ..."
+--      liftD $ insert (dep e) [1, 2, 3, 4]
+--      return "view"
+-- :}
+--
+-- The @adviseRecord@ and @deceiveRecord@ functions from the companion package
+-- \"dep-t-advice\" can facilitate working with this style of components.
+--
+module Control.Monad.Dep.Has (
+        -- * A generic \"Has\"
+        Has (..), 
+        -- * Component defaults
+        Dep (..)
+    ) where
+
+import Data.Kind
+import GHC.Records
+import GHC.TypeLits
+import Data.Coerce
+
+-- $setup
+--
+-- >>> :set -XTypeApplications
+-- >>> :set -XMultiParamTypeClasses
+-- >>> :set -XImportQualifiedPost
+-- >>> :set -XTemplateHaskell
+-- >>> :set -XStandaloneKindSignatures
+-- >>> :set -XNamedFieldPuns
+-- >>> :set -XFunctionalDependencies
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XDataKinds
+-- >>> :set -XRankNTypes
+-- >>> :set -XBlockArguments
+-- >>> :set -XFlexibleInstances
+-- >>> :set -XTypeFamilies
+-- >>> :set -XDeriveGeneric
+-- >>> import Control.Monad.Dep
+-- >>> import Rank2 qualified
+-- >>> import Rank2.TH qualified
+-- >>> import GHC.Generics (Generic)
+--
+
+
+-- | A generic \"Has\" class. When partially applied to a parametrizable
+-- record-of-functions @r_@, produces a 2-place constraint that can be later
+-- used with "Control.Monad.Dep.Class".
+type Has :: ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Constraint
+class Has r_ d e | e -> d where
+  -- |  Given an environment @e@, produce a record-of-functions parameterized by the environment's effect monad @d@.
+  --
+  -- The hope is that using a selector function on the resulting record will
+  -- determine its 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 trick>.)
+  dep :: e -> r_ d
+  default dep :: (Dep r_, HasField (DefaultFieldName r_) e u, Coercible u (r_ d)) => e -> r_ d
+  dep e = coerce . getField @(DefaultFieldName r_) $ e
+
+-- | 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.
+--
+-- This allows defining 'Has' instances with empty bodies, thanks to
+-- @DefaultSignatures@.
+type Dep :: ((Type -> Type) -> Type) -> Constraint
+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.
+  type DefaultFieldName r_ :: Symbol
+
+-- -- Doesn't make much sense to have this, we already have Has!
+-- type Sub :: ((Type -> Type) -> Type) -> ((Type -> Type) -> Type) -> Constraint
+-- class Sub sub super
+-- type SubWrapper :: ((Type -> Type) -> Type) -> ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type
+-- data SubWrapper sub super d e = SubWrapper e
+
+-- type Nested :: ((Type -> Type) -> Type) -> ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type
+-- data Nested sub super d e = Nested e
+-- 
+-- instance (Has sub d e, Has super d (sub d)) => Has super d (Nested sub super d e) where
+--     dep (Nested e) = dep @super (dep @sub e)
+
+-- Possible example
+-- instance Has ReadRef IO (Env IO) via (Nested Ref ReadRef IO (Env IO))
+
+

@@ -1,5 +1,5 @@ module Main (main) where
 
 import Test.DocTest
-main = doctest ["-ilib", "lib/Control/Monad/Dep.hs", "lib/Control/Monad/Dep/Class.hs"]
+main = doctest ["-ilib", "lib/Control/Monad/Dep.hs", "lib/Control/Monad/Dep/Class.hs", "lib/Control/Monad/Dep/Has.hs"]
 

@@ -0,0 +1,162 @@+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Main (main) where
+
+import Control.Monad.Dep
+import Control.Monad.Dep.Has
+import Control.Monad.Dep.Class
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Data.Coerce
+import Data.Kind
+import Data.List (intercalate)
+import Data.SOP
+import GHC.Generics
+import Rank2 qualified
+import Rank2.TH qualified
+import Test.Tasty
+import Test.Tasty.HUnit
+import Prelude hiding (log)
+
+-- 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.
+type Logger :: (Type -> Type) -> Type
+newtype Logger d = Logger {log :: String -> d ()} deriving (Generic)
+
+instance Dep Logger where
+  type DefaultFieldName Logger = "logger"
+
+data Repository d = Repository
+  { select :: String -> d [Int],
+    insert :: [Int] -> d ()
+  }
+  deriving (Generic)
+
+instance Dep Repository where
+  type DefaultFieldName Repository = "repository"
+
+newtype Controller d = Controller {serve :: Int -> d String} deriving (Generic)
+
+instance Dep Controller where
+  type DefaultFieldName Controller = "controller"
+
+type Env :: (Type -> Type) -> Type
+data Env m = Env
+  { 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)
+
+mkController :: forall d e m. MonadDep [Has Logger, Has Repository] d e m => Controller m
+mkController =
+  Controller \url -> do
+    e <- ask
+    liftD $ log (dep e) "I'm going to insert in the db!"
+    -- liftD $ (dep e).log "I'm going to insert in the db!" -- Once RecordDotSyntax arrives...
+    liftD $ select (dep e) "select * from ..."
+    liftD $ insert (dep e) [1, 2, 3, 4]
+    return "view"
+
+-- also toss in this helper function
+-- useEnv :: forall d e m r. (LiftDep d m, MonadReader e m) => (e -> d r) -> m r
+-- useEnv f = do
+--   e <- ask
+--   liftD (f e)
+
+-- better than with all that liftD spam... although slightly less flexible
+mkController' :: forall d e m. MonadDep [Has Logger, Has Repository] d e m => Controller m
+mkController' =
+  Controller \url ->
+    useEnv \e -> do
+      log (dep e) "I'm going to insert in the db!"
+      select (dep e) "select * from ..."
+      insert (dep e) [5, 3, 43]
+      return "view"
+
+type EnvIO :: Type
+data EnvIO = EnvIO
+  { logger :: Logger IO,
+    repository :: Repository IO
+  }
+
+instance Has Logger IO EnvIO
+
+instance Has Repository IO EnvIO
+
+type TestTrace = ([String], [Int])
+
+mkFakeLogger :: MonadWriter TestTrace m => Logger m
+mkFakeLogger = Logger \msg -> tell ([msg], [])
+
+mkFakeRepository :: (MonadDep '[Has Logger] d e m, MonadWriter TestTrace m) => Repository m
+mkFakeRepository =
+  Repository
+    { select = \_ -> do
+        e <- ask
+        liftD $ log (dep e) "I'm going to select an entity"
+        return [],
+      insert = \entity -> do
+        e <- ask
+        liftD $ log (dep e) "I'm going to write the entity!"
+        tell ([], entity)
+    }
+
+env :: Env (DepT Env (Writer TestTrace))
+env =
+  let logger = mkFakeLogger
+      repository = mkFakeRepository
+      controller = mkController
+   in Env {logger, repository, controller}
+
+--
+-- to test the coercible in the definition of Has
+type EnvHKD :: (Type -> Type) -> (Type -> Type) -> Type
+data EnvHKD h m = EnvHKD
+  { logger :: h (Logger m),
+    repository :: h (Repository m),
+    controller :: h (Controller m)
+  }
+
+instance Has Logger m (EnvHKD I m)
+
+instance Has Repository m (EnvHKD I m)
+
+instance Has Controller m (EnvHKD I m)
+
+--
+--
+tests :: TestTree
+tests =
+  testGroup
+    "All"
+    []
+
+main :: IO ()
+main = defaultMain tests