module Fold.ShortcutNonempty.Type
(
ShortcutNonemptyFold (..),
Will (..), Vitality (..),
)
where
import Control.Applicative (Applicative, liftA2, pure, (<*>))
import Data.Functor (Functor, fmap)
import Data.Monoid (Monoid, mempty)
import Data.Semigroup (Semigroup, (<>))
import Strict (Will (..), Vitality (..))
import Data.Void (absurd)
import qualified Strict
data ShortcutNonemptyFold a b = forall x y. ShortcutNonemptyFold
{ ()
initial :: a -> Vitality x y
, ()
step :: y -> a -> Vitality x y
, :: x -> b
, :: y -> b
}
instance Functor (ShortcutNonemptyFold a) where
fmap :: forall a b.
(a -> b) -> ShortcutNonemptyFold a a -> ShortcutNonemptyFold a b
fmap a -> b
f ShortcutNonemptyFold{ y -> a -> Vitality x y
step :: y -> a -> Vitality x y
step :: ()
step, a -> Vitality x y
initial :: a -> Vitality x y
initial :: ()
initial, x -> a
extractDead :: x -> a
extractDead :: ()
extractDead, y -> a
extractLive :: y -> a
extractLive :: ()
extractLive } =
ShortcutNonemptyFold
{ a -> Vitality x y
initial :: a -> Vitality x y
initial :: a -> Vitality x y
initial
, y -> a -> Vitality x y
step :: y -> a -> Vitality x y
step :: y -> a -> Vitality x y
step
, extractDead :: x -> b
extractDead = \x
x -> a -> b
f (x -> a
extractDead x
x)
, extractLive :: y -> b
extractLive = \y
x -> a -> b
f (y -> a
extractLive y
x)
}
instance Applicative (ShortcutNonemptyFold a) where
pure :: forall a. a -> ShortcutNonemptyFold a a
pure a
b = ShortcutNonemptyFold
{ initial :: a -> Vitality () Void
initial = \a
_ -> forall a b. a -> Vitality a b
Dead ()
, step :: Void -> a -> Vitality () Void
step = forall a. Void -> a
absurd
, extractDead :: () -> a
extractDead = \() -> a
b
, extractLive :: Void -> a
extractLive = forall a. Void -> a
absurd
}
<*> :: forall a b.
ShortcutNonemptyFold a (a -> b)
-> ShortcutNonemptyFold a a -> ShortcutNonemptyFold a b
(<*>)
ShortcutNonemptyFold{ initial :: ()
initial = a -> Vitality x y
initialL, step :: ()
step = y -> a -> Vitality x y
stepL, extractDead :: ()
extractDead = x -> a -> b
extractDeadL, extractLive :: ()
extractLive = y -> a -> b
extractLiveL }
ShortcutNonemptyFold{ initial :: ()
initial = a -> Vitality x y
initialR, step :: ()
step = y -> a -> Vitality x y
stepR, extractDead :: ()
extractDead = x -> a
extractDeadR, extractLive :: ()
extractLive = y -> a
extractLiveR } =
ShortcutNonemptyFold
{ initial :: a
-> Vitality
(Tuple2 (Vitality x y) (Vitality x y))
(Tuple2 (Vitality x y) (Vitality x y))
initial = \a
a -> forall a1 b1 a2 b2.
Vitality a1 b1
-> Vitality a2 b2
-> Vitality' (Tuple2 (Vitality a1 b1) (Vitality a2 b2))
Strict.vitality2 (a -> Vitality x y
initialL a
a) (a -> Vitality x y
initialR a
a)
, step :: Tuple2 (Vitality x y) (Vitality x y)
-> a
-> Vitality
(Tuple2 (Vitality x y) (Vitality x y))
(Tuple2 (Vitality x y) (Vitality x y))
step = \(Strict.Tuple2 Vitality x y
xL Vitality x y
xR) a
a -> forall a1 b1 a2 b2.
Vitality a1 b1
-> Vitality a2 b2
-> Vitality' (Tuple2 (Vitality a1 b1) (Vitality a2 b2))
Strict.vitality2
(forall b a. (b -> Vitality a b) -> Vitality a b -> Vitality a b
Strict.unlessDead (\y
x -> y -> a -> Vitality x y
stepL y
x a
a) Vitality x y
xL)
(forall b a. (b -> Vitality a b) -> Vitality a b -> Vitality a b
Strict.unlessDead (\y
x -> y -> a -> Vitality x y
stepR y
x a
a) Vitality x y
xR)
, extractDead :: Tuple2 (Vitality x y) (Vitality x y) -> b
extractDead = Tuple2 (Vitality x y) (Vitality x y) -> b
extract
, extractLive :: Tuple2 (Vitality x y) (Vitality x y) -> b
extractLive = Tuple2 (Vitality x y) (Vitality x y) -> b
extract
}
where
extract :: Tuple2 (Vitality x y) (Vitality x y) -> b
extract(Strict.Tuple2 Vitality x y
xL Vitality x y
xR) = a -> b
f a
x
where
f :: a -> b
f = case Vitality x y
xL of { Dead x
a -> x -> a -> b
extractDeadL x
a; Alive Will
_ y
b -> y -> a -> b
extractLiveL y
b }
x :: a
x = case Vitality x y
xR of { Dead x
a -> x -> a
extractDeadR x
a; Alive Will
_ y
b -> y -> a
extractLiveR y
b }
instance Semigroup b => Semigroup (ShortcutNonemptyFold a b) where
<> :: ShortcutNonemptyFold a b
-> ShortcutNonemptyFold a b -> ShortcutNonemptyFold a b
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid b => Monoid (ShortcutNonemptyFold a b) where
mempty :: ShortcutNonemptyFold a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty