module Data.Record (
-- * Kinds
Kind (type Forall, encase),
Sort (specialize),
-- * Styles
Style (type K),
-- * ???
Value,
-- * Records
Record (build),
ExtenderPiece (ExtenderPiece),
X (X),
(:&) ((:&)),
(:::) ((:=)),
-- * Catenation
Cat,
cat,
-- * Mapping
map,
TransformerPiece (TransformerPiece),
-- * Subrecords
Subrecord (narrow)
) where
-- Prelude
import Prelude hiding (map)
-- Fixities
infixl 2 :&
infix 3 :::, :=
-- * Kinds
class Kind kind where
data Forall kind :: (* -> *) -> *
encase :: (forall sort. (Sort kind sort) => piece sort) -> Forall kind piece
class Sort kind sort where
specialize :: Forall kind piece -> piece sort
-- * Styles
class (Kind (K style)) => Style style where
type K style :: *
-- * ???
type family Value style sort :: *
-- * Records
{-|
The class of all record types.
A record type is a type of records without the style parameter. Therefore, it has kind @* ->
*@.
-}
class (Kind kind) => Record kind record where
{-|
A general method for building record-related “things”.
For each record type, this method constructs a value which is somehow related to this
record type. Such a value is called a thing. The type parameter @thing@ maps record
types to the types of their corresponding things. The first argument of @build@ gives
the thing of the empty record type while the second argument tells how to transform a
thing of an arbitrary record type into the thing of this record type extended
with an arbitrary field type.
@build@ is used, for example, to implement the function 'cat'.
-}
build :: thing X
-> (forall record name. (Record kind record) =>
Forall kind (ExtenderPiece thing record name))
-> thing record
instance (Kind kind) => Record kind X where
build nilThing _ = nilThing
instance (Kind kind, Record kind record, Sort kind sort) =>
Record kind (record :& name ::: sort) where
build nilThing extender = let
ExtenderPiece consThing = specialize extender
in consThing (build nilThing extender)
newtype ExtenderPiece thing record name sort = ExtenderPiece (thing record ->
thing (record :& name ::: sort))
-- |The type of empty records.
data X style = X deriving (Show)
-- |The type of non-empty records, consisting of an initial record and a last field.
data (record :& field) style = !(record style) :& !(field style)
{-
explicit instance declaration to avoid parantheses around init records (will lead to
missing parantheses if init is constructed by an operator constructor of the same fixity as
:& which is right- or non-associative)
-}
instance (Show (init style), Show (last style)) => Show ((init :& last) style) where
showsPrec enclPrec (init :& last) = showParen (enclPrec > snocPrec) $
showsPrec snocPrec init .
showString " :& " .
showsPrec (succ snocPrec) last where
snocPrec = 2
{-|
The family of record fields.
Each instance of it matches arbitrary @name@ parameters and all @signalOfVal@ parameters
which are of the form @/signal/ `'Of'` /val/@. The actual choice of the instance
depends only on the @style@ parameter. The structure of fields of a specific style is
documented together with the respective style type.
-}
data (name ::: sort) style = !name := Value style sort
{-
explicit instance declaration because GHC doesn’t support deriving because of the use of the
type family Value
-}
instance (Show name, Show (Value style sort)) => Show ((name ::: sort) style) where
showsPrec enclPrec (name := val) = showParen (enclPrec > assignPrec) $
showsPrec (succ assignPrec) name .
showString " := " .
showsPrec (succ assignPrec) val where
assignPrec = 3
-- * Catenation
-- |The catenation of two record types.
type family Cat (record1 :: * -> *) (record2 :: * -> *) :: * -> *
type instance Cat record1 X = record1
type instance Cat record1 (record2 :& field2) = Cat record1 record2 :& field2
-- |The catenation of two records.
cat :: (Style style, Record (K style) record1, Record (K style) record2) =>
record1 style -> record2 style -> Cat record1 record2 style
cat record1 = case build (nilCatThing record1) catExtender of CatThing attach -> attach
newtype CatThing style record1 record2 = CatThing (record2 style -> Cat record1 record2 style)
nilCatThing :: record1 style -> CatThing style record1 X
nilCatThing record1 = CatThing $ \X -> record1
catExtender :: (Style style) =>
Forall (K style) (ExtenderPiece (CatThing style record1) record name)
catExtender = encase (ExtenderPiece consCatThing)
consCatThing :: CatThing style record1 record2
-> CatThing style record1 (record2 :& name ::: sort)
consCatThing (CatThing attach) = CatThing $ \(record2 :& field2) -> attach record2 :& field2
-- * Mapping
-- |Application of a function to the fields of a record.
map :: (Style style, Style style', K style ~ K style', Record (K style) record)
=> Forall (K style) (TransformerPiece style style')
-> record style -> record style'
map = case build nilMapThing mapExtender of MapThing map -> map
newtype TransformerPiece style style' sort = TransformerPiece (Value style sort ->
Value style' sort)
newtype MapThing style
style'
record = MapThing (Forall (K style) (TransformerPiece style style') ->
record style -> record style')
nilMapThing :: MapThing style style' X
nilMapThing = MapThing $ \_ X -> X
mapExtender :: (Style style) =>
Forall (K style) (ExtenderPiece (MapThing style style') record name)
mapExtender = encase (ExtenderPiece consMapThing)
consMapThing :: forall style style' record name sort.
(Sort (K style) sort)
=> MapThing style style' record
-> MapThing style style' (record :& name ::: sort)
consMapThing (MapThing map) = MapThing $ \transformer (record :& name := val) -> let
TransformerPiece fun = specialize transformer :: TransformerPiece style style' sort
in map transformer record :& name := fun val
-- * Subrecords
{-|
The class of all pairs of record types where the first is a subrecord of the second.
Currenty, the subrecord relation is only defined for records which do not have multiple
occurences of the same name. A records is a subrecord of another record if all field types
of the first record are also field types of the second, independently of order.
The instance declarations of @Subrecord@ use several helper classes which are hidden. One of
them is the class @Presence@. You get the error message that no instance of @Presence
/name/@ could be found if the alleged subrecord contains a name which is not present in the
alleged superrecord.
-}
class Subrecord subrecord record where
-- |Converts a record into a subrecord by dropping and reordering fields appropriately.
narrow :: (Style style) => record style -> subrecord style
instance Subrecord X record where
narrow _ = X
instance (Dissection record remainder subname subsort, Subrecord subrecord remainder) =>
Subrecord (subrecord :& subname ::: subsort) record where
narrow record = narrow remainder :& lookupField where
(remainder,lookupField) = dissect record
class Dissection record remainder lookupName lookupSort | record lookupName -> remainder where
dissect :: record style -> (remainder style,(lookupName ::: lookupSort) style)
instance (Present lookupName) => Dissection X remainder lookupName lookupSort where
dissect = undefined
instance (lastSort ~ lookupSort) =>
Dissection (init :& lookupName ::: lastSort) init lookupName lookupSort where
dissect (init :& last) = (init,last)
instance (Dissection init initRemainder lookupName lookupSort,
(initRemainder :& lastName ::: lastSort) ~ remainder) =>
Dissection (init :& lastName ::: lastSort) remainder lookupName lookupSort where
dissect (init :& last) = (initRemainder :& last,lookupField) where
(initRemainder,lookupField) = dissect init
class Present lookupName