3rd tick for issue #187

src/Handler/Course.hs

@@ -15,7 +15,7 @@
 
 module Handler.Course where
 
-import Import
+import Import hiding (catMaybes)
 
 import Control.Lens
 import Utils.Lens
@@ -33,6 +33,9 @@ import Data.Maybe
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 
+import qualified Data.CaseInsensitive as CI
+
+
 import Colonnade hiding (fromMaybe,bool)
 -- import Yesod.Colonnade
 
@@ -317,6 +320,14 @@ postCRegisterR tid ssh csh = do
     (_other) -> return () -- TODO check this!
   redirect $ CourseR tid ssh csh CShowR
 
+
+getCourseNewTemplateR :: Maybe TermId -> Maybe SchoolId -> Maybe CourseShorthand -> Handler Html
+getCourseNewTemplateR mbTid mbSsh mbCsh =
+  redirect (CourseNewR, catMaybes [ ("tid",).termToText.unTermKey    <$> mbTid
+                                  , ("ssh",).CI.original.unSchoolKey <$> mbSsh
+                                  , ("csh",).CI.original             <$> mbCsh
+                                  ])
+
 getCourseNewR :: Handler Html -- call via toTextUrl
 getCourseNewR = do
   uid <- requireAuthId
@@ -325,15 +336,11 @@ getCourseNewR = do
             <*> iopt ciField      "ssh"
             <*> iopt ciField      "csh"
   let noTemplateAction = courseEditHandler True Nothing
-  case params of
+  case params of -- DO NOT REMOVE: without this distinction, lecturers would never see an empty newCourseForm any more!
     FormMissing      -> noTemplateAction
-    FormFailure msgs -> forM_ msgs ((addMessage Error) . toHtml)
+    FormFailure msgs -> forM_ msgs ((addMessage Error) . toHtml) >>
-                        >> noTemplateAction
+                        noTemplateAction
-    FormSuccess (mbTid,mbSsh,mbCsh) ->
+    FormSuccess (fmap TermKey -> mbTid, fmap SchoolKey -> mbSsh, mbCsh) -> do
-      getCourseNewTemplateR (TermKey <$> mbTid) (SchoolKey <$> mbSsh) mbCsh
-
-getCourseNewTemplateR :: Maybe TermId -> Maybe SchoolId -> Maybe CourseShorthand -> Handler Html
-getCourseNewTemplateR mbTid mbSsh mbCsh = do
       uid <- requireAuthId
       oldCourses <- runDB $ do
         E.select $ E.from $ \course -> do

src/Handler/Utils/Form.hs

@@ -121,37 +121,6 @@ linkButton lbl cls url = [whamlet| <a href=@{url} .btn .#{bcc2txt cls} role=butt
 --   |]
   --  <input .btn .#{bcc2txt cls} type="submit" value=^{lbl}>
 
-    {-
-combinedButtonField :: Button a => [a] -> Form m -> Form (a,m)
-combinedButtonField btns inner csrf = do
-    buttonIdent <- newFormIdent
-    let button b = mopt (buttonField b) ("n/a"{ fsName = Just buttonIdent }) Nothing
-    (results, btnViews) <- unzip <$> mapM button [minBound..maxBound]
-    (innerRes,innerWdgt) <- inner
-    let widget = do
-          [whamlet|
-            #{csrf}
-            ^{innerWdgt}
-            <div .btn-group>
-              $forall bView <- btnViews
-                ^{fvInput bView}
-          |]
-    let result = case (accResult result, innerRes) of
-                    (FormSuccess b, FormSuccess i) -> FormSuccess (b,i)
-                    _ -> FormFailure ["Something went wrong"] -- TODO
-    return (result,widget)
-  where
-    accResult :: Foldable f => f (FormResult (Maybe a)) -> FormResult a
-    accResult = Foldable.foldr accResult' FormMissing
-
-    accResult' :: FormResult (Maybe a) -> FormResult a -> FormResult a
-    accResult' (FormSuccess (Just _)) (FormSuccess _) = FormFailure ["Ambiguous button parse"]
-    accResult' (FormSuccess (Just x)) _ = FormSuccess x
-    accResult' _ x@(FormSuccess _) = x --SJ: Is this safe? Shouldn't Failure override Success?
-    accResult' (FormSuccess Nothing) x = x
-    accResult' FormMissing _ = FormMissing
-    accResult' (FormFailure errs) _ = FormFailure errs
-    -}
 
 -- buttonForm :: Button a => Markup -> MForm (HandlerT UniWorX IO) (FormResult a, (WidgetT UniWorX IO ()))
 buttonForm :: (Button UniWorX a, Show a) => Form a