Kapitel 3: Typen und Typklassen

hugs Types
ghc -c BinTree.lhs Types.lhs

> module Types
> where
> import Prelude hiding (lookup)
> import BinTree hiding (splitAt)
> import Complex hiding (conjugate)

Datentypen.

> data Color                    =  Red | Green | Blue

> data Point                    =  Point Int Int

> lookup                        :: (Ord a) => Tree (a, b) -> a -> Maybe b
> lookup Empty b                =  Nothing
> lookup (Node l (a, v) r) b
>     | b < a                   =  lookup l b
>     | b == a                  =  Just v
>     | b > a                   =  lookup r b
>
> lookupWithDefault             :: (Ord a) => Tree (a, b) -> b -> a -> b
> lookupWithDefault t def b     =  case lookup t b of
>                                      Nothing -> def
>                                      Just v  -> v

Text mit Einrückung.

< data Text

> text                          :: String -> Text       -- ohne |'\n'|
> nl                            :: Text
> indent                        :: Int -> Text -> Text
> (<>)                          :: Text -> Text -> Text
>
> render                        :: Text -> String

Beispiel.

> layTree                       :: Tree Int -> Text
> layTree Empty                 =  text "Empty"
> layTree (Node l a r)          =  indent 4 (text "Node"   <> nl <>
>                                            layTree l     <> nl <>
>                                            text (show a) <> nl <>
>                                            layTree r)


putStrLn $ render $ layTree (Node (Node Empty 4711 Empty) 12 Empty)

Referenzimplementierung.

> data Text                     =  Text String          -- ohne |'\n'|
>                               |  Newline
>                               |  Indent Int Text
>                               |  Text :<> Text
>
> text                          =  Text
> nl                            =  Newline
> indent                        =  Indent
> (<>)                          =  (:<>)

> render (Text s)               =  s
> render Newline                =  "\n"
> render (Indent i d)           =  tab i (render d)
> render (d1 :<> d2)            =  render d1 ++ render d2
>
> tab                           :: Int -> String -> String
> tab i ""                      =  ""
> tab i (c : s)
>     | c == '\n'               =  c : replicate i ' ' ++ tab i s
>     | otherwise               =  c :                    tab i s

Eigenschaften.

< text "" <> d                  =  d
<
< d <> text ""                  =  d
<
< d1 <> (d2 <> d3)              =  (d1 <> d2) <> d3
<
< indent 0 d                    =  d
<
< indent i (text s)             =  text s
<
< indent i nl                   =  nl <> text (replicate i ' ')
<
< indent i (indent j d)         =  indent (i + j) d
<
< indent i (d1 <> d2)           =  indent i d1 <> indent i d2
<
< render (text s)               =  s
<
< render nl                     =  "\n"
<
< render (d1 :<> d2)            =  render d1 ++ render d2


Spezifikation:

< render' i doc x               =  render (indent i doc) ++ x

> render'                       :: Int -> Text -> String -> String
> render' i (Text s)     x      =  s ++ x
> render' i Newline      x      =  '\n' : replicate i ' ' ++ x
> render' i (Indent j d) x      =  render' (i + j) d x
> render' i (d1 :<> d2)  x      =  render' i d1 (render' i d2 x)

Typsynonyme.

> type Set a                    =  [a]
>
> type Dict a b                 =  Tree (a, b)

Typklassen.

> instance (Eq a) => Eq (Tree a) where
>     Empty         == Empty            =  True
>     Node l1 a1 r1 == Node l2 a2 r2    =  l1 == l2 && a1 == a2 && r1 == r2
>     _             == _                =  False
>     t /= u                            =  not (t == u)

> conjugate                     :: (RealFloat a) => Complex a -> Complex a
> conjugate (x :+ y)            =  x :+ (-y)

> pyth                          :: (Floating a) => a -> a -> a
> pyth x y                      =  sqrt (x ^ 2 + y ^ 2)

> default (Int, Double)

> whoops                        :: String -> String
> whoops x                      =  show (read x :: [Int])

Text mit Einrückung.

> class (Show a) => Lay a where
>     lay                       :: a -> Text
>
>     lay a                     =  text (show a)
>
> instance Lay Int
> instance Lay Integer

> instance (Lay a) => Lay (Tree a) where
>     lay Empty                 =  text "Empty"
>     lay (Node l a r)          =  indent 4 (text "Node" <> nl <>
>                                            lay l       <> nl <>
>                                            lay a       <> nl <>
>                                            lay r)

putStrLn $ render $ lay (Node (Node Empty 4711 Empty) 12 Empty :: Tree Int)