{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module      : Data.Functor.Invariant.Internative.Free
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Provide an invariant functor combinator choice-collector, like
-- a combination of 'ListF' and 'Dec'.
--
-- This module was named 'Data.Functor.Invariant.DecAlt' before v0.4.0.0
--
-- @since 0.4.0.0
module Data.Functor.Invariant.Internative.Free (
  -- * Chain
    DecAlt(.., Swerve, Reject)
  , runCoDecAlt
  , runContraDecAlt
  , decAltListF
  , decAltListF_
  , decAltDec
  , foldDecAlt
  , assembleDecAlt
  -- * Nonempty Chain
  , DecAlt1(.., DecAlt1)
  , runCoDecAlt1
  , runContraDecAlt1
  , decAltNonEmptyF
  , decAltNonEmptyF_
  , decAltDec1
  , foldDecAlt1
  , assembleDecAlt1
  ) where

import           Control.Applicative.ListF
import           Control.Natural
import           Data.Coerce
import           Data.Functor.Alt
import           Data.Functor.Contravariant.Conclude
import           Data.Functor.Contravariant.Decide
import           Data.Functor.Contravariant.Divisible.Free
import           Data.Functor.Invariant
import           Data.Functor.Invariant.Internative
import           Data.Functor.Invariant.Night
import           Data.Functor.Plus
import           Data.HBifunctor.Tensor hiding             (elim1, elim2, intro1, intro2)
import           Data.HFunctor
import           Data.HFunctor.Chain
import           Data.HFunctor.Chain.Internal
import           Data.SOP hiding (hmap)
import           Data.Void
import qualified Control.Monad.Trans.Compose               as CT
import qualified Data.Functor.Coyoneda                     as CY
import qualified Data.List.NonEmpty                        as NE


-- | In the covariant direction, we can interpret into any 'Alt'.
--
-- In theory, this shouldn't never be necessary, because you should just be
-- able to use 'interpret', since any instance of 'Alt' is also an instance
-- of 'Inalt'.  However, this can be handy if you are using an instance of
-- 'Alt' that has no 'Inalt' instance.  Consider also 'unsafeInaltCo' if
-- you are using a specific, concrete type for @g@.
runCoDecAlt1
    :: forall f g. Alt g
    => f ~> g
    -> DecAlt1 f ~> g
runCoDecAlt1 :: forall (f :: * -> *) (g :: * -> *).
Alt g =>
(f ~> g) -> DecAlt1 f ~> g
runCoDecAlt1 f ~> g
f = forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> (Night f g ~> g) -> DecAlt1 f ~> g
foldDecAlt1 f ~> g
f (forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
Alt h =>
(f ~> h) -> (g ~> h) -> Night f g ~> h
runNightAlt f ~> g
f forall a. a -> a
id)

-- | In the contravariant direction, we can interpret into any 'Decide'.
--
-- In theory, this shouldn't never be necessary, because you should just be
-- able to use 'interpret', since any instance of 'Decide' is also an instance
-- of 'Inalt'.  However, this can be handy if you are using an instance of
-- 'Decide' that has no 'Inalt' instance.  Consider also
-- 'unsafeInaltContra' if you are using a specific, concrete type for @g@.
runContraDecAlt1
    :: forall f g. Decide g
    => f ~> g
    -> DecAlt1 f ~> g
runContraDecAlt1 :: forall (f :: * -> *) (g :: * -> *).
Decide g =>
(f ~> g) -> DecAlt1 f ~> g
runContraDecAlt1 f ~> g
f = forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> (Night f g ~> g) -> DecAlt1 f ~> g
foldDecAlt1 f ~> g
f (forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
Decide h =>
(f ~> h) -> (g ~> h) -> Night f g ~> h
runNightDecide f ~> g
f forall a. a -> a
id)

-- | Extract the 'Dec' part out of a 'DecAlt', shedding the
-- covariant bits.
decAltDec :: DecAlt f ~> Dec f
decAltDec :: forall (f :: * -> *). DecAlt f ~> Dec f
decAltDec = forall (f :: * -> *) (g :: * -> *).
Conclude g =>
(f ~> g) -> DecAlt f ~> g
runContraDecAlt forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject

-- | Extract the 'Dec1' part out of a 'DecAlt1', shedding the
-- covariant bits.
decAltDec1 :: DecAlt1 f ~> Dec1 f
decAltDec1 :: forall (f :: * -> *). DecAlt1 f ~> Dec1 f
decAltDec1 = forall (f :: * -> *) (g :: * -> *).
Decide g =>
(f ~> g) -> DecAlt1 f ~> g
runContraDecAlt1 forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject

-- | In the covariant direction, we can interpret into any 'Plus'.
--
-- In theory, this shouldn't never be necessary, because you should just be
-- able to use 'interpret', since any instance of 'Plus' is also an instance
-- of 'Inplus'.  However, this can be handy if you are using an instance of
-- 'Plus' that has no 'Inplus' instance.  Consider also 'unsafeInplusCo' if
-- you are using a specific, concrete type for @g@.
runCoDecAlt
    :: forall f g. Plus g
    => f ~> g
    -> DecAlt f ~> g
runCoDecAlt :: forall (f :: * -> *) (g :: * -> *).
Plus g =>
(f ~> g) -> DecAlt f ~> g
runCoDecAlt f ~> g
f = forall (g :: * -> *) (f :: * -> *).
(forall x. (x -> Void) -> g x) -> (Night f g ~> g) -> DecAlt f ~> g
foldDecAlt (forall a b. a -> b -> a
const forall (f :: * -> *) a. Plus f => f a
zero) (forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
Alt h =>
(f ~> h) -> (g ~> h) -> Night f g ~> h
runNightAlt f ~> g
f forall a. a -> a
id)

-- | In the contravariant direction, we can interpret into any 'Decide'.
--
-- In theory, this shouldn't never be necessary, because you should just be
-- able to use 'interpret', since any instance of 'Conclude' is also an
-- instance of 'Inplus'.  However, this can be handy if you are using an
-- instance of 'Conclude' that has no 'Inplus' instance.  Consider also
-- 'unsafeInplusContra' if you are using a specific, concrete type for @g@.
runContraDecAlt
    :: forall f g. Conclude g
    => f ~> g
    -> DecAlt f ~> g
runContraDecAlt :: forall (f :: * -> *) (g :: * -> *).
Conclude g =>
(f ~> g) -> DecAlt f ~> g
runContraDecAlt f ~> g
f = forall (g :: * -> *) (f :: * -> *).
(forall x. (x -> Void) -> g x) -> (Night f g ~> g) -> DecAlt f ~> g
foldDecAlt forall (f :: * -> *) a. Conclude f => (a -> Void) -> f a
conclude (forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
Decide h =>
(f ~> h) -> (g ~> h) -> Night f g ~> h
runNightDecide f ~> g
f forall a. a -> a
id)

-- | Extract the 'ListF' part out of a 'DecAlt', shedding the
-- contravariant bits.
--
-- @since 0.3.2.0
decAltListF :: Functor f => DecAlt f ~> ListF f
decAltListF :: forall (f :: * -> *). Functor f => DecAlt f ~> ListF f
decAltListF = forall (f :: * -> *) (g :: * -> *).
Plus g =>
(f ~> g) -> DecAlt f ~> g
runCoDecAlt forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject

-- | Extract the 'ListF' part out of a 'DecAlt', shedding the
-- contravariant bits.
--
-- This version does not require a 'Functor' constraint because it converts
-- to the coyoneda-wrapped product, which is more accurately the true
-- conversion to a covariant chain.
--
-- @since 0.3.2.0
decAltListF_ :: DecAlt f ~> CT.ComposeT ListF CY.Coyoneda f
decAltListF_ :: forall (f :: * -> *). DecAlt f ~> ComposeT ListF Coyoneda f
decAltListF_ = forall (g :: * -> *) (f :: * -> *).
(forall x. (x -> Void) -> g x) -> (Night f g ~> g) -> DecAlt f ~> g
foldDecAlt (forall a b. a -> b -> a
const (forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) a.
f (g m) a -> ComposeT f g m a
CT.ComposeT (forall {k} (f :: k -> *) (a :: k). [f a] -> ListF f a
ListF []))) forall a b. (a -> b) -> a -> b
$ \case
    Night f b1
x (CT.ComposeT (ListF [Coyoneda f c1]
xs)) b1 -> x
f c1 -> x
g x -> Either b1 c1
_ -> forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) a.
f (g m) a -> ComposeT f g m a
CT.ComposeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). [f a] -> ListF f a
ListF forall a b. (a -> b) -> a -> b
$
      forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
CY.Coyoneda b1 -> x
f f b1
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 b. Functor f => (a -> b) -> f a -> f b
fmap) c1 -> x
g [Coyoneda f c1]
xs

-- | Extract the 'NonEmptyF' part out of a 'DecAlt1', shedding the
-- contravariant bits.
--
-- @since 0.3.2.0
decAltNonEmptyF :: Functor f => DecAlt1 f ~> NonEmptyF f
decAltNonEmptyF :: forall (f :: * -> *). Functor f => DecAlt1 f ~> NonEmptyF f
decAltNonEmptyF = forall (f :: * -> *) (g :: * -> *).
Alt g =>
(f ~> g) -> DecAlt1 f ~> g
runCoDecAlt1 forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject

-- | Extract the 'NonEmptyF' part out of a 'DecAlt1', shedding the
-- contravariant bits.
--
-- This version does not require a 'Functor' constraint because it converts
-- to the coyoneda-wrapped product, which is more accurately the true
-- conversion to a covariant chain.
--
-- @since 0.3.2.0
decAltNonEmptyF_ :: DecAlt1 f ~> CT.ComposeT NonEmptyF CY.Coyoneda f
decAltNonEmptyF_ :: forall (f :: * -> *). DecAlt1 f ~> ComposeT NonEmptyF Coyoneda f
decAltNonEmptyF_ = forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> (Night f g ~> g) -> DecAlt1 f ~> g
foldDecAlt1 forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject forall a b. (a -> b) -> a -> b
$ \case
    Night f b1
x (CT.ComposeT (NonEmptyF NonEmpty (Coyoneda f c1)
xs)) b1 -> x
f c1 -> x
g x -> Either b1 c1
_ -> forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) a.
f (g m) a -> ComposeT f g m a
CT.ComposeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). NonEmpty (f a) -> NonEmptyF f a
NonEmptyF forall a b. (a -> b) -> a -> b
$
      forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
CY.Coyoneda b1 -> x
f f b1
x forall a. a -> NonEmpty a -> NonEmpty a
NE.<| (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) c1 -> x
g NonEmpty (Coyoneda f c1)
xs

-- | General-purpose folder of 'DecAlt'.  Provide a way to handle the
-- identity ('empty'/'conclude'/'Reject') and a way to handle a cons
-- ('<!>'/'decide'/'swerve').
--
-- @since 0.3.5.0
foldDecAlt
    :: (forall x. (x -> Void) -> g x)
    -> (Night f g ~> g)
    -> DecAlt f ~> g
foldDecAlt :: forall (g :: * -> *) (f :: * -> *).
(forall x. (x -> Void) -> g x) -> (Night f g ~> g) -> DecAlt f ~> g
foldDecAlt forall x. (x -> Void) -> g x
f Night f g ~> g
g = forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k -> *) (g :: k -> *).
HBifunctor t =>
(i ~> g) -> (t f g ~> g) -> Chain t i f ~> g
foldChain (forall x. (x -> Void) -> g x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Not a -> a -> Void
refute) Night f g ~> g
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. DecAlt f a -> Chain Night Not f a
unDecAlt

-- | General-purpose folder of 'DecAlt1'.  Provide a way to handle the
-- individual leaves and a way to handle a cons ('<!>'/'decide'/'swerve').
--
-- @since 0.3.5.0
foldDecAlt1
    :: (f ~> g)
    -> (Night f g ~> g)
    -> DecAlt1 f ~> g
foldDecAlt1 :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> (Night f g ~> g) -> DecAlt1 f ~> g
foldDecAlt1 f ~> g
f Night f g ~> g
g = forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HBifunctor t =>
(f ~> g) -> (t f g ~> g) -> Chain1 t f ~> g
foldChain1 f ~> g
f Night f g ~> g
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. DecAlt1 f a -> Chain1 Night f a
unDecAlt1

-- | Match on a non-empty 'DecAlt'; contains the splitting function,
-- the two rejoining functions, the first @f@, and the rest of the chain.
-- Analogous to the 'Data.Functor.Contravariant.Divisible.Free.Choose'
-- constructor.
pattern Swerve :: (b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> DecAlt f c -> DecAlt f a
pattern $bSwerve :: forall a (f :: * -> *) b c.
(b -> a)
-> (c -> a) -> (a -> Either b c) -> f b -> DecAlt f c -> DecAlt f a
$mSwerve :: forall {r} {a} {f :: * -> *}.
DecAlt f a
-> (forall {b} {c}.
    (b -> a)
    -> (c -> a) -> (a -> Either b c) -> f b -> DecAlt f c -> r)
-> ((# #) -> r)
-> r
Swerve f g h x xs <- (unSwerve_->MaybeF (Just (Night x xs f g h)))
  where
    Swerve b -> a
f c -> a
g a -> Either b c
h f b
x DecAlt f c
xs = forall (f :: * -> *) a. Chain Night Not f a -> DecAlt f a
DecAlt forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
t f (Chain t i f) a -> Chain t i f a
More forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
Night f b
x (forall (f :: * -> *) a. DecAlt f a -> Chain Night Not f a
unDecAlt DecAlt f c
xs) b -> a
f c -> a
g a -> Either b c
h

unSwerve_ :: DecAlt f ~> MaybeF (Night f (DecAlt f))
unSwerve_ :: forall (f :: * -> *). DecAlt f ~> MaybeF (Night f (DecAlt f))
unSwerve_ = \case
  DecAlt (More (Night f b1
x Chain Night Not f c1
xs b1 -> x
g c1 -> x
f x -> Either b1 c1
h)) -> forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> MaybeF f a
MaybeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
Night f b1
x (forall (f :: * -> *) a. Chain Night Not f a -> DecAlt f a
DecAlt Chain Night Not f c1
xs) b1 -> x
g c1 -> x
f x -> Either b1 c1
h
  DecAlt (Done Not x
_                 ) -> forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> MaybeF f a
MaybeF forall a. Maybe a
Nothing


-- | Match on an "empty" 'DecAlt'; contains no @f@s, but only the
-- terminal value.  Analogous to the
-- 'Data.Functor.Contravariant.Divisible.Free.Lose' constructor.
pattern Reject :: (a -> Void) -> DecAlt f a
pattern $bReject :: forall a (f :: * -> *). (a -> Void) -> DecAlt f a
$mReject :: forall {r} {a} {f :: * -> *}.
DecAlt f a -> ((a -> Void) -> r) -> ((# #) -> r) -> r
Reject x = DecAlt (Done (Not x))
{-# COMPLETE Swerve, Reject #-}

instance Inalt (DecAlt f) where
    swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> DecAlt f b
-> DecAlt f c
-> DecAlt f a
swerve = coerce :: forall a b. Coercible a b => a -> b
coerce (forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve @(Chain Night Not _))

instance Inplus (DecAlt f) where
    reject :: forall a. (a -> Void) -> DecAlt f a
reject = coerce :: forall a b. Coercible a b => a -> b
coerce (forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject @(Chain Night Not _))

-- | Match on a 'DecAlt1' to get the head and the rest of the items.
-- Analogous to the 'Data.Functor.Contravariant.Divisible.Free.Dec1'
-- constructor.
pattern DecAlt1 :: Invariant f => (b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> DecAlt f c -> DecAlt1 f a
pattern $bDecAlt1 :: forall (f :: * -> *) a b c.
Invariant f =>
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> f b
-> DecAlt f c
-> DecAlt1 f a
$mDecAlt1 :: forall {r} {f :: * -> *} {a}.
Invariant f =>
DecAlt1 f a
-> (forall {b} {c}.
    (b -> a)
    -> (c -> a) -> (a -> Either b c) -> f b -> DecAlt f c -> r)
-> ((# #) -> r)
-> r
DecAlt1 f g h x xs <- (coerce splitChain1->Night x xs f g h)
  where
    DecAlt1 b -> a
f c -> a
g a -> Either b c
h f b
x DecAlt f c
xs = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
(Matchable t i, FunctorBy t f) =>
t f (ListBy t f) ~> NonEmptyBy t f
unsplitNE forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
Night f b
x DecAlt f c
xs b -> a
f c -> a
g a -> Either b c
h
{-# COMPLETE DecAlt1 #-}

instance Invariant f => Inalt (DecAlt1 f) where
    swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> DecAlt1 f b
-> DecAlt1 f c
-> DecAlt1 f a
swerve = coerce :: forall a b. Coercible a b => a -> b
coerce (forall (f :: * -> *) b a c.
Inalt f =>
(b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> f c -> f a
swerve @(Chain1 Night _))

-- | Convenient wrapper to build up a 'DecAlt' on by providing each
-- branch of it.  This makes it much easier to build up longer chains
-- because you would only need to write the splitting/joining functions in
-- one place.
--
-- For example, if you had a data type
--
-- @
-- data MyType = MTI Int | MTB Bool | MTS String
-- @
--
-- and an invariant functor @Prim@ (representing, say, a bidirectional
-- parser, where @Prim Int@ is a bidirectional parser for an 'Int'@),
-- then you could assemble a bidirectional parser for a @MyType@ using:
--
-- @
-- invmap (\case MTI x -> Z (I x); MTB y -> S (Z (I y)); MTS z -> S (S (Z (I z))))
--        (\case Z (I x) -> MTI x; S (Z (I y)) -> MTB y; S (S (Z (I z))) -> MTS z) $
--   assembleDecAlt $ intPrim
--                     :* boolPrim
--                     :* stringPrim
--                     :* Nil
-- @
--
-- Some notes on usefulness depending on how many components you have:
--
-- *    If you have 0 components, use 'Reject' directly.
-- *    If you have 1 component, use 'inject' or 'injectChain' directly.
-- *    If you have 2 components, use 'toListBy' or 'toChain'.
-- *    If you have 3 or more components, these combinators may be useful;
--      otherwise you'd need to manually peel off eithers one-by-one.
--
-- If each component is itself a @'DecAlt' f@ (instead of @f@), you can use
-- 'concatInplus'.
assembleDecAlt
    :: NP f as
    -> DecAlt f (NS I as)
assembleDecAlt :: forall (f :: * -> *) (as :: [*]). NP f as -> DecAlt f (NS I as)
assembleDecAlt = \case
    NP f as
Nil     -> forall (f :: * -> *) a. Chain Night Not f a -> DecAlt f a
DecAlt forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall a b. (a -> b) -> a -> b
$ forall a. (a -> Void) -> Not a
Not (\case {})
    f x
x :* NP f xs
xs -> forall (f :: * -> *) a. Chain Night Not f a -> DecAlt f a
DecAlt forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
t f (Chain t i f) a -> Chain t i f a
More forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
Night
      f x
x
      (forall (f :: * -> *) a. DecAlt f a -> Chain Night Not f a
unDecAlt forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (as :: [*]). NP f as -> DecAlt f (NS I as)
assembleDecAlt NP f xs
xs)
      (forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> I a
I)
      forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S
      (\case Z (I x
y) -> forall a b. a -> Either a b
Left x
y; S NS I xs
ys -> forall a b. b -> Either a b
Right NS I xs
ys)

-- | A version of 'assembleDecAlt' but for 'DecAlt1' instead.  Can
-- be useful if you intend on interpreting it into something with only
-- a 'Decide' or 'Alt' instance, but no
-- 'Data.Functor.Contravariant.Divisible.Decidable' or 'Plus' or
-- 'Control.Applicative.Alternative'.
--
-- If each component is itself a @'DecAlt1' f@ (instead of @f@), you can
-- use 'concatInalt'.
assembleDecAlt1
    :: Invariant f
    => NP f (a ': as)
    -> DecAlt1 f (NS I (a ': as))
assembleDecAlt1 :: forall (f :: * -> *) a (as :: [*]).
Invariant f =>
NP f (a : as) -> DecAlt1 f (NS I (a : as))
assembleDecAlt1 (f x
x :* NP f xs
xs) = forall (f :: * -> *) a. Chain1 Night f a -> DecAlt1 f a
DecAlt1_ forall a b. (a -> b) -> a -> b
$ case NP f xs
xs of
    NP f xs
Nil    -> forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap (forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> I a
I) (forall a. I a -> a
unI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
unZ) f x
x
    f x
_ :* NP f xs
_ -> forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
Night
      f x
x
      (forall (f :: * -> *) a. DecAlt1 f a -> Chain1 Night f a
unDecAlt1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a (as :: [*]).
Invariant f =>
NP f (a : as) -> DecAlt1 f (NS I (a : as))
assembleDecAlt1 NP f xs
xs)
      (forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> I a
I)
      forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S
      (\case Z (I x
y) -> forall a b. a -> Either a b
Left x
y; S NS I xs
ys -> forall a b. b -> Either a b
Right NS I xs
ys)