new course handler stub

routes

@@ -7,3 +7,6 @@
 / HomeR GET POST
 
 /profile ProfileR GET
+
+
+/assist/newcourse NewCourseR GET POST

src/Application.hs

@@ -20,7 +20,6 @@ module Application
     ) where
 
 import Control.Monad.Logger                 (liftLoc, runLoggingT)
-import Database.Persist.Sql                 (runMigrationUnsafe)
 import Database.Persist.Postgresql          (createPostgresqlPool, pgConnStr,
                                              pgPoolSize, runSqlPool)
 import Import
@@ -42,6 +41,7 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
 import Handler.Common
 import Handler.Home
 import Handler.Profile
+import Handler.Assist
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
@@ -80,7 +80,7 @@ makeFoundation appSettings = do
         (pgPoolSize $ appDatabaseConf appSettings)
 
     -- Perform database migration using our application's logging settings.
-    runLoggingT (runSqlPool (runMigrationUnsafe migrateAll) pool) logFunc
+    runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
 
     -- Return the foundation
     return $ mkFoundation pool

src/Foundation.hs

@@ -166,6 +166,8 @@ instance Yesod UniWorX where
     isAuthorized (StaticR _) _ = return Authorized
 
     isAuthorized ProfileR _ = isAuthenticated
+    -- TODO: change to Assistants
+    isAuthorized NewCourseR _ = return Authorized
 
     -- This function creates static content files in the static folder
     -- and names them based on a hash of their content. This allows

src/Handler/Assist.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+module Handler.Assist where
+
+import Import
+import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
+-- import Text.Julius (RawJS (..))
+
+data NewCourseForm = NewCourseForm 
+    {   ncf_name     :: Text 
+    ,   ncf_short    :: Text 
+    ,   ncf_capacity :: Maybe Int
+    }
+-- Handler for Assistants
+
+getNewCourseR :: Handler Html
+getNewCourseR = do
+    (formWidget, formEnctype) <- generateFormPost newCourseForm
+    defaultLayout $ do
+        setTitle "Neuen Kurs anlegen"
+        $(widgetFile "newcourse")
+
+postNewCourseR :: Handler Html
+postNewCourseR = do
+    ((result, formWidget), formEnctype) <- runFormPost newCourseForm
+    case result of
+       FormSuccess res -> do
+            setMessage "Got something!"
+            redirect NewCourseR
+       _ -> redirect NewCourseR
+
+{-
+    defaultLayout $ do
+        let (commentFormId, commentTextareaId, commentListId) = commentIds
+        aDomId <- newIdent
+        setTitle "Welcome To Yesod!"
+        $(widgetFile "homepage")
+-}
+
+
+
+newCourseForm :: Form NewCourseForm 
+newCourseForm = renderBootstrap3 BootstrapBasicForm $ NewCourseForm
+    <$> areq textField (set "Name des Kurses")           Nothing
+    <*> areq textField (set "Kurs Kürzel (3-4 Zeichen)") Nothing
+    <*> aopt intField  (set "Maximale Teilnehmer")       Nothing
+    -- Add attributes like the placeholder and CSS classes.
+   where set txt = FieldSettings
+            { fsLabel = txt
+            , fsTooltip = Nothing
+            , fsId = Nothing
+            , fsName = Nothing
+            , fsAttrs =
+                [ ("class", "form-control")                
+                ]
+            }

templates/newcourse.hamlet

@@ -0,0 +1,20 @@
+<div .container>
+    <div .bs-docs-section>
+        <div .row>
+            <div .col-lg-12>
+                <div .page-header>
+                    <h1 #forms>Neuen Kurs anlegen:
+
+                    <p>
+                        Bitte alles ausfüllen!
+
+        <div .row>
+            <div .col-lg-6>
+                <div .bs-callout bs-callout-info well>
+                    <form .form-horizontal method=post action=@{NewCourseR}#forms enctype=#{formEnctype}>
+                        ^{formWidget}
+
+                        <button .btn.btn-primary type="submit">
+                            Kurs anlegen!
+
+