{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ExistentialQuantification #-}
module Data.Fold.L1'
( L1'(..)
) where
import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Monad.Fix
import Control.Monad.Reader.Class
import Control.Lens
import Data.Distributive
import Data.Fold.Class
import Data.Fold.Internal
import Data.Functor.Apply
import Data.Functor.Rep as Functor
import Data.List.NonEmpty as NonEmpty
import Data.Pointed
import Data.Profunctor.Closed
import Data.Profunctor
import Data.Profunctor.Rep as Profunctor
import Data.Profunctor.Sieve
import Data.Profunctor.Unsafe
import Data.Semigroupoid
import Prelude hiding (id,(.))
import Unsafe.Coerce
data L1' a b = forall c. L1' (c -> b) (c -> a -> c) (a -> c)
instance Scan L1' where
run1 :: a -> L1' a b -> b
run1 a
a (L1' c -> b
k c -> a -> c
_ a -> c
z) = c -> b
k (a -> c
z a
a)
prefix1 :: a -> L1' a b -> L1' a b
prefix1 a
a (L1' c -> b
k c -> a -> c
h a -> c
z) = (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' c -> b
k c -> a -> c
h (c -> a -> c
h (c -> a -> c) -> c -> a -> c
forall a b. (a -> b) -> a -> b
$! a -> c
z a
a)
postfix1 :: L1' a b -> a -> L1' a b
postfix1 (L1' c -> b
k c -> a -> c
h a -> c
z) a
a = (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (\c
c -> c -> b
k (c -> b) -> c -> b
forall a b. (a -> b) -> a -> b
$! c -> a -> c
h c
c a
a) c -> a -> c
h a -> c
z
interspersing :: a -> L1' a b -> L1' a b
interspersing a
a (L1' c -> b
k c -> a -> c
h a -> c
z) = (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' c -> b
k (\c
x a
b -> (c -> a -> c
h (c -> a -> c) -> c -> a -> c
forall a b. (a -> b) -> a -> b
$! c -> a -> c
h c
x a
a) a
b) a -> c
z
{-# INLINE run1 #-}
{-# INLINE prefix1 #-}
{-# INLINE postfix1 #-}
{-# INLINE interspersing #-}
instance Functor (L1' a) where
fmap :: (a -> b) -> L1' a a -> L1' a b
fmap a -> b
f (L1' c -> a
k c -> a -> c
h a -> c
z) = (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (a -> b
f(a -> b) -> (c -> a) -> c -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.c -> a
k) c -> a -> c
h a -> c
z
{-# INLINE fmap #-}
a
b <$ :: a -> L1' a b -> L1' a a
<$ L1' a b
_ = a -> L1' a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b
{-# INLINE (<$) #-}
instance Pointed (L1' a) where
point :: a -> L1' a a
point a
x = (() -> a) -> (() -> a -> ()) -> (a -> ()) -> L1' a a
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (\() -> a
x) (\() a
_ -> ()) (\a
_ -> ())
{-# INLINE point #-}
instance Apply (L1' a) where
<.> :: L1' a (a -> b) -> L1' a a -> L1' a b
(<.>) = L1' a (a -> b) -> L1' a a -> L1' a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
{-# INLINE (<.>) #-}
<. :: L1' a a -> L1' a b -> L1' a a
(<.) L1' a a
m = \L1' a b
_ -> L1' a a
m
{-# INLINE (<.) #-}
L1' a a
_ .> :: L1' a a -> L1' a b -> L1' a b
.> L1' a b
m = L1' a b
m
{-# INLINE (.>) #-}
instance Applicative (L1' a) where
pure :: a -> L1' a a
pure a
x = (() -> a) -> (() -> a -> ()) -> (a -> ()) -> L1' a a
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (\() -> a
x) (\() a
_ -> ()) (\a
_ -> ())
{-# INLINE pure #-}
L1' c -> a -> b
kf c -> a -> c
hf a -> c
zf <*> :: L1' a (a -> b) -> L1' a a -> L1' a b
<*> L1' c -> a
ka c -> a -> c
ha a -> c
za = (Pair' c c -> b)
-> (Pair' c c -> a -> Pair' c c) -> (a -> Pair' c c) -> L1' a b
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1'
(\(Pair' c
x c
y) -> c -> a -> b
kf c
x (c -> a
ka c
y))
(\(Pair' c
x c
y) a
a -> c -> c -> Pair' c c
forall a b. a -> b -> Pair' a b
Pair' (c -> a -> c
hf c
x a
a) (c -> a -> c
ha c
y a
a))
(\a
a -> c -> c -> Pair' c c
forall a b. a -> b -> Pair' a b
Pair' (a -> c
zf a
a) (a -> c
za a
a))
<* :: L1' a a -> L1' a b -> L1' a a
(<*) L1' a a
m = \ L1' a b
_ -> L1' a a
m
{-# INLINE (<*) #-}
L1' a a
_ *> :: L1' a a -> L1' a b -> L1' a b
*> L1' a b
m = L1' a b
m
{-# INLINE (*>) #-}
instance Monad (L1' a) where
return :: a -> L1' a a
return = a -> L1' a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
L1' a a
m >>= :: L1' a a -> (a -> L1' a b) -> L1' a b
>>= a -> L1' a b
f = (SnocList1 a -> a -> b)
-> (SnocList1 a -> a -> SnocList1 a)
-> (a -> SnocList1 a)
-> L1' a (a -> b)
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (\SnocList1 a
xs a
a -> SnocList1 a -> L1' a b -> b
forall a b. SnocList1 a -> L1' a b -> b
walk SnocList1 a
xs (a -> L1' a b
f a
a)) SnocList1 a -> a -> SnocList1 a
forall a. SnocList1 a -> a -> SnocList1 a
Snoc1 a -> SnocList1 a
forall a. a -> SnocList1 a
First L1' a (a -> b) -> L1' a a -> L1' a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> L1' a a
m
{-# INLINE (>>=) #-}
>> :: L1' a a -> L1' a b -> L1' a b
(>>) = L1' a a -> L1' a b -> L1' a b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
{-# INLINE (>>) #-}
instance Semigroupoid L1' where
o :: L1' j k1 -> L1' i j -> L1' i k1
o = L1' j k1 -> L1' i j -> L1' i k1
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.)
{-# INLINE o #-}
instance Category L1' where
id :: L1' a a
id = (a -> a) -> L1' a a
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINE id #-}
L1' c -> c
k c -> b -> c
h b -> c
z . :: L1' b c -> L1' a b -> L1' a c
. L1' c -> b
k' c -> a -> c
h' a -> c
z' = (Pair' c c -> c)
-> (Pair' c c -> a -> Pair' c c) -> (a -> Pair' c c) -> L1' a c
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (\(Pair' c
b c
_) -> c -> c
k c
b) Pair' c c -> a -> Pair' c c
h'' a -> Pair' c c
z'' where
z'' :: a -> Pair' c c
z'' a
a = c -> c -> Pair' c c
forall a b. a -> b -> Pair' a b
Pair' (b -> c
z (c -> b
k' c
b)) c
b where b :: c
b = a -> c
z' a
a
h'' :: Pair' c c -> a -> Pair' c c
h'' (Pair' c
c c
d) a
a = c -> c -> Pair' c c
forall a b. a -> b -> Pair' a b
Pair' (c -> b -> c
h c
c (c -> b
k' c
d')) c
d' where d' :: c
d' = c -> a -> c
h' c
d a
a
{-# INLINE (.) #-}
instance Arrow L1' where
arr :: (b -> c) -> L1' b c
arr b -> c
h = (b -> c) -> (b -> b -> b) -> (b -> b) -> L1' b c
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' b -> c
h (\b
_ b
a -> b
a) b -> b
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINE arr #-}
first :: L1' b c -> L1' (b, d) (c, d)
first (L1' c -> c
k c -> b -> c
h b -> c
z) = ((c, d) -> (c, d))
-> ((c, d) -> (b, d) -> (c, d))
-> ((b, d) -> (c, d))
-> L1' (b, d) (c, d)
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' ((c -> c) -> (c, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first c -> c
k) (c, d) -> (b, d) -> (c, d)
h' ((b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first b -> c
z) where
h' :: (c, d) -> (b, d) -> (c, d)
h' (c
a,d
_) (b
c,d
b) = (c -> b -> c
h c
a b
c, d
b)
{-# INLINE first #-}
second :: L1' b c -> L1' (d, b) (d, c)
second (L1' c -> c
k c -> b -> c
h b -> c
z) = ((d, c) -> (d, c))
-> ((d, c) -> (d, b) -> (d, c))
-> ((d, b) -> (d, c))
-> L1' (d, b) (d, c)
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' ((c -> c) -> (d, c) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> c
k) (d, c) -> (d, b) -> (d, c)
h' ((b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second b -> c
z) where
h' :: (d, c) -> (d, b) -> (d, c)
h' (d
_,c
b) (d
a,b
c) = (d
a, c -> b -> c
h c
b b
c)
{-# INLINE second #-}
L1' c -> c
k c -> b -> c
h b -> c
z *** :: L1' b c -> L1' b' c' -> L1' (b, b') (c, c')
*** L1' c -> c'
k' c -> b' -> c
h' b' -> c
z' = ((c, c) -> (c, c'))
-> ((c, c) -> (b, b') -> (c, c))
-> ((b, b') -> (c, c))
-> L1' (b, b') (c, c')
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (c -> c
k (c -> c) -> (c -> c') -> (c, c) -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** c -> c'
k') (c, c) -> (b, b') -> (c, c)
h'' (b -> c
z (b -> c) -> (b' -> c) -> (b, b') -> (c, c)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** b' -> c
z') where
h'' :: (c, c) -> (b, b') -> (c, c)
h'' (c
a,c
b) (b
c,b'
d) = (c -> b -> c
h c
a b
c, c -> b' -> c
h' c
b b'
d)
{-# INLINE (***) #-}
L1' c -> c
k c -> b -> c
h b -> c
z &&& :: L1' b c -> L1' b c' -> L1' b (c, c')
&&& L1' c -> c'
k' c -> b -> c
h' b -> c
z' = ((c, c) -> (c, c'))
-> ((c, c) -> b -> (c, c)) -> (b -> (c, c)) -> L1' b (c, c')
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (c -> c
k (c -> c) -> (c -> c') -> (c, c) -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** c -> c'
k') (c, c) -> b -> (c, c)
h'' (b -> c
z (b -> c) -> (b -> c) -> b -> (c, c)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& b -> c
z') where
h'' :: (c, c) -> b -> (c, c)
h'' (c
c,c
d) b
a = (c -> b -> c
h c
c b
a, c -> b -> c
h' c
d b
a)
{-# INLINE (&&&) #-}
instance Profunctor L1' where
dimap :: (a -> b) -> (c -> d) -> L1' b c -> L1' a d
dimap a -> b
f c -> d
g (L1' c -> c
k c -> b -> c
h b -> c
z) = (c -> d) -> (c -> a -> c) -> (a -> c) -> L1' a d
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (c -> d
g(c -> d) -> (c -> c) -> c -> d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.c -> c
k) (\c
a -> c -> b -> c
h c
a (b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f) (b -> c
z(b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.a -> b
f)
{-# INLINE dimap #-}
lmap :: (a -> b) -> L1' b c -> L1' a c
lmap a -> b
f (L1' c -> c
k c -> b -> c
h b -> c
z) = (c -> c) -> (c -> a -> c) -> (a -> c) -> L1' a c
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' c -> c
k (\c
a -> c -> b -> c
h c
a (b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f) (b -> c
z(b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.a -> b
f)
{-# INLINE lmap #-}
rmap :: (b -> c) -> L1' a b -> L1' a c
rmap b -> c
g (L1' c -> b
k c -> a -> c
h a -> c
z) = (c -> c) -> (c -> a -> c) -> (a -> c) -> L1' a c
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (b -> c
g(b -> c) -> (c -> b) -> c -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.c -> b
k) c -> a -> c
h a -> c
z
{-# INLINE rmap #-}
( #. ) q b c
_ = L1' a b -> L1' a c
forall a b. a -> b
unsafeCoerce
{-# INLINE (#.) #-}
L1' b c
x .# :: L1' b c -> q a b -> L1' a c
.# q a b
_ = L1' b c -> L1' a c
forall a b. a -> b
unsafeCoerce L1' b c
x
{-# INLINE (.#) #-}
instance Strong L1' where
first' :: L1' a b -> L1' (a, c) (b, c)
first' = L1' a b -> L1' (a, c) (b, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
{-# INLINE first' #-}
second' :: L1' a b -> L1' (c, a) (c, b)
second' = L1' a b -> L1' (c, a) (c, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
{-# INLINE second' #-}
instance Choice L1' where
left' :: L1' a b -> L1' (Either a c) (Either b c)
left' (L1' c -> b
k c -> a -> c
h a -> c
z) = (Either c c -> Either b c)
-> (Either c c -> Either a c -> Either c c)
-> (Either a c -> Either c c)
-> L1' (Either a c) (Either b c)
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' ((c -> Identity b) -> Either c c -> Identity (Either b c)
forall a c b. Prism (Either a c) (Either b c) a b
_Left ((c -> Identity b) -> Either c c -> Identity (Either b c))
-> (c -> b) -> Either c c -> Either b c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ c -> b
k) Either c c -> Either a c -> Either c c
step ((a -> Identity c) -> Either a c -> Identity (Either c c)
forall a c b. Prism (Either a c) (Either b c) a b
_Left ((a -> Identity c) -> Either a c -> Identity (Either c c))
-> (a -> c) -> Either a c -> Either c c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> c
z) where
step :: Either c c -> Either a c -> Either c c
step (Left c
x) (Left a
y) = c -> Either c c
forall a b. a -> Either a b
Left (c -> a -> c
h c
x a
y)
step (Right c
c) Either a c
_ = c -> Either c c
forall a b. b -> Either a b
Right c
c
step Either c c
_ (Right c
c) = c -> Either c c
forall a b. b -> Either a b
Right c
c
{-# INLINE left' #-}
right' :: L1' a b -> L1' (Either c a) (Either c b)
right' (L1' c -> b
k c -> a -> c
h a -> c
z) = (Either c c -> Either c b)
-> (Either c c -> Either c a -> Either c c)
-> (Either c a -> Either c c)
-> L1' (Either c a) (Either c b)
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' ((c -> Identity b) -> Either c c -> Identity (Either c b)
forall c a b. Prism (Either c a) (Either c b) a b
_Right ((c -> Identity b) -> Either c c -> Identity (Either c b))
-> (c -> b) -> Either c c -> Either c b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ c -> b
k) Either c c -> Either c a -> Either c c
step ((a -> Identity c) -> Either c a -> Identity (Either c c)
forall c a b. Prism (Either c a) (Either c b) a b
_Right ((a -> Identity c) -> Either c a -> Identity (Either c c))
-> (a -> c) -> Either c a -> Either c c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> c
z) where
step :: Either c c -> Either c a -> Either c c
step (Right c
x) (Right a
y) = c -> Either c c
forall a b. b -> Either a b
Right (c -> a -> c
h c
x a
y)
step (Left c
c) Either c a
_ = c -> Either c c
forall a b. a -> Either a b
Left c
c
step Either c c
_ (Left c
c) = c -> Either c c
forall a b. a -> Either a b
Left c
c
{-# INLINE right' #-}
instance ArrowChoice L1' where
left :: L1' b c -> L1' (Either b d) (Either c d)
left (L1' c -> c
k c -> b -> c
h b -> c
z) = (Either c d -> Either c d)
-> (Either c d -> Either b d -> Either c d)
-> (Either b d -> Either c d)
-> L1' (Either b d) (Either c d)
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' ((c -> Identity c) -> Either c d -> Identity (Either c d)
forall a c b. Prism (Either a c) (Either b c) a b
_Left ((c -> Identity c) -> Either c d -> Identity (Either c d))
-> (c -> c) -> Either c d -> Either c d
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ c -> c
k) Either c d -> Either b d -> Either c d
step ((b -> Identity c) -> Either b d -> Identity (Either c d)
forall a c b. Prism (Either a c) (Either b c) a b
_Left ((b -> Identity c) -> Either b d -> Identity (Either c d))
-> (b -> c) -> Either b d -> Either c d
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ b -> c
z) where
step :: Either c d -> Either b d -> Either c d
step (Left c
x) (Left b
y) = c -> Either c d
forall a b. a -> Either a b
Left (c -> b -> c
h c
x b
y)
step (Right d
c) Either b d
_ = d -> Either c d
forall a b. b -> Either a b
Right d
c
step Either c d
_ (Right d
c) = d -> Either c d
forall a b. b -> Either a b
Right d
c
{-# INLINE left #-}
right :: L1' b c -> L1' (Either d b) (Either d c)
right (L1' c -> c
k c -> b -> c
h b -> c
z) = (Either d c -> Either d c)
-> (Either d c -> Either d b -> Either d c)
-> (Either d b -> Either d c)
-> L1' (Either d b) (Either d c)
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' ((c -> Identity c) -> Either d c -> Identity (Either d c)
forall c a b. Prism (Either c a) (Either c b) a b
_Right ((c -> Identity c) -> Either d c -> Identity (Either d c))
-> (c -> c) -> Either d c -> Either d c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ c -> c
k) Either d c -> Either d b -> Either d c
step ((b -> Identity c) -> Either d b -> Identity (Either d c)
forall c a b. Prism (Either c a) (Either c b) a b
_Right ((b -> Identity c) -> Either d b -> Identity (Either d c))
-> (b -> c) -> Either d b -> Either d c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ b -> c
z) where
step :: Either d c -> Either d b -> Either d c
step (Right c
x) (Right b
y) = c -> Either d c
forall a b. b -> Either a b
Right (c -> b -> c
h c
x b
y)
step (Left d
c) Either d b
_ = d -> Either d c
forall a b. a -> Either a b
Left d
c
step Either d c
_ (Left d
c) = d -> Either d c
forall a b. a -> Either a b
Left d
c
{-# INLINE right #-}
walk :: SnocList1 a -> L1' a b -> b
walk :: SnocList1 a -> L1' a b -> b
walk SnocList1 a
xs0 (L1' c -> b
k c -> a -> c
h a -> c
z) = c -> b
k (SnocList1 a -> c
go SnocList1 a
xs0) where
go :: SnocList1 a -> c
go (First a
a) = a -> c
z a
a
go (Snoc1 SnocList1 a
as a
a) = c -> a -> c
h (SnocList1 a -> c
go SnocList1 a
as) a
a
{-# INLINE walk #-}
instance Cosieve L1' NonEmpty where
cosieve :: L1' a b -> NonEmpty a -> b
cosieve (L1' c -> b
k c -> a -> c
h a -> c
z) (a
a :| [a]
as) = c -> b
k ((c -> a -> c) -> c -> [a] -> c
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl c -> a -> c
h (a -> c
z a
a) [a]
as)
instance Costrong L1' where
unfirst :: L1' (a, d) (b, d) -> L1' a b
unfirst = L1' (a, d) (b, d) -> L1' a b
forall (p :: * -> * -> *) a d b.
Corepresentable p =>
p (a, d) (b, d) -> p a b
unfirstCorep
unsecond :: L1' (d, a) (d, b) -> L1' a b
unsecond = L1' (d, a) (d, b) -> L1' a b
forall (p :: * -> * -> *) d a b.
Corepresentable p =>
p (d, a) (d, b) -> p a b
unsecondCorep
instance Profunctor.Corepresentable L1' where
type Corep L1' = NonEmpty
cotabulate :: (Corep L1' d -> c) -> L1' d c
cotabulate Corep L1' d -> c
f = ([d] -> c) -> ([d] -> d -> [d]) -> (d -> [d]) -> L1' d c
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (NonEmpty d -> c
Corep L1' d -> c
f (NonEmpty d -> c) -> ([d] -> NonEmpty d) -> [d] -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [d] -> NonEmpty d
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([d] -> NonEmpty d) -> ([d] -> [d]) -> [d] -> NonEmpty d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [d] -> [d]
forall a. [a] -> [a]
Prelude.reverse) ((d -> [d] -> [d]) -> [d] -> d -> [d]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) d -> [d]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE cotabulate #-}
instance Distributive (L1' a) where
distribute :: f (L1' a a) -> L1' a (f a)
distribute = f (L1' a a) -> L1' a (f a)
forall (f :: * -> *) (w :: * -> *) a.
(Representable f, Functor w) =>
w (f a) -> f (w a)
distributeRep
instance Functor.Representable (L1' a) where
type Rep (L1' a) = NonEmpty a
tabulate :: (Rep (L1' a) -> a) -> L1' a a
tabulate = (Rep (L1' a) -> a) -> L1' a a
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate
index :: L1' a a -> Rep (L1' a) -> a
index = L1' a a -> Rep (L1' a) -> a
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve
instance Closed L1' where
closed :: L1' a b -> L1' (x -> a) (x -> b)
closed (L1' c -> b
k c -> a -> c
h a -> c
z) = ((x -> c) -> x -> b)
-> ((x -> c) -> (x -> a) -> x -> c)
-> ((x -> a) -> x -> c)
-> L1' (x -> a) (x -> b)
forall a b c. (c -> b) -> (c -> a -> c) -> (a -> c) -> L1' a b
L1' (\x -> c
f x
x -> c -> b
k (x -> c
f x
x)) ((c -> a -> c) -> (x -> c) -> (x -> a) -> x -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 c -> a -> c
h) ((a -> c) -> (x -> a) -> x -> c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> c
z)
instance MonadReader (NonEmpty a) (L1' a) where
ask :: L1' a (NonEmpty a)
ask = L1' a (NonEmpty a)
forall (f :: * -> *). Representable f => f (Rep f)
askRep
local :: (NonEmpty a -> NonEmpty a) -> L1' a a -> L1' a a
local = (NonEmpty a -> NonEmpty a) -> L1' a a -> L1' a a
forall (f :: * -> *) a.
Representable f =>
(Rep f -> Rep f) -> f a -> f a
localRep
instance MonadFix (L1' a) where
mfix :: (a -> L1' a a) -> L1' a a
mfix = (a -> L1' a a) -> L1' a a
forall (f :: * -> *) a. Representable f => (a -> f a) -> f a
mfixRep