{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Control.Monad.Trail (Trail (..)) where
import Control.Monad (ap)
import Data.Bifunctor
import FMonad
newtype Trail mm a = Trail {forall (mm :: (* -> *) -> * -> *) a. Trail mm a -> mm ((,) a) ()
runTrail :: mm ((,) a) ()}
instance (FFunctor mm) => Functor (Trail mm) where
fmap :: forall a b. (a -> b) -> Trail mm a -> Trail mm b
fmap a -> b
f = mm ((,) b) () -> Trail mm b
forall (mm :: (* -> *) -> * -> *) a. mm ((,) a) () -> Trail mm a
Trail (mm ((,) b) () -> Trail mm b)
-> (Trail mm a -> mm ((,) b) ()) -> Trail mm a -> Trail mm b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((,) a ~> (,) b) -> mm ((,) a) () -> mm ((,) b) ()
forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> mm g x -> mm h x
forall (ff :: (* -> *) -> * -> *) (g :: * -> *) (h :: * -> *) x.
(FFunctor ff, Functor g, Functor h) =>
(g ~> h) -> ff g x -> ff h x
ffmap ((a -> b) -> (a, x) -> (b, x)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) (mm ((,) a) () -> mm ((,) b) ())
-> (Trail mm a -> mm ((,) a) ()) -> Trail mm a -> mm ((,) b) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail mm a -> mm ((,) a) ()
forall (mm :: (* -> *) -> * -> *) a. Trail mm a -> mm ((,) a) ()
runTrail
instance (FMonad mm) => Applicative (Trail mm) where
pure :: forall a. a -> Trail mm a
pure a
a = mm ((,) a) () -> Trail mm a
forall (mm :: (* -> *) -> * -> *) a. mm ((,) a) () -> Trail mm a
Trail (mm ((,) a) () -> Trail mm a) -> mm ((,) a) () -> Trail mm a
forall a b. (a -> b) -> a -> b
$ (a, ()) -> mm ((,) a) ()
(,) a ~> mm ((,) a)
forall (g :: * -> *). Functor g => g ~> mm g
forall (ff :: (* -> *) -> * -> *) (g :: * -> *).
(FMonad ff, Functor g) =>
g ~> ff g
fpure (a
a, ())
<*> :: forall a b. Trail mm (a -> b) -> Trail mm a -> Trail mm b
(<*>) = Trail mm (a -> b) -> Trail mm a -> Trail mm b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (FMonad mm) => Monad (Trail mm) where
Trail mm a
ma >>= :: forall a b. Trail mm a -> (a -> Trail mm b) -> Trail mm b
>>= a -> Trail mm b
k = mm ((,) b) () -> Trail mm b
forall (mm :: (* -> *) -> * -> *) a. mm ((,) a) () -> Trail mm a
Trail (mm ((,) b) () -> Trail mm b)
-> (Trail mm a -> mm ((,) b) ()) -> Trail mm a -> Trail mm b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. mm (mm ((,) b)) () -> mm ((,) b) ()
mm (mm ((,) b)) ~> mm ((,) b)
forall (ff :: (* -> *) -> * -> *) (g :: * -> *).
(FMonad ff, Functor g) =>
ff (ff g) ~> ff g
fjoin (mm (mm ((,) b)) () -> mm ((,) b) ())
-> (Trail mm a -> mm (mm ((,) b)) ())
-> Trail mm a
-> mm ((,) b) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((,) a ~> mm ((,) b)) -> mm ((,) a) () -> mm (mm ((,) b)) ()
forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> mm g x -> mm h x
forall (ff :: (* -> *) -> * -> *) (g :: * -> *) (h :: * -> *) x.
(FFunctor ff, Functor g, Functor h) =>
(g ~> h) -> ff g x -> ff h x
ffmap ((mm ((,) b) (), x) -> mm ((,) b) x
forall (f :: * -> *) x. Functor f => (f (), x) -> f x
plug ((mm ((,) b) (), x) -> mm ((,) b) x)
-> ((a, x) -> (mm ((,) b) (), x)) -> (a, x) -> mm ((,) b) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> mm ((,) b) ()) -> (a, x) -> (mm ((,) b) (), x)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Trail mm b -> mm ((,) b) ()
forall (mm :: (* -> *) -> * -> *) a. Trail mm a -> mm ((,) a) ()
runTrail (Trail mm b -> mm ((,) b) ())
-> (a -> Trail mm b) -> a -> mm ((,) b) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Trail mm b
k)) (mm ((,) a) () -> mm (mm ((,) b)) ())
-> (Trail mm a -> mm ((,) a) ())
-> Trail mm a
-> mm (mm ((,) b)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail mm a -> mm ((,) a) ()
forall (mm :: (* -> *) -> * -> *) a. Trail mm a -> mm ((,) a) ()
runTrail (Trail mm a -> Trail mm b) -> Trail mm a -> Trail mm b
forall a b. (a -> b) -> a -> b
$ Trail mm a
ma
plug :: forall f x. Functor f => (f (), x) -> f x
plug :: forall (f :: * -> *) x. Functor f => (f (), x) -> f x
plug (f ()
f_, x
a) = x
a x -> f () -> f x
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
f_