{-# LANGUAGE PolyKinds, StandaloneDeriving, UndecidableInstances #-}
module Data.SOP.NP
(
NP(..)
, POP(..)
, unPOP
, pure_NP
, pure_POP
, cpure_NP
, cpure_POP
, fromList
, ap_NP
, ap_POP
, hd
, tl
, Projection
, projections
, shiftProjection
, liftA_NP
, liftA_POP
, liftA2_NP
, liftA2_POP
, liftA3_NP
, liftA3_POP
, map_NP
, map_POP
, zipWith_NP
, zipWith_POP
, zipWith3_NP
, zipWith3_POP
, cliftA_NP
, cliftA_POP
, cliftA2_NP
, cliftA2_POP
, cliftA3_NP
, cliftA3_POP
, cmap_NP
, cmap_POP
, czipWith_NP
, czipWith_POP
, czipWith3_NP
, czipWith3_POP
, hcliftA'
, hcliftA2'
, hcliftA3'
, cliftA2'_NP
, collapse_NP
, collapse_POP
, ctraverse__NP
, ctraverse__POP
, traverse__NP
, traverse__POP
, cfoldMap_NP
, cfoldMap_POP
, sequence'_NP
, sequence'_POP
, sequence_NP
, sequence_POP
, ctraverse'_NP
, ctraverse'_POP
, traverse'_NP
, traverse'_POP
, ctraverse_NP
, ctraverse_POP
, cata_NP
, ccata_NP
, ana_NP
, cana_NP
, trans_NP
, trans_POP
, coerce_NP
, coerce_POP
, fromI_NP
, fromI_POP
, toI_NP
, toI_POP
) where
import Data.Coerce
import Data.Kind (Type)
import Data.Proxy (Proxy(..))
import Unsafe.Coerce
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif
import Control.DeepSeq (NFData(..))
import Data.SOP.BasicFunctors
import Data.SOP.Classes
import Data.SOP.Constraint
import Data.SOP.Sing
data NP :: (k -> Type) -> [k] -> Type where
Nil :: NP f '[]
(:*) :: f x -> NP f xs -> NP f (x ': xs)
infixr 5 :*
instance All (Show `Compose` f) xs => Show (NP f xs) where
showsPrec _ Nil = showString "Nil"
showsPrec d (f :* fs) = showParen (d > 5)
$ showsPrec (5 + 1) f
. showString " :* "
. showsPrec 5 fs
deriving instance All (Eq `Compose` f) xs => Eq (NP f xs)
deriving instance (All (Eq `Compose` f) xs, All (Ord `Compose` f) xs) => Ord (NP f xs)
instance All (Semigroup `Compose` f) xs => Semigroup (NP f xs) where
(<>) = czipWith_NP (Proxy :: Proxy (Semigroup `Compose` f)) (<>)
instance (All (Monoid `Compose` f) xs
#if MIN_VERSION_base(4,11,0)
, All (Semigroup `Compose` f) xs
#endif
) => Monoid (NP f xs) where
mempty = cpure_NP (Proxy :: Proxy (Monoid `Compose` f)) mempty
mappend = czipWith_NP (Proxy :: Proxy (Monoid `Compose` f)) mappend
instance All (NFData `Compose` f) xs => NFData (NP f xs) where
rnf Nil = ()
rnf (x :* xs) = rnf x `seq` rnf xs
newtype POP (f :: (k -> Type)) (xss :: [[k]]) = POP (NP (NP f) xss)
deriving instance (Show (NP (NP f) xss)) => Show (POP f xss)
deriving instance (Eq (NP (NP f) xss)) => Eq (POP f xss)
deriving instance (Ord (NP (NP f) xss)) => Ord (POP f xss)
instance (Semigroup (NP (NP f) xss)) => Semigroup (POP f xss) where
POP xss <> POP yss = POP (xss <> yss)
instance (Monoid (NP (NP f) xss)) => Monoid (POP f xss) where
mempty = POP mempty
mappend (POP xss) (POP yss) = POP (mappend xss yss)
instance (NFData (NP (NP f) xss)) => NFData (POP f xss) where
rnf (POP xss) = rnf xss
unPOP :: POP f xss -> NP (NP f) xss
unPOP (POP xss) = xss
type instance AllN NP c = All c
type instance AllN POP c = All2 c
type instance AllZipN NP c = AllZip c
type instance AllZipN POP c = AllZip2 c
type instance SListIN NP = SListI
type instance SListIN POP = SListI2
pure_NP :: forall f xs. SListI xs => (forall a. f a) -> NP f xs
pure_NP f = cpure_NP topP f
{-# INLINE pure_NP #-}
pure_POP :: All SListI xss => (forall a. f a) -> POP f xss
pure_POP f = cpure_POP topP f
{-# INLINE pure_POP #-}
topP :: Proxy Top
topP = Proxy
cpure_NP :: forall c xs proxy f. All c xs
=> proxy c -> (forall a. c a => f a) -> NP f xs
cpure_NP p f = case sList :: SList xs of
SNil -> Nil
SCons -> f :* cpure_NP p f
cpure_POP :: forall c xss proxy f. All2 c xss
=> proxy c -> (forall a. c a => f a) -> POP f xss
cpure_POP p f = POP (cpure_NP (allP p) (cpure_NP p f))
allP :: proxy c -> Proxy (All c)
allP _ = Proxy
instance HPure NP where
hpure = pure_NP
hcpure = cpure_NP
instance HPure POP where
hpure = pure_POP
hcpure = cpure_POP
fromList :: SListI xs => [a] -> Maybe (NP (K a) xs)
fromList = go sList
where
go :: SList xs -> [a] -> Maybe (NP (K a) xs)
go SNil [] = return Nil
go SCons (x:xs) = do ys <- go sList xs ; return (K x :* ys)
go _ _ = Nothing
ap_NP :: NP (f -.-> g) xs -> NP f xs -> NP g xs
ap_NP Nil Nil = Nil
ap_NP (Fn f :* fs) (x :* xs) = f x :* ap_NP fs xs
ap_POP :: POP (f -.-> g) xss -> POP f xss -> POP g xss
ap_POP (POP fss') (POP xss') = POP (go fss' xss')
where
go :: NP (NP (f -.-> g)) xss -> NP (NP f) xss -> NP (NP g) xss
go Nil Nil = Nil
go (fs :* fss) (xs :* xss) = ap_NP fs xs :* go fss xss
_ap_POP_spec :: SListI xss => POP (f -.-> g) xss -> POP f xss -> POP g xss
_ap_POP_spec (POP fs) (POP xs) = POP (liftA2_NP ap_NP fs xs)
type instance Same NP = NP
type instance Same POP = POP
type instance Prod NP = NP
type instance Prod POP = POP
instance HAp NP where hap = ap_NP
instance HAp POP where hap = ap_POP
hd :: NP f (x ': xs) -> f x
hd (x :* _xs) = x
tl :: NP f (x ': xs) -> NP f xs
tl (_x :* xs) = xs
type Projection (f :: k -> Type) (xs :: [k]) = K (NP f xs) -.-> f
projections :: forall xs f . SListI xs => NP (Projection f xs) xs
projections = case sList :: SList xs of
SNil -> Nil
SCons -> fn (hd . unK) :* liftA_NP shiftProjection projections
shiftProjection :: Projection f xs a -> Projection f (x ': xs) a
shiftProjection (Fn f) = Fn $ f . K . tl . unK
liftA_NP :: SListI xs => (forall a. f a -> g a) -> NP f xs -> NP g xs
liftA_POP :: All SListI xss => (forall a. f a -> g a) -> POP f xss -> POP g xss
liftA_NP = hliftA
liftA_POP = hliftA
liftA2_NP :: SListI xs => (forall a. f a -> g a -> h a) -> NP f xs -> NP g xs -> NP h xs
liftA2_POP :: All SListI xss => (forall a. f a -> g a -> h a) -> POP f xss -> POP g xss -> POP h xss
liftA2_NP = hliftA2
liftA2_POP = hliftA2
liftA3_NP :: SListI xs => (forall a. f a -> g a -> h a -> i a) -> NP f xs -> NP g xs -> NP h xs -> NP i xs
liftA3_POP :: All SListI xss => (forall a. f a -> g a -> h a -> i a) -> POP f xss -> POP g xss -> POP h xss -> POP i xss
liftA3_NP = hliftA3
liftA3_POP = hliftA3
map_NP :: SListI xs => (forall a. f a -> g a) -> NP f xs -> NP g xs
map_POP :: All SListI xss => (forall a. f a -> g a) -> POP f xss -> POP g xss
map_NP = hmap
map_POP = hmap
zipWith_NP :: SListI xs => (forall a. f a -> g a -> h a) -> NP f xs -> NP g xs -> NP h xs
zipWith_POP :: All SListI xss => (forall a. f a -> g a -> h a) -> POP f xss -> POP g xss -> POP h xss
zipWith_NP = hzipWith
zipWith_POP = hzipWith
zipWith3_NP :: SListI xs => (forall a. f a -> g a -> h a -> i a) -> NP f xs -> NP g xs -> NP h xs -> NP i xs
zipWith3_POP :: All SListI xss => (forall a. f a -> g a -> h a -> i a) -> POP f xss -> POP g xss -> POP h xss -> POP i xss
zipWith3_NP = hzipWith3
zipWith3_POP = hzipWith3
cliftA_NP :: All c xs => proxy c -> (forall a. c a => f a -> g a) -> NP f xs -> NP g xs
cliftA_POP :: All2 c xss => proxy c -> (forall a. c a => f a -> g a) -> POP f xss -> POP g xss
cliftA_NP = hcliftA
cliftA_POP = hcliftA
cliftA2_NP :: All c xs => proxy c -> (forall a. c a => f a -> g a -> h a) -> NP f xs -> NP g xs -> NP h xs
cliftA2_POP :: All2 c xss => proxy c -> (forall a. c a => f a -> g a -> h a) -> POP f xss -> POP g xss -> POP h xss
cliftA2_NP = hcliftA2
cliftA2_POP = hcliftA2
cliftA3_NP :: All c xs => proxy c -> (forall a. c a => f a -> g a -> h a -> i a) -> NP f xs -> NP g xs -> NP h xs -> NP i xs
cliftA3_POP :: All2 c xss => proxy c -> (forall a. c a => f a -> g a -> h a -> i a) -> POP f xss -> POP g xss -> POP h xss -> POP i xss
cliftA3_NP = hcliftA3
cliftA3_POP = hcliftA3
cmap_NP :: All c xs => proxy c -> (forall a. c a => f a -> g a) -> NP f xs -> NP g xs
cmap_POP :: All2 c xss => proxy c -> (forall a. c a => f a -> g a) -> POP f xss -> POP g xss
cmap_NP = hcmap
cmap_POP = hcmap
czipWith_NP :: All c xs => proxy c -> (forall a. c a => f a -> g a -> h a) -> NP f xs -> NP g xs -> NP h xs
czipWith_POP :: All2 c xss => proxy c -> (forall a. c a => f a -> g a -> h a) -> POP f xss -> POP g xss -> POP h xss
czipWith_NP = hczipWith
czipWith_POP = hczipWith
czipWith3_NP :: All c xs => proxy c -> (forall a. c a => f a -> g a -> h a -> i a) -> NP f xs -> NP g xs -> NP h xs -> NP i xs
czipWith3_POP :: All2 c xss => proxy c -> (forall a. c a => f a -> g a -> h a -> i a) -> POP f xss -> POP g xss -> POP h xss -> POP i xss
czipWith3_NP = hczipWith3
czipWith3_POP = hczipWith3
{-# DEPRECATED hcliftA' "Use 'hcliftA' or 'hcmap' instead." #-}
hcliftA' :: (All2 c xss, Prod h ~ NP, HAp h) => proxy c -> (forall xs. All c xs => f xs -> f' xs) -> h f xss -> h f' xss
{-# DEPRECATED hcliftA2' "Use 'hcliftA2' or 'hczipWith' instead." #-}
hcliftA2' :: (All2 c xss, Prod h ~ NP, HAp h) => proxy c -> (forall xs. All c xs => f xs -> f' xs -> f'' xs) -> Prod h f xss -> h f' xss -> h f'' xss
{-# DEPRECATED hcliftA3' "Use 'hcliftA3' or 'hczipWith3' instead." #-}
hcliftA3' :: (All2 c xss, Prod h ~ NP, HAp h) => proxy c -> (forall xs. All c xs => f xs -> f' xs -> f'' xs -> f''' xs) -> Prod h f xss -> Prod h f' xss -> h f'' xss -> h f''' xss
hcliftA' p = hcliftA (allP p)
hcliftA2' p = hcliftA2 (allP p)
hcliftA3' p = hcliftA3 (allP p)
{-# DEPRECATED cliftA2'_NP "Use 'cliftA2_NP' instead." #-}
cliftA2'_NP :: All2 c xss => proxy c -> (forall xs. All c xs => f xs -> g xs -> h xs) -> NP f xss -> NP g xss -> NP h xss
cliftA2'_NP = hcliftA2'
collapse_NP :: NP (K a) xs -> [a]
collapse_POP :: SListI xss => POP (K a) xss -> [[a]]
collapse_NP Nil = []
collapse_NP (K x :* xs) = x : collapse_NP xs
collapse_POP = collapse_NP . hliftA (K . collapse_NP) . unPOP
type instance CollapseTo NP a = [a]
type instance CollapseTo POP a = [[a]]
instance HCollapse NP where hcollapse = collapse_NP
instance HCollapse POP where hcollapse = collapse_POP
ctraverse__NP ::
forall c proxy xs f g. (All c xs, Applicative g)
=> proxy c -> (forall a. c a => f a -> g ()) -> NP f xs -> g ()
ctraverse__NP _ f = go
where
go :: All c ys => NP f ys -> g ()
go Nil = pure ()
go (x :* xs) = f x *> go xs
traverse__NP ::
forall xs f g. (SListI xs, Applicative g)
=> (forall a. f a -> g ()) -> NP f xs -> g ()
traverse__NP f =
ctraverse__NP topP f
{-# INLINE traverse__NP #-}
ctraverse__POP ::
forall c proxy xss f g. (All2 c xss, Applicative g)
=> proxy c -> (forall a. c a => f a -> g ()) -> POP f xss -> g ()
ctraverse__POP p f = ctraverse__NP (allP p) (ctraverse__NP p f) . unPOP
traverse__POP ::
forall xss f g. (SListI2 xss, Applicative g)
=> (forall a. f a -> g ()) -> POP f xss -> g ()
traverse__POP f =
ctraverse__POP topP f
{-# INLINE traverse__POP #-}
instance HTraverse_ NP where
hctraverse_ = ctraverse__NP
htraverse_ = traverse__NP
instance HTraverse_ POP where
hctraverse_ = ctraverse__POP
htraverse_ = traverse__POP
cfoldMap_NP :: (All c xs, Monoid m) => proxy c -> (forall a. c a => f a -> m) -> NP f xs -> m
cfoldMap_NP = hcfoldMap
cfoldMap_POP :: (All2 c xs, Monoid m) => proxy c -> (forall a. c a => f a -> m) -> POP f xs -> m
cfoldMap_POP = hcfoldMap
sequence'_NP :: Applicative f => NP (f :.: g) xs -> f (NP g xs)
sequence'_NP Nil = pure Nil
sequence'_NP (mx :* mxs) = (:*) <$> unComp mx <*> sequence'_NP mxs
sequence'_POP :: (SListI xss, Applicative f) => POP (f :.: g) xss -> f (POP g xss)
sequence'_POP = fmap POP . sequence'_NP . hliftA (Comp . sequence'_NP) . unPOP
ctraverse'_NP ::
forall c proxy xs f f' g. (All c xs, Applicative g)
=> proxy c -> (forall a. c a => f a -> g (f' a)) -> NP f xs -> g (NP f' xs)
ctraverse'_NP _ f = go where
go :: All c ys => NP f ys -> g (NP f' ys)
go Nil = pure Nil
go (x :* xs) = (:*) <$> f x <*> go xs
traverse'_NP ::
forall xs f f' g. (SListI xs, Applicative g)
=> (forall a. f a -> g (f' a)) -> NP f xs -> g (NP f' xs)
traverse'_NP f =
ctraverse'_NP topP f
{-# INLINE traverse'_NP #-}
ctraverse'_POP :: (All2 c xss, Applicative g) => proxy c -> (forall a. c a => f a -> g (f' a)) -> POP f xss -> g (POP f' xss)
ctraverse'_POP p f = fmap POP . ctraverse'_NP (allP p) (ctraverse'_NP p f) . unPOP
traverse'_POP :: (SListI2 xss, Applicative g) => (forall a. f a -> g (f' a)) -> POP f xss -> g (POP f' xss)
traverse'_POP f =
ctraverse'_POP topP f
{-# INLINE traverse'_POP #-}
instance HSequence NP where
hsequence' = sequence'_NP
hctraverse' = ctraverse'_NP
htraverse' = traverse'_NP
instance HSequence POP where
hsequence' = sequence'_POP
hctraverse' = ctraverse'_POP
htraverse' = traverse'_POP
sequence_NP :: (SListI xs, Applicative f) => NP f xs -> f (NP I xs)
sequence_POP :: (All SListI xss, Applicative f) => POP f xss -> f (POP I xss)
sequence_NP = hsequence
sequence_POP = hsequence
ctraverse_NP :: (All c xs, Applicative g) => proxy c -> (forall a. c a => f a -> g a) -> NP f xs -> g (NP I xs)
ctraverse_POP :: (All2 c xs, Applicative g) => proxy c -> (forall a. c a => f a -> g a) -> POP f xs -> g (POP I xs)
ctraverse_NP = hctraverse
ctraverse_POP = hctraverse
cata_NP ::
forall r f xs .
r '[]
-> (forall y ys . f y -> r ys -> r (y ': ys))
-> NP f xs
-> r xs
cata_NP nil cons = go
where
go :: forall ys . NP f ys -> r ys
go Nil = nil
go (x :* xs) = cons x (go xs)
ccata_NP ::
forall c proxy r f xs . (All c xs)
=> proxy c
-> r '[]
-> (forall y ys . c y => f y -> r ys -> r (y ': ys))
-> NP f xs
-> r xs
ccata_NP _ nil cons = go
where
go :: forall ys . (All c ys) => NP f ys -> r ys
go Nil = nil
go (x :* xs) = cons x (go xs)
ana_NP ::
forall s f xs .
SListI xs
=> (forall y ys . s (y ': ys) -> (f y, s ys))
-> s xs
-> NP f xs
ana_NP uncons =
cana_NP topP uncons
{-# INLINE ana_NP #-}
cana_NP ::
forall c proxy s f xs . (All c xs)
=> proxy c
-> (forall y ys . c y => s (y ': ys) -> (f y, s ys))
-> s xs
-> NP f xs
cana_NP _ uncons = go sList
where
go :: forall ys . (All c ys) => SList ys -> s ys -> NP f ys
go SNil _ = Nil
go SCons s = case uncons s of
(x, s') -> x :* go sList s'
trans_NP ::
AllZip c xs ys
=> proxy c
-> (forall x y . c x y => f x -> g y)
-> NP f xs -> NP g ys
trans_NP _ _t Nil = Nil
trans_NP p t (x :* xs) = t x :* trans_NP p t xs
trans_POP ::
AllZip2 c xss yss
=> proxy c
-> (forall x y . c x y => f x -> g y)
-> POP f xss -> POP g yss
trans_POP p t =
POP . trans_NP (allZipP p) (trans_NP p t) . unPOP
allZipP :: proxy c -> Proxy (AllZip c)
allZipP _ = Proxy
coerce_NP ::
forall f g xs ys .
AllZip (LiftedCoercible f g) xs ys
=> NP f xs -> NP g ys
coerce_NP =
unsafeCoerce
_safe_coerce_NP ::
forall f g xs ys .
AllZip (LiftedCoercible f g) xs ys
=> NP f xs -> NP g ys
_safe_coerce_NP =
trans_NP (Proxy :: Proxy (LiftedCoercible f g)) coerce
coerce_POP ::
forall f g xss yss .
AllZip2 (LiftedCoercible f g) xss yss
=> POP f xss -> POP g yss
coerce_POP =
unsafeCoerce
_safe_coerce_POP ::
forall f g xss yss .
AllZip2 (LiftedCoercible f g) xss yss
=> POP f xss -> POP g yss
_safe_coerce_POP =
trans_POP (Proxy :: Proxy (LiftedCoercible f g)) coerce
fromI_NP ::
forall f xs ys .
AllZip (LiftedCoercible I f) xs ys
=> NP I xs -> NP f ys
fromI_NP = hfromI
toI_NP ::
forall f xs ys .
AllZip (LiftedCoercible f I) xs ys
=> NP f xs -> NP I ys
toI_NP = htoI
fromI_POP ::
forall f xss yss .
AllZip2 (LiftedCoercible I f) xss yss
=> POP I xss -> POP f yss
fromI_POP = hfromI
toI_POP ::
forall f xss yss .
AllZip2 (LiftedCoercible f I) xss yss
=> POP f xss -> POP I yss
toI_POP = htoI
instance HTrans NP NP where
htrans = trans_NP
hcoerce = coerce_NP
instance HTrans POP POP where
htrans = trans_POP
hcoerce = coerce_POP