FFP 11.1

5 files changed, 486 insertions, 0 deletions

diff --git a/ws2015/ffp/blaetter/11/FFP_U11-1_GADTs.hs b/ws2015/ffp/blaetter/11/FFP_U11-1_GADTs.hs
new file mode 100644
index 0000000..495e4c5
--- /dev/null
+++ b/ws2015/ffp/blaetter/11/FFP_U11-1_GADTs.hs
@@ -0,0 +1,115 @@
+-- Fortgeschrittene Funktionale Programmierung, 
+--   LMU, TCS, Wintersemester 2015/16
+--   Steffen Jost, Alexander Isenko
+--
+-- Übungsblatt 11. 13.01.2016
+--
+-- Thema: GADTs, Yesod-Formulare
+--
+-- Hinweis:
+--   Für Übung A11-2 und A11-3 benötigen Sie die Yesod-Bibliothek.
+--   Hinweise zur Installation mit Stack finden sich in den Folien
+--   und auf Alexander's githup Seite:
+--      https://github.com/cirquit/ffp-lib
+-- 
+--   Die Aufgaben A11-2 und A11-3 finden Sie in separaten, beiligenden Dateien.
+--   Dies ist notwendig, weil sich sonst das von Yesod verwendete TemplateHaskell
+--   in die Quere kommt.
+
+{-# LANGUAGE GADTs #-}
+
+module Main where
+
+
+main :: IO ()
+main = main_A11_1
+
+
+
+-- A11-1 GADTs
+--
+-- Ein beliebtes Beispiel für die Mächtigkeit von GADTs ist ein Datentyp
+-- zur sicheren Verwendung von head und tail auf Listen.
+--
+-- Betrachten Sie dazu folgende Datentypdeklarationen,
+-- bei denen einen Listentyp SList a b deklariert wird,
+-- dessen zweites Typargument protokolliert, ob die Liste
+-- leer ist oder nicht:
+
+-- We should call these "Z" and "S", they're peano naturals.
+data Empty      = Empty    
+data NonEmpty a = NonEmpty
+
+data SList a b where
+    Nil  :: SList a Empty
+    Cons :: a -> SList a b -> SList a (NonEmpty b)
+
+list0 :: SList Int Empty
+list0 = Nil
+
+list1 :: SList Int (NonEmpty (NonEmpty Empty))
+list1 = Cons 42 (Cons 69 list0)
+
+safeHead :: SList a (NonEmpty b) -> a
+safeHead (Cons x _) = x
+
+main_A11_1 :: IO ()
+main_A11_1 = do
+  putStrLn "Hallo zur Übung 10!"
+  -- print $ safeHead list0          -- Zeile 1: liefert Typfehler beim Kompilieren!
+  print $ safeHead list1             -- Zeile 2: sollte funktionieren
+  print $ safeHead $ safeTail list1  -- Zeile 3: sollte funktionieren
+  -- print $ safeHead $ safeTail $ safeTail list1 -- Zeile 4: sollte Typfehler beim Kompilieren liefern!
+
+-- a) Machen Sie als Aufwärmübung den Datentyp SList
+--    zu einer Instanz der Typklasse Show.
+--    Zur vereinfachten Behandlung der Klammerung geben wir die Listen so aus:
+--      > list0
+--      []
+--      > list1
+--      42:69:[]
+
+
+instance Show a => Show (SList a b) where
+  showsPrec _ Nil = showString "[]"
+  showsPrec d (Cons a as) = showParen (d > 10) $ showsPrec (10 + 1) a . showString ":" . showsPrec (10 + 1) as
+
+
+-- b) Geben Sie den Typ von list1 explizit an!
+
+
+-- !!! TODO !!! Typangabe
+
+
+-- c) Wie wir mit Zeile 1 von main_A11_1 überprüfen können,
+--    wird eine Aufruf von safeHead auf eine leere Liste
+--    bereits während der Kompilation von der Typprüfung verhindert!
+--
+--    Probieren Sie dies durch Entfernen der Kommentare in Zeile 1 von main_A11_1 aus,
+--    und schauen Sie sich die Fehlermeldung an. Was passiert hier?
+--
+--    Warum würde eine Datentypdeklaration wie
+--       data IsEmpty a = Empty | NonEmpty a
+--    anstatt von Empty und NonEmpty hier nicht weiterhelfen?
+
+
+{-
+A type like IsEmpty carries the sought after distinction at value level -- ordinary lists do so as well.
+-}
+
+
+-- d) Deklarieren Sie eine Funktion safeTail,
+--    welche einer SList den Kopf entfernt.
+--    Achten Sie dabei auf die korrekte Typsignatur!
+--    Wenn Sie es richtig gemacht haben, dann sollte die
+--     3. Zeile von main_A11_1 sollte nun funktionieren
+--     4. Zeile von main_A11_1 einen Typfehler beim Kompilieren liefern
+
+safeTail :: SList a (NonEmpty b) -> SList a b
+safeTail (Cons _ l) = l
+
+
+
+-- 
+-- Weiter geht es mit der Datei FFP_U11-2_Yesod.hs
+-- 
diff --git a/ws2015/ffp/blaetter/11/FFP_U11-2_Yesod.hs b/ws2015/ffp/blaetter/11/FFP_U11-2_Yesod.hs
new file mode 100644
index 0000000..83f7945
--- /dev/null
+++ b/ws2015/ffp/blaetter/11/FFP_U11-2_Yesod.hs
@@ -0,0 +1,85 @@
+-- Fortgeschrittene Funktionale Programmierung, 
+--   LMU, TCS, Wintersemester 2015/16
+--   Steffen Jost, Alexander Isenko
+--
+-- Übungsblatt 11. 13.01.2016
+--
+-- Teilaufgabe 
+-- A11-2 Yesod Grundlagen (Routing & Handling)
+--
+
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
+
+module Main where
+
+import Yesod
+import qualified Data.Text as T
+
+{-
+  Ausgehend von dem minimalen Yesod Beispielen auf Folie 09-12,
+  erstellen Sie eine kleine Webseite mit Yesod, welche Integer-Zahlen
+  addieren und multiplizieren kann.
+  Zur Übung der Grundlagen des Routings möchten wir dies
+  unsinnigerweise über die URL-Pfade der Webseite machen:
+
+  * http://localhost:3000/24/plus/373/ist
+    zeigt eine Seite an, welche die Zahl 397 anzeigt.
+
+  * http://localhost:3000/5/mal/-13/ist
+    zeigt eine Seite an, welche die Zahl -65 anzeigt.
+
+  * http://localhost:3000/5/plus/-1foo3/ist
+    zeigt eine Hilfseite an, welche darauf hinweist, dass nur ganze Zahlen erlaubt sind.
+
+  * jeder unsinniger Pfad wie etwa
+      http://localhost:3000/5/foo/-13/ist
+    zeigt eine Hilfseite an, die sagt welche Rechenoperationen erlaubt sind.
+    
+    
+  Hinweis: Yesod verwendet Data.Text, ein effizienter Ersatz für den ineffizienten Typ String.
+  Modul Data.Text stellt Methoden zur Bearbeitung von Werte dieses Typs bereit, hier eine Auswahl davon:
+    pack   :: String -> Text
+    unpack :: Text -> String
+    append :: Text -> Text -> Text
+    strip  :: Text -> Text
+    null   :: Text -> Bool
+    length :: Text -> Int
+-}
+
+
+{- LÖSUNGSVORSCHLAG -}
+
+main :: IO ()
+main = warp 3000 CalcApp
+
+data CalcApp = CalcApp
+
+instance Yesod CalcApp
+
+mkYesod "CalcApp" [parseRoutes|
+  / HomeR   GET
+|]
+
+
+getHomeR :: Handler Html
+getHomeR = defaultLayout $ do
+    setTitle "Hello!"
+    let x = 2
+    let y = 3        
+    toWidget [whamlet|
+        <h2>Hello World!
+        <p> Some text that is <i>displayed</i> here.
+        <p> We have #{show x}+#{show y}=#{show $ x + y}!
+      |]
+
+
+
+
+
+-- 
+-- Weiter geht es mit der Datei FFP_U11-3_Yesod.hs
+-- 
diff --git a/ws2015/ffp/blaetter/11/FFP_U11-3_Yesod.hs b/ws2015/ffp/blaetter/11/FFP_U11-3_Yesod.hs
new file mode 100644
index 0000000..badd9e0
--- /dev/null
+++ b/ws2015/ffp/blaetter/11/FFP_U11-3_Yesod.hs
@@ -0,0 +1,145 @@
+-- Fortgeschrittene Funktionale Programmierung, 
+--   LMU, TCS, Wintersemester 2015/16
+--   Steffen Jost, Alexander Isenko
+--
+-- Übungsblatt 11. 13.01.2016
+--
+-- Teilaufgabe 
+-- A11-3 Yesod: Applikative Formulare
+--
+-- Betrachten Sie das Beispiel aus der Vorlesung zu applikativen Formularen.
+-- Der Code ist hier vollständig enthalten und sollte problemlos ausführbar sein.
+
+-- a)
+-- Erweiteren Sie diese Webapplikation um eine Seite, auf der ein Benutzer
+-- mit einem Formular zur Eingabe einer positiven ganzen Zahl auffordert.
+-- Der Benutzer wird ggf. solange erneut aufgefordert, bis eine positive ganze Zahl ermittelt wurde;
+-- danach wird die Zahl einfach auf dem Bildschirm ausgegeben.
+
+
+
+-- b)
+-- Erweitern Sie Ihr Programm aus der vorherigen Teilausgabe, so dass
+-- je nach der eingegebenen Zahl ein Formular zur Eingabe dieser Anzahl
+-- an Autos (gemäß dem Beispiel) abgefragt werden.
+--
+-- Nutzen Sie dazu die Möglichkeit zur Kombination mehrerer Formulare in Yesod!
+-- Auch für 5 Autos soll nur ein einziges Formular mit einem einzelnen Absenden-Knopf
+-- angzeigt werden, welches entsprechend viele Felder für 5 Autos enthält.
+--
+-- Nach dem Absenden des Formulares, sollen die eingegebenen Autos einfach nur
+-- auf dem Bildschrim dargestellt werden.
+--
+-- Ein Beispiel zur Kombination zweier Formulare zu einem einzigen Formular:
+--
+--      twoCarAForm :: AForm Handler (Car,Car)
+--      twoCarAForm = (,) <$> carAForm <*> carAForm
+--
+
+
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
+
+
+import Yesod
+import Data.Text
+import Control.Applicative
+import Yesod.Form 
+
+
+{- LÖSUNGSVORSCHLAG -}
+
+main :: IO ()
+main = warp 3000 CarApp
+
+
+data CarApp = CarApp
+
+instance Yesod CarApp
+
+instance RenderMessage CarApp FormMessage where
+    renderMessage _ _ = defaultFormMessage
+
+mkYesod "CarApp" [parseRoutes|
+/               HomeR
+/car/#Int       CarR
+|]
+
+
+
+data Car = Car { carModel :: Text
+               , carYear  :: Int
+               , carColor :: Maybe Text
+               }
+   deriving Show
+
+carAForm :: AForm Handler Car
+carAForm = Car
+    <$> areq textField "Model"  Nothing
+    <*> areq intField  "Year"   (Just 1996)
+    <*> aopt textField "Color"  Nothing
+
+carForm :: Html -> MForm Handler (FormResult Car, Widget)
+carForm = renderBootstrap2 carAForm
+
+-- Beispiel zur Kombination zweier applikativer Formulare zu einem:
+twoCarAForm :: AForm Handler (Car,Car)
+twoCarAForm = (,) <$> carAForm <*> carAForm
+
+
+handleHomeR :: Handler Html
+handleHomeR = redirect $ CarR 3
+
+
+handleCarR :: Int -> Handler Html
+handleCarR n = do
+  ((result,widget), enctype) <- runFormPost $ carForm
+  case result of
+    FormMissing -> defaultLayout $ do
+      setTitle "Form Demo"
+      [whamlet|
+        <h2>Form Demo
+        <form method=post action=@{CarR n} enctype=#{enctype}>
+          ^{widget}
+          <button>Submit
+      |]
+
+    FormSuccess car -> defaultLayout $ do
+      setTitle "Form Auswerten"
+      [whamlet|
+        <h2>#{n} Cars should have been received:
+        <ul>
+          $forall acar <- [car]
+            <li>#{show acar}
+        <p>
+          <a href=@{HomeR}>Zurück
+      |]
+      
+    _ -> defaultLayout [whamlet|
+          <h2>Fehler!
+          <p>Bitte nochmal eingeben:
+          <form method=post action=@{CarR n} enctype=#{enctype}>
+            ^{widget}
+            <button>Abschicken
+        |]
+    -- das gemeinsame hamlet-widget bei 
+    -- FormMissing und FormFailure text
+    -- kann man natürlich auch nur einmal 
+    -- in einer lokalen Variable definieren
+    
+    
+    
+    
+    
+    
+-- 
+-- Weiter geht es mit der Datei FFP_U11-4_TemplateHaskell.hs
+-- 
+
+    
+    
+    
diff --git a/ws2015/ffp/blaetter/11/FFP_U11-4_TemplateHaskell.hs b/ws2015/ffp/blaetter/11/FFP_U11-4_TemplateHaskell.hs
new file mode 100644
index 0000000..05668a7
--- /dev/null
+++ b/ws2015/ffp/blaetter/11/FFP_U11-4_TemplateHaskell.hs
@@ -0,0 +1,65 @@
+-- Fortgeschrittene Funktionale Programmierung, 
+--   LMU, TCS, Wintersemester 2015/16
+--   Steffen Jost, Alexander Isenko
+--
+-- Übungsblatt 11. 13.01.2016
+--
+-- Teilaufgabe 
+-- A11-4a TemplateHaskell
+--
+-- Im Modul GameUnits sind einige 
+-- Kreaturen definiert, und eine Funktion,
+-- um zwei gegeneinander Kämpfen zu lassen,
+-- wie in Übungsblatt 7 bereits verwendet.
+--
+-- Es ist nervig, jedes Mal die komplette Figur einzugeben,
+-- weshalb wir Konstanten definieren möchten, etwa so:
+{-
+units = 
+    [ unit{ name = "Scout", str= 5 }
+    , unit{ name = "Crow",  str= 5, hit=1, flyer=True }
+    , unit{ name = "Orc",   str=20, hit=1 }
+    ]
+    
+scout = units !! 0
+crow  = units !! 1
+orc   = units !! 2
+-}
+
+-- Es ist jedoch schwierig, dies konsistent zu halten!
+-- Schreiben Sie innerhalb des Moduls GameUnit eine
+-- Funktion, welche die entsprechende Konstanten-Deklaration
+-- für alle Einheiten der stockUnitList automatisch generiert,
+-- so dass der folgende Code danach funktioniert!
+
+-- Hinweis: Dazu benötigen Sie vermutlich 
+--  aus Modul Language.Haskell.TH folgende Definitionen
+--  ValD, VarP, NormalB, newName und QuasiQuoting
+-- 
+
+{-# LANGUAGE TemplateHaskell #-}
+
+
+import GameUnits
+
+
+$(stockUnitShortcuts)
+
+
+main = do
+  dobattle orc elf
+  dobattle orc elf
+  dobattle elf dwarf
+  dobattle elf dwarf
+  dobattle elf dwarf
+  dobattle elf dwarf
+  
+  
+  
+dobattle :: Unit -> Unit -> IO ()
+dobattle att def = do
+  putStrLn $ "Attacker: " ++ name att
+  putStrLn $ "Defender: " ++ name def
+  winner <- battle att def
+  putStrLn $ "Winner: " ++ show winner
+  putStrLn "---"
\ No newline at end of file
diff --git a/ws2015/ffp/blaetter/11/GameUnits.hs b/ws2015/ffp/blaetter/11/GameUnits.hs
new file mode 100644
index 0000000..a47614e
--- /dev/null
+++ b/ws2015/ffp/blaetter/11/GameUnits.hs
@@ -0,0 +1,76 @@
+-- Fortgeschrittene Funktionale Programmierung, 
+--   LMU, TCS, Wintersemester 2015/16
+--   Steffen Jost, Alexander Isenko
+--
+-- Übungsblatt 11. 13.01.2016
+--
+-- Teilaufgabe 
+-- A11-4b TemplateHaskell
+
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
+
+module GameUnits where
+
+
+import Data.Char
+import System.Random
+import Language.Haskell.TH
+
+uncapitalize :: String -> String
+uncapitalize (c:s) = (toLower c):s
+uncapitalize []    = []
+
+---------------------------
+-- Datatype Declarations --
+---------------------------
+
+data Unit = Unit {str, hit :: Int, flyer :: Bool, name :: String } 
+  deriving (Eq, Show)
+type Units = [Unit]
+
+unit :: Unit -- default Value 
+unit = Unit {str=undefined, hit=2, flyer=False, name=undefined }
+    
+takeHit :: Unit -> Unit
+takeHit monster = monster { hit = hit monster - 1 }
+    
+isDead :: Unit -> Bool
+isDead Unit { hit=n } = n <= 0
+
+----------------------------------    
+-- Some Stock Units in the game --
+----------------------------------
+stockUnitList :: [Unit]
+stockUnitList = 
+    [ unit{ name = "Scout", str= 5 }
+    , unit{ name = "Crow",  str= 5, hit=1, flyer=True }
+    , unit{ name = "Orc",   str=20, hit=1 }
+    , unit{ name = "Dwarf", str=15, hit=2 }
+    , unit{ name = "Elf",   str=30, hit=1 }
+    , unit{ name = "Giant", str=20, hit=4 }
+    , unit{ name = "Knight",str=35, hit=2 }
+    , unit{ name = "Dragon",str=55, hit=3, flyer=True }
+    ]
+
+    
+battle :: Unit -> Unit -> IO Unit
+battle att def = do
+    attRoll <- randomRIO (0,99)
+    defRoll <- randomRIO (0,99)
+    case (attRoll < str att, defRoll < str def) of
+      (True, False) -> check att $ takeHit def
+      (False,True ) -> check (takeHit att) def
+      _other -> battle att def -- reroll
+  where
+    check a d 
+      | isDead a  = return d
+      | isDead d  = return a
+      | otherwise = battle a d
+      
+      
+      
+stockUnitShortcuts :: Q [Dec] 
+-- declares a constants of type Unit for each unit on the 
+stockUnitShortcuts = undefined -- !!! TODO !!!
+    
+    
\ No newline at end of file