{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
module Data.Parameterized.TraversableFC
( TestEqualityFC(..)
, OrdFC(..)
, ShowFC(..)
, HashableFC(..)
, FunctorFC(..)
, FoldableFC(..)
, foldlMFC
, foldlMFC'
, foldrMFC
, foldrMFC'
, TraversableFC(..)
, traverseFC_
, forMFC_
, forFC_
, forFC
, fmapFCDefault
, foldMapFCDefault
, allFC
, anyFC
, lengthFC
) where
import Control.Applicative (Const(..) )
import Control.Monad.Identity ( Identity (..) )
import Data.Coerce
import Data.Kind
import Data.Monoid
import GHC.Exts (build)
import Data.Type.Equality
import Data.Parameterized.Classes
class FunctorFC (t :: (k -> Type) -> l -> Type) where
fmapFC :: forall f g. (forall x. f x -> g x) ->
(forall x. t f x -> t g x)
class ShowFC (t :: (k -> Type) -> l -> Type) where
{-# MINIMAL showFC | showsPrecFC #-}
showFC :: forall f. (forall x. f x -> String)
-> (forall x. t f x -> String)
showFC forall (x :: k). f x -> String
sh t f x
x = (forall (x :: k). Int -> f x -> ShowS) -> Int -> t f x -> ShowS
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *).
ShowFC t =>
(forall (x :: k). Int -> f x -> ShowS)
-> forall (x :: l). Int -> t f x -> ShowS
showsPrecFC (\Int
_prec f x
z String
rest -> f x -> String
forall (x :: k). f x -> String
sh f x
z String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest) Int
0 t f x
x []
showsPrecFC :: forall f. (forall x. Int -> f x -> ShowS) ->
(forall x. Int -> t f x -> ShowS)
showsPrecFC forall (x :: k). Int -> f x -> ShowS
sh Int
_prec t f x
x String
rest = (forall (x :: k). f x -> String) -> t f x -> String
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *).
ShowFC t =>
(forall (x :: k). f x -> String)
-> forall (x :: l). t f x -> String
showFC (\f x
z -> Int -> f x -> ShowS
forall (x :: k). Int -> f x -> ShowS
sh Int
0 f x
z []) t f x
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest
class HashableFC (t :: (k -> Type) -> l -> Type) where
hashWithSaltFC :: forall f. (forall x. Int -> f x -> Int) ->
(forall x. Int -> t f x -> Int)
class TestEqualityFC (t :: (k -> Type) -> l -> Type) where
testEqualityFC :: forall f. (forall x y. f x -> f y -> (Maybe (x :~: y))) ->
(forall x y. t f x -> t f y -> (Maybe (x :~: y)))
class TestEqualityFC t => OrdFC (t :: (k -> Type) -> l -> Type) where
compareFC :: forall f. (forall x y. f x -> f y -> OrderingF x y) ->
(forall x y. t f x -> t f y -> OrderingF x y)
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
#. :: (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_f = (a -> b) -> a -> c
coerce
class FoldableFC (t :: (k -> Type) -> l -> Type) where
{-# MINIMAL foldMapFC | foldrFC #-}
foldMapFC :: forall f m. Monoid m => (forall x. f x -> m) -> (forall x. t f x -> m)
foldMapFC forall (x :: k). f x -> m
f = (forall (x :: k). f x -> m -> m) -> m -> t f x -> m
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). f x -> b -> b)
-> forall (x :: l). b -> t f x -> b
foldrFC (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (m -> m -> m) -> (f x -> m) -> f x -> m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> m
forall (x :: k). f x -> m
f) m
forall a. Monoid a => a
mempty
foldrFC :: forall f b. (forall x. f x -> b -> b) -> (forall x. b -> t f x -> b)
foldrFC forall (x :: k). f x -> b -> b
f b
z t f x
t = Endo b -> b -> b
forall a. Endo a -> a -> a
appEndo ((forall (x :: k). f x -> Endo b) -> t f x -> Endo b
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) m.
(FoldableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
foldMapFC ((b -> b) -> Endo b
forall a. (a -> a) -> Endo a
Endo ((b -> b) -> Endo b) -> (f x -> b -> b) -> f x -> Endo b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. f x -> b -> b
forall (x :: k). f x -> b -> b
f) t f x
t) b
z
foldlFC :: forall f b. (forall x. b -> f x -> b) -> (forall x. b -> t f x -> b)
foldlFC forall (x :: k). b -> f x -> b
f b
z t f x
t = Endo b -> b -> b
forall a. Endo a -> a -> a
appEndo (Dual (Endo b) -> Endo b
forall a. Dual a -> a
getDual ((forall (x :: k). f x -> Dual (Endo b)) -> t f x -> Dual (Endo b)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) m.
(FoldableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
foldMapFC (\f x
e -> Endo b -> Dual (Endo b)
forall a. a -> Dual a
Dual ((b -> b) -> Endo b
forall a. (a -> a) -> Endo a
Endo (\b
r -> b -> f x -> b
forall (x :: k). b -> f x -> b
f b
r f x
e))) t f x
t)) b
z
foldrFC' :: forall f b. (forall x. f x -> b -> b) -> (forall x. b -> t f x -> b)
foldrFC' forall (x :: k). f x -> b -> b
f0 b
z0 t f x
xs = (forall (x :: k). (b -> b) -> f x -> b -> b)
-> (b -> b) -> t f x -> b -> b
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). b -> f x -> b)
-> forall (x :: l). b -> t f x -> b
foldlFC ((f x -> b -> b) -> (b -> b) -> f x -> b -> b
forall t t a b. (t -> t -> a) -> (a -> b) -> t -> t -> b
f' f x -> b -> b
forall (x :: k). f x -> b -> b
f0) b -> b
forall a. a -> a
id t f x
xs b
z0
where f' :: (t -> t -> a) -> (a -> b) -> t -> t -> b
f' t -> t -> a
f a -> b
k t
x t
z = a -> b
k (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$! t -> t -> a
f t
x t
z
foldlFC' :: forall f b. (forall x. b -> f x -> b) -> (forall x. b -> t f x -> b)
foldlFC' forall (x :: k). b -> f x -> b
f0 b
z0 t f x
xs = (forall (x :: k). f x -> (b -> b) -> b -> b)
-> (b -> b) -> t f x -> b -> b
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). f x -> b -> b)
-> forall (x :: l). b -> t f x -> b
foldrFC ((b -> f x -> b) -> f x -> (b -> b) -> b -> b
forall t t a b. (t -> t -> a) -> t -> (a -> b) -> t -> b
f' b -> f x -> b
forall (x :: k). b -> f x -> b
f0) b -> b
forall a. a -> a
id t f x
xs b
z0
where f' :: (t -> t -> a) -> t -> (a -> b) -> t -> b
f' t -> t -> a
f t
x a -> b
k t
z = a -> b
k (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$! t -> t -> a
f t
z t
x
toListFC :: forall f a. (forall x. f x -> a) -> (forall x. t f x -> [a])
toListFC forall (x :: k). f x -> a
f t f x
t = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
c b
n -> (forall (x :: k). f x -> b -> b) -> b -> t f x -> b
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). f x -> b -> b)
-> forall (x :: l). b -> t f x -> b
foldrFC (\f x
e b
v -> a -> b -> b
c (f x -> a
forall (x :: k). f x -> a
f f x
e) b
v) b
n t f x
t)
foldlMFC :: (FoldableFC t, Monad m) => (forall x . b -> f x -> m b) -> b -> t f c -> m b
foldlMFC :: (forall (x :: k). b -> f x -> m b) -> b -> t f c -> m b
foldlMFC forall (x :: k). b -> f x -> m b
f b
z0 t f c
xs = (forall (x :: k). f x -> (b -> m b) -> b -> m b)
-> (b -> m b) -> t f c -> b -> m b
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). f x -> b -> b)
-> forall (x :: l). b -> t f x -> b
foldrFC forall (x :: k). f x -> (b -> m b) -> b -> m b
forall (x :: k) b. f x -> (b -> m b) -> b -> m b
f' b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return t f c
xs b
z0
where f' :: f x -> (b -> m b) -> b -> m b
f' f x
x b -> m b
k b
z = b -> f x -> m b
forall (x :: k). b -> f x -> m b
f b
z f x
x m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
k
foldlMFC' :: (FoldableFC t, Monad m) => (forall x . b -> f x -> m b) -> b -> t f c -> m b
foldlMFC' :: (forall (x :: k). b -> f x -> m b) -> b -> t f c -> m b
foldlMFC' forall (x :: k). b -> f x -> m b
f b
z0 t f c
xs = b -> m b -> m b
seq b
z0 (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ (forall (x :: k). f x -> (b -> m b) -> b -> m b)
-> (b -> m b) -> t f c -> b -> m b
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). f x -> b -> b)
-> forall (x :: l). b -> t f x -> b
foldrFC forall (x :: k). f x -> (b -> m b) -> b -> m b
forall (x :: k) b. f x -> (b -> m b) -> b -> m b
f' b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return t f c
xs b
z0
where f' :: f x -> (b -> m b) -> b -> m b
f' f x
x b -> m b
k b
z = b -> f x -> m b
forall (x :: k). b -> f x -> m b
f b
z f x
x m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> b -> m b -> m b
seq b
r (b -> m b
k b
r)
foldrMFC :: (FoldableFC t, Monad m) => (forall x . f x -> b -> m b) -> b -> t f c -> m b
foldrMFC :: (forall (x :: k). f x -> b -> m b) -> b -> t f c -> m b
foldrMFC forall (x :: k). f x -> b -> m b
f b
z0 t f c
xs = (forall (x :: k). (b -> m b) -> f x -> b -> m b)
-> (b -> m b) -> t f c -> b -> m b
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). b -> f x -> b)
-> forall (x :: l). b -> t f x -> b
foldlFC forall (x :: k). (b -> m b) -> f x -> b -> m b
forall b (x :: k). (b -> m b) -> f x -> b -> m b
f' b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return t f c
xs b
z0
where f' :: (b -> m b) -> f x -> b -> m b
f' b -> m b
k f x
x b
z = f x -> b -> m b
forall (x :: k). f x -> b -> m b
f f x
x b
z m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
k
foldrMFC' :: (FoldableFC t, Monad m) => (forall x . f x -> b -> m b) -> b -> t f c -> m b
foldrMFC' :: (forall (x :: k). f x -> b -> m b) -> b -> t f c -> m b
foldrMFC' forall (x :: k). f x -> b -> m b
f b
z0 t f c
xs = b -> m b -> m b
seq b
z0 ((forall (x :: k). (b -> m b) -> f x -> b -> m b)
-> (b -> m b) -> t f c -> b -> m b
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). b -> f x -> b)
-> forall (x :: l). b -> t f x -> b
foldlFC forall (x :: k). (b -> m b) -> f x -> b -> m b
forall b (x :: k). (b -> m b) -> f x -> b -> m b
f' b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return t f c
xs b
z0)
where f' :: (b -> m b) -> f x -> b -> m b
f' b -> m b
k f x
x b
z = f x -> b -> m b
forall (x :: k). f x -> b -> m b
f f x
x b
z m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> b -> m b -> m b
seq b
r (b -> m b
k b
r)
allFC :: FoldableFC t => (forall x. f x -> Bool) -> (forall x. t f x -> Bool)
allFC :: (forall (x :: k). f x -> Bool) -> forall (x :: l). t f x -> Bool
allFC forall (x :: k). f x -> Bool
p = All -> Bool
getAll (All -> Bool) -> (t f x -> All) -> t f x -> Bool
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall (x :: k). f x -> All) -> forall (x :: l). t f x -> All
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) m.
(FoldableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
foldMapFC (Bool -> All
All (Bool -> All) -> (f x -> Bool) -> f x -> All
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. f x -> Bool
forall (x :: k). f x -> Bool
p)
anyFC :: FoldableFC t => (forall x. f x -> Bool) -> (forall x. t f x -> Bool)
anyFC :: (forall (x :: k). f x -> Bool) -> forall (x :: l). t f x -> Bool
anyFC forall (x :: k). f x -> Bool
p = Any -> Bool
getAny (Any -> Bool) -> (t f x -> Any) -> t f x -> Bool
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall (x :: k). f x -> Any) -> forall (x :: l). t f x -> Any
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) m.
(FoldableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
foldMapFC (Bool -> Any
Any (Bool -> Any) -> (f x -> Bool) -> f x -> Any
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. f x -> Bool
forall (x :: k). f x -> Bool
p)
lengthFC :: FoldableFC t => t f x -> Int
lengthFC :: t f x -> Int
lengthFC = (forall (x :: k). f x -> Int -> Int) -> Int -> t f x -> Int
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). f x -> b -> b)
-> forall (x :: l). b -> t f x -> b
foldrFC ((Int -> Int) -> f x -> Int -> Int
forall a b. a -> b -> a
const (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) Int
0
class (FunctorFC t, FoldableFC t) => TraversableFC (t :: (k -> Type) -> l -> Type) where
traverseFC :: forall f g m. Applicative m
=> (forall x. f x -> m (g x))
-> (forall x. t f x -> m (t g x))
fmapFCDefault :: TraversableFC t => forall f g. (forall x. f x -> g x) -> (forall x. t f x -> t g x)
fmapFCDefault :: forall (f :: k -> *) (g :: k -> *).
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFCDefault = \forall (x :: k). f x -> g x
f -> Identity (t g x) -> t g x
forall a. Identity a -> a
runIdentity (Identity (t g x) -> t g x)
-> (t f x -> Identity (t g x)) -> t f x -> t g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: k). f x -> Identity (g x))
-> forall (x :: l). t f x -> Identity (t g x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC (g x -> Identity (g x)
forall a. a -> Identity a
Identity (g x -> Identity (g x)) -> (f x -> g x) -> f x -> Identity (g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> g x
forall (x :: k). f x -> g x
f)
{-# INLINE fmapFCDefault #-}
foldMapFCDefault :: (TraversableFC t, Monoid m) => (forall x. f x -> m) -> (forall x. t f x -> m)
foldMapFCDefault :: (forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
foldMapFCDefault = \forall (x :: k). f x -> m
f -> Const m (t Any x) -> m
forall a k (b :: k). Const a b -> a
getConst (Const m (t Any x) -> m)
-> (t f x -> Const m (t Any x)) -> t f x -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: k). f x -> Const m (Any x))
-> forall (x :: l). t f x -> Const m (t Any x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC (m -> Const m (Any x)
forall k a (b :: k). a -> Const a b
Const (m -> Const m (Any x)) -> (f x -> m) -> f x -> Const m (Any x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> m
forall (x :: k). f x -> m
f)
{-# INLINE foldMapFCDefault #-}
traverseFC_ :: (FoldableFC t, Applicative m) => (forall x. f x -> m a) -> (forall x. t f x -> m ())
traverseFC_ :: (forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
traverseFC_ forall (x :: k). f x -> m a
f = (forall (x :: k). f x -> m () -> m ()) -> m () -> t f x -> m ()
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) b.
FoldableFC t =>
(forall (x :: k). f x -> b -> b)
-> forall (x :: l). b -> t f x -> b
foldrFC (\f x
e m ()
r -> f x -> m a
forall (x :: k). f x -> m a
f f x
e m a -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
r) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE traverseFC_ #-}
forMFC_ :: (FoldableFC t, Applicative m) => t f c -> (forall x. f x -> m a) -> m ()
forMFC_ :: t f c -> (forall (x :: k). f x -> m a) -> m ()
forMFC_ t f c
v forall (x :: k). f x -> m a
f = (forall (x :: k). f x -> m a) -> t f c -> m ()
forall k l (t :: (k -> *) -> l -> *) (m :: * -> *) (f :: k -> *) a.
(FoldableFC t, Applicative m) =>
(forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
traverseFC_ forall (x :: k). f x -> m a
f t f c
v
{-# INLINE forMFC_ #-}
{-# DEPRECATED forMFC_ "Use forFC_" #-}
forFC_ :: (FoldableFC t, Applicative m) => t f c -> (forall x. f x -> m a) -> m ()
forFC_ :: t f c -> (forall (x :: k). f x -> m a) -> m ()
forFC_ t f c
v forall (x :: k). f x -> m a
f = (forall (x :: k). f x -> m a) -> t f c -> m ()
forall k l (t :: (k -> *) -> l -> *) (m :: * -> *) (f :: k -> *) a.
(FoldableFC t, Applicative m) =>
(forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
traverseFC_ forall (x :: k). f x -> m a
f t f c
v
{-# INLINE forFC_ #-}
forFC ::
(TraversableFC t, Applicative m) =>
t f x -> (forall y. f y -> m (g y)) -> m (t g x)
forFC :: t f x -> (forall (y :: k). f y -> m (g y)) -> m (t g x)
forFC t f x
v forall (y :: k). f y -> m (g y)
f = (forall (y :: k). f y -> m (g y)) -> t f x -> m (t g x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC forall (y :: k). f y -> m (g y)
f t f x
v
{-# INLINE forFC #-}