{- |
   The HList library

   (C) 2004, Oleg Kiselyov, Ralf Laemmel, Keean Schupke

   Zipping and unzipping for (conceptually) lists of pairs.

   Provides two alternative implementations
 -}

module Data.HList.HZip where

import Data.HList.HList
import Data.HList.FakePrelude

-- * zip
-- ** functional dependency

-- $note1 moved to "Data.HList.HList" to avoid an orphan instance

-- ** type family
-- $note 'hZip2' can be written as a standalone function, with an appropriate
-- type family to calculate the result type. However, that does not seem to
-- be the case for 'hUnzip2', so to re-use some type functions the two are
-- in the same class.

-- | HZipR in the superclass constraint doesn't hurt, but it doesn't seem to be
-- necessary
class HZipR (MapFst z) (MapSnd z) ~ z => HUnZip z where
  type MapFst z :: [*]
  type MapSnd z :: [*]
  hZip2 :: HList (MapFst z) -> HList (MapSnd z) -> HList z
  hUnzip2 :: HList z -> (HList (MapFst z), HList (MapSnd z))

instance HUnZip '[] where
  type MapFst '[] = '[]
  type MapSnd '[] = '[]
  hZip2 :: HList (MapFst '[]) -> HList (MapSnd '[]) -> HList '[]
hZip2 HList (MapFst '[])
_ HList (MapSnd '[])
_ = HList '[]
HNil
  hUnzip2 :: HList '[] -> (HList (MapFst '[]), HList (MapSnd '[]))
hUnzip2 HList '[]
_ = (HList '[]
HList (MapFst '[])
HNil, HList '[]
HList (MapSnd '[])
HNil)

instance (z ~ (x,y), HUnZip zs) => HUnZip (z ': zs) where
  type MapFst (z ': zs) = ( Fst z ': MapFst zs )
  type MapSnd (z ': zs) = ( Snd z ': MapSnd zs )
  hZip2 :: HList (MapFst (z : zs))
-> HList (MapSnd (z : zs)) -> HList (z : zs)
hZip2 (HCons x xs) (HCons y ys) = (x, y) -> HList zs -> HList ((x, y) : zs)
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
HCons (x
x,y
y) (HList (MapFst zs) -> HList (MapSnd zs) -> HList zs
forall (z :: [*]).
HUnZip z =>
HList (MapFst z) -> HList (MapSnd z) -> HList z
hZip2 HList (MapFst zs)
xs HList (MapSnd zs)
ys)
  hUnzip2 :: HList (z : zs)
-> (HList (MapFst (z : zs)), HList (MapSnd (z : zs)))
hUnzip2 (HCons ~(x,y) zs) = let ~(HList (MapFst zs)
xs,HList (MapSnd zs)
ys) = HList zs -> (HList (MapFst zs), HList (MapSnd zs))
forall (z :: [*]).
HUnZip z =>
HList z -> (HList (MapFst z), HList (MapSnd z))
hUnzip2 HList zs
zs in (x
x x -> HList (MapFst zs) -> HList (x : MapFst zs)
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList (MapFst zs)
xs, y
y y -> HList (MapSnd zs) -> HList (y : MapSnd zs)
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList (MapSnd zs)
ys)


-- | calculates something like:
--
-- > [a] -> [b] -> [(a,b)]
--
-- can be used to give another type for 'hZip2'
--
-- > hZip2 :: HList a -> HList b -> HList (HZipR a b)
type family HZipR (x::[*]) (y::[*]) :: [*]
type instance HZipR '[] '[] = '[]
type instance HZipR (x ': xs) (y ': ys) = (x,y) ': HZipR xs ys


-- ** utility type functions
-- $note do they belong somewhere else?
type family Fst a
type instance Fst (a,b) = a
type family Snd a
type instance Snd (a,b) = b


-- * transpose

{- | this transpose requires equal-length HLists inside a HList:

>>> import Data.HList.HListPrelude
>>> let ex = (1 .*. 2 .*. HNil) .*. ('a' .*. 'b' .*. HNil) .*. ( 3 .*. 5 .*. HNil) .*. HNil

The original list:

>>> ex
H[H[1,2],H['a','b'],H[3,5]]

And transposed:

>>> hTranspose ex
H[H[1,'a',3],H[2,'b',5]]

-}
hTranspose :: HList (HList a : l) -> HList c
hTranspose HList (HList a : l)
x = HZipF -> HList es -> HList (HList a : l) -> HList c
forall f v (l :: [*]) r. HFoldr f v l r => f -> v -> HList l -> r
hFoldr HZipF
HZipF (Proxy n -> HList '[] -> HList es
forall (n :: HNat) e (es :: [*]).
HReplicateFD n e es =>
Proxy n -> e -> HList es
hReplicate (HList a -> Proxy n
forall (l :: [*]) (n :: HNat). HLengthEq l n => HList l -> Proxy n
hLength (HList (HList a : l) -> HList a
forall e (l :: [*]). HList (e : l) -> e
hHead HList (HList a : l)
x)) HList '[]
HNil) HList (HList a : l)
x


-- ** helpers

-- | same as 'HZip' but HCons the elements of x onto y. This might be doable as
-- a @hMap f (hZip x y)@, but that one doesn't propagate types as easily it
-- seems.
class HZip3 x y l | x y -> l, l -> x y where
  hZip3   :: HList x -> HList y -> HList l

instance HZip3 '[] '[] '[] where
  hZip3 :: HList '[] -> HList '[] -> HList '[]
hZip3 HList '[]
_ HList '[]
_ = HList '[]
HNil

instance (HList (x ': y) ~ z, HZip3 xs ys zs) => HZip3 (x ': xs) (HList y ': ys) (z ': zs) where
  hZip3 :: HList (x : xs) -> HList (HList y : ys) -> HList (z : zs)
hZip3 (HCons x xs) (HCons y ys) = x -> HList y -> HList (x : y)
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
HCons x
x HList y
y  HList (x : y) -> HList zs -> HList (HList (x : y) : zs)
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList xs -> HList ys -> HList zs
forall (x :: [*]) (y :: [*]) (l :: [*]).
HZip3 x y l =>
HList x -> HList y -> HList l
hZip3 HList xs
xs HList ys
ys

data HZipF = HZipF
instance (
    HZip3 a b c,
    x ~ (HList a, HList b),
    y ~ HList c) => ApplyAB HZipF x y
    where applyAB :: HZipF -> x -> y
applyAB HZipF
_ (x,y) = HList a -> HList b -> HList c
forall (x :: [*]) (y :: [*]) (l :: [*]).
HZip3 x y l =>
HList x -> HList y -> HList l
hZip3 HList a
x HList b
y