74 lines
1.7 KiB
Haskell
74 lines
1.7 KiB
Haskell
{-|
|
|
The heterogeneous list.
|
|
-}
|
|
|
|
module Product where
|
|
|
|
import GHC.Types
|
|
|
|
import Duplo.Pretty
|
|
|
|
-- | `Product xs` contains elements of each of the types from the `xs` list.
|
|
data Product xs where
|
|
(:>) :: x -> Product xs -> Product (x : xs)
|
|
Nil :: Product '[]
|
|
|
|
infixr 5 :>
|
|
|
|
-- | Find/modify the element with a given type.
|
|
--
|
|
-- If you want to have same-types, use newtype wrappers.
|
|
--
|
|
class Contains x xs where
|
|
getElem :: Product xs -> x
|
|
modElem :: (x -> x) -> Product xs -> Product xs
|
|
|
|
instance {-# OVERLAPS #-} Contains x (x : xs) where
|
|
getElem (x :> _) = x
|
|
modElem f (x :> xs) = f x :> xs
|
|
|
|
instance Contains x xs => Contains x (y : xs) where
|
|
getElem (_ :> xs) = getElem xs
|
|
modElem f (x :> xs) = x :> modElem f xs
|
|
|
|
-- | Add a name to the type.
|
|
--
|
|
newtype (s :: Symbol) := t = Tag { unTag :: t }
|
|
|
|
-- | Retrieve a type associated with the given name.
|
|
--
|
|
getTag :: forall s t xs. Contains (s := t) xs => Product xs -> t
|
|
getTag = unTag . getElem @(s := t)
|
|
|
|
-- | Modify a type associated with the given name.
|
|
--
|
|
modTag
|
|
:: forall s t xs
|
|
. Contains (s := t) xs
|
|
=> (t -> t)
|
|
-> Product xs -> Product xs
|
|
modTag f = modElem @(s := t) (Tag . f . unTag)
|
|
|
|
instance Eq (Product '[]) where
|
|
_ == _ = True
|
|
|
|
instance (Eq x, Eq (Product xs)) => Eq (Product (x : xs)) where
|
|
x :> xs == y :> ys = and [x == y, xs == ys]
|
|
|
|
-- instance Modifies (Product xs) where
|
|
-- ascribe _ = id
|
|
|
|
class PrettyProd xs where
|
|
ppProd :: Product xs -> Doc
|
|
|
|
instance {-# OVERLAPS #-} Pretty x => PrettyProd '[x] where
|
|
ppProd (x :> Nil) = pp x
|
|
|
|
instance (Pretty x, PrettyProd xs) => PrettyProd (x : xs) where
|
|
ppProd (x :> xs) = pp x <.> "," <+> ppProd xs
|
|
|
|
instance Pretty (Product '[]) where
|
|
pp Nil = "{}"
|
|
|
|
instance PrettyProd xs => Pretty (Product xs) where
|
|
pp = braces . ppProd |