Eigene Typen und Typklassen

data Farbe = Rot | Gruen | Blau deriving (Show, Eq, Ord, Enum, Bounded)

data Form
  = Kreis Double
  | Rechteck Double Double
  | Dreieck Double Double Double
  deriving (Show, Eq)

flaeche :: Form -> Double
flaeche (Kreis r) = pi * r * r
flaeche (Rechteck b h) = b * h
flaeche (Dreieck a b c) = let s = (a + b + c) / 2 in sqrt (s * (s - a) * (s - b) * (s - c))

data Person = Person
  { name :: String
  , alter :: Int
  , email :: Maybe String
  } deriving (Show, Eq)

main :: IO ()
main = do
  print [minBound .. maxBound :: Farbe]
  print (succ Rot, Rot < Blau, fromEnum Gruen)
  mapM_ (print . flaeche) [Kreis 1, Rechteck 3 4, Dreieck 3 4 5]
  let mia = Person { name = "Mia", alter = 17, email = Nothing }
      aelter = mia { alter = 18, email = Just "mia@example.com" }   -- Kopie mit Änderung
  print mia
  print aelter
  putStrLn (name aelter ++ " ist " ++ show (alter aelter))
  print (mia == aelter, mia == mia { email = Nothing })

[Rot,Gruen,Blau]
(Gruen,True,1)
3.141592653589793
12.0
6.0
Person {name = "Mia", alter = 17, email = Nothing}
Person {name = "Mia", alter = 18, email = Just "mia@example.com"}
Mia ist 18
(False,True)

data Baum a = Blatt | Knoten (Baum a) a (Baum a) deriving Show

einfuegen :: Ord a => a -> Baum a -> Baum a
einfuegen x Blatt = Knoten Blatt x Blatt
einfuegen x t@(Knoten l w r)
  | x < w = Knoten (einfuegen x l) w r
  | x > w = Knoten l w (einfuegen x r)
  | otherwise = t

inorder :: Baum a -> [a]
inorder Blatt = []
inorder (Knoten l w r) = inorder l ++ [w] ++ inorder r

tiefe :: Baum a -> Int
tiefe Blatt = 0
tiefe (Knoten l _ r) = 1 + max (tiefe l) (tiefe r)

enthaelt :: Ord a => a -> Baum a -> Bool
enthaelt _ Blatt = False
enthaelt x (Knoten l w r)
  | x == w = True
  | x < w = enthaelt x l
  | otherwise = enthaelt x r

data Ausdruck = Zahl Double | Plus Ausdruck Ausdruck | Mal Ausdruck Ausdruck | Neg Ausdruck deriving Show

auswerten :: Ausdruck -> Double
auswerten (Zahl n) = n
auswerten (Plus a b) = auswerten a + auswerten b
auswerten (Mal a b) = auswerten a * auswerten b
auswerten (Neg a) = negate (auswerten a)

main :: IO ()
main = do
  let baum = foldr einfuegen Blatt [5, 3, 8, 1, 4, 7, 9, 2, 6 :: Int]
  print (inorder baum)
  print (tiefe baum, enthaelt 4 baum, enthaelt 10 baum)
  print (auswerten (Mal (Plus (Zahl 2) (Zahl 3)) (Neg (Zahl 4))))
  print (Plus (Zahl 1) (Zahl 2))

[1,2,3,4,5,6,7,8,9]
(4,True,False)
-20.0
Plus (Zahl 1.0) (Zahl 2.0)

class Beschreibbar a where
  beschreibe :: a -> String
  kurz :: a -> String
  kurz x = take 10 (beschreibe x)            -- Standardimplementierung

data Hund = Hund String
data Auto = Auto String Int

instance Beschreibbar Hund where
  beschreibe (Hund n) = "Hund namens " ++ n

instance Beschreibbar Auto where
  beschreibe (Auto marke ps) = marke ++ " mit " ++ show ps ++ " PS"
  kurz (Auto marke _) = marke

instance Beschreibbar Bool where
  beschreibe True = "wahr"
  beschreibe False = "falsch"

ausgabe :: Beschreibbar a => a -> IO ()
ausgabe x = putStrLn (beschreibe x ++ " | " ++ kurz x)

-- Eigene Instanzen der Standardklassen
newtype Meter = Meter Double deriving (Eq, Ord)
instance Show Meter where
  show (Meter m) = show m ++ " m"
instance Num Meter where
  Meter a + Meter b = Meter (a + b)
  Meter a * Meter b = Meter (a * b)
  abs (Meter a) = Meter (abs a)
  signum (Meter a) = Meter (signum a)
  fromInteger = Meter . fromInteger
  negate (Meter a) = Meter (negate a)

main :: IO ()
main = do
  ausgabe (Hund "Rex")
  ausgabe (Auto "Volkswagen" 90)
  ausgabe True
  print (Meter 3 + Meter 4.5, maximum [Meter 1, Meter 7, Meter 3])
  print (sum [Meter 1, Meter 2, Meter 3])

Hund namens Rex | Hund namen
Volkswagen mit 90 PS | Volkswagen
wahr | wahr
(7.5 m,7.0 m)
6.0 m

import Data.Monoid

main :: IO ()
main = do
  print ([1, 2] <> [3], "ab" <> "cd", mempty :: String)
  print (getSum (foldMap Sum [1 .. 10]), getProduct (foldMap Product [1 .. 5]))
  print (getAll (foldMap (All . even) [2, 4]), getAny (foldMap (Any . odd) [2, 4]))
  print (mconcat ["Hallo", " ", "Welt"])
  print (Just [1] <> Nothing <> Just [2])
  print (getFirst (First (Just 1) <> First Nothing <> First (Just 3)))
  print (compare 1 2 <> compare 3 3)

([1,2,3],"abcd","")
(55,120)
(True,False)
"Hallo Welt"
Just [1,2]
Just 1
LT