Buttons for Links utility added

routes

@@ -13,7 +13,7 @@
 /term/#TermIdentifier/edit  TermEditExistR    GET
 
 /course/                    CourseListR       GET
-!/course/edit               CourseEditR       GET POST
+!/course/new                CourseEditR       GET POST
 !/course/#TermIdentifier    CourseListTermR   GET
 /course/#TermIdentifier/#Text/edit CourseEditExistR GET
 /course/#TermIdentifier/#Text/show CourseShowR GET POST

src/Handler/Course.hs

@@ -53,7 +53,8 @@ getCourseListTermR tidini = do
               |] )  
         ]  
   defaultLayout $ do
-    setTitle "Semesterkurse"            
+    setTitle "Semesterkurse"  
+    linkButton "Neuen Kurs anlegen" BCPrimary CourseEditR
     encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal courses)
 
 getCourseShowR :: TermIdentifier -> Text -> Handler Html
@@ -232,12 +233,12 @@ courseToForm cEntity = CourseForm
     course = entityVal cEntity
       
 newCourseForm :: Maybe CourseForm -> Form CourseForm
-newCourseForm template html = do       
+newCourseForm template = identifyForm "newCourseForm" $ \html -> do
     -- mopt hiddenField    
---     cidKey <- getsYesod appCryptoIDKey
+    --     cidKey <- getsYesod appCryptoIDKey
---     courseId <- runMaybeT $ do
+    --     courseId <- runMaybeT $ do
---         cid <- cfCourseId template
+    --         cid <- cfCourseId template
---         UUID.encrypt cidKey cid 
+    --         UUID.encrypt cidKey cid 
     (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ CourseForm
       -- <$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work?
       <$> aopt hiddenField "KursId"             (cfCourseId <$> template)

src/Handler/Utils/Form.hs

@@ -25,7 +25,6 @@ import Yesod.Form.Bootstrap3
 import Web.PathPieces (showToPathPiece, readFromPathPiece)
 
 
-
 ----------------------------
 -- Buttons (new version ) --
 ----------------------------
@@ -43,9 +42,11 @@ class (Enum a, Bounded a, Ord a, PathPiece a) => Button a where
   cssClass :: a -> ButtonCssClass
   cssClass _ = BCDefault
   
+  
+--Some standard Buttons useful throughout  
 data StandardButton = BtnDelete | BtnAbort | BtnSave
   deriving (Enum, Eq, Ord, Bounded, Read, Show)
-  
+     
 instance PathPiece StandardButton where    -- for displaying the button only, not really for paths
   toPathPiece   = showToPathPiece
   fromPathPiece = readFromPathPiece
@@ -59,7 +60,23 @@ instance Button StandardButton where
   cssClass BtnAbort  = BCDefault
   cssClass BtnSave   = BCPrimary
   
-
+-- -- Looks like a button, but is just a link (e.g. for create course, etc.)  
+-- data LinkButton = LinkButton (Route UniWorX)
+--   deriving (Enum, Eq, Ord, Bounded, Read, Show)
+-- 
+-- instance PathPiece LinkButton where
+--     LinkButton route = ???
+  
+linkButton :: Widget -> ButtonCssClass -> Route UniWorX -> Widget
+linkButton lbl cls url = do
+  [whamlet|
+    <form method=post action=@{url}>      
+      <input type="hidden" name="_formid" value="identify-linkButton">
+      <button .btn .#{bcc2txt cls} type=submit value="Link to @{url}">^{lbl}
+  |] 
+  --  <input .btn .#{bcc2txt cls} type="submit" value=^{lbl}> 
+  
+  
 buttonField :: Button a => a -> Field Handler a
 buttonField btn = Field {fieldParse, fieldView, fieldEnctype}
   where