dep-t-advice 0.4.4.0 → 0.4.5.0

raw patch · 4 files changed

+43/−4 lines, 4 filesdep ~dep-tPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: dep-t

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• dep-t-advice.cabal +2/−2
• lib/Control/Monad/Dep/Advice.hs +18/−2
• test/weird-advice-tests.hs +16/−0

@@ -1,5 +1,12 @@ # Revision history for dep-t-advice
 
+
+## 0.4.5.0 
+
+* Added runFromDep.
+
+  This required bumping the minimum version of dep-t to 0.4.4.0.
+
 ## 0.4.4.0 
 
 * Added 'adviseRecord' and 'deceiveRecord' that manipulate entire

@@ -1,7 +1,7 @@ cabal-version:       3.0
 
 name:                dep-t-advice
-version:             0.4.4.0
+version:             0.4.5.0
 synopsis:            Giving good advice to functions in a DepT environment.
 description:         Companion to the dep-t package. Easily add behaviour to functions living in a DepT environment, 
                      whatever the number of arguments they might have.
@@ -24,7 +24,7 @@   build-depends:       base >=4.10.0.0 && < 5,
                        sop-core ^>= 0.5.0.0,
                        transformers ^>= 0.5.0.0,
-                       dep-t ^>= 0.4.0.0,
+                       dep-t ^>= 0.4.4.0,
   default-language:    Haskell2010
 
 common common-tests

@@ -92,6 +92,7 @@     -- $invocation
     runFinalDepT,
     runFromEnv,
+    runFromDep,
 
     -- * Making functions see a different environment
     deceive,
@@ -114,6 +115,7 @@ where
 
 import Control.Monad.Dep
+import Control.Monad.Dep.Has
 import Control.Monad.Trans.Reader (ReaderT (..), withReaderT)
 import Data.Kind
 import Data.SOP
@@ -489,6 +491,20 @@   DownToBaseMonad as e_ m r curried
 runFromEnv = _runFromEnv
 
+-- | Like 'runFromEnv', but the function to run is extracted from a dependency
+-- @dep@ which is found using 'Has'. The selector should be concrete enough to
+-- identify @dep@ in the environment.
+runFromDep ::
+  forall dep as e_ m r curried.
+  (Multicurryable as e_ m r curried, Has dep (DepT e_ m) (e_ (DepT e_ m))) =>
+  -- | action that gets hold of the environment
+  m (e_ (DepT e_ m)) ->
+  -- | selector that gets a function from a dependency found using 'Has'
+  (dep (DepT e_ m) -> curried) ->
+  -- | a new function with effects in the base monad
+  DownToBaseMonad as e_ m r curried
+runFromDep envAction member = _runFromEnv envAction (member . dep)
+
 -- $restrict
 --
 --    'Advice' values can be composed using the 'Monoid' instance, but only if
@@ -734,7 +750,7 @@         deceived_ = _deceiveProduct @_ @e @e_ @m f gullible_
      in G.to (G.M1 (G.M1 deceived_))
 
--- | Makes an entire record-of-functions see a different version of the glooal environment record, a version that might have different @HasX@ instances.
+-- | Makes an entire record-of-functions see a different version of the global environment record, a version that might have different @HasX@ instances.
 --
 -- 'deceiveRecord' must be applied before 'adviseRecord'.
 deceiveRecord ::
@@ -844,7 +860,7 @@ 
 -- $records
 --
--- Versions of 'advise' and 'deceive' that, instead of working on bare
+-- 'adviseRecord' and 'deceiveRecord' are versions of 'advise' and 'deceive' that, instead of working on bare
 -- functions, transform entire records-of-functions in one go. They also work
 -- with newtypes containing a single function. The records must derive 'GHC.Generics.Generic'.
 --

@@ -25,6 +25,7 @@ module Main (main) where
 
 import Control.Monad.Dep
+import Control.Monad.Dep.Has
 import Control.Monad.Dep.Advice
 import Control.Monad.Reader
 import Control.Monad.Writer
@@ -43,15 +44,21 @@ -- 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"
 
 type Repository :: (Type -> Type) -> Type
 data Repository d = Repository
   { select :: String -> d [Int],
     insert :: [Int] -> d ()
   } deriving Generic
+instance Dep Repository where
+    type DefaultFieldName Repository = "repository"
 
 type Controller :: (Type -> Type) -> Type
 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
@@ -59,6 +66,9 @@     repository :: Repository m,
     controller :: Controller m
   }
+instance Has Logger m (Env m)
+instance Has Repository m (Env m)
+instance Has Controller m (Env m)
 
 -- dumb wrapper newtype
 newtype Wraps x = Wraps x
@@ -75,6 +85,12 @@         deceiveRecord Wraps $ 
         Controller \_ -> pure "view"
    in Env {logger, repository, controller}
+
+
+
+
+ran :: Writer () String
+ran = runFromDep (pure env) serve 7
 
 --
 -- to test the coercible in the definition of Has