mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-12-04 19:01:08 +03:00
Improve some haddock
This commit is contained in:
parent
0b627c9898
commit
1c68c3c7fb
@ -29,7 +29,16 @@ module Polysemy
|
||||
, lazilyStateful
|
||||
-- * Performance
|
||||
, inlineRecursiveCalls
|
||||
|
||||
-- * Tactics
|
||||
-- | Higher-order effects need to explicitly thread /other effects'/ state
|
||||
-- through themselves. Tactics are a domain-specific language for describing
|
||||
-- exactly how this threading should take place.
|
||||
--
|
||||
-- The first computation to be run should use 'runT', and subsequent
|
||||
-- computations /in the same environment/ should use 'bindT'. Any
|
||||
-- first-order constructors which appear in a higher-order context may use
|
||||
-- 'pureT' to satisfy the typechecker.
|
||||
, Tactical
|
||||
, WithTactics
|
||||
, pureT
|
||||
|
@ -99,6 +99,9 @@ hoistSemantic nat (Semantic m) = Semantic $ \k -> m $ \u -> k $ nat u
|
||||
{-# INLINE hoistSemantic #-}
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Introduce an effect into 'Semantic'. Analogous to
|
||||
-- 'Control.Monad.Class.Trans.lift' in the mtl ecosystem
|
||||
raise :: forall e r a. Semantic r a -> Semantic (e ': r) a
|
||||
raise = hoistSemantic $ hoist raise_b . weaken
|
||||
{-# INLINE raise #-}
|
||||
@ -109,6 +112,9 @@ raise_b = raise
|
||||
{-# NOINLINE raise_b #-}
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Lift an effect into a 'Semantic'. This is used primarily via
|
||||
-- 'Polysemy.makeSemantic' to implement smart constructors.
|
||||
send :: Member e r => e (Semantic r) a -> Semantic r a
|
||||
send = liftSemantic . inj
|
||||
{-# INLINE[3] send #-}
|
||||
|
@ -35,16 +35,29 @@ swap ~(a, b) = (b, a)
|
||||
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | The simplest way to produce an effect handler. Interprets an effect 'e' by
|
||||
-- transforming it into other effects inside of 'r'.
|
||||
interpret
|
||||
:: FirstOrder e "interpret"
|
||||
=> (∀ x m. e m x -> Semantic r x)
|
||||
-- ^ A natural transformation from the handled effect to other effects
|
||||
-- already in 'Semantic'.
|
||||
-> Semantic (e ': r) a
|
||||
-> Semantic r a
|
||||
-- TODO(sandy): could probably give a `coerce` impl for `runTactics` here
|
||||
interpret f = interpretH $ \(e :: e m x) -> liftT @m $ f e
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Like 'interpret', but for higher-order effects (ie. those which make use of
|
||||
-- the 'm' parameter.)
|
||||
--
|
||||
-- See the notes on 'Tactical' for how to use this function.
|
||||
interpretH
|
||||
:: (∀ x m . e m x -> Tactical e m r x)
|
||||
-- ^ A natural transformation from the handled effect to other effects
|
||||
-- already in 'Semantic'.
|
||||
-> Semantic (e ': r) a
|
||||
-> Semantic r a
|
||||
interpretH f (Semantic m) = m $ \u ->
|
||||
@ -120,10 +133,9 @@ lazilyStateful f = interpretInLazyStateT $ \e -> LS.StateT $ fmap swap . f e
|
||||
-- some new effect @f@. This function will fuse when followed by
|
||||
-- 'Polysemy.State.runState', meaning it's free to 'reinterpret' in terms of
|
||||
-- the 'Polysemy.State.State' effect and immediately run it.
|
||||
--
|
||||
-- TODO(sandy): Make this fuse in with 'stateful' directly.
|
||||
reinterpretH
|
||||
:: (∀ m x. e1 m x -> Tactical e1 m (e2 ': r) x)
|
||||
-- ^ A natural transformation from the handled effect to the new effect.
|
||||
-> Semantic (e1 ': r) a
|
||||
-> Semantic (e2 ': r) a
|
||||
reinterpretH f (Semantic m) = Semantic $ \k -> m $ \u ->
|
||||
@ -133,24 +145,31 @@ reinterpretH f (Semantic m) = Semantic $ \k -> m $ \u ->
|
||||
a <- usingSemantic k $ runTactics s (raise . reinterpretH_b f . d) $ f e
|
||||
pure $ y a
|
||||
{-# INLINE[3] reinterpretH #-}
|
||||
-- TODO(sandy): Make this fuse in with 'stateful' directly.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Like 'interpret', but instead of removing the effect @e@, reencodes it in
|
||||
-- some new effect @f@. This function will fuse when followed by
|
||||
-- 'Polysemy.State.runState', meaning it's free to 'reinterpret' in terms of
|
||||
-- the 'Polysemy.State.State' effect and immediately run it.
|
||||
--
|
||||
-- TODO(sandy): Make this fuse in with 'stateful' directly.
|
||||
reinterpret
|
||||
:: FirstOrder e1 "reinterpret"
|
||||
=> (∀ m x. e1 m x -> Semantic (e2 ': r) x)
|
||||
-- ^ A natural transformation from the handled effect to the new effect.
|
||||
-> Semantic (e1 ': r) a
|
||||
-> Semantic (e2 ': r) a
|
||||
reinterpret f = reinterpretH $ \(e :: e m x) -> liftT @m $ f e
|
||||
{-# INLINE[3] reinterpret #-}
|
||||
-- TODO(sandy): Make this fuse in with 'stateful' directly.
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Like 'reinterpret2', but for higher-order effects.
|
||||
--
|
||||
-- See the notes on 'Tactical' for how to use this function.
|
||||
reinterpret2H
|
||||
:: (∀ m x. e1 m x -> Tactical e1 m (e2 ': e3 ': r) x)
|
||||
-- ^ A natural transformation from the handled effect to the new effects.
|
||||
-> Semantic (e1 ': r) a
|
||||
-> Semantic (e2 ': e3 ': r) a
|
||||
reinterpret2H f (Semantic m) = Semantic $ \k -> m $ \u ->
|
||||
@ -161,16 +180,25 @@ reinterpret2H f (Semantic m) = Semantic $ \k -> m $ \u ->
|
||||
pure $ y a
|
||||
{-# INLINE[3] reinterpret2H #-}
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Like 'reinterpret', but introduces /two/ intermediary effects.
|
||||
reinterpret2
|
||||
:: FirstOrder e1 "reinterpret2"
|
||||
=> (∀ m x. e1 m x -> Semantic (e2 ': e3 ': r) x)
|
||||
-- ^ A natural transformation from the handled effect to the new effects.
|
||||
-> Semantic (e1 ': r) a
|
||||
-> Semantic (e2 ': e3 ': r) a
|
||||
reinterpret2 f = reinterpret2H $ \(e :: e m x) -> liftT @m $ f e
|
||||
{-# INLINE[3] reinterpret2 #-}
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Like 'reinterpret3', but for higher-order effects.
|
||||
--
|
||||
-- See the notes on 'Tactical' for how to use this function.
|
||||
reinterpret3H
|
||||
:: (∀ m x. e1 m x -> Tactical e1 m (e2 ': e3 ': e4 ': r) x)
|
||||
-- ^ A natural transformation from the handled effect to the new effects.
|
||||
-> Semantic (e1 ': r) a
|
||||
-> Semantic (e2 ': e3 ': e4 ': r) a
|
||||
reinterpret3H f (Semantic m) = Semantic $ \k -> m $ \u ->
|
||||
@ -181,9 +209,13 @@ reinterpret3H f (Semantic m) = Semantic $ \k -> m $ \u ->
|
||||
pure $ y a
|
||||
{-# INLINE[3] reinterpret3H #-}
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Like 'reinterpret', but introduces /three/ intermediary effects.
|
||||
reinterpret3
|
||||
:: FirstOrder e1 "reinterpret2"
|
||||
=> (∀ m x. e1 m x -> Semantic (e2 ': e3 ': e4 ': r) x)
|
||||
-- ^ A natural transformation from the handled effect to the new effects.
|
||||
-> Semantic (e1 ': r) a
|
||||
-> Semantic (e2 ': e3 ': e4 ': r) a
|
||||
reinterpret3 f = reinterpret3H $ \(e :: e m x) -> liftT @m $ f e
|
||||
|
@ -115,6 +115,9 @@ type family FirstOrderError e (fn :: Symbol) :: k where
|
||||
':<>: 'Text "H' instead."
|
||||
)
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | This constraint gives helpful error messages if you attempt to use a
|
||||
-- first-order combinator with a higher-order type.
|
||||
type FirstOrder e fn = ∀ m. Coercible (e m) (e (FirstOrderError e fn))
|
||||
|
||||
|
||||
|
@ -12,19 +12,19 @@ effect algebra. For example, using the @FileSystem@ effect from the example in
|
||||
the module documentation for "Polysemy", we can write the following:
|
||||
|
||||
@
|
||||
data FileSystem r where
|
||||
data FileSystem m a where
|
||||
ReadFile :: 'FilePath' -> FileSystem 'String'
|
||||
WriteFile :: 'FilePath' -> 'String' -> FileSystem ()
|
||||
'makeEffect' ''FileSystem
|
||||
'makeSemantic' ''FileSystem
|
||||
@
|
||||
|
||||
This will automatically generate the following functions:
|
||||
|
||||
@
|
||||
readFile :: 'Member' FileSystem effs => 'FilePath' -> 'Eff' effs 'String'
|
||||
readFile :: 'Member' FileSystem r => 'FilePath' -> 'Semantic' r 'String'
|
||||
readFile a = 'send' (ReadFile a)
|
||||
|
||||
writeFile :: 'Member' FileSystem effs => 'FilePath' -> 'String' -> 'Eff' effs ()
|
||||
writeFile :: 'Member' FileSystem r => 'FilePath' -> 'String' -> 'Semantic' r ()
|
||||
writeFile a b = 'send' (WriteFile a b)
|
||||
@
|
||||
-}
|
||||
@ -44,26 +44,26 @@ import Polysemy.Internal.CustomErrors (DefiningModule)
|
||||
|
||||
|
||||
-- | If @T@ is a GADT representing an effect algebra, as described in the module
|
||||
-- documentation for "Polysemy", @$('makeEffect' ''T)@ automatically
|
||||
-- documentation for "Polysemy", @$('makeSemantic' ''T)@ automatically
|
||||
-- generates a function that uses 'send' with each operation. For more
|
||||
-- information, see the module documentation for "Polysemy.TH".
|
||||
-- information, see the module documentation for "Polysemy.Internal.TH.Effect".
|
||||
makeSemantic :: Name -> Q [Dec]
|
||||
makeSemantic = genFreer True
|
||||
|
||||
-- | Like 'makeEffect', but does not provide type signatures. This can be used
|
||||
-- | Like 'makeSemantic', but does not provide type signatures. This can be used
|
||||
-- to attach Haddock comments to individual arguments for each generated
|
||||
-- function.
|
||||
--
|
||||
-- @
|
||||
-- data Lang x where
|
||||
-- data Lang m a where
|
||||
-- Output :: String -> Lang ()
|
||||
--
|
||||
-- makeSemantic_ ''Lang
|
||||
--
|
||||
-- -- | Output a string.
|
||||
-- output :: Member Lang effs
|
||||
-- => String -- ^ String to output.
|
||||
-- -> Semantic effs () -- ^ No result.
|
||||
-- output :: Member Lang r
|
||||
-- => String -- ^ String to output.
|
||||
-- -> Semantic r () -- ^ No result.
|
||||
-- @
|
||||
--
|
||||
-- Note that 'makeEffect_' must be used /before/ the explicit type signatures.
|
||||
@ -71,7 +71,7 @@ makeSemantic_ :: Name -> Q [Dec]
|
||||
makeSemantic_ = genFreer False
|
||||
|
||||
-- | Generates declarations and possibly signatures for functions to lift GADT
|
||||
-- constructors into 'Eff' actions.
|
||||
-- constructors into 'Semantic' actions.
|
||||
genFreer :: Bool -> Name -> Q [Dec]
|
||||
genFreer makeSigs tcName = do
|
||||
-- The signatures for the generated definitions require FlexibleContexts.
|
||||
@ -130,7 +130,7 @@ tyVarBndrKind (PlainTV _) = Nothing
|
||||
tyVarBndrKind (KindedTV _ k) = Just k
|
||||
|
||||
-- | Generates a function type from the corresponding GADT type constructor
|
||||
-- @x :: Member (Effect e) effs => a -> b -> c -> Semantic effs r@.
|
||||
-- @x :: Member (Effect e) r => a -> b -> c -> Semantic r r@.
|
||||
genType :: Con -> Q (Type, Maybe Name, Maybe Type)
|
||||
genType (ForallC tyVarBindings conCtx con) = do
|
||||
(t, mn, _) <- genType con
|
||||
@ -143,13 +143,13 @@ genType (ForallC tyVarBindings conCtx con) = do
|
||||
, k
|
||||
)
|
||||
genType (GadtC _ tArgs' (eff `AppT` m `AppT` tRet)) = do
|
||||
effs <- newName "r"
|
||||
r <- newName "r"
|
||||
let
|
||||
tArgs = fmap snd tArgs'
|
||||
memberConstraint = ConT ''Member `AppT` eff `AppT` VarT effs
|
||||
resultType = ConT ''Semantic `AppT` VarT effs `AppT` tRet
|
||||
memberConstraint = ConT ''Member `AppT` eff `AppT` VarT r
|
||||
resultType = ConT ''Semantic `AppT` VarT r `AppT` tRet
|
||||
|
||||
replaceMType t | t == m = ConT ''Semantic `AppT` VarT effs
|
||||
replaceMType t | t == m = ConT ''Semantic `AppT` VarT r
|
||||
| otherwise = t
|
||||
ts = everywhere (mkT replaceMType) tArgs
|
||||
tn = case tRet of
|
||||
@ -158,7 +158,7 @@ genType (GadtC _ tArgs' (eff `AppT` m `AppT` tRet)) = do
|
||||
|
||||
pure
|
||||
. (, tn, Nothing)
|
||||
. ForallT [PlainTV effs] [memberConstraint]
|
||||
. ForallT [PlainTV r] [memberConstraint]
|
||||
. foldArrows
|
||||
$ ts
|
||||
++ [resultType]
|
||||
@ -178,7 +178,7 @@ simplifyBndr _ (KindedTV tv StarT) = PlainTV tv
|
||||
simplifyBndr _ bndr = bndr
|
||||
|
||||
-- | Generates a type signature of the form
|
||||
-- @x :: Member (Effect e) effs => a -> b -> c -> Semantic effs r@.
|
||||
-- @x :: Member (Effect e) r => a -> b -> c -> Semantic r r@.
|
||||
genSig :: Con -> Q Dec
|
||||
genSig con = do
|
||||
let
|
||||
|
@ -27,14 +27,22 @@ getInitialState :: forall f m r e. Semantic (WithTactics e f m r) (f ())
|
||||
getInitialState = send @(Tactics _ m (e ': r)) GetInitialState
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Lift a value into 'Tactical'.
|
||||
pureT :: a -> Tactical e m r a
|
||||
pureT a = do
|
||||
istate <- getInitialState
|
||||
pure $ a <$ istate
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Run a monadic action in a 'Tactical' environment. The stateful environment
|
||||
-- used will be the same one that the effect is initally run in. Use 'bindT' if
|
||||
-- you'd prefer to explicitly manage your stateful environment.
|
||||
runT
|
||||
:: m a
|
||||
-- ^ The monadic action to lift. This is usually a parameter in your
|
||||
-- effect.
|
||||
-> Semantic (WithTactics e f m r)
|
||||
(Semantic (e ': r) (f a))
|
||||
runT na = do
|
||||
@ -46,6 +54,11 @@ runT na = do
|
||||
|
||||
bindT
|
||||
:: (a -> m b)
|
||||
-- ^ The monadic continuation to lift. This is usually a parameter in
|
||||
-- your effect.
|
||||
--
|
||||
-- Continuations lifted via 'bindT' will run in the same environment
|
||||
-- which produced the 'a'.
|
||||
-> Semantic (WithTactics e f m r)
|
||||
(f a -> Semantic (e ': r) (f b))
|
||||
bindT f = send $ HoistInterpretation f
|
||||
|
@ -1,13 +1,12 @@
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE UndecidableSuperClasses #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Polysemy.Internal.Union
|
||||
( Union (..)
|
||||
@ -94,28 +93,15 @@ instance Effect (Union r) where
|
||||
{-# INLINE hoist #-}
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Hide the actual implementation of 'Member' from the haddock.
|
||||
class
|
||||
type Member e r = Member' e r
|
||||
|
||||
type Member' e r =
|
||||
( Find r e
|
||||
, e ~ IndexOf r (Found r e)
|
||||
#ifdef ERROR_MESSAGES
|
||||
, Break (AmbiguousSend r e) (IndexOf r (Found r e))
|
||||
#endif
|
||||
) => Member' e r
|
||||
|
||||
instance
|
||||
( Find r e
|
||||
, e ~ IndexOf r (Found r e)
|
||||
#ifdef ERROR_MESSAGES
|
||||
, Break (AmbiguousSend r e) (IndexOf r (Found r e))
|
||||
#endif
|
||||
) => Member' e r
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | A @Member e r@ constraint is a proof that the effect @e@ is available in
|
||||
-- the list of effects @r@.
|
||||
type Member = Member'
|
||||
)
|
||||
|
||||
|
||||
data Dict c where Dict :: c => Dict c
|
||||
|
Loading…
Reference in New Issue
Block a user