From c3911983dbe7a1c383b3887846cf5a01444879ce Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 13 Jan 2016 21:11:13 +0100
Subject: FFP 11.2

---
 ws2015/ffp/blaetter/11/FFP_U11-2_Yesod.hs | 53 +++++++++++++++++++++----------
 1 file changed, 37 insertions(+), 16 deletions(-)

(limited to 'ws2015/ffp/blaetter')

diff --git a/ws2015/ffp/blaetter/11/FFP_U11-2_Yesod.hs b/ws2015/ffp/blaetter/11/FFP_U11-2_Yesod.hs
index 83f7945..156e002 100644
--- a/ws2015/ffp/blaetter/11/FFP_U11-2_Yesod.hs
+++ b/ws2015/ffp/blaetter/11/FFP_U11-2_Yesod.hs
@@ -17,6 +17,7 @@
 module Main where
 
 import Yesod
+import Data.Text (Text)
 import qualified Data.Text as T
 
 {-
@@ -58,26 +59,46 @@ main = warp 3000 CalcApp
 
 data CalcApp = CalcApp
 
-instance Yesod CalcApp
+data ArithOp = ArithAdd
+             | ArithMult
+             deriving (Show, Eq, Read)
+
+instance PathPiece ArithOp where
+  fromPathPiece "plus" = Just ArithAdd
+  fromPathPiece "mal" = Just ArithMult
+  fromPathPiece _ = Nothing
+  toPathPiece ArithAdd = "plus"
+  toPathPiece ArithMult = "mal"
 
 mkYesod "CalcApp" [parseRoutes|
-  / HomeR   GET
+  / IndexR GET
+  !#Int/#ArithOp/#Int/ist MathR GET
+  !#Text/#ArithOp/#Text/ist MathErrR 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}!
-      |]
-
-
-
+getIndexR :: Handler Html
+getIndexR = defaultLayout $ do
+  setTitle "math!"
+  [whamlet|
+    <h1>Math!
+    <p>We support:
+      <ul>
+        <li>plus
+        <li>mal
+  |]
+
+instance Yesod CalcApp where
+  errorHandler NotFound = fmap toTypedContent getIndexR
+
+getMathR :: Int -> ArithOp -> Int -> Handler Text
+getMathR x op y = return . T.pack . show $ runCalc op x y
+  where
+    runCalc ArithAdd = (+)
+    runCalc ArithMult = (*)
+
+getMathErrR :: Text -> ArithOp -> Text -> Handler Text
+getMathErrR _ _ _ = return . T.pack $ "Nur ganze Zahlen!"
+    
 
 
 -- 
-- 
cgit v1.2.3