Skip to content

Instantly share code, notes, and snippets.

@merijn
Last active January 2, 2019 10:07
Show Gist options
  • Save merijn/dc00bc7cebd6df012c5e to your computer and use it in GitHub Desktop.
Save merijn/dc00bc7cebd6df012c5e to your computer and use it in GitHub Desktop.
HList
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module HList where
import Prelude hiding (head, tail, zip)
import GHC.Exts (Constraint)
data HList :: [*] -> * where
Nil :: HList '[]
Cons :: a -> HList l -> HList (a ': l)
instance Show (HList '[]) where
show Nil = "Nil"
instance (Show a, Show (HList l)) => Show (HList (a ': l)) where
show (Cons x xs) = "Cons " ++ show x ++ " (" ++ show xs ++ show ")"
head :: HList (a ': l) -> a
head (Cons h _) = h
tail :: HList (a ': l) -> HList l
tail (Cons _ t) = t
type family Fun (l :: [*]) (r :: *) where
Fun '[] r = r
Fun (a ': as) r = a -> Fun as r
apply :: Fun l c -> HList l -> c
apply x Nil = x
apply f (Cons h t) = apply (f h) t
type family Zip (l :: [*]) (k :: [*]) where
Zip '[] '[] = '[]
Zip (a ': as) (b ': bs) = (a,b) ': Zip as bs
type family Zippable (l :: [*]) (k :: [*]) :: Constraint where
Zippable '[] '[] = ()
Zippable (a ': as) (b ': bs) = Zippable as bs
Zippable as bs = ("Error!" ~ "List lengths are unequal!")
zip :: Zippable l k => HList l -> HList k -> HList (Zip l k)
zip Nil Nil = Nil
zip (Cons a as) (Cons b bs) = Cons (a,b) (zip as bs)
someList :: HList [Bool, Char, Int]
someList = Cons True (Cons 'c' (Cons 1 Nil))
anotherList :: HList [Maybe (), [a], Double]
anotherList = Cons (Just ()) (Cons [] (Cons 2.0 Nil))
zippedList :: HList [(Bool, Maybe ()), (Char, [a]), (Int, Double)]
zippedList = zip someList anotherList
main :: IO ()
main = print $ apply (,,) someList
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment