dep-t-0.6.2.0: Dependency injection for records-of-functions.
Safe HaskellSafe-Inferred
LanguageHaskell2010

Dep.Tagged

Description

Companion module to Dep.Has for disambiguanting record components within an environment.

Similar in purpose to the Qualifier annotation in Java Spring.

>>> :{
newtype Foo d = Foo {foo :: String -> d ()} deriving Generic
makeIOFoo :: MonadIO m => Foo m
makeIOFoo = Foo (liftIO . putStrLn)
makeIOFoo' :: MonadIO m => Foo m
makeIOFoo' = Foo (\_ -> liftIO $ putStrLn "this is secondary")
env :: InductiveEnv '[Foo, Tagged "secondary" Foo] Identity IO
env = AddDep @Foo (Identity makeIOFoo)
    $ AddDep @(Tagged "secondary" Foo) (Identity (tagged makeIOFoo'))
    $ EmptyEnv 
 :}
>>> :{
 foo (dep env) "this is foo"
:}
this is foo
>>> :{
 foo (untag @"secondary" (dep env)) "this is foo"
:}
this is secondary

When using functions from Dep.SimpleAdvice (which tend to depend on coercions) with Tagged components, remember to import the newtype's constructor.

Synopsis

Documentation

newtype Tagged s r_ m Source #

Very similar to the Data.Tagged type from the "tagged" package, but with an extra monad type argument. The intended use is to disambiguate record components within an environment, when there are multiple records of the same type.

Constructors

Tagged 

Fields

Instances

Instances details
Generic (Tagged s r_ m) Source # 
Instance details

Defined in Dep.Tagged

Associated Types

type Rep (Tagged s r_ m) :: Type -> Type #

Methods

from :: Tagged s r_ m -> Rep (Tagged s r_ m) x #

to :: Rep (Tagged s r_ m) x -> Tagged s r_ m #

type Rep (Tagged s r_ m) Source # 
Instance details

Defined in Dep.Tagged

type Rep (Tagged s r_ m) = D1 ('MetaData "Tagged" "Dep.Tagged" "dep-t-0.6.2.0-IYXNnNORU1BYL13TIUGF4" 'True) (C1 ('MetaCons "Tagged" 'PrefixI 'True) (S1 ('MetaSel ('Just "unTagged") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (r_ m))))

tagged :: forall s r_ m. r_ m -> Tagged s r_ m Source #

untag :: Tagged s r_ m -> r_ m Source #

Alias for unTagged.

When invoking a method from a tagged dependency, provide the tag using a type application and compose with the record selector.