-- 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 (Text)
import qualified Data.Text as T
import Control.Applicative
import Data.Traversable (sequenceA)
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

-- Beispiel zur Kombination zweier applikativer Formulare zu einem:
twoCarAForm :: AForm Handler (Car,Car)
twoCarAForm = (,) <$> carAForm <*> carAForm


handleHomeR :: Handler Html
handleHomeR = do
  ((result, widget), enctype) <- runFormPost . renderBootstrap2 $ areq intField "Number of Cars" Nothing
  case result of
    FormMissing -> defaultLayout $ do
      [whamlet|
        <h2>Form Demo
        <form method=post action=@{HomeR} enctype=#{enctype}>
          ^{widget}
          <button>Submit
       |]
    FormSuccess n -> redirect $ CarR n


handleCarR :: Int -> Handler Html
handleCarR n = do
  ((result,widget), enctype) <- runFormPost . renderBootstrap2 . sequenceA . replicate n $ carAForm
  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 cars -> defaultLayout $ do
      setTitle "Form Auswerten"
      [whamlet|
        <h2>#{n} Cars should have been received:
        <ul>
          $forall acar <- cars
            <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
--