{-# LANGUAGE DeriveFunctor, DeriveGeneric, KindSignatures #-}
module Control.Effect.Pure
( -- * Pure effect
  Pure
  -- * Pure carrier
, run
, PureC(..)
) where

import Control.Applicative
import Control.Monad.Fix
import Data.Coerce
import GHC.Generics (Generic1)

data Pure (m :: * -> *) k
  deriving ((a -> b) -> Pure m a -> Pure m b
(forall a b. (a -> b) -> Pure m a -> Pure m b)
-> (forall a b. a -> Pure m b -> Pure m a) -> Functor (Pure m)
forall a b. a -> Pure m b -> Pure m a
forall a b. (a -> b) -> Pure m a -> Pure m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> Pure m b -> Pure m a
forall (m :: * -> *) a b. (a -> b) -> Pure m a -> Pure m b
<$ :: a -> Pure m b -> Pure m a
$c<$ :: forall (m :: * -> *) a b. a -> Pure m b -> Pure m a
fmap :: (a -> b) -> Pure m a -> Pure m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> Pure m a -> Pure m b
Functor, (forall a. Pure m a -> Rep1 (Pure m) a)
-> (forall a. Rep1 (Pure m) a -> Pure m a) -> Generic1 (Pure m)
forall a. Rep1 (Pure m) a -> Pure m a
forall a. Pure m a -> Rep1 (Pure m) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall (m :: * -> *) a. Rep1 (Pure m) a -> Pure m a
forall (m :: * -> *) a. Pure m a -> Rep1 (Pure m) a
$cto1 :: forall (m :: * -> *) a. Rep1 (Pure m) a -> Pure m a
$cfrom1 :: forall (m :: * -> *) a. Pure m a -> Rep1 (Pure m) a
Generic1)


-- | Run an action exhausted of effects to produce its final result value.
run :: PureC a -> a
run :: PureC a -> a
run = PureC a -> a
forall a. PureC a -> a
runPureC
{-# INLINE run #-}

newtype PureC a = PureC { PureC a -> a
runPureC :: a }

instance Functor PureC where
  fmap :: (a -> b) -> PureC a -> PureC b
fmap = (a -> b) -> PureC a -> PureC b
forall a b. Coercible a b => a -> b
coerce
  {-# INLINE fmap #-}

  a :: a
a <$ :: a -> PureC b -> PureC a
<$ _ = a -> PureC a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  {-# INLINE (<$) #-}

instance Applicative PureC where
  pure :: a -> PureC a
pure = a -> PureC a
forall a. a -> PureC a
PureC
  {-# INLINE pure #-}

  <*> :: PureC (a -> b) -> PureC a -> PureC b
(<*>) = PureC (a -> b) -> PureC a -> PureC b
forall a b. Coercible a b => a -> b
coerce
  {-# INLINE (<*>) #-}

  liftA2 :: (a -> b -> c) -> PureC a -> PureC b -> PureC c
liftA2 = (a -> b -> c) -> PureC a -> PureC b -> PureC c
forall a b. Coercible a b => a -> b
coerce
  {-# INLINE liftA2 #-}

  _ *> :: PureC a -> PureC b -> PureC b
*> b :: PureC b
b = PureC b
b
  {-# INLINE (*>) #-}

  a :: PureC a
a <* :: PureC a -> PureC b -> PureC a
<* _ = PureC a
a
  {-# INLINE (<*) #-}

instance Monad PureC where
  return :: a -> PureC a
return = a -> PureC a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}

  PureC a :: a
a >>= :: PureC a -> (a -> PureC b) -> PureC b
>>= f :: a -> PureC b
f = a -> PureC b
f a
a
  {-# INLINE (>>=) #-}

instance MonadFix PureC where
  mfix :: (a -> PureC a) -> PureC a
mfix f :: a -> PureC a
f = a -> PureC a
forall a. a -> PureC a
PureC ((a -> a) -> a
forall a. (a -> a) -> a
fix (PureC a -> a
forall a. PureC a -> a
runPureC (PureC a -> a) -> (a -> PureC a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PureC a
f))
  {-# INLINE mfix #-}