{-# LANGUAGE DerivingVia #-}

-- |
-- Module      : Data.Functor.Contravariant.Divisible.Free
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Provides free structures for the various typeclasses of the 'Divisible'
-- hierarchy.
--
-- @since 0.3.0.0
module Data.Functor.Contravariant.Divisible.Free (
    Div(.., Conquer, Divide)
  , hoistDiv, liftDiv, runDiv
  , divListF, listFDiv
  , Div1(.., Div1_)
  , hoistDiv1, liftDiv1, toDiv, runDiv1
  , div1NonEmptyF, nonEmptyFDiv1
  , Dec(..)
  , hoistDec, liftDec, runDec
  , Dec1(..)
  , hoistDec1, liftDec1, toDec, runDec1
  ) where

import           Control.Applicative.ListF
import           Control.Natural
import           Data.Bifunctor
import           Data.Bifunctor.Assoc
import           Data.Foldable
import           Data.Functor.Apply
import           Data.Functor.Contravariant
import           Data.Functor.Contravariant.Conclude
import           Data.Functor.Contravariant.Coyoneda
import           Data.Functor.Contravariant.Decide
import           Data.Functor.Contravariant.Divise
import           Data.Functor.Contravariant.Divisible
import           Data.Functor.Invariant
import           Data.Functor.Invariant.Inplicative
import           Data.Functor.Invariant.Internative
import           Data.HFunctor
import           Data.HFunctor.HTraversable
import           Data.HFunctor.Interpret
import           Data.Kind
import           Data.List.NonEmpty                   (NonEmpty(..))
import           Data.Semigroup.Traversable
import           Data.Void
import qualified Control.Monad.Trans.Compose          as CT
import qualified Data.Functor.Contravariant.Day       as CD

-- | The free 'Divisible'.  Used to sequence multiple contravariant
-- consumers, splitting out the input across all consumers.
--
-- This type is essentially 'ListF'; the only reason why it has to exist
-- separately outside of 'ListF' is because the current typeclass hierarchy
-- isn't compatible with both the covariant 'Interpret' instance (requiring
-- 'Plus') and the contravariant 'Interpret' instance (requiring
-- 'Divisible').
--
-- The wrapping in 'Coyoneda' is also to provide a usable
-- 'Data.HBifunctor.Associative.Associative' instance for the contravariant
-- 'CD.Day'.
newtype Div f a = Div { forall (f :: * -> *) a. Div f a -> [Coyoneda f a]
unDiv :: [Coyoneda f a] }
  deriving (forall b a. b -> Div f b -> Div f a
forall a' a. (a' -> a) -> Div f a -> Div f a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
forall (f :: * -> *) b a. b -> Div f b -> Div f a
forall (f :: * -> *) a' a. (a' -> a) -> Div f a -> Div f a'
>$ :: forall b a. b -> Div f b -> Div f a
$c>$ :: forall (f :: * -> *) b a. b -> Div f b -> Div f a
contramap :: forall a' a. (a' -> a) -> Div f a -> Div f a'
$ccontramap :: forall (f :: * -> *) a' a. (a' -> a) -> Div f a -> Div f a'
Contravariant, forall a b. Div f a -> Div f b -> Div f (a, b)
forall a b c. (a -> (b, c)) -> Div f b -> Div f c -> Div f a
forall (f :: * -> *). Contravariant (Div f)
forall (f :: * -> *).
Contravariant f
-> (forall a b c. (a -> (b, c)) -> f b -> f c -> f a)
-> (forall a b. f a -> f b -> f (a, b))
-> Divise f
forall (f :: * -> *) a b. Div f a -> Div f b -> Div f (a, b)
forall (f :: * -> *) a b c.
(a -> (b, c)) -> Div f b -> Div f c -> Div f a
divised :: forall a b. Div f a -> Div f b -> Div f (a, b)
$cdivised :: forall (f :: * -> *) a b. Div f a -> Div f b -> Div f (a, b)
divise :: forall a b c. (a -> (b, c)) -> Div f b -> Div f c -> Div f a
$cdivise :: forall (f :: * -> *) a b c.
(a -> (b, c)) -> Div f b -> Div f c -> Div f a
Divise, forall a. Div f a
forall a b c. (a -> (b, c)) -> Div f b -> Div f c -> Div f a
forall (f :: * -> *). Contravariant (Div f)
forall (f :: * -> *).
Contravariant f
-> (forall a b c. (a -> (b, c)) -> f b -> f c -> f a)
-> (forall a. f a)
-> Divisible f
forall (f :: * -> *) a. Div f a
forall (f :: * -> *) a b c.
(a -> (b, c)) -> Div f b -> Div f c -> Div f a
conquer :: forall a. Div f a
$cconquer :: forall (f :: * -> *) a. Div f a
divide :: forall a b c. (a -> (b, c)) -> Div f b -> Div f c -> Div f a
$cdivide :: forall (f :: * -> *) a b c.
(a -> (b, c)) -> Div f b -> Div f c -> Div f a
Divisible) via (ListF (Coyoneda f))
  deriving (forall {k} {k1} (t :: (k -> *) -> k1 -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div f ~> Div g
hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div f ~> Div g
$chmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div f ~> Div g
HFunctor, HFunctor Div
forall {k} (t :: (k -> *) -> k -> *).
HFunctor t -> (forall (f :: k -> *). f ~> t f) -> Inject t
forall (f :: * -> *) x. f x -> Div f x
inject :: forall (f :: * -> *) x. f x -> Div f x
$cinject :: forall (f :: * -> *) x. f x -> Div f x
Inject) via (CT.ComposeT ListF Coyoneda)

instance HTraversable Div where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Div f a -> h (Div g a)
htraverse forall x. f x -> h (g x)
f (Div [Coyoneda f a]
xs) = forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall x. f x -> h (g x)
f) [Coyoneda f a]
xs

instance Invariant (Div f) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Div f a -> Div f b
invmap a -> b
_ = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap

deriving via WrappedDivisible (Div f) instance Inply (Div f)
deriving via WrappedDivisible (Div f) instance Inplicative (Div f)

-- | Pattern matching on an empty 'Div'.
--
-- Before v0.3.3.0, this used to be the concrete constructor of 'Div'.
-- After, it is now an abstract pattern.
pattern Conquer :: Div f a
pattern $bConquer :: forall (f :: * -> *) a. Div f a
$mConquer :: forall {r} {f :: * -> *} {a}.
Div f a -> ((# #) -> r) -> ((# #) -> r) -> r
Conquer = Div []

-- | Pattern matching on a non-empty 'Div', exposing the raw @f@ instead of
-- having it wrapped in a 'Coyoneda'.  This is the analogue of
-- 'Control.Applicative.Free.Pure' and essentially treats the "cons" of the
-- 'Div' as a contravariant day convolution.
--
-- Before v0.3.3.0, this used to be the concrete constructor of 'Div'.
-- After, it is now an abstract pattern.
pattern Divide :: (a -> (b, c)) -> f b -> Div f c -> Div f a
pattern $bDivide :: forall a (f :: * -> *) b c.
(a -> (b, c)) -> f b -> Div f c -> Div f a
$mDivide :: forall {r} {a} {f :: * -> *}.
Div f a
-> (forall {b} {c}. (a -> (b, c)) -> f b -> Div f c -> r)
-> ((# #) -> r)
-> r
Divide f x xs <- (divDay_ -> Just (CD.Day x xs f))
  where
    Divide a -> (b, c)
f f b
x (Div [Coyoneda f c]
xs) = forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div forall a b. (a -> b) -> a -> b
$ forall a b (f :: * -> *). (a -> b) -> f b -> Coyoneda f a
Coyoneda (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) f b
x forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap) (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) [Coyoneda f c]
xs
{-# COMPLETE Conquer, Divide #-}

divDay_ :: Div f a -> Maybe (CD.Day f (Div f) a)
divDay_ :: forall (f :: * -> *) a. Div f a -> Maybe (Day f (Div f) a)
divDay_ (Div []) = forall a. Maybe a
Nothing
divDay_ (Div (Coyoneda a -> b
f f b
x : [Coyoneda f a]
xs)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (a -> (b, c)) -> Day f g a
CD.Day f b
x (forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div [Coyoneda f a]
xs) (\a
y -> (a -> b
f a
y, a
y))

-- | 'Div' is isomorphic to 'ListF' for contravariant @f@.  This witnesses
-- one way of that isomorphism.
divListF :: forall f. Contravariant f => Div f ~> ListF f
divListF :: forall (f :: * -> *). Contravariant f => Div f ~> ListF f
divListF = forall {k} (f :: k -> *) (a :: k). [f a] -> ListF f a
ListF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Contravariant f => Coyoneda f a -> f a
lowerCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Div f a -> [Coyoneda f a]
unDiv

-- | 'Div' is isomorphic to 'ListF' for contravariant @f@.  This witnesses
-- one way of that isomorphism.
listFDiv :: ListF f ~> Div f
listFDiv :: forall (f :: * -> *). ListF f ~> Div f
listFDiv = forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). ListF f a -> [f a]
runListF

-- | Map over the undering context in a 'Div'.
hoistDiv :: forall f g. (f ~> g) -> Div f ~> Div g
hoistDiv :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div f ~> Div g
hoistDiv = forall {k} {k1} (t :: (k -> *) -> k1 -> *) (f :: k -> *)
       (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap

-- | Inject a single action in @f@ into a @'Div' f@.
liftDiv :: f ~> Div f
liftDiv :: forall (f :: * -> *) x. f x -> Div f x
liftDiv = forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject

-- | Interpret a 'Div' into a context @g@, provided @g@ is 'Divisible'.
runDiv :: forall f g. Divisible g => (f ~> g) -> Div f ~> g
runDiv :: forall (f :: * -> *) (g :: * -> *).
Divisible g =>
(f ~> g) -> Div f ~> g
runDiv f ~> g
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Coyoneda f x -> g x -> g x
go forall (f :: * -> *) a. Divisible f => f a
conquer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Div f a -> [Coyoneda f a]
unDiv
  where
    go :: Coyoneda f x -> g x -> g x
go (Coyoneda x -> b
g f b
x) = forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\x
y -> (x
y,x
y)) (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap x -> b
g (f ~> g
f f b
x))

instance Divisible f => Interpret Div f where
    interpret :: forall (g :: * -> *). (g ~> f) -> Div g ~> f
interpret = forall (f :: * -> *) (g :: * -> *).
Divisible g =>
(f ~> g) -> Div f ~> g
runDiv

-- | The free 'Divise': a non-empty version of 'Div'.
--
-- This type is essentially 'NonEmptyF'; the only reason why it has to exist
-- separately outside of 'NonEmptyF' is because the current typeclass
-- hierarchy isn't compatible with both the covariant 'Interpret' instance
-- (requiring 'Plus') and the contravariant 'Interpret' instance (requiring
-- 'Divisible').
--
-- The wrapping in 'Coyoneda' is also to provide a usable
-- 'Data.HBifunctor.Associative.Associative' instance for the contravariant
-- 'CD.Day'.
newtype Div1 f a = Div1 { forall (f :: * -> *) a. Div1 f a -> NonEmpty (Coyoneda f a)
unDiv1 :: NonEmpty (Coyoneda f a) }
  deriving (forall b a. b -> Div1 f b -> Div1 f a
forall a' a. (a' -> a) -> Div1 f a -> Div1 f a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
forall (f :: * -> *) b a. b -> Div1 f b -> Div1 f a
forall (f :: * -> *) a' a. (a' -> a) -> Div1 f a -> Div1 f a'
>$ :: forall b a. b -> Div1 f b -> Div1 f a
$c>$ :: forall (f :: * -> *) b a. b -> Div1 f b -> Div1 f a
contramap :: forall a' a. (a' -> a) -> Div1 f a -> Div1 f a'
$ccontramap :: forall (f :: * -> *) a' a. (a' -> a) -> Div1 f a -> Div1 f a'
Contravariant, forall a b. Div1 f a -> Div1 f b -> Div1 f (a, b)
forall a b c. (a -> (b, c)) -> Div1 f b -> Div1 f c -> Div1 f a
forall (f :: * -> *). Contravariant (Div1 f)
forall (f :: * -> *).
Contravariant f
-> (forall a b c. (a -> (b, c)) -> f b -> f c -> f a)
-> (forall a b. f a -> f b -> f (a, b))
-> Divise f
forall (f :: * -> *) a b. Div1 f a -> Div1 f b -> Div1 f (a, b)
forall (f :: * -> *) a b c.
(a -> (b, c)) -> Div1 f b -> Div1 f c -> Div1 f a
divised :: forall a b. Div1 f a -> Div1 f b -> Div1 f (a, b)
$cdivised :: forall (f :: * -> *) a b. Div1 f a -> Div1 f b -> Div1 f (a, b)
divise :: forall a b c. (a -> (b, c)) -> Div1 f b -> Div1 f c -> Div1 f a
$cdivise :: forall (f :: * -> *) a b c.
(a -> (b, c)) -> Div1 f b -> Div1 f c -> Div1 f a
Divise) via (NonEmptyF (Coyoneda f))
  deriving (forall {k} {k1} (t :: (k -> *) -> k1 -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div1 f ~> Div1 g
hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div1 f ~> Div1 g
$chmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div1 f ~> Div1 g
HFunctor, HFunctor Div1
forall {k} (t :: (k -> *) -> k -> *).
HFunctor t -> (forall (f :: k -> *). f ~> t f) -> Inject t
forall (f :: * -> *) x. f x -> Div1 f x
inject :: forall (f :: * -> *) x. f x -> Div1 f x
$cinject :: forall (f :: * -> *) x. f x -> Div1 f x
Inject) via (CT.ComposeT NonEmptyF Coyoneda)

instance HTraversable Div1 where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Div1 f a -> h (Div1 g a)
htraverse forall x. f x -> h (g x)
f (Div1 NonEmpty (Coyoneda f a)
xs) = forall (f :: * -> *) a. NonEmpty (Coyoneda f a) -> Div1 f a
Div1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall x. f x -> h (g x)
f) NonEmpty (Coyoneda f a)
xs

instance HTraversable1 Div1 where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> Div1 f a -> h (Div1 g a)
htraverse1 forall x. f x -> h (g x)
f (Div1 NonEmpty (Coyoneda f a)
xs) = forall (f :: * -> *) a. NonEmpty (Coyoneda f a) -> Div1 f a
Div1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 (forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable1 t, Apply h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse1 forall x. f x -> h (g x)
f) NonEmpty (Coyoneda f a)
xs

instance Invariant (Div1 f) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Div1 f a -> Div1 f b
invmap a -> b
_ = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap

deriving via WrappedDivisible (Div1 f) instance Inply (Div1 f)

instance Divise f => Interpret Div1 f where
    interpret :: forall (g :: * -> *). (g ~> f) -> Div1 g ~> f
interpret = forall (g :: * -> *) (f :: * -> *).
Divise g =>
(f ~> g) -> Div1 f ~> g
runDiv1

-- | Pattern matching on a 'Div1', exposing the raw @f@ instead of
-- having it wrapped in a 'Coyoneda'.  This is the analogue of
-- 'Data.Functor.Apply.Ap1' and essentially treats the "cons" of the
-- 'Div1' as a contravariant day convolution.
--
-- Before v0.3.3.0, this used to be the concrete constructor of 'Div1'.
-- After, it is now an abstract pattern.
--
-- @since 0.3.3.0
pattern Div1_ :: (a -> (b, c)) -> f b -> Div f c -> Div1 f a
pattern $bDiv1_ :: forall a (f :: * -> *) b c.
(a -> (b, c)) -> f b -> Div f c -> Div1 f a
$mDiv1_ :: forall {r} {a} {f :: * -> *}.
Div1 f a
-> (forall {b} {c}. (a -> (b, c)) -> f b -> Div f c -> r)
-> ((# #) -> r)
-> r
Div1_ f x xs <- (div1_->CD.Day x xs f)
  where
    Div1_ a -> (b, c)
f f b
x (Div [Coyoneda f c]
xs) = forall (f :: * -> *) a. NonEmpty (Coyoneda f a) -> Div1 f a
Div1 forall a b. (a -> b) -> a -> b
$ forall a b (f :: * -> *). (a -> b) -> f b -> Coyoneda f a
Coyoneda (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) f b
x forall a. a -> [a] -> NonEmpty a
:| (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap) (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) [Coyoneda f c]
xs
{-# COMPLETE Div1_ #-}

div1_ :: Div1 f ~> CD.Day f (Div f)
div1_ :: forall (f :: * -> *). Div1 f ~> Day f (Div f)
div1_ (Div1 (Coyoneda x -> b
g f b
x :| [Coyoneda f x]
xs)) = forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (a -> (b, c)) -> Day f g a
CD.Day f b
x (forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div [Coyoneda f x]
xs) (\x
y -> (x -> b
g x
y, x
y))

-- | A 'Div1' is a "non-empty" 'Div'; this function "forgets" the non-empty
-- property and turns it back into a normal 'Div'.
toDiv :: Div1 f ~> Div f
toDiv :: forall (f :: * -> *). Div1 f ~> Div f
toDiv = forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Div1 f a -> NonEmpty (Coyoneda f a)
unDiv1

-- | Map over the underlying context in a 'Div1'.
hoistDiv1 :: (f ~> g) -> Div1 f ~> Div1 g
hoistDiv1 :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div1 f ~> Div1 g
hoistDiv1 = forall {k} {k1} (t :: (k -> *) -> k1 -> *) (f :: k -> *)
       (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap

-- | Inject a single action in @f@ into a @'Div' f@.
liftDiv1 :: f ~> Div1 f
liftDiv1 :: forall (f :: * -> *) x. f x -> Div1 f x
liftDiv1 = forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject

-- | Interpret a 'Div1' into a context @g@, provided @g@ is 'Divise'.
runDiv1 :: Divise g => (f ~> g) -> Div1 f ~> g
runDiv1 :: forall (g :: * -> *) (f :: * -> *).
Divise g =>
(f ~> g) -> Div1 f ~> g
runDiv1 f ~> g
f = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (\x
y->(x
y,x
y))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coyoneda f x -> g x
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Div1 f a -> NonEmpty (Coyoneda f a)
unDiv1
  where
    go :: Coyoneda f x -> g x
go (Coyoneda x -> b
g f b
x) = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap x -> b
g (f ~> g
f f b
x)

-- | 'Div1' is isomorphic to 'NonEmptyF' for contravariant @f@.  This
-- witnesses one way of that isomorphism.
div1NonEmptyF :: Contravariant f => Div1 f ~> NonEmptyF f
div1NonEmptyF :: forall (f :: * -> *). Contravariant f => Div1 f ~> NonEmptyF f
div1NonEmptyF = forall {k} (f :: k -> *) (a :: k). NonEmpty (f a) -> NonEmptyF f a
NonEmptyF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Contravariant f => Coyoneda f a -> f a
lowerCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Div1 f a -> NonEmpty (Coyoneda f a)
unDiv1

-- | 'Div1' is isomorphic to 'NonEmptyF' for contravariant @f@.  This
-- witnesses one way of that isomorphism.
nonEmptyFDiv1 :: NonEmptyF f ~> Div1 f
nonEmptyFDiv1 :: forall (f :: * -> *). NonEmptyF f ~> Div1 f
nonEmptyFDiv1 = forall (f :: * -> *) a. NonEmpty (Coyoneda f a) -> Div1 f a
Div1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). NonEmptyF f a -> NonEmpty (f a)
runNonEmptyF

-- | The free 'Decide'.  Used to aggregate multiple possible consumers,
-- directing the input into an appropriate consumer.
data Dec :: (Type -> Type) -> Type -> Type where
    Lose   :: (a -> Void) -> Dec f a
    Choose :: (a -> Either b c) -> f b -> Dec f c -> Dec f a

instance Contravariant (Dec f) where
    contramap :: forall a' a. (a' -> a) -> Dec f a -> Dec f a'
contramap a' -> a
f = \case
      Lose   a -> Void
g      -> forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose   (a -> Void
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f)
      Choose a -> Either b c
g f b
x Dec f c
xs -> forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose (a -> Either b c
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f) f b
x Dec f c
xs
instance Invariant (Dec f) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Dec f a -> Dec f b
invmap a -> b
_ = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap
deriving via WrappedDivisible (Dec f) instance Inalt (Dec f)
deriving via WrappedDivisible (Dec f) instance Inplus (Dec f)
instance Decide (Dec f) where
    decide :: forall a b c. (a -> Either b c) -> Dec f b -> Dec f c -> Dec f a
decide a -> Either b c
f = \case
      Lose   b -> Void
g      -> forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Void
g) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f)
      Choose b -> Either b c
g f b
x Dec f c
xs -> forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose (forall (p :: * -> * -> *) a b c.
Assoc p =>
p (p a b) c -> p a (p b c)
assoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> Either b c
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f) f b
x
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide forall a. a -> a
id Dec f c
xs
instance Conclude (Dec f) where
    conclude :: forall a. (a -> Void) -> Dec f a
conclude = forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose
instance HFunctor Dec where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Dec f ~> Dec g
hmap = forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Dec f ~> Dec g
hoistDec
instance Inject Dec where
    inject :: forall (f :: * -> *). f ~> Dec f
inject = forall (f :: * -> *). f ~> Dec f
liftDec
instance Conclude f => Interpret Dec f where
    interpret :: forall (g :: * -> *). (g ~> f) -> Dec g ~> f
interpret = forall (f :: * -> *) (g :: * -> *).
Conclude g =>
(f ~> g) -> Dec f ~> g
runDec

instance HTraversable Dec where
    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> Dec f a -> h (Dec g a)
    htraverse :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Dec f a -> h (Dec g a)
htraverse forall x. f x -> h (g x)
f = forall b. Dec f b -> h (Dec g b)
go
      where
        go :: Dec f b -> h (Dec g b)
        go :: forall b. Dec f b -> h (Dec g b)
go = \case
          Lose   b -> Void
v      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose b -> Void
v)
          Choose b -> Either b c
g f b
x Dec f c
xs -> forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose b -> Either b c
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f b
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b. Dec f b -> h (Dec g b)
go Dec f c
xs

-- | Map over the underlying context in a 'Dec'.
hoistDec :: forall f g. (f ~> g) -> Dec f ~> Dec g
hoistDec :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Dec f ~> Dec g
hoistDec f ~> g
f = Dec f ~> Dec g
go
  where
    go :: Dec f ~> Dec g
    go :: Dec f ~> Dec g
go = \case
      Lose x -> Void
g -> forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose x -> Void
g
      Choose x -> Either b c
g f b
x Dec f c
xs -> forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose x -> Either b c
g (f ~> g
f f b
x) (Dec f ~> Dec g
go Dec f c
xs)

-- | Inject a single action in @f@ into a @'Dec' f@.
liftDec :: f ~> Dec f
liftDec :: forall (f :: * -> *). f ~> Dec f
liftDec f x
x = forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose forall a b. a -> Either a b
Left f x
x (forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose forall a. a -> a
id)

-- | Interpret a 'Dec' into a context @g@, provided @g@ is 'Conclude'.
runDec :: forall f g. Conclude g => (f ~> g) -> Dec f ~> g
runDec :: forall (f :: * -> *) (g :: * -> *).
Conclude g =>
(f ~> g) -> Dec f ~> g
runDec f ~> g
f = Dec f ~> g
go
  where
    go :: Dec f ~> g
    go :: Dec f ~> g
go = \case
      Lose x -> Void
g -> forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude x -> Void
g
      Choose x -> Either b c
g f b
x Dec f c
xs -> forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide x -> Either b c
g (f ~> g
f f b
x) (Dec f ~> g
go Dec f c
xs)


-- | The free 'Decide': a non-empty version of 'Dec'.
data Dec1 :: (Type -> Type) -> Type -> Type where
    Dec1 :: (a -> Either b c) -> f b -> Dec f c -> Dec1 f a

-- | A 'Dec1' is a "non-empty" 'Dec'; this function "forgets" the non-empty
-- property and turns it back into a normal 'Dec'.
toDec :: Dec1 f a -> Dec f a
toDec :: forall (f :: * -> *) a. Dec1 f a -> Dec f a
toDec (Dec1 a -> Either b c
f f b
x Dec f c
xs) = forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose a -> Either b c
f f b
x Dec f c
xs

instance Contravariant (Dec1 f) where
    contramap :: forall a' a. (a' -> a) -> Dec1 f a -> Dec1 f a'
contramap a' -> a
f (Dec1 a -> Either b c
g f b
x Dec f c
xs) = forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 (a -> Either b c
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f) f b
x Dec f c
xs
instance Invariant (Dec1 f) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Dec1 f a -> Dec1 f b
invmap a -> b
_ = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap
deriving via WrappedDivisible (Dec1 f) instance Inalt (Dec1 f)
instance Decide (Dec1 f) where
    decide :: forall a b c. (a -> Either b c) -> Dec1 f b -> Dec1 f c -> Dec1 f a
decide a -> Either b c
f (Dec1 b -> Either b c
g f b
x Dec f c
xs) = forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 (forall (p :: * -> * -> *) a b c.
Assoc p =>
p (p a b) c -> p a (p b c)
assoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> Either b c
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f) f b
x
                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide forall a. a -> a
id Dec f c
xs
                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Dec1 f a -> Dec f a
toDec
instance HFunctor Dec1 where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Dec1 f ~> Dec1 g
hmap = forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Dec1 f ~> Dec1 g
hoistDec1
instance Inject Dec1 where
    inject :: forall (f :: * -> *). f ~> Dec1 f
inject = forall (f :: * -> *). f ~> Dec1 f
liftDec1
instance Decide f => Interpret Dec1 f where
    interpret :: forall (g :: * -> *). (g ~> f) -> Dec1 g ~> f
interpret = forall (g :: * -> *) (f :: * -> *).
Decide g =>
(f ~> g) -> Dec1 f ~> g
runDec1

instance HTraversable Dec1 where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> Dec1 f a -> h (Dec1 g a)
htraverse forall x. f x -> h (g x)
f (Dec1 a -> Either b c
g f b
x Dec f c
xs) = forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 a -> Either b c
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f b
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} {k1} (t :: (k -> *) -> k1 -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k1).
(HTraversable t, Applicative h) =>
(forall (x :: k). f x -> h (g x)) -> t f a -> h (t g a)
htraverse forall x. f x -> h (g x)
f Dec f c
xs

instance HTraversable1 Dec1 where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> Dec1 f a -> h (Dec1 g a)
htraverse1 forall x. f x -> h (g x)
f (Dec1 a -> Either b c
g f b
x Dec f c
xs) = forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a b c.
Apply h =>
(forall x. f x -> h (g x))
-> (a -> Either b c) -> f b -> Dec f c -> h (Dec1 g a)
traverseDec1_ forall x. f x -> h (g x)
f a -> Either b c
g f b
x Dec f c
xs

-- | Map over the undering context in a 'Dec1'.
hoistDec1 :: forall f g. (f ~> g) -> Dec1 f ~> Dec1 g
hoistDec1 :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Dec1 f ~> Dec1 g
hoistDec1 f ~> g
f (Dec1 x -> Either b c
g f b
x Dec f c
xs) = forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 x -> Either b c
g (f ~> g
f f b
x) (forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Dec f ~> Dec g
hoistDec f ~> g
f Dec f c
xs)

-- | Inject a single action in @f@ into a @'Dec1' f@.
liftDec1 :: f ~> Dec1 f
liftDec1 :: forall (f :: * -> *). f ~> Dec1 f
liftDec1 f x
x = forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 forall a b. a -> Either a b
Left f x
x (forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose forall a. a -> a
id)

-- | Interpret a 'Dec1' into a context @g@, provided @g@ is 'Decide'.
runDec1 :: Decide g => (f ~> g) -> Dec1 f ~> g
runDec1 :: forall (g :: * -> *) (f :: * -> *).
Decide g =>
(f ~> g) -> Dec1 f ~> g
runDec1 f ~> g
f (Dec1 x -> Either b c
g f b
x Dec f c
xs) = forall (f :: * -> *) (g :: * -> *) a b c.
Decide g =>
(f ~> g) -> (a -> Either b c) -> f b -> Dec f c -> g a
runDec1_ f ~> g
f x -> Either b c
g f b
x Dec f c
xs

runDec1_
    :: forall f g a b c. Decide g
    => (f ~> g)
    -> (a -> Either b c)
    -> f b
    -> Dec f c
    -> g a
runDec1_ :: forall (f :: * -> *) (g :: * -> *) a b c.
Decide g =>
(f ~> g) -> (a -> Either b c) -> f b -> Dec f c -> g a
runDec1_ f ~> g
f = forall x y z. (x -> Either y z) -> f y -> Dec f z -> g x
go
  where
    go :: (x -> Either y z) -> f y -> Dec f z -> g x
    go :: forall x y z. (x -> Either y z) -> f y -> Dec f z -> g x
go x -> Either y z
g f y
x = \case
      Lose z -> Void
h        -> forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. z -> Void
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Either y z
g) (f ~> g
f f y
x)
      Choose z -> Either b c
h f b
y Dec f c
ys -> forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide x -> Either y z
g (f ~> g
f f y
x) (forall x y z. (x -> Either y z) -> f y -> Dec f z -> g x
go z -> Either b c
h f b
y Dec f c
ys)

traverseDec1_
    :: forall f g h a b c. Apply h
    => (forall x. f x -> h (g x))
    -> (a -> Either b c)
    -> f b
    -> Dec f c
    -> h (Dec1 g a)
traverseDec1_ :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a b c.
Apply h =>
(forall x. f x -> h (g x))
-> (a -> Either b c) -> f b -> Dec f c -> h (Dec1 g a)
traverseDec1_ forall x. f x -> h (g x)
f = forall x y z. (x -> Either y z) -> f y -> Dec f z -> h (Dec1 g x)
go
  where
    go :: (x -> Either y z) -> f y -> Dec f z -> h (Dec1 g x)
    go :: forall x y z. (x -> Either y z) -> f y -> Dec f z -> h (Dec1 g x)
go x -> Either y z
g f y
x = \case
      Lose z -> Void
h        -> (\g y
x' -> forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 x -> Either y z
g g y
x' (forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose z -> Void
h)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f y
x
      Choose z -> Either b c
h f b
y Dec f c
ys -> forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 x -> Either y z
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. f x -> h (g x)
f f y
x forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (forall (f :: * -> *) a. Dec1 f a -> Dec f a
toDec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x y z. (x -> Either y z) -> f y -> Dec f z -> h (Dec1 g x)
go z -> Either b c
h f b
y Dec f c
ys)