record-class model

gistfile1.txt

{-# LANGUAGE
  MultiParamTypeClasses,
  TypeFamilies #-}

class Field f where
  type FType f :: *

class (Field field) => Has field o where
  get :: field -> o -> FType field

data Name = Name
instance Field Name where
  type FType Name = String
data Area = Area
instance Field Area where
  type FType Area = Float
data AsString = AsString
instance Field AsString where
  type FType AsString = String

data Srec = Srec { sn :: String, srepr :: String } 
instance Has Name Srec where
  get _ s = sn s
instance Has AsString Srec where
  get _ s = srepr s

shape name = \self -> Srec
  name
  ("Shape "++name++" with area "++show (get Area self))

{- inferred type:
shape :: Has Area o => String -> o -> Srec
 -}

data SqRec = SqRec {sqn :: String,
                    sqa :: Float,
                    sqrepr :: String}
instance Has Name SqRec where
  get _ s = sqn s
instance Has Area SqRec where
  get _ s = sqa s
instance Has AsString SqRec where
  get _ s = sqrepr s

square name side = \self ->
  let super = shape name self in
  SqRec (get Name super) (side*side) (get AsString super)