module Control.Foldl.NonEmpty where
import Control.Applicative (liftA2)
import Control.Foldl (Fold(..))
import Control.Foldl.Internal (Either'(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Profunctor (Profunctor(..))
import Data.Semigroup.Foldable (Foldable1(..))
import Prelude hiding (head, last, minimum, maximum)
import qualified Control.Foldl as Foldl
data Fold1 a b = Fold1 (a -> Fold a b)
instance Functor (Fold1 a) where
fmap :: forall a b. (a -> b) -> Fold1 a a -> Fold1 a b
fmap a -> b
f (Fold1 a -> Fold a a
k) = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) a -> Fold a a
k)
{-# INLINE fmap #-}
instance Profunctor Fold1 where
lmap :: forall a b c. (a -> b) -> Fold1 b c -> Fold1 a c
lmap a -> b
f (Fold1 b -> Fold b c
k) = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 a -> Fold a c
k'
where
k' :: a -> Fold a c
k' a
a = forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f (b -> Fold b c
k (a -> b
f a
a))
{-# INLINE lmap #-}
rmap :: forall b c a. (b -> c) -> Fold1 a b -> Fold1 a c
rmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
{-# INLINE rmap #-}
instance Applicative (Fold1 a) where
pure :: forall a. a -> Fold1 a a
pure a
b = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b))
{-# INLINE pure #-}
Fold1 a -> Fold a (a -> b)
l <*> :: forall a b. Fold1 a (a -> b) -> Fold1 a a -> Fold1 a b
<*> Fold1 a -> Fold a a
r = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) a -> Fold a (a -> b)
l a -> Fold a a
r)
{-# INLINE (<*>) #-}
instance Semigroup b => Semigroup (Fold1 a b) where
<> :: Fold1 a b -> Fold1 a b -> Fold1 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
(<>)
{-# INLINE (<>) #-}
instance Monoid b => Monoid (Fold1 a b) where
mempty :: Fold1 a b
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
mappend :: Fold1 a b -> Fold1 a b -> Fold1 a b
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend
{-# INLINE mappend #-}
instance Num b => Num (Fold1 a b) where
fromInteger :: Integer -> Fold1 a b
fromInteger = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
{-# INLINE fromInteger #-}
negate :: Fold1 a b -> Fold1 a b
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
negate
{-# INLINE negate #-}
abs :: Fold1 a b -> Fold1 a b
abs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
abs
{-# INLINE abs #-}
signum :: Fold1 a b -> Fold1 a b
signum = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => a -> a
signum
{-# INLINE signum #-}
+ :: Fold1 a b -> Fold1 a b -> Fold1 a b
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+)
{-# INLINE (+) #-}
* :: Fold1 a b -> Fold1 a b -> Fold1 a b
(*) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(*)
{-# INLINE (*) #-}
(-) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
{-# INLINE (-) #-}
instance Fractional b => Fractional (Fold1 a b) where
fromRational :: Rational -> Fold1 a b
fromRational = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
{-# INLINE fromRational #-}
recip :: Fold1 a b -> Fold1 a b
recip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Fractional a => a -> a
recip
{-# INLINE recip #-}
/ :: Fold1 a b -> Fold1 a b -> Fold1 a b
(/) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Fractional a => a -> a -> a
(/)
{-# INLINE (/) #-}
instance Floating b => Floating (Fold1 a b) where
pi :: Fold1 a b
pi = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Floating a => a
pi
{-# INLINE pi #-}
exp :: Fold1 a b -> Fold1 a b
exp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
exp
{-# INLINE exp #-}
sqrt :: Fold1 a b -> Fold1 a b
sqrt = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sqrt
{-# INLINE sqrt #-}
log :: Fold1 a b -> Fold1 a b
log = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
log
{-# INLINE log #-}
sin :: Fold1 a b -> Fold1 a b
sin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sin
{-# INLINE sin #-}
tan :: Fold1 a b -> Fold1 a b
tan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tan
{-# INLINE tan #-}
cos :: Fold1 a b -> Fold1 a b
cos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cos
{-# INLINE cos #-}
asin :: Fold1 a b -> Fold1 a b
asin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asin
{-# INLINE asin #-}
atan :: Fold1 a b -> Fold1 a b
atan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atan
{-# INLINE atan #-}
acos :: Fold1 a b -> Fold1 a b
acos = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acos
{-# INLINE acos #-}
sinh :: Fold1 a b -> Fold1 a b
sinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
sinh
{-# INLINE sinh #-}
tanh :: Fold1 a b -> Fold1 a b
tanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
tanh
{-# INLINE tanh #-}
cosh :: Fold1 a b -> Fold1 a b
cosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
cosh
{-# INLINE cosh #-}
asinh :: Fold1 a b -> Fold1 a b
asinh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
asinh
{-# INLINE asinh #-}
atanh :: Fold1 a b -> Fold1 a b
atanh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
atanh
{-# INLINE atanh #-}
acosh :: Fold1 a b -> Fold1 a b
acosh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Floating a => a -> a
acosh
{-# INLINE acosh #-}
** :: Fold1 a b -> Fold1 a b -> Fold1 a b
(**) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
(**)
{-# INLINE (**) #-}
logBase :: Fold1 a b -> Fold1 a b -> Fold1 a b
logBase = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Floating a => a -> a -> a
logBase
{-# INLINE logBase #-}
fold1 :: Foldable1 f => Fold1 a b -> f a -> b
fold1 :: forall (f :: * -> *) a b. Foldable1 f => Fold1 a b -> f a -> b
fold1 (Fold1 a -> Fold a b
k) f a
as1 = forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Foldl.fold (a -> Fold a b
k a
a) [a]
as
where
a
a :| [a]
as = forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty f a
as1
{-# INLINABLE fold1 #-}
fromFold :: Fold a b -> Fold1 a b
fromFold :: forall a b. Fold a b -> Fold1 a b
fromFold (Fold x -> a -> x
step x
begin x -> b
done) = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
a -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step (x -> a -> x
step x
begin a
a) x -> b
done)
{-# INLINABLE fromFold #-}
toFold :: Fold1 a b -> Fold a (Maybe b)
toFold :: forall a b. Fold1 a b -> Fold a (Maybe b)
toFold (Fold1 a -> Fold a b
k0) = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {a} {b} {a}.
Either' (a -> Fold a b) (Fold a b) -> a -> Either' a (Fold a b)
step forall {b}. Either' (a -> Fold a b) b
begin forall {a} {a} {a}. Either' a (Fold a a) -> Maybe a
done
where
begin :: Either' (a -> Fold a b) b
begin = forall a b. a -> Either' a b
Left' a -> Fold a b
k0
step :: Either' (a -> Fold a b) (Fold a b) -> a -> Either' a (Fold a b)
step (Left' a -> Fold a b
k) a
a = forall a b. b -> Either' a b
Right' (a -> Fold a b
k a
a)
step (Right' (Fold x -> a -> x
step' x
begin' x -> b
done')) a
a =
forall a b. b -> Either' a b
Right' (forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' (x -> a -> x
step' x
begin' a
a) x -> b
done')
done :: Either' a (Fold a a) -> Maybe a
done (Right' (Fold x -> a -> x
_ x
begin' x -> a
done')) = forall a. a -> Maybe a
Just (x -> a
done' x
begin')
done (Left' a
_) = forall a. Maybe a
Nothing
{-# INLINABLE toFold #-}
nonEmpty :: Fold1 a (NonEmpty a)
nonEmpty :: forall a. Fold1 a (NonEmpty a)
nonEmpty = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
a -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
a forall a. a -> [a] -> NonEmpty a
:|) forall a. Fold a [a]
Foldl.list)
{-# INLINEABLE nonEmpty #-}
sconcat :: Semigroup a => Fold1 a a
sconcat :: forall a. Semigroup a => Fold1 a a
sconcat = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Semigroup a => a -> a -> a
(<>) a
begin forall a. a -> a
id)
{-# INLINABLE sconcat #-}
head :: Fold1 a a
head :: forall a. Fold1 a a
head = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {p} {p}. p -> p -> p
step a
begin forall a. a -> a
id)
where
step :: p -> p -> p
step p
a p
_ = p
a
{-# INLINABLE head #-}
last :: Fold1 a a
last :: forall a. Fold1 a a
last = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall {p} {p}. p -> p -> p
step a
begin forall a. a -> a
id)
where
step :: p -> p -> p
step p
_ p
a = p
a
{-# INLINABLE last #-}
maximum :: Ord a => Fold1 a a
maximum :: forall a. Ord a => Fold1 a a
maximum = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Ord a => a -> a -> a
max a
begin forall a. a -> a
id)
{-# INLINABLE maximum #-}
maximumBy :: (a -> a -> Ordering) -> Fold1 a a
maximumBy :: forall a. (a -> a -> Ordering) -> Fold1 a a
maximumBy a -> a -> Ordering
cmp = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
max' a
begin forall a. a -> a
id)
where
max' :: a -> a -> a
max' a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
Ordering
GT -> a
x
Ordering
_ -> a
y
{-# INLINABLE maximumBy #-}
minimum :: Ord a => Fold1 a a
minimum :: forall a. Ord a => Fold1 a a
minimum = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Ord a => a -> a -> a
min a
begin forall a. a -> a
id)
{-# INLINABLE minimum #-}
minimumBy :: (a -> a -> Ordering) -> Fold1 a a
minimumBy :: forall a. (a -> a -> Ordering) -> Fold1 a a
minimumBy a -> a -> Ordering
cmp = forall a b. (a -> Fold a b) -> Fold1 a b
Fold1 (\a
begin -> forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold a -> a -> a
min' a
begin forall a. a -> a
id)
where
min' :: a -> a -> a
min' a
x a
y = case a -> a -> Ordering
cmp a
x a
y of
Ordering
GT -> a
y
Ordering
_ -> a
x
{-# INLINABLE minimumBy #-}