{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BlockArguments #-}

module Data.Functor.Day.Extra where

import Data.Functor.Day
import Data.Functor.Day.Curried
import Data.Functor.Identity
import FFunctor (type (~>))

import Control.Monad.Trans.Reader
import Control.Comonad.Trans.Env
import Control.Comonad.Trans.Traced
import Control.Monad.Trans.Writer

-- @'uncurry' :: (a -> b -> c) -> (a,b) -> c@
uncurried :: forall f g h c. (Functor f, Functor g) => Curried f (Curried g h) c -> Curried (Day f g) h c
uncurried :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) c.
(Functor f, Functor g) =>
Curried f (Curried g h) c -> Curried (Day f g) h c
uncurried = (forall x. Day (Day f g) (Curried f (Curried g h)) x -> h x)
-> Curried f (Curried g h) c -> Curried (Day f g) h c
forall (g :: * -> *) (k :: * -> *) (h :: * -> *) a.
(forall x. Day g k x -> h x) -> k a -> Curried g h a
toCurried (Day g (Curried g h) x -> h x
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
Day f (Curried f g) a -> g a
applied (Day g (Curried g h) x -> h x)
-> (Day (Day f g) (Curried f (Curried g h)) x
    -> Day g (Curried g h) x)
-> Day (Day f g) (Curried f (Curried g h)) x
-> h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Day f (Curried f (Curried g h)) x -> Curried g h x)
-> Day g (Day f (Curried f (Curried g h))) x
-> Day g (Curried g h) x
forall (g :: * -> *) (h :: * -> *) (f :: * -> *) a.
(forall x. g x -> h x) -> Day f g a -> Day f h a
trans2 Day f (Curried f (Curried g h)) x -> Curried g h x
forall x. Day f (Curried f (Curried g h)) x -> Curried g h x
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
Day f (Curried f g) a -> g a
applied (Day g (Day f (Curried f (Curried g h))) x
 -> Day g (Curried g h) x)
-> (Day (Day f g) (Curried f (Curried g h)) x
    -> Day g (Day f (Curried f (Curried g h))) x)
-> Day (Day f g) (Curried f (Curried g h)) x
-> Day g (Curried g h) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day (Day g f) (Curried f (Curried g h)) x
-> Day g (Day f (Curried f (Curried g h))) x
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
Day (Day f g) h a -> Day f (Day g h) a
disassoc (Day (Day g f) (Curried f (Curried g h)) x
 -> Day g (Day f (Curried f (Curried g h))) x)
-> (Day (Day f g) (Curried f (Curried g h)) x
    -> Day (Day g f) (Curried f (Curried g h)) x)
-> Day (Day f g) (Curried f (Curried g h)) x
-> Day g (Day f (Curried f (Curried g h))) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Day f g x -> Day g f x)
-> Day (Day f g) (Curried f (Curried g h)) x
-> Day (Day g f) (Curried f (Curried g h)) x
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
(forall x. f x -> g x) -> Day f h a -> Day g h a
trans1 Day f g x -> Day g f x
forall x. Day f g x -> Day g f x
forall (f :: * -> *) (g :: * -> *) a. Day f g a -> Day g f a
swapped)

-- @'curry' :: ((a,b) -> c) -> (a -> b -> c)@
curried :: forall f g h c. (Functor f, Functor g) => Curried (Day f g) h c -> Curried f (Curried g h) c
curried :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) c.
(Functor f, Functor g) =>
Curried (Day f g) h c -> Curried f (Curried g h) c
curried = (forall x. Day f (Curried (Day f g) h) x -> Curried g h x)
-> Curried (Day f g) h c -> Curried f (Curried g h) c
forall (g :: * -> *) (k :: * -> *) (h :: * -> *) a.
(forall x. Day g k x -> h x) -> k a -> Curried g h a
toCurried ((forall x. Day g (Day f (Curried (Day f g) h)) x -> h x)
-> Day f (Curried (Day f g) h) x -> Curried g h x
forall (g :: * -> *) (k :: * -> *) (h :: * -> *) a.
(forall x. Day g k x -> h x) -> k a -> Curried g h a
toCurried (Day (Day f g) (Curried (Day f g) h) x -> h x
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
Day f (Curried f g) a -> g a
applied (Day (Day f g) (Curried (Day f g) h) x -> h x)
-> (Day g (Day f (Curried (Day f g) h)) x
    -> Day (Day f g) (Curried (Day f g) h) x)
-> Day g (Day f (Curried (Day f g) h)) x
-> h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Day g f x -> Day f g x)
-> Day (Day g f) (Curried (Day f g) h) x
-> Day (Day f g) (Curried (Day f g) h) x
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
(forall x. f x -> g x) -> Day f h a -> Day g h a
trans1 Day g f x -> Day f g x
forall x. Day g f x -> Day f g x
forall (f :: * -> *) (g :: * -> *) a. Day f g a -> Day g f a
swapped (Day (Day g f) (Curried (Day f g) h) x
 -> Day (Day f g) (Curried (Day f g) h) x)
-> (Day g (Day f (Curried (Day f g) h)) x
    -> Day (Day g f) (Curried (Day f g) h) x)
-> Day g (Day f (Curried (Day f g) h)) x
-> Day (Day f g) (Curried (Day f g) h) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day g (Day f (Curried (Day f g) h)) x
-> Day (Day g f) (Curried (Day f g) h) x
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
Day f (Day g h) a -> Day (Day f g) h a
assoc))

-- | Internal identity of natural transformation.
--
-- @ unitCurried = 'toCurried' 'elim2' @
unitCurried :: Functor g => Identity ~> Curried g g
unitCurried :: forall (g :: * -> *). Functor g => Identity ~> Curried g g
unitCurried = (forall x. Day g Identity x -> g x) -> Identity x -> Curried g g x
forall (g :: * -> *) (k :: * -> *) (h :: * -> *) a.
(forall x. Day g k x -> h x) -> k a -> Curried g h a
toCurried Day g Identity x -> g x
forall x. Day g Identity x -> g x
forall (f :: * -> *) a. Functor f => Day f Identity a -> f a
elim2

-- | Internal composition of natural transformations.
--
-- @ composeCurried = 'toCurried' ('applied' . 'trans1' 'applied' . 'assoc') @
composeCurried :: (Functor f, Functor g, Functor h) => Day (Curried f g) (Curried g h) ~> Curried f h
composeCurried :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(Functor f, Functor g, Functor h) =>
Day (Curried f g) (Curried g h) ~> Curried f h
composeCurried = (forall x. Day f (Day (Curried f g) (Curried g h)) x -> h x)
-> Day (Curried f g) (Curried g h) x -> Curried f h x
forall (g :: * -> *) (k :: * -> *) (h :: * -> *) a.
(forall x. Day g k x -> h x) -> k a -> Curried g h a
toCurried (Day g (Curried g h) x -> h x
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
Day f (Curried f g) a -> g a
applied (Day g (Curried g h) x -> h x)
-> (Day f (Day (Curried f g) (Curried g h)) x
    -> Day g (Curried g h) x)
-> Day f (Day (Curried f g) (Curried g h)) x
-> h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Day f (Curried f g) x -> g x)
-> Day (Day f (Curried f g)) (Curried g h) x
-> Day g (Curried g h) x
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
(forall x. f x -> g x) -> Day f h a -> Day g h a
trans1 Day f (Curried f g) x -> g x
forall x. Day f (Curried f g) x -> g x
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
Day f (Curried f g) a -> g a
applied (Day (Day f (Curried f g)) (Curried g h) x
 -> Day g (Curried g h) x)
-> (Day f (Day (Curried f g) (Curried g h)) x
    -> Day (Day f (Curried f g)) (Curried g h) x)
-> Day f (Day (Curried f g) (Curried g h)) x
-> Day g (Curried g h) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day f (Day (Curried f g) (Curried g h)) x
-> Day (Day f (Curried f g)) (Curried g h) x
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
Day f (Day g h) a -> Day (Day f g) h a
assoc)

-- * Conversions to Monad/Comonad transformers

dayToEnv :: Functor f => Day ((,) s0) f ~> EnvT s0 f
dayToEnv :: forall (f :: * -> *) s0. Functor f => Day ((,) s0) f ~> EnvT s0 f
dayToEnv (Day (s0
s0,b
b) f c
fc b -> c -> x
op) = s0 -> f x -> EnvT s0 f x
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT s0
s0 (b -> c -> x
op b
b (c -> x) -> f c -> f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f c
fc)

envToDay :: EnvT s0 f ~> Day ((,) s0) f 
envToDay :: forall s0 (f :: * -> *) x. EnvT s0 f x -> Day ((,) s0) f x
envToDay (EnvT s0
s0 f x
f) = (s0, x -> x) -> f x -> Day ((,) s0) f x
forall (f :: * -> *) a b (g :: * -> *).
f (a -> b) -> g a -> Day f g b
day (s0
s0, x -> x
forall a. a -> a
id) f x
f

curriedToReader :: Curried ((,) s0) f ~> ReaderT s0 f
curriedToReader :: forall s0 (f :: * -> *) x. Curried ((,) s0) f x -> ReaderT s0 f x
curriedToReader (Curried forall r. (s0, x -> r) -> f r
sf) = (s0 -> f x) -> ReaderT s0 f x
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \s0
s0 -> (s0, x -> x) -> f x
forall r. (s0, x -> r) -> f r
sf (s0
s0, x -> x
forall a. a -> a
id)

readerToCurried :: Functor f => ReaderT s0 f ~> Curried ((,) s0) f
readerToCurried :: forall (f :: * -> *) s0.
Functor f =>
ReaderT s0 f ~> Curried ((,) s0) f
readerToCurried (ReaderT s0 -> f x
sf) = (forall r. (s0, x -> r) -> f r) -> Curried ((,) s0) f x
forall (g :: * -> *) (h :: * -> *) a.
(forall r. g (a -> r) -> h r) -> Curried g h a
Curried \(s0
s0,x -> r
k) -> (x -> r) -> f x -> f r
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> r
k (s0 -> f x
sf s0
s0)

dayToTraced :: Functor f => Day ((->) s1) f ~> TracedT s1 f
dayToTraced :: forall (f :: * -> *) s1.
Functor f =>
Day ((->) s1) f ~> TracedT s1 f
dayToTraced (Day s1 -> b
sb f c
fc b -> c -> x
op) = f (s1 -> x) -> TracedT s1 f x
forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT (f (s1 -> x) -> TracedT s1 f x) -> f (s1 -> x) -> TracedT s1 f x
forall a b. (a -> b) -> a -> b
$ (c -> s1 -> x) -> f c -> f (s1 -> x)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
c s1
s -> b -> c -> x
op (s1 -> b
sb s1
s) c
c) f c
fc

tracedToDay :: TracedT s1 f ~> Day ((->) s1) f 
tracedToDay :: forall s1 (f :: * -> *) x. TracedT s1 f x -> Day ((->) s1) f x
tracedToDay (TracedT f (s1 -> x)
fk) = (s1 -> s1)
-> f (s1 -> x) -> (s1 -> (s1 -> x) -> x) -> Day ((->) s1) f x
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day s1 -> s1
forall a. a -> a
id f (s1 -> x)
fk (\s1
s s1 -> x
k -> s1 -> x
k s1
s)

curriedToWriter :: Curried ((->) s1) f ~> WriterT s1 f
curriedToWriter :: forall s1 (f :: * -> *) x. Curried ((->) s1) f x -> WriterT s1 f x
curriedToWriter (Curried forall r. (s1 -> (x -> r)) -> f r
sf) = f (x, s1) -> WriterT s1 f x
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (f (x, s1) -> WriterT s1 f x) -> f (x, s1) -> WriterT s1 f x
forall a b. (a -> b) -> a -> b
$ (s1 -> (x -> (x, s1))) -> f (x, s1)
forall r. (s1 -> (x -> r)) -> f r
sf (\s1
s x
a -> (x
a,s1
s))

writerToCurried :: Functor f => WriterT s1 f ~> Curried ((->) s1) f
writerToCurried :: forall (f :: * -> *) s1.
Functor f =>
WriterT s1 f ~> Curried ((->) s1) f
writerToCurried (WriterT f (x, s1)
fas) = (forall r. (s1 -> (x -> r)) -> f r) -> Curried ((->) s1) f x
forall (g :: * -> *) (h :: * -> *) a.
(forall r. g (a -> r) -> h r) -> Curried g h a
Curried ((forall r. (s1 -> (x -> r)) -> f r) -> Curried ((->) s1) f x)
-> (forall r. (s1 -> (x -> r)) -> f r) -> Curried ((->) s1) f x
forall a b. (a -> b) -> a -> b
$ \s1 -> (x -> r)
sar -> ((x, s1) -> r) -> f (x, s1) -> f r
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(x
a,s1
s) -> s1 -> (x -> r)
sar s1
s x
a) f (x, s1)
fas