{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | 'Trail' type which makes an ordinary 'Monad' out of 'FMonad'
module Control.Monad.Trail (Trail (..)) where

import Control.Monad (ap)
import Data.Bifunctor
import FMonad

-- | For any @'FMonad' mm@, @Trail mm@ is a 'Monad'.
--
-- ==== Example
--
-- @Trail mm@ can become variantions of @Monad@ for different @FMonad mm@.
--
-- * @mm = 'FMonad.Compose.ComposePost' m@
--
--     For any @Monad m@, @Trail (ComposePost m)@ is isomorphic to @m@.
--
--     @
--     Trail (ComposePost m) a
--       ~ ComposePost m ((,) a) ()
--       ~ m (a, ())
--       ~ m a
--     @
--
-- * @mm = 'Control.Monad.Free.Free'@
--
--     @Trail Free@ is isomorphic to the list monad @[]@.
--
--     @
--     Trail Free a
--       ~ Free ((,) a) ()
--       ~ [a]
--     @
--
--
-- * @mm = 'FMonad.FreeT.FreeT'' m@
--
--     For any @Monad m@, @Trail (FreeT' m)@ is isomorphic to @ListT m@,
--     where @ListT@ is so-called \"ListT done right.\"
--
--     @
--     Trail (FreeT' m) a
--       ~ FreeT ((,) a) m ()
--       ~ ListT m a
--     @
--
--     See more for examples\/ListTVia.hs
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

-- f :: a -> b
-- first f :: forall c. (a, c) -> (b, c)

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_