{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeOperators #-}

module Data.Functor.Precompose where

import Data.Kind (Type)

import Control.Applicative (Alternative)
import Control.Monad (join)
import Control.Comonad(Comonad(..))
import Data.Functor.Classes (Eq1, Ord1)
import Data.Functor.Compose ( Compose(..) )

import FMonad
import FComonad

-- | Single-kinded type alias of Compose
type (:.:) :: (Type -> Type) -> (Type -> Type) -> Type -> Type
type (:.:) = Compose

-- | Flipped-order Compose.
--
-- When @f@ is a @Monad@, @Precompose f@ is a 'FMonad' in the similar way 'Compose' is.
--
-- The only difference is @Precompose f@ composes @f@ to the right (_pre_compose)
-- compared to @Compose f@ which composes to the left (_post_compose).
type Precompose :: (j -> k) -> (k -> Type) -> j -> Type
newtype Precompose f g a = Precompose {forall j k (f :: j -> k) (g :: k -> *) (a :: j).
Precompose f g a -> g (f a)
getPrecompose :: g (f a)}
  deriving stock (Int -> Precompose f g a -> ShowS
[Precompose f g a] -> ShowS
Precompose f g a -> String
(Int -> Precompose f g a -> ShowS)
-> (Precompose f g a -> String)
-> ([Precompose f g a] -> ShowS)
-> Show (Precompose f g a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Show (g (f a)) =>
Int -> Precompose f g a -> ShowS
forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Show (g (f a)) =>
[Precompose f g a] -> ShowS
forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Show (g (f a)) =>
Precompose f g a -> String
$cshowsPrec :: forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Show (g (f a)) =>
Int -> Precompose f g a -> ShowS
showsPrec :: Int -> Precompose f g a -> ShowS
$cshow :: forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Show (g (f a)) =>
Precompose f g a -> String
show :: Precompose f g a -> String
$cshowList :: forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Show (g (f a)) =>
[Precompose f g a] -> ShowS
showList :: [Precompose f g a] -> ShowS
Show, ReadPrec [Precompose f g a]
ReadPrec (Precompose f g a)
Int -> ReadS (Precompose f g a)
ReadS [Precompose f g a]
(Int -> ReadS (Precompose f g a))
-> ReadS [Precompose f g a]
-> ReadPrec (Precompose f g a)
-> ReadPrec [Precompose f g a]
-> Read (Precompose f g a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Read (g (f a)) =>
ReadPrec [Precompose f g a]
forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Read (g (f a)) =>
ReadPrec (Precompose f g a)
forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Read (g (f a)) =>
Int -> ReadS (Precompose f g a)
forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Read (g (f a)) =>
ReadS [Precompose f g a]
$creadsPrec :: forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Read (g (f a)) =>
Int -> ReadS (Precompose f g a)
readsPrec :: Int -> ReadS (Precompose f g a)
$creadList :: forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Read (g (f a)) =>
ReadS [Precompose f g a]
readList :: ReadS [Precompose f g a]
$creadPrec :: forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Read (g (f a)) =>
ReadPrec (Precompose f g a)
readPrec :: ReadPrec (Precompose f g a)
$creadListPrec :: forall k j (f :: j -> k) (g :: k -> *) (a :: j).
Read (g (f a)) =>
ReadPrec [Precompose f g a]
readListPrec :: ReadPrec [Precompose f g a]
Read, (forall a b. (a -> b) -> Precompose f g a -> Precompose f g b)
-> (forall a b. a -> Precompose f g b -> Precompose f g a)
-> Functor (Precompose f g)
forall a b. a -> Precompose f g b -> Precompose f g a
forall a b. (a -> b) -> Precompose f g a -> Precompose f g b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (f :: * -> *) (g :: * -> *) a b.
(Functor g, Functor f) =>
a -> Precompose f g b -> Precompose f g a
forall (f :: * -> *) (g :: * -> *) a b.
(Functor g, Functor f) =>
(a -> b) -> Precompose f g a -> Precompose f g b
$cfmap :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor g, Functor f) =>
(a -> b) -> Precompose f g a -> Precompose f g b
fmap :: forall a b. (a -> b) -> Precompose f g a -> Precompose f g b
$c<$ :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor g, Functor f) =>
a -> Precompose f g b -> Precompose f g a
<$ :: forall a b. a -> Precompose f g b -> Precompose f g a
Functor, (forall m. Monoid m => Precompose f g m -> m)
-> (forall m a. Monoid m => (a -> m) -> Precompose f g a -> m)
-> (forall m a. Monoid m => (a -> m) -> Precompose f g a -> m)
-> (forall a b. (a -> b -> b) -> b -> Precompose f g a -> b)
-> (forall a b. (a -> b -> b) -> b -> Precompose f g a -> b)
-> (forall b a. (b -> a -> b) -> b -> Precompose f g a -> b)
-> (forall b a. (b -> a -> b) -> b -> Precompose f g a -> b)
-> (forall a. (a -> a -> a) -> Precompose f g a -> a)
-> (forall a. (a -> a -> a) -> Precompose f g a -> a)
-> (forall a. Precompose f g a -> [a])
-> (forall a. Precompose f g a -> Bool)
-> (forall a. Precompose f g a -> Int)
-> (forall a. Eq a => a -> Precompose f g a -> Bool)
-> (forall a. Ord a => Precompose f g a -> a)
-> (forall a. Ord a => Precompose f g a -> a)
-> (forall a. Num a => Precompose f g a -> a)
-> (forall a. Num a => Precompose f g a -> a)
-> Foldable (Precompose f g)
forall a. Eq a => a -> Precompose f g a -> Bool
forall a. Num a => Precompose f g a -> a
forall a. Ord a => Precompose f g a -> a
forall m. Monoid m => Precompose f g m -> m
forall a. Precompose f g a -> Bool
forall a. Precompose f g a -> Int
forall a. Precompose f g a -> [a]
forall a. (a -> a -> a) -> Precompose f g a -> a
forall m a. Monoid m => (a -> m) -> Precompose f g a -> m
forall b a. (b -> a -> b) -> b -> Precompose f g a -> b
forall a b. (a -> b -> b) -> b -> Precompose f g a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f, Eq a) =>
a -> Precompose f g a -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f, Num a) =>
Precompose f g a -> a
forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f, Ord a) =>
Precompose f g a -> a
forall (f :: * -> *) (g :: * -> *) m.
(Foldable g, Foldable f, Monoid m) =>
Precompose f g m -> m
forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f) =>
Precompose f g a -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f) =>
Precompose f g a -> Int
forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f) =>
Precompose f g a -> [a]
forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f) =>
(a -> a -> a) -> Precompose f g a -> a
forall (f :: * -> *) (g :: * -> *) m a.
(Foldable g, Foldable f, Monoid m) =>
(a -> m) -> Precompose f g a -> m
forall (f :: * -> *) (g :: * -> *) b a.
(Foldable g, Foldable f) =>
(b -> a -> b) -> b -> Precompose f g a -> b
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable g, Foldable f) =>
(a -> b -> b) -> b -> Precompose f g a -> b
$cfold :: forall (f :: * -> *) (g :: * -> *) m.
(Foldable g, Foldable f, Monoid m) =>
Precompose f g m -> m
fold :: forall m. Monoid m => Precompose f g m -> m
$cfoldMap :: forall (f :: * -> *) (g :: * -> *) m a.
(Foldable g, Foldable f, Monoid m) =>
(a -> m) -> Precompose f g a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Precompose f g a -> m
$cfoldMap' :: forall (f :: * -> *) (g :: * -> *) m a.
(Foldable g, Foldable f, Monoid m) =>
(a -> m) -> Precompose f g a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Precompose f g a -> m
$cfoldr :: forall (f :: * -> *) (g :: * -> *) a b.
(Foldable g, Foldable f) =>
(a -> b -> b) -> b -> Precompose f g a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Precompose f g a -> b
$cfoldr' :: forall (f :: * -> *) (g :: * -> *) a b.
(Foldable g, Foldable f) =>
(a -> b -> b) -> b -> Precompose f g a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Precompose f g a -> b
$cfoldl :: forall (f :: * -> *) (g :: * -> *) b a.
(Foldable g, Foldable f) =>
(b -> a -> b) -> b -> Precompose f g a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Precompose f g a -> b
$cfoldl' :: forall (f :: * -> *) (g :: * -> *) b a.
(Foldable g, Foldable f) =>
(b -> a -> b) -> b -> Precompose f g a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Precompose f g a -> b
$cfoldr1 :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f) =>
(a -> a -> a) -> Precompose f g a -> a
foldr1 :: forall a. (a -> a -> a) -> Precompose f g a -> a
$cfoldl1 :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f) =>
(a -> a -> a) -> Precompose f g a -> a
foldl1 :: forall a. (a -> a -> a) -> Precompose f g a -> a
$ctoList :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f) =>
Precompose f g a -> [a]
toList :: forall a. Precompose f g a -> [a]
$cnull :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f) =>
Precompose f g a -> Bool
null :: forall a. Precompose f g a -> Bool
$clength :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f) =>
Precompose f g a -> Int
length :: forall a. Precompose f g a -> Int
$celem :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f, Eq a) =>
a -> Precompose f g a -> Bool
elem :: forall a. Eq a => a -> Precompose f g a -> Bool
$cmaximum :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f, Ord a) =>
Precompose f g a -> a
maximum :: forall a. Ord a => Precompose f g a -> a
$cminimum :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f, Ord a) =>
Precompose f g a -> a
minimum :: forall a. Ord a => Precompose f g a -> a
$csum :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f, Num a) =>
Precompose f g a -> a
sum :: forall a. Num a => Precompose f g a -> a
$cproduct :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable g, Foldable f, Num a) =>
Precompose f g a -> a
product :: forall a. Num a => Precompose f g a -> a
Foldable)

deriving stock instance (Traversable f, Traversable g) => Traversable (Precompose f g)

deriving via
  ((g :.: f) a)
  instance
    (Eq1 f, Eq1 g, Eq a) => Eq (Precompose f g a)

deriving via
  ((g :.: f) a)
  instance
    (Ord1 f, Ord1 g, Ord a) => Ord (Precompose f g a)

deriving via
  (g :.: f)
  instance
    (Eq1 f, Eq1 g) => Eq1 (Precompose f g)

deriving via
  (g :.: f)
  instance
    (Ord1 f, Ord1 g) => Ord1 (Precompose f g)

deriving via
  (g :.: f)
  instance
    (Applicative f, Applicative g) => Applicative (Precompose f g)

deriving via
  (g :.: f)
  instance
    (Applicative f, Alternative g) => Alternative (Precompose f g)

instance Functor f => FFunctor (Precompose f) where
  ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Precompose f g x -> Precompose f h x
ffmap g ~> h
gh = h (f x) -> Precompose f h x
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
g (f a) -> Precompose f g a
Precompose (h (f x) -> Precompose f h x)
-> (Precompose f g x -> h (f x))
-> Precompose f g x
-> Precompose f h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g (f x) -> h (f x)
g ~> h
gh (g (f x) -> h (f x))
-> (Precompose f g x -> g (f x)) -> Precompose f g x -> h (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precompose f g x -> g (f x)
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
Precompose f g a -> g (f a)
getPrecompose

instance Monad f => FMonad (Precompose f) where
  fpure :: forall (g :: * -> *). Functor g => g ~> Precompose f g
fpure = g (f x) -> Precompose f g x
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
g (f a) -> Precompose f g a
Precompose (g (f x) -> Precompose f g x)
-> (g x -> g (f x)) -> g x -> Precompose f g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> f x) -> g x -> g (f x)
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> f x
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return
  fbind :: forall (g :: * -> *) (h :: * -> *) a.
(Functor g, Functor h) =>
(g ~> Precompose f h) -> Precompose f g a -> Precompose f h a
fbind g ~> Precompose f h
k = h (f a) -> Precompose f h a
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
g (f a) -> Precompose f g a
Precompose (h (f a) -> Precompose f h a)
-> (Precompose f g a -> h (f a))
-> Precompose f g a
-> Precompose f h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (f a) -> f a) -> h (f (f a)) -> h (f a)
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (f a) -> f a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (h (f (f a)) -> h (f a))
-> (Precompose f g a -> h (f (f a))) -> Precompose f g a -> h (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precompose f h (f a) -> h (f (f a))
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
Precompose f g a -> g (f a)
getPrecompose (Precompose f h (f a) -> h (f (f a)))
-> (Precompose f g a -> Precompose f h (f a))
-> Precompose f g a
-> h (f (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g (f a) -> Precompose f h (f a)
g ~> Precompose f h
k (g (f a) -> Precompose f h (f a))
-> (Precompose f g a -> g (f a))
-> Precompose f g a
-> Precompose f h (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precompose f g a -> g (f a)
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
Precompose f g a -> g (f a)
getPrecompose

instance Comonad f => FComonad (Precompose f) where
  fextract :: forall (g :: * -> *). Functor g => Precompose f g ~> g
fextract = (f x -> x) -> g (f x) -> g x
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> x
forall a. f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (g (f x) -> g x)
-> (Precompose f g x -> g (f x)) -> Precompose f g x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precompose f g x -> g (f x)
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
Precompose f g a -> g (f a)
getPrecompose
  fextend :: forall (g :: * -> *) (h :: * -> *).
(Functor g, Functor h) =>
(Precompose f g ~> h) -> Precompose f g ~> Precompose f h
fextend Precompose f g ~> h
tr = h (f x) -> Precompose f h x
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
g (f a) -> Precompose f g a
Precompose (h (f x) -> Precompose f h x)
-> (Precompose f g x -> h (f x))
-> Precompose f g x
-> Precompose f h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precompose f g (f x) -> h (f x)
Precompose f g ~> h
tr (Precompose f g (f x) -> h (f x))
-> (Precompose f g x -> Precompose f g (f x))
-> Precompose f g x
-> h (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g (f (f x)) -> Precompose f g (f x)
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
g (f a) -> Precompose f g a
Precompose (g (f (f x)) -> Precompose f g (f x))
-> (Precompose f g x -> g (f (f x)))
-> Precompose f g x
-> Precompose f g (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f x -> f (f x)) -> g (f x) -> g (f (f x))
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> f (f x)
forall a. f a -> f (f a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate (g (f x) -> g (f (f x)))
-> (Precompose f g x -> g (f x)) -> Precompose f g x -> g (f (f x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precompose f g x -> g (f x)
forall j k (f :: j -> k) (g :: k -> *) (a :: j).
Precompose f g a -> g (f a)
getPrecompose