mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 09:22:43 +03:00
3833aaaba9
During the preparation of [my talk on monad interpretation](https://www.youtube.com/watch?v=cRh56LGzwas), I realized that the interpretation technique is not lawful for monad transformers in general. This fixes that, while also simplifying the approach a little bit. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4134 GitOrigin-RevId: 7296a44185e6a87a81ac7efcdd9c7bdd9665a4e3
86 lines
3.0 KiB
Haskell
86 lines
3.0 KiB
Haskell
{-# LANGUAGE Arrows #-}
|
|
|
|
-- |
|
|
-- = TL;DR
|
|
--
|
|
-- We go from this:
|
|
--
|
|
-- > (|
|
|
-- > withRecordInconsistency
|
|
-- > ( (|
|
|
-- > modifyErrA
|
|
-- > ( do
|
|
-- > (info, dependencies) <- liftEitherA -< buildRelInfo relDef
|
|
-- > recordDependencies -< (metadataObject, schemaObject, dependencies)
|
|
-- > returnA -< info
|
|
-- > )
|
|
-- > |) (addTableContext @b table . addRelationshipContext)
|
|
-- > )
|
|
-- > |) metadataObject
|
|
--
|
|
-- to this:
|
|
--
|
|
-- > withRecordInconsistencyM metadataObject $ do
|
|
-- > modifyErr (addTableContext @b table . addRelationshipContext) $ do
|
|
-- > (info, dependencies) <- liftEither $ buildRelInfo relDef
|
|
-- > recordDependenciesM metadataObject schemaObject dependencies
|
|
-- > return info
|
|
--
|
|
-- = Background
|
|
--
|
|
-- We use Haskell's @Arrows@ language extension to gain some syntactic sugar when
|
|
-- working with `Arrow`s. `Arrow`s are a programming abstraction comparable to
|
|
-- `Monad`s.
|
|
--
|
|
-- Unfortunately the syntactic sugar provided by this language extension is not
|
|
-- very sweet.
|
|
--
|
|
-- This module allows us to sometimes avoid using @Arrows@ syntax altogether,
|
|
-- without loss of functionality or correctness. It is a demo of a technique that
|
|
-- can be used to cut down the amount of @Arrows@-based code in our codebase by
|
|
-- about half.
|
|
--
|
|
-- = Approach
|
|
--
|
|
-- Although /in general/ not every `Monad` is an `Arrow`, specific `Arrow`
|
|
-- instantiations are exactly as powerful as their `Monad` equivalents. Otherwise
|
|
-- they wouldn't be very equivalent, would they?
|
|
--
|
|
-- Just like `liftEither` interprets the @`Either` e@ monad into an arbitrary
|
|
-- monad implementing @`MonadError` e@, we add interpret certain concrete monads
|
|
-- such as @`Control.Monad.Trans.Writer.CPS.Writer` w@ into arrows satisfying
|
|
-- constraints, in this example the ones satisfying @`ArrowWriter` w@. This
|
|
-- means that the part of the code that only uses such interpretable arrow
|
|
-- effects can be written /monadically/, and then used in /arrow/ constructions
|
|
-- down the line.
|
|
--
|
|
-- This approach cannot be used for arrow effects which do not have a monadic
|
|
-- equivalent. In our codebase, the only instance of this is
|
|
-- @`Hasura.Incremental.ArrowCache` m@, implemented by the
|
|
-- @`Hasura.Incremental.Rule` m@ arrow. So code written with
|
|
-- @`Hasura.Incremental.ArrowCache` m@ in the context cannot be rewritten
|
|
-- monadically using this technique.
|
|
module Control.Arrow.Interpret
|
|
( interpretWriter,
|
|
)
|
|
where
|
|
|
|
import Control.Arrow
|
|
import Control.Arrow.Extended
|
|
import Control.Monad.Trans.Writer
|
|
|
|
-- | Translate a monadic writer effect stack of a computation into arrow-based
|
|
-- effects.
|
|
--
|
|
-- NB: This is conceptually different from `ArrowKleisli`, which /inserts/ a
|
|
-- single monadic effect into an arrow-based effect stack.
|
|
--
|
|
-- NB: This is conceptually different from `ArrowApply`, which expresses that a
|
|
-- given `Arrow` /is/ a Kleisli arrow. `ArrowInterpret` has no such condition
|
|
-- on @arr@.
|
|
interpretWriter :: ArrowWriter w arr => Writer w a `arr` a
|
|
interpretWriter = proc m -> do
|
|
let (a, w) = runWriter m
|
|
tellA -< w
|
|
returnA -< a
|