{-# 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.Contravariant
import           Data.Functor.Contravariant.Conclude
import           Data.Functor.Contravariant.Coyoneda
import           Data.Functor.Contravariant.Decide
import           Data.Functor.Contravariant.Divise
import           Data.Functor.Apply
import           Data.Functor.Contravariant.Divisible
import           Data.Functor.Invariant
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 { Div f a -> [Coyoneda f a]
unDiv :: [Coyoneda f a] }
  deriving (b -> Div f b -> Div f a
(a -> b) -> Div f b -> Div f a
(forall a b. (a -> b) -> Div f b -> Div f a)
-> (forall b a. b -> Div f b -> Div f a) -> Contravariant (Div f)
forall b a. b -> Div f b -> Div f a
forall a b. (a -> b) -> Div f b -> Div f a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> 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 b. (a -> b) -> Div f b -> Div f a
>$ :: b -> Div f b -> Div f a
$c>$ :: forall (f :: * -> *) b a. b -> Div f b -> Div f a
contramap :: (a -> b) -> Div f b -> Div f a
$ccontramap :: forall (f :: * -> *) a b. (a -> b) -> Div f b -> Div f a
Contravariant, Contravariant (Div f)
Contravariant (Div f) =>
(forall a b c. (a -> (b, c)) -> Div f b -> Div f c -> Div f a)
-> Divise (Div f)
(a -> (b, c)) -> Div f b -> Div f c -> 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) -> Divise f
forall (f :: * -> *) a b c.
(a -> (b, c)) -> Div f b -> Div f c -> Div f a
divise :: (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
$cp1Divise :: forall (f :: * -> *). Contravariant (Div f)
Divise, Contravariant (Div f)
Div f a
Contravariant (Div f) =>
(forall a b c. (a -> (b, c)) -> Div f b -> Div f c -> Div f a)
-> (forall a. Div f a) -> Divisible (Div f)
(a -> (b, c)) -> Div f b -> Div f c -> Div f a
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 :: Div f a
$cconquer :: forall (f :: * -> *) a. Div f a
divide :: (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
$cp1Divisible :: forall (f :: * -> *). Contravariant (Div f)
Divisible) via (ListF (Coyoneda f))
  deriving ((f ~> g) -> Div f ~> Div g
(forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div f ~> Div g)
-> HFunctor Div
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div f ~> Div g
hmap :: (f ~> g) -> Div f ~> Div g
$chmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div f ~> Div g
HFunctor, HFunctor Div
f x -> Div f x
HFunctor Div => (forall (f :: * -> *). f ~> Div f) -> Inject Div
forall k (t :: (k -> *) -> k -> *).
HFunctor t =>
(forall (f :: k -> *). f ~> t f) -> Inject t
forall (f :: * -> *). f ~> Div f
inject :: f x -> Div f x
$cinject :: forall (f :: * -> *). f ~> Div f
$cp1Inject :: HFunctor Div
Inject) via (CT.ComposeT ListF Coyoneda)

instance HTraversable Div where
    htraverse :: (forall x. f x -> h (g x)) -> Div f a -> h (Div g a)
htraverse f :: forall x. f x -> h (g x)
f (Div xs :: [Coyoneda f a]
xs) = [Coyoneda g a] -> Div g a
forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div ([Coyoneda g a] -> Div g a) -> h [Coyoneda g a] -> h (Div g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Coyoneda f a -> h (Coyoneda g a))
-> [Coyoneda f a] -> h [Coyoneda g a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((forall x. f x -> h (g x)) -> Coyoneda f a -> h (Coyoneda g a)
forall k k (t :: (k -> *) -> k -> *) (h :: * -> *) (f :: k -> *)
       (g :: k -> *) (a :: k).
(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 :: (a -> b) -> (b -> a) -> Div f a -> Div f b
invmap _ = (b -> a) -> Div f a -> Div f b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap

-- | 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 :: Div f a
$mConquer :: forall r (f :: * -> *) a.
Div f a -> (Void# -> r) -> (Void# -> 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 :: (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)
-> (Void# -> r)
-> r
Divide f x xs <- (divDay_ -> Just (CD.Day x xs f))
  where
    Divide f :: a -> (b, c)
f x :: f b
x (Div xs :: [Coyoneda f c]
xs) = [Coyoneda f a] -> Div f a
forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div ([Coyoneda f a] -> Div f a) -> [Coyoneda f a] -> Div f a
forall a b. (a -> b) -> a -> b
$ (a -> b) -> f b -> Coyoneda f a
forall a b (f :: * -> *). (a -> b) -> f b -> Coyoneda f a
Coyoneda ((b, c) -> b
forall a b. (a, b) -> a
fst ((b, c) -> b) -> (a -> (b, c)) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) f b
x Coyoneda f a -> [Coyoneda f a] -> [Coyoneda f a]
forall a. a -> [a] -> [a]
: ((Coyoneda f c -> Coyoneda f a) -> [Coyoneda f c] -> [Coyoneda f a]
forall a b. (a -> b) -> [a] -> [b]
map ((Coyoneda f c -> Coyoneda f a)
 -> [Coyoneda f c] -> [Coyoneda f a])
-> ((a -> c) -> Coyoneda f c -> Coyoneda f a)
-> (a -> c)
-> [Coyoneda f c]
-> [Coyoneda f a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> c) -> Coyoneda f c -> Coyoneda f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap) ((b, c) -> c
forall a b. (a, b) -> b
snd ((b, c) -> c) -> (a -> (b, c)) -> a -> c
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_ :: Div f a -> Maybe (Day f (Div f) a)
divDay_ (Div []) = Maybe (Day f (Div f) a)
forall a. Maybe a
Nothing
divDay_ (Div (Coyoneda f :: a -> b
f x :: f b
x : xs :: [Coyoneda f a]
xs)) = Day f (Div f) a -> Maybe (Day f (Div f) a)
forall a. a -> Maybe a
Just (Day f (Div f) a -> Maybe (Day f (Div f) a))
-> Day f (Div f) a -> Maybe (Day f (Div f) a)
forall a b. (a -> b) -> a -> b
$ f b -> Div f a -> (a -> (b, a)) -> Day f (Div f) a
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (a -> (b, c)) -> Day f g a
CD.Day f b
x ([Coyoneda f a] -> Div f a
forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div [Coyoneda f a]
xs) (\y :: 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 :: Div f ~> ListF f
divListF = [f x] -> ListF f x
forall k (f :: k -> *) (a :: k). [f a] -> ListF f a
ListF ([f x] -> ListF f x) -> (Div f x -> [f x]) -> Div f x -> ListF f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coyoneda f x -> f x) -> [Coyoneda f x] -> [f x]
forall a b. (a -> b) -> [a] -> [b]
map Coyoneda f x -> f x
forall (f :: * -> *) a. Contravariant f => Coyoneda f a -> f a
lowerCoyoneda ([Coyoneda f x] -> [f x])
-> (Div f x -> [Coyoneda f x]) -> Div f x -> [f x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Div f x -> [Coyoneda f x]
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 :: ListF f x -> Div f x
listFDiv = [Coyoneda f x] -> Div f x
forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div ([Coyoneda f x] -> Div f x)
-> (ListF f x -> [Coyoneda f x]) -> ListF f x -> Div f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f x -> Coyoneda f x) -> [f x] -> [Coyoneda f x]
forall a b. (a -> b) -> [a] -> [b]
map f x -> Coyoneda f x
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda ([f x] -> [Coyoneda f x])
-> (ListF f x -> [f x]) -> ListF f x -> [Coyoneda f x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListF f x -> [f x]
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 :: (f ~> g) -> Div f ~> Div g
hoistDiv = (f ~> g) -> Div f x -> Div g x
forall k k (t :: (k -> *) -> k -> *) (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 :: f x -> Div f x
liftDiv = f x -> Div f x
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 :: (f ~> g) -> Div f ~> g
runDiv f :: f ~> g
f = (Coyoneda f x -> g x -> g x) -> g x -> [Coyoneda f x] -> g x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Coyoneda f x -> g x -> g x
go g x
forall (f :: * -> *) a. Divisible f => f a
conquer ([Coyoneda f x] -> g x)
-> (Div f x -> [Coyoneda f x]) -> Div f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Div f x -> [Coyoneda f x]
forall (f :: * -> *) a. Div f a -> [Coyoneda f a]
unDiv
  where
    go :: Coyoneda f x -> g x -> g x
go (Coyoneda g :: x -> b
g x :: f b
x) = (x -> (x, x)) -> g x -> g x -> g x
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\y :: x
y -> (x
y,x
y)) ((x -> b) -> g b -> g x
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap x -> b
g (f b -> g b
f ~> g
f f b
x))

instance Divisible f => Interpret Div f where
    interpret :: (g ~> f) -> Div g ~> f
interpret = (g ~> f) -> Div g x -> f x
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 { Div1 f a -> NonEmpty (Coyoneda f a)
unDiv1 :: NonEmpty (Coyoneda f a) }
  deriving (b -> Div1 f b -> Div1 f a
(a -> b) -> Div1 f b -> Div1 f a
(forall a b. (a -> b) -> Div1 f b -> Div1 f a)
-> (forall b a. b -> Div1 f b -> Div1 f a)
-> Contravariant (Div1 f)
forall b a. b -> Div1 f b -> Div1 f a
forall a b. (a -> b) -> Div1 f b -> Div1 f a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> 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 b. (a -> b) -> Div1 f b -> Div1 f a
>$ :: b -> Div1 f b -> Div1 f a
$c>$ :: forall (f :: * -> *) b a. b -> Div1 f b -> Div1 f a
contramap :: (a -> b) -> Div1 f b -> Div1 f a
$ccontramap :: forall (f :: * -> *) a b. (a -> b) -> Div1 f b -> Div1 f a
Contravariant, Contravariant (Div1 f)
Contravariant (Div1 f) =>
(forall a b c. (a -> (b, c)) -> Div1 f b -> Div1 f c -> Div1 f a)
-> Divise (Div1 f)
(a -> (b, c)) -> Div1 f b -> Div1 f c -> Div1 f a
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) -> Divise f
forall (f :: * -> *) a b c.
(a -> (b, c)) -> Div1 f b -> Div1 f c -> Div1 f a
divise :: (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
$cp1Divise :: forall (f :: * -> *). Contravariant (Div1 f)
Divise) via (NonEmptyF (Coyoneda f))
  deriving ((f ~> g) -> Div1 f ~> Div1 g
(forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div1 f ~> Div1 g)
-> HFunctor Div1
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div1 f ~> Div1 g
hmap :: (f ~> g) -> Div1 f ~> Div1 g
$chmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Div1 f ~> Div1 g
HFunctor, HFunctor Div1
f x -> Div1 f x
HFunctor Div1 => (forall (f :: * -> *). f ~> Div1 f) -> Inject Div1
forall k (t :: (k -> *) -> k -> *).
HFunctor t =>
(forall (f :: k -> *). f ~> t f) -> Inject t
forall (f :: * -> *). f ~> Div1 f
inject :: f x -> Div1 f x
$cinject :: forall (f :: * -> *). f ~> Div1 f
$cp1Inject :: HFunctor Div1
Inject) via (CT.ComposeT NonEmptyF Coyoneda)

instance HTraversable Div1 where
    htraverse :: (forall x. f x -> h (g x)) -> Div1 f a -> h (Div1 g a)
htraverse f :: forall x. f x -> h (g x)
f (Div1 xs :: NonEmpty (Coyoneda f a)
xs) = NonEmpty (Coyoneda g a) -> Div1 g a
forall (f :: * -> *) a. NonEmpty (Coyoneda f a) -> Div1 f a
Div1 (NonEmpty (Coyoneda g a) -> Div1 g a)
-> h (NonEmpty (Coyoneda g a)) -> h (Div1 g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Coyoneda f a -> h (Coyoneda g a))
-> NonEmpty (Coyoneda f a) -> h (NonEmpty (Coyoneda g a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((forall x. f x -> h (g x)) -> Coyoneda f a -> h (Coyoneda g a)
forall k k (t :: (k -> *) -> k -> *) (h :: * -> *) (f :: k -> *)
       (g :: k -> *) (a :: k).
(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 x. f x -> h (g x)) -> Div1 f a -> h (Div1 g a)
htraverse1 f :: forall x. f x -> h (g x)
f (Div1 xs :: NonEmpty (Coyoneda f a)
xs) = NonEmpty (Coyoneda g a) -> Div1 g a
forall (f :: * -> *) a. NonEmpty (Coyoneda f a) -> Div1 f a
Div1 (NonEmpty (Coyoneda g a) -> Div1 g a)
-> h (NonEmpty (Coyoneda g a)) -> h (Div1 g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Coyoneda f a -> h (Coyoneda g a))
-> NonEmpty (Coyoneda f a) -> h (NonEmpty (Coyoneda g a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 ((forall x. f x -> h (g x)) -> Coyoneda f a -> h (Coyoneda g a)
forall k k (t :: (k -> *) -> k -> *) (h :: * -> *) (f :: k -> *)
       (g :: k -> *) (a :: k).
(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 :: (a -> b) -> (b -> a) -> Div1 f a -> Div1 f b
invmap _ = (b -> a) -> Div1 f a -> Div1 f b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap

instance Divise f => Interpret Div1 f where
    interpret :: (g ~> f) -> Div1 g ~> f
interpret = (g ~> f) -> Div1 g x -> f x
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_ :: (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)
-> (Void# -> r)
-> r
Div1_ f x xs <- (div1_->CD.Day x xs f)
  where
    Div1_ f :: a -> (b, c)
f x :: f b
x (Div xs :: [Coyoneda f c]
xs) = NonEmpty (Coyoneda f a) -> Div1 f a
forall (f :: * -> *) a. NonEmpty (Coyoneda f a) -> Div1 f a
Div1 (NonEmpty (Coyoneda f a) -> Div1 f a)
-> NonEmpty (Coyoneda f a) -> Div1 f a
forall a b. (a -> b) -> a -> b
$ (a -> b) -> f b -> Coyoneda f a
forall a b (f :: * -> *). (a -> b) -> f b -> Coyoneda f a
Coyoneda ((b, c) -> b
forall a b. (a, b) -> a
fst ((b, c) -> b) -> (a -> (b, c)) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) f b
x Coyoneda f a -> [Coyoneda f a] -> NonEmpty (Coyoneda f a)
forall a. a -> [a] -> NonEmpty a
:| ((Coyoneda f c -> Coyoneda f a) -> [Coyoneda f c] -> [Coyoneda f a]
forall a b. (a -> b) -> [a] -> [b]
map ((Coyoneda f c -> Coyoneda f a)
 -> [Coyoneda f c] -> [Coyoneda f a])
-> ((a -> c) -> Coyoneda f c -> Coyoneda f a)
-> (a -> c)
-> [Coyoneda f c]
-> [Coyoneda f a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> c) -> Coyoneda f c -> Coyoneda f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap) ((b, c) -> c
forall a b. (a, b) -> b
snd ((b, c) -> c) -> (a -> (b, c)) -> a -> c
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_ :: Div1 f x -> Day f (Div f) x
div1_ (Div1 (Coyoneda g :: x -> b
g x :: f b
x :| xs :: [Coyoneda f x]
xs)) = f b -> Div f x -> (x -> (b, x)) -> Day f (Div f) x
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (a -> (b, c)) -> Day f g a
CD.Day f b
x ([Coyoneda f x] -> Div f x
forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div [Coyoneda f x]
xs) (\y :: 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 :: Div1 f x -> Div f x
toDiv = [Coyoneda f x] -> Div f x
forall (f :: * -> *) a. [Coyoneda f a] -> Div f a
Div ([Coyoneda f x] -> Div f x)
-> (Div1 f x -> [Coyoneda f x]) -> Div1 f x -> Div f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Coyoneda f x) -> [Coyoneda f x]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Coyoneda f x) -> [Coyoneda f x])
-> (Div1 f x -> NonEmpty (Coyoneda f x))
-> Div1 f x
-> [Coyoneda f x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Div1 f x -> NonEmpty (Coyoneda f x)
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 :: (f ~> g) -> Div1 f ~> Div1 g
hoistDiv1 = (f ~> g) -> Div1 f x -> Div1 g x
forall k k (t :: (k -> *) -> k -> *) (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 :: f x -> Div1 f x
liftDiv1 = f x -> Div1 f x
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 :: (f ~> g) -> Div1 f ~> g
runDiv1 f :: f ~> g
f = (g x -> g x -> g x) -> NonEmpty (g x) -> g x
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ((x -> (x, x)) -> g x -> g x -> g x
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise (\y :: x
y->(x
y,x
y))) (NonEmpty (g x) -> g x)
-> (Div1 f x -> NonEmpty (g x)) -> Div1 f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coyoneda f x -> g x) -> NonEmpty (Coyoneda f x) -> NonEmpty (g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coyoneda f x -> g x
go (NonEmpty (Coyoneda f x) -> NonEmpty (g x))
-> (Div1 f x -> NonEmpty (Coyoneda f x))
-> Div1 f x
-> NonEmpty (g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Div1 f x -> NonEmpty (Coyoneda f x)
forall (f :: * -> *) a. Div1 f a -> NonEmpty (Coyoneda f a)
unDiv1
  where
    go :: Coyoneda f x -> g x
go (Coyoneda g :: x -> b
g x :: f b
x) = (x -> b) -> g b -> g x
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap x -> b
g (f b -> g b
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 :: Div1 f ~> NonEmptyF f
div1NonEmptyF = NonEmpty (f x) -> NonEmptyF f x
forall k (f :: k -> *) (a :: k). NonEmpty (f a) -> NonEmptyF f a
NonEmptyF (NonEmpty (f x) -> NonEmptyF f x)
-> (Div1 f x -> NonEmpty (f x)) -> Div1 f x -> NonEmptyF f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coyoneda f x -> f x) -> NonEmpty (Coyoneda f x) -> NonEmpty (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coyoneda f x -> f x
forall (f :: * -> *) a. Contravariant f => Coyoneda f a -> f a
lowerCoyoneda (NonEmpty (Coyoneda f x) -> NonEmpty (f x))
-> (Div1 f x -> NonEmpty (Coyoneda f x))
-> Div1 f x
-> NonEmpty (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Div1 f x -> NonEmpty (Coyoneda f x)
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 :: NonEmptyF f x -> Div1 f x
nonEmptyFDiv1 = NonEmpty (Coyoneda f x) -> Div1 f x
forall (f :: * -> *) a. NonEmpty (Coyoneda f a) -> Div1 f a
Div1 (NonEmpty (Coyoneda f x) -> Div1 f x)
-> (NonEmptyF f x -> NonEmpty (Coyoneda f x))
-> NonEmptyF f x
-> Div1 f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f x -> Coyoneda f x) -> NonEmpty (f x) -> NonEmpty (Coyoneda f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> Coyoneda f x
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda (NonEmpty (f x) -> NonEmpty (Coyoneda f x))
-> (NonEmptyF f x -> NonEmpty (f x))
-> NonEmptyF f x
-> NonEmpty (Coyoneda f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF f x -> NonEmpty (f x)
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 :: (a -> b) -> Dec f b -> Dec f a
contramap f :: a -> b
f = \case
      Lose   g :: b -> Void
g      -> (a -> Void) -> Dec f a
forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose   (b -> Void
g (b -> Void) -> (a -> b) -> a -> Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
      Choose g :: b -> Either b c
g x :: f b
x xs :: Dec f c
xs -> (a -> Either b c) -> f b -> Dec f c -> Dec f a
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose (b -> Either b c
g (b -> Either b c) -> (a -> b) -> a -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) f b
x Dec f c
xs
instance Invariant (Dec f) where
    invmap :: (a -> b) -> (b -> a) -> Dec f a -> Dec f b
invmap _ = (b -> a) -> Dec f a -> Dec f b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap
instance Decide (Dec f) where
    decide :: (a -> Either b c) -> Dec f b -> Dec f c -> Dec f a
decide f :: a -> Either b c
f = \case
      Lose   g :: b -> Void
g      -> (a -> c) -> Dec f c -> Dec f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((b -> c) -> (c -> c) -> Either b c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Void -> c
forall a. Void -> a
absurd (Void -> c) -> (b -> Void) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Void
g) c -> c
forall a. a -> a
id (Either b c -> c) -> (a -> Either b c) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f)
      Choose g :: b -> Either b c
g x :: f b
x xs :: Dec f c
xs -> (a -> Either b (Either c c))
-> f b -> Dec f (Either c c) -> Dec f a
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose (Either (Either b c) c -> Either b (Either c c)
forall (p :: * -> * -> *) a b c.
Assoc p =>
p (p a b) c -> p a (p b c)
assoc (Either (Either b c) c -> Either b (Either c c))
-> (a -> Either (Either b c) c) -> a -> Either b (Either c c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Either b c) -> Either b c -> Either (Either b c) c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> Either b c
g (Either b c -> Either (Either b c) c)
-> (a -> Either b c) -> a -> Either (Either b c) c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f) f b
x
                     (Dec f (Either c c) -> Dec f a)
-> (Dec f c -> Dec f (Either c c)) -> Dec f c -> Dec f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either c c -> Either c c)
-> Dec f c -> Dec f c -> Dec f (Either c c)
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide Either c c -> Either c c
forall a. a -> a
id Dec f c
xs
instance Conclude (Dec f) where
    conclude :: (a -> Void) -> Dec f a
conclude = (a -> Void) -> Dec f a
forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose
instance HFunctor Dec where
    hmap :: (f ~> g) -> Dec f ~> Dec g
hmap = (f ~> g) -> Dec f x -> Dec g x
forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Dec f ~> Dec g
hoistDec
instance Inject Dec where
    inject :: f x -> Dec f x
inject = f x -> Dec f x
forall (f :: * -> *). f ~> Dec f
liftDec
instance Conclude f => Interpret Dec f where
    interpret :: (g ~> f) -> Dec g ~> f
interpret = (g ~> f) -> Dec g x -> f x
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 x. f x -> h (g x)) -> Dec f a -> h (Dec g a)
htraverse f :: forall x. f x -> h (g x)
f = Dec f a -> h (Dec g a)
forall b. Dec f b -> h (Dec g b)
go
      where
        go :: Dec f b -> h (Dec g b)
        go :: Dec f b -> h (Dec g b)
go = \case
          Lose   v :: b -> Void
v      -> Dec g b -> h (Dec g b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b -> Void) -> Dec g b
forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose b -> Void
v)
          Choose g :: b -> Either b c
g x :: f b
x xs :: Dec f c
xs -> (b -> Either b c) -> g b -> Dec g c -> Dec g b
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose b -> Either b c
g (g b -> Dec g c -> Dec g b) -> h (g b) -> h (Dec g c -> Dec g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b -> h (g b)
forall x. f x -> h (g x)
f f b
x h (Dec g c -> Dec g b) -> h (Dec g c) -> h (Dec g b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dec f c -> h (Dec g c)
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 :: (f ~> g) -> Dec f ~> Dec g
hoistDec f :: f ~> g
f = Dec f x -> Dec g x
Dec f ~> Dec g
go
  where
    go :: Dec f ~> Dec g
    go :: Dec f x -> Dec g x
go = \case
      Lose g :: x -> Void
g -> (x -> Void) -> Dec g x
forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose x -> Void
g
      Choose g :: x -> Either b c
g x :: f b
x xs :: Dec f c
xs -> (x -> Either b c) -> g b -> Dec g c -> Dec g x
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose x -> Either b c
g (f b -> g b
f ~> g
f f b
x) (Dec f c -> Dec g c
Dec f ~> Dec g
go Dec f c
xs)

-- | Inject a single action in @f@ into a @'Dec' f@.
liftDec :: f ~> Dec f
liftDec :: f x -> Dec f x
liftDec x :: f x
x = (x -> Either x Void) -> f x -> Dec f Void -> Dec f x
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec f a
Choose x -> Either x Void
forall a b. a -> Either a b
Left f x
x ((Void -> Void) -> Dec f Void
forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose Void -> Void
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 :: (f ~> g) -> Dec f ~> g
runDec f :: f ~> g
f = Dec f x -> g x
Dec f ~> g
go
  where
    go :: Dec f ~> g
    go :: Dec f x -> g x
go = \case
      Lose g :: x -> Void
g -> (x -> Void) -> g x
forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude x -> Void
g
      Choose g :: x -> Either b c
g x :: f b
x xs :: Dec f c
xs -> (x -> Either b c) -> g b -> g c -> g x
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide x -> Either b c
g (f b -> g b
f ~> g
f f b
x) (Dec f c -> g c
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 :: Dec1 f a -> Dec f a
toDec (Dec1 f :: a -> Either b c
f x :: f b
x xs :: Dec f c
xs) = (a -> Either b c) -> f b -> Dec f c -> Dec f a
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 :: (a -> b) -> Dec1 f b -> Dec1 f a
contramap f :: a -> b
f (Dec1 g :: b -> Either b c
g x :: f b
x xs :: Dec f c
xs) = (a -> Either b c) -> f b -> Dec f c -> Dec1 f a
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 (b -> Either b c
g (b -> Either b c) -> (a -> b) -> a -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) f b
x Dec f c
xs
instance Invariant (Dec1 f) where
    invmap :: (a -> b) -> (b -> a) -> Dec1 f a -> Dec1 f b
invmap _ = (b -> a) -> Dec1 f a -> Dec1 f b
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap
instance Decide (Dec1 f) where
    decide :: (a -> Either b c) -> Dec1 f b -> Dec1 f c -> Dec1 f a
decide f :: a -> Either b c
f (Dec1 g :: b -> Either b c
g x :: f b
x xs :: Dec f c
xs) = (a -> Either b (Either c c))
-> f b -> Dec f (Either c c) -> Dec1 f a
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 (Either (Either b c) c -> Either b (Either c c)
forall (p :: * -> * -> *) a b c.
Assoc p =>
p (p a b) c -> p a (p b c)
assoc (Either (Either b c) c -> Either b (Either c c))
-> (a -> Either (Either b c) c) -> a -> Either b (Either c c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Either b c) -> Either b c -> Either (Either b c) c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> Either b c
g (Either b c -> Either (Either b c) c)
-> (a -> Either b c) -> a -> Either (Either b c) c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f) f b
x
                           (Dec f (Either c c) -> Dec1 f a)
-> (Dec1 f c -> Dec f (Either c c)) -> Dec1 f c -> Dec1 f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either c c -> Either c c)
-> Dec f c -> Dec f c -> Dec f (Either c c)
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide Either c c -> Either c c
forall a. a -> a
id Dec f c
xs
                           (Dec f c -> Dec f (Either c c))
-> (Dec1 f c -> Dec f c) -> Dec1 f c -> Dec f (Either c c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec1 f c -> Dec f c
forall (f :: * -> *) a. Dec1 f a -> Dec f a
toDec
instance HFunctor Dec1 where
    hmap :: (f ~> g) -> Dec1 f ~> Dec1 g
hmap = (f ~> g) -> Dec1 f x -> Dec1 g x
forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Dec1 f ~> Dec1 g
hoistDec1
instance Inject Dec1 where
    inject :: f x -> Dec1 f x
inject = f x -> Dec1 f x
forall (f :: * -> *). f ~> Dec1 f
liftDec1
instance Decide f => Interpret Dec1 f where
    interpret :: (g ~> f) -> Dec1 g ~> f
interpret = (g ~> f) -> Dec1 g x -> f x
forall (g :: * -> *) (f :: * -> *).
Decide g =>
(f ~> g) -> Dec1 f ~> g
runDec1

instance HTraversable Dec1 where
    htraverse :: (forall x. f x -> h (g x)) -> Dec1 f a -> h (Dec1 g a)
htraverse f :: forall x. f x -> h (g x)
f (Dec1 g :: a -> Either b c
g x :: f b
x xs :: Dec f c
xs) = (a -> Either b c) -> g b -> Dec g c -> Dec1 g a
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 a -> Either b c
g (g b -> Dec g c -> Dec1 g a) -> h (g b) -> h (Dec g c -> Dec1 g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b -> h (g b)
forall x. f x -> h (g x)
f f b
x h (Dec g c -> Dec1 g a) -> h (Dec g c) -> h (Dec1 g a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall x. f x -> h (g x)) -> Dec f c -> h (Dec g c)
forall k k (t :: (k -> *) -> k -> *) (h :: * -> *) (f :: k -> *)
       (g :: k -> *) (a :: k).
(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 x. f x -> h (g x)) -> Dec1 f a -> h (Dec1 g a)
htraverse1 f :: forall x. f x -> h (g x)
f (Dec1 g :: a -> Either b c
g x :: f b
x xs :: Dec f c
xs) = (forall x. f x -> h (g x))
-> (a -> Either b c) -> f b -> Dec f c -> h (Dec1 g a)
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 :: (f ~> g) -> Dec1 f ~> Dec1 g
hoistDec1 f :: f ~> g
f (Dec1 g :: x -> Either b c
g x :: f b
x xs :: Dec f c
xs) = (x -> Either b c) -> g b -> Dec g c -> Dec1 g x
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 x -> Either b c
g (f b -> g b
f ~> g
f f b
x) ((f ~> g) -> Dec f c -> Dec g c
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 :: f x -> Dec1 f x
liftDec1 x :: f x
x = (x -> Either x Void) -> f x -> Dec f Void -> Dec1 f x
forall a b c (f :: * -> *).
(a -> Either b c) -> f b -> Dec f c -> Dec1 f a
Dec1 x -> Either x Void
forall a b. a -> Either a b
Left f x
x ((Void -> Void) -> Dec f Void
forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose Void -> Void
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 :: (f ~> g) -> Dec1 f ~> g
runDec1 f :: f ~> g
f (Dec1 g :: x -> Either b c
g x :: f b
x xs :: Dec f c
xs) = (f ~> g) -> (x -> Either b c) -> f b -> Dec f c -> g x
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_ :: (f ~> g) -> (a -> Either b c) -> f b -> Dec f c -> g a
runDec1_ f :: f ~> g
f = (a -> Either b c) -> f b -> Dec f c -> g a
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 :: (x -> Either y z) -> f y -> Dec f z -> g x
go g :: x -> Either y z
g x :: f y
x = \case
      Lose h :: z -> Void
h        -> (x -> y) -> g y -> g x
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((y -> y) -> (z -> y) -> Either y z -> y
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either y -> y
forall a. a -> a
id (Void -> y
forall a. Void -> a
absurd (Void -> y) -> (z -> Void) -> z -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. z -> Void
h) (Either y z -> y) -> (x -> Either y z) -> x -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Either y z
g) (f y -> g y
f ~> g
f f y
x)
      Choose h :: z -> Either b c
h y :: f b
y ys :: Dec f c
ys -> (x -> Either y z) -> g y -> g z -> g x
forall (f :: * -> *) a b c.
Decide f =>
(a -> Either b c) -> f b -> f c -> f a
decide x -> Either y z
g (f y -> g y
f ~> g
f f y
x) ((z -> Either b c) -> f b -> Dec f c -> g z
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 x. f x -> h (g x))
-> (a -> Either b c) -> f b -> Dec f c -> h (Dec1 g a)
traverseDec1_ f :: forall x. f x -> h (g x)
f = (a -> Either b c) -> f b -> Dec f c -> h (Dec1 g a)
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 :: (x -> Either y z) -> f y -> Dec f z -> h (Dec1 g x)
go g :: x -> Either y z
g x :: f y
x = \case
      Lose h :: z -> Void
h        -> (\x' :: g y
x' -> (x -> Either y z) -> g y -> Dec g z -> Dec1 g 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' ((z -> Void) -> Dec g z
forall a (f :: * -> *). (a -> Void) -> Dec f a
Lose z -> Void
h)) (g y -> Dec1 g x) -> h (g y) -> h (Dec1 g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f y -> h (g y)
forall x. f x -> h (g x)
f f y
x
      Choose h :: z -> Either b c
h y :: f b
y ys :: Dec f c
ys -> (x -> Either y z) -> g y -> Dec g z -> Dec1 g 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 -> Dec g z -> Dec1 g x) -> h (g y) -> h (Dec g z -> Dec1 g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f y -> h (g y)
forall x. f x -> h (g x)
f f y
x h (Dec g z -> Dec1 g x) -> h (Dec g z) -> h (Dec1 g x)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (Dec1 g z -> Dec g z
forall (f :: * -> *) a. Dec1 f a -> Dec f a
toDec (Dec1 g z -> Dec g z) -> h (Dec1 g z) -> h (Dec g z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (z -> Either b c) -> f b -> Dec f c -> h (Dec1 g z)
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)