{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Dep.Phases (
    -- * Managing phases
    Phased (..),
    liftAH,
    pullPhase,
    mapPhase,
    liftA2Phase,
    -- * Qualified do-notation for building phases
    -- $warning
    (>>=), 
    (>>),
    -- * Re-exports
    Compose (..),
    ) where


import Control.Applicative
import Data.Coerce
import Data.Function (fix)
import Data.Functor (($>), (<&>))
import Data.Functor.Identity
import Data.Kind
import Data.Proxy
import Data.String
import Data.Type.Equality (type (==))
import Data.Typeable
import GHC.Generics qualified as G
import GHC.Records
import GHC.TypeLits
import Data.Functor.Compose
import Prelude (Functor, (<$>), (<$), ($), (.))

--
--
-- Managing Phases

-- see also https://github.com/haskell/cabal/issues/7394#issuecomment-861767980

-- | Class of 2-parameter environments for which the first parameter @h@ wraps
-- each field and corresponds to phases in the construction of the environment,
-- and the second parameter @m@ is the effect monad used by each component.
--
-- @h@ will typically be a composition of applicative functors, each one
-- representing a phase. We advance through the phases by \"pulling out\" the
-- outermost phase and running it in some way, until we are are left with a
-- 'Constructor' phase, which we can remove using 'fixEnv'.
--
-- 'Phased' resembles [FunctorT, TraversableT and
-- ApplicativeT](https://hackage.haskell.org/package/barbies-2.0.3.0/docs/Data-Functor-Transformer.html)
-- from the [barbies](https://hackage.haskell.org/package/barbies) library,
-- although 'Phased' instances /can't/ be written in terms of them because of the extra 'Typeable' constraints.
type Phased :: ((Type -> Type) -> (Type -> Type) -> Type) -> Constraint
class Phased (env_ :: (Type -> Type) -> (Type -> Type) -> Type) where
  -- | Used to implement 'pullPhase' and 'mapPhase',  typically you should use those functions instead.
  traverseH ::
    forall
      (h :: Type -> Type)
      (f :: Type -> Type)
      (g :: Type -> Type)
      (m :: Type -> Type).
    ( 
      Applicative f,
      Typeable f,
      Typeable g,
      Typeable h,
      Typeable m
    ) =>
    -- | Transform to be applied to each field.
    (forall x. Typeable x => h x -> f (g x)) ->
    env_ h m ->
    f (env_ g m)
  default traverseH ::
    forall
      (h :: Type -> Type)
      (f :: Type -> Type)
      (g :: Type -> Type)
      (m :: Type -> Type).
    ( Applicative f,
      Typeable f,
      Typeable g,
      Typeable h,
      Typeable m,
      G.Generic (env_ h m),
      G.Generic (env_ g m),
      GTraverseH h g (G.Rep (env_ h m)) (G.Rep (env_ g m))
    ) =>
    -- | Transform to be applied to each field.
    (forall x. Typeable x => h x -> f (g x)) ->
    env_ h m ->
    f (env_ g m)
  traverseH forall x. Typeable x => h x -> f (g x)
t env_ h m
env = forall a x. Generic a => Rep a x -> a
G.to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k} (h :: k -> *) (g :: k -> *) (env :: k -> *)
       (env' :: k -> *) (f :: * -> *) (x :: k).
(GTraverseH h g env env', Applicative f) =>
(forall (x :: k). Typeable x => h x -> f (g x))
-> env x -> f (env' x)
gTraverseH forall x. Typeable x => h x -> f (g x)
t (forall a x. Generic a => a -> Rep a x
G.from env_ h m
env)

  -- | Used to implement 'liftA2Phase', typically you should use that function instead.
  liftA2H ::
    forall (a :: Type -> Type) (f :: Type -> Type) (f' :: Type -> Type) (m :: Type -> Type).
    ( Typeable a,
      Typeable f,
      Typeable f',
      Typeable m
    ) =>
    -- | Binary operation to combine corresponding fields.
    (forall x. Typeable x => a x -> f x -> f' x) ->
    env_ a m ->
    env_ f m ->
    env_ f' m
  default liftA2H ::
    forall (a :: Type -> Type) (f :: Type -> Type) (f' :: Type -> Type) m.
    ( Typeable a,
      Typeable f,
      Typeable f',
      Typeable m,
      G.Generic (env_ a m),
      G.Generic (env_ f m),
      G.Generic (env_ f' m),
      GLiftA2Phase a f f' (G.Rep (env_ a m)) (G.Rep (env_ f m)) (G.Rep (env_ f' m))
    ) =>
    -- | Transform to be applied to each field.
    (forall x. Typeable x => a x -> f x -> f' x) ->
    env_ a m ->
    env_ f m ->
    env_ f' m
  liftA2H forall x. Typeable x => a x -> f x -> f' x
f env_ a m
enva env_ f m
env = forall a x. Generic a => Rep a x -> a
G.to (forall {k} {k} (a :: k -> *) (f :: k -> *) (f' :: k -> *)
       (enva :: k -> *) (env :: k -> *) (env' :: k -> *) (x :: k).
GLiftA2Phase a f f' enva env env' =>
(forall (r :: k). Typeable r => a r -> f r -> f' r)
-> enva x -> env x -> env' x
gLiftA2Phase forall x. Typeable x => a x -> f x -> f' x
f (forall a x. Generic a => a -> Rep a x
G.from env_ a m
enva) (forall a x. Generic a => a -> Rep a x
G.from env_ f m
env))

-- | Slightly less powerful version of 'traverseH'.
liftAH ::
  forall deps_ phases phases' m.
  (Phased deps_, Typeable phases, Typeable phases', Typeable m) =>
  -- | Transform to be applied to each field.
  (forall x. Typeable x => phases x -> phases' x) ->
  deps_ phases m ->
  deps_ phases' m
liftAH :: forall (deps_ :: (* -> *) -> (* -> *) -> *) (phases :: * -> *)
       (phases' :: * -> *) (m :: * -> *).
(Phased deps_, Typeable phases, Typeable phases', Typeable m) =>
(forall x. Typeable x => phases x -> phases' x)
-> deps_ phases m -> deps_ phases' m
liftAH forall x. Typeable x => phases x -> phases' x
tweak =
  forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (env_ :: (* -> *) -> (* -> *) -> *) (h :: * -> *)
       (f :: * -> *) (g :: * -> *) (m :: * -> *).
(Phased env_, Applicative f, Typeable f, Typeable g, Typeable h,
 Typeable m) =>
(forall x. Typeable x => h x -> f (g x))
-> env_ h m -> f (env_ g m)
traverseH (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Typeable x => phases x -> phases' x
tweak)

-- | Take the outermost phase wrapping each component and \"pull it outwards\",
-- aggregating the phase's applicative effects.
--
-- >>> :{
--  newtype Foo d = Foo {foo :: String -> d ()} deriving Generic
--  makeIOFoo :: MonadIO m => Foo m
--  makeIOFoo = Foo (liftIO . putStrLn)
--  env :: InductiveEnv '[Foo] (IO `Compose` Constructor (InductiveEnv '[Foo] Identity IO)) IO
--  env = EmptyEnv
--      & AddDep @Foo (putStrLn "io phase" `bindPhase` \() -> constructor (\_ -> makeIOFoo))
--  ioOutside :: IO (InductiveEnv '[Foo] (Constructor (InductiveEnv '[Foo] Identity IO)) IO)
--  ioOutside = pullPhase env
-- :}
pullPhase ::
  forall (f :: Type -> Type) (g :: Type -> Type) (m :: Type -> Type) env_.
  (Phased env_, Applicative f, Typeable f, Typeable g, Typeable m) =>
  env_ (Compose f g) m ->
  -- | Environment with the outer 'Applicative' layer pulled outward.
  f (env_ g m)
-- f first to help annotate the phase
pullPhase :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *)
       (env_ :: (* -> *) -> (* -> *) -> *).
(Phased env_, Applicative f, Typeable f, Typeable g, Typeable m) =>
env_ (Compose f g) m -> f (env_ g m)
pullPhase = forall (env_ :: (* -> *) -> (* -> *) -> *) (h :: * -> *)
       (f :: * -> *) (g :: * -> *) (m :: * -> *).
(Phased env_, Applicative f, Typeable f, Typeable g, Typeable h,
 Typeable m) =>
(forall x. Typeable x => h x -> f (g x))
-> env_ h m -> f (env_ g m)
traverseH @env_ forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

-- | Modify the outermost phase wrapping each component.
--
-- >>> :{
--  newtype Foo d = Foo {foo :: String -> d ()} deriving Generic
--  makeIOFoo :: MonadIO m => Foo m
--  makeIOFoo = Foo (liftIO . putStrLn)
--  env :: InductiveEnv '[Foo] ((,) Int `Compose` Constructor String) IO
--  env = EmptyEnv
--      & AddDep @Foo ((2,()) `bindPhase` \() -> constructor (\_ -> makeIOFoo))
--  env' :: InductiveEnv '[Foo] ((,) String `Compose` Constructor String) IO
--  env' = mapPhase (\(n,x) -> (show n,x)) env
-- :}
mapPhase ::
  forall (f :: Type -> Type) (f' :: Type -> Type) (g :: Type -> Type) (m :: Type -> Type) env_.
  (Phased env_, Typeable f, Typeable f', Typeable g, Typeable m) =>
  -- | Transform to be applied to each field.
  (forall x. Typeable x => f x -> f' x) ->
  env_ (Compose f g) m ->
  env_ (Compose f' g) m
-- f' first to help annotate the *target* of the transform?
mapPhase :: forall (f :: * -> *) (f' :: * -> *) (g :: * -> *) (m :: * -> *)
       (env_ :: (* -> *) -> (* -> *) -> *).
(Phased env_, Typeable f, Typeable f', Typeable g, Typeable m) =>
(forall x. Typeable x => f x -> f' x)
-> env_ (Compose f g) m -> env_ (Compose f' g) m
mapPhase forall x. Typeable x => f x -> f' x
f env_ (Compose f g) m
env = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (env_ :: (* -> *) -> (* -> *) -> *) (h :: * -> *)
       (f :: * -> *) (g :: * -> *) (m :: * -> *).
(Phased env_, Applicative f, Typeable f, Typeable g, Typeable h,
 Typeable m) =>
(forall x. Typeable x => h x -> f (g x))
-> env_ h m -> f (env_ g m)
traverseH @env_ (\(Compose f (g x)
fg) -> forall a. a -> Identity a
Identity (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall x. Typeable x => f x -> f' x
f f (g x)
fg))) env_ (Compose f g) m
env

-- | Combine two environments with a function that works on their outermost phases.
liftA2Phase ::
  forall (a :: Type -> Type) (f' :: Type -> Type) (f :: Type -> Type) (g :: Type -> Type) (m :: Type -> Type) env_.
  (Phased env_, Typeable a, Typeable f, Typeable f', Typeable g, Typeable m) =>
  -- | Binary operation to combine corresponding fields.
  (forall x. Typeable x => a x -> f x -> f' x) ->
  env_ (Compose a g) m ->
  env_ (Compose f g) m ->
  env_ (Compose f' g) m
-- f' first to help annotate the *target* of the transform?
liftA2Phase :: forall (a :: * -> *) (f' :: * -> *) (f :: * -> *) (g :: * -> *)
       (m :: * -> *) (env_ :: (* -> *) -> (* -> *) -> *).
(Phased env_, Typeable a, Typeable f, Typeable f', Typeable g,
 Typeable m) =>
(forall x. Typeable x => a x -> f x -> f' x)
-> env_ (Compose a g) m
-> env_ (Compose f g) m
-> env_ (Compose f' g) m
liftA2Phase forall x. Typeable x => a x -> f x -> f' x
f = forall (env_ :: (* -> *) -> (* -> *) -> *) (a :: * -> *)
       (f :: * -> *) (f' :: * -> *) (m :: * -> *).
(Phased env_, Typeable a, Typeable f, Typeable f', Typeable m) =>
(forall x. Typeable x => a x -> f x -> f' x)
-> env_ a m -> env_ f m -> env_ f' m
liftA2H @env_ (\(Compose a (g x)
fa) (Compose f (g x)
fg) -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall x. Typeable x => a x -> f x -> f' x
f a (g x)
fa f (g x)
fg))

class GTraverseH h g env env' | env -> h, env' -> g where
  gTraverseH :: Applicative f => (forall x. Typeable x => h x -> f (g x)) -> env x -> f (env' x)

instance
  (GTraverseH h g fields fields') =>
  GTraverseH
    h
    g
    (G.D1 metaData (G.C1 metaCons fields))
    (G.D1 metaData (G.C1 metaCons fields'))
  where
  gTraverseH :: forall (f :: * -> *) (x :: k).
Applicative f =>
(forall (x :: k). Typeable x => h x -> f (g x))
-> D1 metaData (C1 metaCons fields) x
-> f (D1 metaData (C1 metaCons fields') x)
gTraverseH forall (x :: k). Typeable x => h x -> f (g x)
t (G.M1 (G.M1 fields x
fields)) =
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k} (h :: k -> *) (g :: k -> *) (env :: k -> *)
       (env' :: k -> *) (f :: * -> *) (x :: k).
(GTraverseH h g env env', Applicative f) =>
(forall (x :: k). Typeable x => h x -> f (g x))
-> env x -> f (env' x)
gTraverseH @h @g forall (x :: k). Typeable x => h x -> f (g x)
t fields x
fields

instance
  ( GTraverseH h g left left',
    GTraverseH h g right right'
  ) =>
  GTraverseH h g (left G.:*: right) (left' G.:*: right')
  where
  gTraverseH :: forall (f :: * -> *) (x :: k).
Applicative f =>
(forall (x :: k). Typeable x => h x -> f (g x))
-> (:*:) left right x -> f ((:*:) left' right' x)
gTraverseH forall (x :: k). Typeable x => h x -> f (g x)
t (left x
left G.:*: right x
right) =
    let left' :: f (left' x)
left' = forall {k} {k} (h :: k -> *) (g :: k -> *) (env :: k -> *)
       (env' :: k -> *) (f :: * -> *) (x :: k).
(GTraverseH h g env env', Applicative f) =>
(forall (x :: k). Typeable x => h x -> f (g x))
-> env x -> f (env' x)
gTraverseH @h @g forall (x :: k). Typeable x => h x -> f (g x)
t left x
left
        right' :: f (right' x)
right' = forall {k} {k} (h :: k -> *) (g :: k -> *) (env :: k -> *)
       (env' :: k -> *) (f :: * -> *) (x :: k).
(GTraverseH h g env env', Applicative f) =>
(forall (x :: k). Typeable x => h x -> f (g x))
-> env x -> f (env' x)
gTraverseH @h @g forall (x :: k). Typeable x => h x -> f (g x)
t right x
right
     in forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(G.:*:) f (left' x)
left' f (right' x)
right'

instance
  Typeable bean =>
  GTraverseH
    h
    g
    (G.S1 metaSel (G.Rec0 (h bean)))
    (G.S1 metaSel (G.Rec0 (g bean)))
  where
  gTraverseH :: forall (f :: * -> *) (x :: k).
Applicative f =>
(forall (x :: k). Typeable x => h x -> f (g x))
-> S1 metaSel (Rec0 (h bean)) x -> f (S1 metaSel (Rec0 (g bean)) x)
gTraverseH forall (x :: k). Typeable x => h x -> f (g x)
t (G.M1 (G.K1 h bean
hbean)) =
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
G.K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k). Typeable x => h x -> f (g x)
t h bean
hbean

--
--
class GLiftA2Phase a f f' enva env env' | enva -> a, env -> f, env' -> f' where
  gLiftA2Phase :: (forall r. Typeable r => a r -> f r -> f' r) -> enva x -> env x -> env' x

instance
  GLiftA2Phase a f f' fieldsa fields fields' =>
  GLiftA2Phase
    a
    f
    f'
    (G.D1 metaData (G.C1 metaCons fieldsa))
    (G.D1 metaData (G.C1 metaCons fields))
    (G.D1 metaData (G.C1 metaCons fields'))
  where
  gLiftA2Phase :: forall (x :: k).
(forall (r :: k). Typeable r => a r -> f r -> f' r)
-> D1 metaData (C1 metaCons fieldsa) x
-> D1 metaData (C1 metaCons fields) x
-> D1 metaData (C1 metaCons fields') x
gLiftA2Phase forall (r :: k). Typeable r => a r -> f r -> f' r
f (G.M1 (G.M1 fieldsa x
fieldsa)) (G.M1 (G.M1 fields x
fields)) =
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (forall {k} {k} (a :: k -> *) (f :: k -> *) (f' :: k -> *)
       (enva :: k -> *) (env :: k -> *) (env' :: k -> *) (x :: k).
GLiftA2Phase a f f' enva env env' =>
(forall (r :: k). Typeable r => a r -> f r -> f' r)
-> enva x -> env x -> env' x
gLiftA2Phase @a @f @f' forall (r :: k). Typeable r => a r -> f r -> f' r
f fieldsa x
fieldsa fields x
fields))

instance
  ( GLiftA2Phase a f f' lefta left left',
    GLiftA2Phase a f f' righta right right'
  ) =>
  GLiftA2Phase a f f' (lefta G.:*: righta) (left G.:*: right) (left' G.:*: right')
  where
  gLiftA2Phase :: forall (x :: k).
(forall (r :: k). Typeable r => a r -> f r -> f' r)
-> (:*:) lefta righta x
-> (:*:) left right x
-> (:*:) left' right' x
gLiftA2Phase forall (r :: k). Typeable r => a r -> f r -> f' r
f (lefta x
lefta G.:*: righta x
righta) (left x
left G.:*: right x
right) =
    let left' :: left' x
left' = forall {k} {k} (a :: k -> *) (f :: k -> *) (f' :: k -> *)
       (enva :: k -> *) (env :: k -> *) (env' :: k -> *) (x :: k).
GLiftA2Phase a f f' enva env env' =>
(forall (r :: k). Typeable r => a r -> f r -> f' r)
-> enva x -> env x -> env' x
gLiftA2Phase @a @f @f' forall (r :: k). Typeable r => a r -> f r -> f' r
f lefta x
lefta left x
left
        right' :: right' x
right' = forall {k} {k} (a :: k -> *) (f :: k -> *) (f' :: k -> *)
       (enva :: k -> *) (env :: k -> *) (env' :: k -> *) (x :: k).
GLiftA2Phase a f f' enva env env' =>
(forall (r :: k). Typeable r => a r -> f r -> f' r)
-> enva x -> env x -> env' x
gLiftA2Phase @a @f @f' forall (r :: k). Typeable r => a r -> f r -> f' r
f righta x
righta right x
right
     in forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(G.:*:) left' x
left' right' x
right'

instance
  Typeable bean =>
  GLiftA2Phase
    a
    f
    f'
    (G.S1 metaSel (G.Rec0 (a bean)))
    (G.S1 metaSel (G.Rec0 (f bean)))
    (G.S1 metaSel (G.Rec0 (f' bean)))
  where
  gLiftA2Phase :: forall (x :: k).
(forall (r :: k). Typeable r => a r -> f r -> f' r)
-> S1 metaSel (Rec0 (a bean)) x
-> S1 metaSel (Rec0 (f bean)) x
-> S1 metaSel (Rec0 (f' bean)) x
gLiftA2Phase forall (r :: k). Typeable r => a r -> f r -> f' r
f (G.M1 (G.K1 a bean
abean)) (G.M1 (G.K1 f bean
fgbean)) =
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
G.M1 (forall k i c (p :: k). c -> K1 i c p
G.K1 (forall (r :: k). Typeable r => a r -> f r -> f' r
f a bean
abean f bean
fgbean))


-- | Examples without @-XQualifiedDo@:
--
-- >>> :{
--  type Phases = IO `Compose` IO `Compose` Identity
--  phased :: Phases Int
--  phased =
--      pure 1 Dep.Phases.>>= \i1 ->
--      pure 2 Dep.Phases.>>= \i2 ->
--      pure $ i1 + i2
-- :}
--
--
-- >>> :{
-- type Phases = (IO `Compose` Maybe `Compose` Either Char) Int
-- phases :: Phases
-- phases = 
--    pure () Dep.Phases.>>= \_ ->
--    Just 5 Dep.Phases.>>= \_ ->
--    Left 'e'
-- :}
--
--
(>>=) :: Functor f => f x -> (x -> g y) -> Compose f g y
f x
f >>= :: forall {k1} (f :: * -> *) x (g :: k1 -> *) (y :: k1).
Functor f =>
f x -> (x -> g y) -> Compose f g y
>>= x -> g y
k = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (x -> g y
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x
f)

-- | Better not use this one without @-XQualifiedDo@
(>>) :: Functor f => f x -> g y -> Compose f g y
f x
f >> :: forall {k1} (f :: * -> *) x (g :: k1 -> *) (y :: k1).
Functor f =>
f x -> g y -> Compose f g y
>> g y
g = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (g y
g forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f x
f)

-- $warning
-- Convenient [qualified
-- do-notation](https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/qualified_do.html#extension-QualifiedDo)
-- for defining nested applicative phases wrapped in 'Compose's.
-- 
-- __BEWARE__! Despite its convenience, this do-notation lacks [many of the properties](https://wiki.haskell.org/Monad_laws#The_monad_laws_in_practice) 
-- we tend to assume when working with do-notation. In particular, it's 
-- NOT associative! This means that if we have 
--
-- @
-- Dep.Phases.do    
--    somePhase
--    someOtherPhase
--    finalPhase
-- @
--
-- we CAN'T refactor to
--
-- @
-- Dep.Phases.do    
--    Dep.Phases.do 
--      somePhase
--      someOtherPhase
--    finalPhase
-- @
--
-- It would indeed be useful (it would allow pre-packaging and sharing initial
-- phases as do-blocks) but it isn't supported.
--
-- __BEWARE#2__! Do not use 'return' in this do-notation.
--
-- Some valid examples:
--
-- >>> :{
-- type Phases = (IO `Compose` IO `Compose` IO) Int
-- phases :: Phases
-- phases = Dep.Phases.do
--    r1 <- pure 1
--    r2 <- pure 2
--    pure $ r1 + r2
-- :}
--
--
-- >>> :{
-- type Phases = (IO `Compose` Maybe `Compose` Either Char) Int
-- phases :: Phases
-- phases = Dep.Phases.do
--    pure ()
--    Just 5
--    Left 'e'
-- :}
--
--


-- $setup
--
-- >>> :set -XTypeApplications
-- >>> :set -XMultiParamTypeClasses
-- >>> :set -XImportQualifiedPost
-- >>> :set -XStandaloneKindSignatures
-- >>> :set -XNamedFieldPuns
-- >>> :set -XFunctionalDependencies
-- >>> :set -XFlexibleContexts
-- >>> :set -XDataKinds
-- >>> :set -XBlockArguments
-- >>> :set -XFlexibleInstances
-- >>> :set -XTypeFamilies
-- >>> :set -XDeriveGeneric
-- >>> :set -XViewPatterns
-- >>> :set -XDerivingStrategies
-- >>> :set -XDerivingVia
-- >>> :set -XDeriveAnyClass
-- >>> :set -XStandaloneDeriving
-- >>> :set -XUndecidableInstances
-- >>> :set -XTypeOperators
-- >>> :set -XScopedTypeVariables
-- >>> :set -XQualifiedDo
-- >>> :set -fno-warn-deprecations
-- >>> import Data.Kind
-- >>> import Data.Function ((&))
-- >>> import Control.Monad.IO.Class
-- >>> import Dep.Env
-- >>> import GHC.Generics (Generic)
-- >>> import Prelude hiding ((>>=), (>>))