Improve some haddock

This commit is contained in:
Sandy Maguire 2019-04-10 00:11:16 -04:00
parent 0b627c9898
commit 1c68c3c7fb
7 changed files with 99 additions and 50 deletions

View File

@ -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

View File

@ -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 #-}

View File

@ -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

View File

@ -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))

View File

@ -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

View File

@ -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

View File

@ -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