{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module provides definitions that let us translate record-of-functions code of the form:

--

-- >>> :{ 

--  type HasLogger :: (Type -> Type) -> Type -> Constraint

--  class HasLogger d e | e -> d where

--    logger :: e -> String -> d ()

--  type HasRepository :: (Type -> Type) -> Type -> Constraint

--  class HasRepository d e | e -> d where

--    repository :: e -> Int -> d ()

--  mkControllerIO :: (HasLogger IO e, HasRepository IO e) => Int -> ReaderT e IO String

--  mkControllerIO x = do

--    e <- ask

--    liftIO $ logger e "I'm going to insert in the db!"

--    liftIO $ repository e x

--    return "view"

-- :}

--

-- into the more polymorphic form:

--

-- >>> :{

--  mkController :: MonadDep [HasLogger, HasRepository] d e m => Int -> m String

--  mkController x = do

--    e <- ask

--    liftD $ logger e "I'm going to insert in the db!"

--    liftD $ repository e x

--    return "view"

-- :}

--

-- which can also be given the equivalent signature:

--

-- >>> :{

--    mkController' :: (HasLogger d e, HasRepository d e, LiftDep d m, MonadReader e m) => Int -> m String

--    mkController' = mkController

-- :}   

--

-- The new code can be used as a drop-in replacement of the old one: 

--

-- >>> :{ 

--    mkControllerIO' :: (HasLogger IO e, HasRepository IO e) => Int -> ReaderT e IO String

--    mkControllerIO' = mkController'

-- :}

--

-- Notice that in the new code effects taken from the environment record are

-- lifted using 'liftD' instead of 'lift' or 'liftIO'. 

--

module Control.Monad.Dep.Class
  ( -- * Reader-like monads carrying dependencies in their environment

    MonadDep,

    -- * Lifting effects from dependencies

    LiftDep (..),
    -- * Helpers

    useEnv
  )
where

import Control.Monad.Reader
import Data.Kind

-- $setup

--

-- >>> :set -XTypeApplications

-- >>> :set -XMultiParamTypeClasses

-- >>> :set -XImportQualifiedPost

-- >>> :set -XTemplateHaskell

-- >>> :set -XStandaloneKindSignatures

-- >>> :set -XNamedFieldPuns

-- >>> :set -XFunctionalDependencies

-- >>> :set -XFlexibleContexts

-- >>> :set -XDataKinds

-- >>> import Control.Monad.Reader

-- >>> import Control.Monad.Dep

-- >>> import Rank2 qualified

-- >>> import Rank2.TH qualified

--



-- | Auxiliary typeclass for monads that can be lifted to other monads.

--

-- Its intended use is lifting monadic actions found in some reader-like

-- environment.

--

-- __Note:__ The @RIO@ monad from <http://hackage.haskell.org/package/rio rio> could be

-- given a @LiftDept IO RIO@ instance; it's not done here to avoid increasing

-- the dependency footprint.

type LiftDep :: (Type -> Type) -> (Type -> Type) -> Constraint
class Monad d => LiftDep d m where
  liftD :: d x -> m x

-- | The simplest case: we can d-lift the base monad sitting just below a 'ReaderT'.

--

-- (Perhaps this could be extended to any monad transformer, but let's leave it simple for now.)

instance Monad m => LiftDep m (ReaderT e m) where
  liftD :: m x -> ReaderT e m x
liftD = m x -> ReaderT e m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- Trying to write a general "lift from anywhere in the stack" like

-- instance (Monad m, LiftDep below m, MonadTrans t) => LiftDep below (t m)

-- caused OverlappedInstances problems with DepT.

-- Lot let's not try to be *excessively* general.


-- -- | Any monad can be \"lifted\" to itself.

-- Better limit this to DepT

-- instance LiftDep m m where

--   liftD = id


-- | 'MonadDep' is not its own typeclass, but 'MonadReader' plus some supplementary constraints. 

--

-- A @MonadDep dependencies d e m@ is a @MonadReader e m@ where the environment

-- @e@ provides some @dependencies@ with effects in the monad @d@, additionally requiring that the 

-- effects can be lifted back to the monad @m@ by using 'liftD'.

--

-- The @dependencies@ are specified as a type-level list of two-parameter

-- @HasX@ typeclasses. Those typeclasses should expect the effect monad

-- @d@ as its first parameter.

--

-- Writing code polymorphic over 'MonadDep' lets us execute it in both 'ReaderT' and 'Control.Monad.Dep.DepT' contexts.

type MonadDep ::
  [(Type -> Type) -> Type -> Constraint] ->
  (Type -> Type) ->
  Type ->
  (Type -> Type) ->
  Constraint
type family MonadDep (dependencies :: [(Type -> Type) -> Type -> Constraint]) (d :: Type -> Type) (e :: Type) (m :: Type -> Type) where
  MonadDep '[] d e m = (LiftDep d m, MonadReader e m)
  MonadDep (dependency ': dependencies) d e m = (dependency d e, MonadDep dependencies d e m)

-- | Avoids repeated calls to 'liftD' when all the effects in a function come from the environment.

useEnv :: forall d e m r. (LiftDep d m, MonadReader e m) => (e -> d r) -> m r
useEnv :: (e -> d r) -> m r
useEnv e -> d r
f = do
  e
e <- m e
forall r (m :: * -> *). MonadReader r m => m r
ask
  d r -> m r
forall (d :: * -> *) (m :: * -> *) x. LiftDep d m => d x -> m x
liftD (e -> d r
f e
e)