{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
module Darcs.Util.IndexedMonad
  ( Monad(..), LiftIx(..), when, ifThenElse
  , MonadReader(..), ReaderT(..), asks
  ) where

import Darcs.Prelude hiding ( Monad(..) )

-- This is required to implement the "if then else" syntax
-- because we are using RebindableSyntax.
-- It doesn't currently exist anywhere standard: see
-- https://gitlab.haskell.org/ghc/ghc/-/issues/18081
-- It doesn't strictly belong in this module but in practice
-- we only use RebindableSyntax to allow us to use the
-- indexed monad class.
ifThenElse :: Bool -> a -> a -> a
ifThenElse :: forall a. Bool -> a -> a -> a
ifThenElse Bool
True  a
t a
_ = a
t
ifThenElse Bool
False a
_ a
e = a
e

-- At the moment the code is organised into different modules partially to
-- separate it by which Monad class we want (normal or indexed). Once qualified
-- do-notation is available (i.e. min GHC is 9.0) we can stop doing that.
-- |An alternative monad class, indexed by a "from" and "to" state.
class Monad m where
  return :: a -> m i i a
  (>>=) :: m i j a -> (a -> m j k b) -> m i k b
  (>>) :: m i j a -> m j k b -> m i k b

when :: Monad m => Bool -> m i i () -> m i i ()
when :: forall (m :: * -> * -> * -> *) i.
Monad m =>
Bool -> m i i () -> m i i ()
when Bool
b m i i ()
m = if Bool
b then m i i ()
m else () -> m i i ()
forall a i. a -> m i i a
forall (m :: * -> * -> * -> *) a i. Monad m => a -> m i i a
return ()

-- |A class for indexed monad transformers, going from normal Haskell monads
-- into our indexed monads.
class LiftIx t where
  liftIx :: m a -> t m i i a

-- |An indexed version of the standard 'MonadReader' class
class Monad m => MonadReader r m | m -> r where
  ask :: m i i r
  local :: (r -> r) -> m i i a -> m i i a

asks :: MonadReader r m => (r -> a) -> m i i a
asks :: forall r (m :: * -> * -> * -> *) a i.
MonadReader r m =>
(r -> a) -> m i i a
asks r -> a
f = m i i r
forall i. m i i r
forall r (m :: * -> * -> * -> *) i. MonadReader r m => m i i r
ask m i i r -> (r -> m i i a) -> m i i a
forall i j a k b. m i j a -> (a -> m j k b) -> m i k b
forall (m :: * -> * -> * -> *) i j a k b.
Monad m =>
m i j a -> (a -> m j k b) -> m i k b
>>= \r
r -> a -> m i i a
forall a i. a -> m i i a
forall (m :: * -> * -> * -> *) a i. Monad m => a -> m i i a
return (r -> a
f r
r)

-- |An indexed version of the standard 'ReaderT' transformer
newtype ReaderT r m i j a = ReaderT { forall r (m :: * -> * -> * -> *) i j a.
ReaderT r m i j a -> r -> m i j a
runReaderT :: r -> m i j a }

instance Monad m => Monad (ReaderT r m) where
  return :: forall a i. a -> ReaderT r m i i a
return a
v = (r -> m i i a) -> ReaderT r m i i a
forall r (m :: * -> * -> * -> *) i j a.
(r -> m i j a) -> ReaderT r m i j a
ReaderT (\r
_ -> a -> m i i a
forall a i. a -> m i i a
forall (m :: * -> * -> * -> *) a i. Monad m => a -> m i i a
return a
v)
  ReaderT r -> m i j a
m >>= :: forall i j a k b.
ReaderT r m i j a -> (a -> ReaderT r m j k b) -> ReaderT r m i k b
>>= a -> ReaderT r m j k b
f = (r -> m i k b) -> ReaderT r m i k b
forall r (m :: * -> * -> * -> *) i j a.
(r -> m i j a) -> ReaderT r m i j a
ReaderT (\r
r -> r -> m i j a
m r
r m i j a -> (a -> m j k b) -> m i k b
forall i j a k b. m i j a -> (a -> m j k b) -> m i k b
forall (m :: * -> * -> * -> *) i j a k b.
Monad m =>
m i j a -> (a -> m j k b) -> m i k b
>>= \a
a -> ReaderT r m j k b -> r -> m j k b
forall r (m :: * -> * -> * -> *) i j a.
ReaderT r m i j a -> r -> m i j a
runReaderT (a -> ReaderT r m j k b
f a
a) r
r)
  ReaderT r -> m i j a
m >> :: forall i j a k b.
ReaderT r m i j a -> ReaderT r m j k b -> ReaderT r m i k b
>> ReaderT r -> m j k b
n = (r -> m i k b) -> ReaderT r m i k b
forall r (m :: * -> * -> * -> *) i j a.
(r -> m i j a) -> ReaderT r m i j a
ReaderT (\r
r -> r -> m i j a
m r
r m i j a -> m j k b -> m i k b
forall i j a k b. m i j a -> m j k b -> m i k b
forall (m :: * -> * -> * -> *) i j a k b.
Monad m =>
m i j a -> m j k b -> m i k b
>> r -> m j k b
n r
r)

instance Monad m => MonadReader r (ReaderT r m) where
  ask :: forall i. ReaderT r m i i r
ask = (r -> m i i r) -> ReaderT r m i i r
forall r (m :: * -> * -> * -> *) i j a.
(r -> m i j a) -> ReaderT r m i j a
ReaderT r -> m i i r
forall a i. a -> m i i a
forall (m :: * -> * -> * -> *) a i. Monad m => a -> m i i a
return
  local :: forall i a. (r -> r) -> ReaderT r m i i a -> ReaderT r m i i a
local r -> r
f (ReaderT r -> m i i a
m) = (r -> m i i a) -> ReaderT r m i i a
forall r (m :: * -> * -> * -> *) i j a.
(r -> m i j a) -> ReaderT r m i j a
ReaderT (r -> m i i a
m (r -> m i i a) -> (r -> r) -> r -> m i i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> r
f)