chore(lms): add working direct upload page lms results

routes

@@ -255,8 +255,9 @@
 !/*WellKnownFileName WellKnownR GET !free
 
 -- OSIS CSV Export Demo
-/lms/#SchoolId/#QualificationShorthand              LmsR  				GET POST
-/lms/#SchoolId/#QualificationShorthand/users        LmsUsersR	    GET POST
-/lms/#SchoolId/#QualificationShorthand/userlist     LmsUserlistR	GET POST
-/lms/#SchoolId/#QualificationShorthand/result       LmsResultR    GET POST
- 
+/lms/#SchoolId/#QualificationShorthand                LmsR  				    GET POST
+/lms/#SchoolId/#QualificationShorthand/users          LmsUsersR	        GET POST
+/lms/#SchoolId/#QualificationShorthand/userlist       LmsUserlistR	    GET POST
+/lms/#SchoolId/#QualificationShorthand/result         LmsResultR        GET POST
+/lms/#SchoolId/#QualificationShorthand/result/upload  LmsResultUploadR  GET POST
+/lms/test LmsTestR GET

src/Foundation/Navigation.hs

@@ -137,6 +137,8 @@ breadcrumb (LmsR         _sid _qsh) = i18nCrumb MsgMenuLms             Nothing
 breadcrumb (LmsUsersR     sid  qsh) = i18nCrumb MsgMenuLmsUsers      $ Just $ LmsR sid qsh
 breadcrumb (LmsUserlistR  sid  qsh) = i18nCrumb MsgMenuLmsUserlist   $ Just $ LmsR sid qsh
 breadcrumb (LmsResultR    sid  qsh) = i18nCrumb MsgMenuLmsResult     $ Just $ LmsR sid qsh
+breadcrumb (LmsResultUploadR sid qsh) = i18nCrumb MsgMenuLmsResult   $ Just $ LmsResultR sid qsh
+breadcrumb  LmsTestR                = i18nCrumb MsgMenuLmsResult       Nothing
 
 breadcrumb ProfileR         = i18nCrumb MsgBreadcrumbProfile   Nothing
 breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail  $ Just ProfileR

src/Handler/LMS.hs

@@ -9,6 +9,8 @@ module Handler.LMS
   , getLmsUsersR   , postLmsUsersR
   , getLmsUserlistR, postLmsUserlistR
   , getLmsResultR  , postLmsResultR
+  , getLmsResultUploadR  , postLmsResultUploadR
+  , getLmsTestR
   )
   where
 

src/Handler/LMS/Result.hs

@@ -2,6 +2,8 @@
 
 module Handler.LMS.Result
   ( getLmsResultR, postLmsResultR 
+  , getLmsResultUploadR, postLmsResultUploadR
+  , getLmsTestR
   )
   where
 
@@ -199,3 +201,73 @@ postLmsResultR sid qsh = do
   siteLayoutMsg MsgMenuLmsResult $ do
     setTitleI MsgMenuLmsResult
     $(widgetFile "lms-result")
+
+
+-- Direct File Upload/Download
+getLmsTestR :: Handler Html 
+getLmsTestR = siteLayoutMsg MsgMenuLmsResult $ do
+  setTitleI MsgMenuLmsResult
+  [whamlet|$newline never
+      Hello!
+  |]
+
+
+getLmsResultUploadR :: SchoolId -> QualificationShorthand -> Handler Html
+getLmsResultUploadR _sid _qsh = do
+  -- _qid <- runDB $ getKeyBy404 $ UniqueSchoolShort sid qsh 
+  ((_,widget), enctype) <- runFormPost makeResultUploadForm
+  siteLayoutMsg MsgMenuLmsResult $ do
+    setTitleI MsgMenuLmsResult
+    [whamlet|$newline never
+      <form method=post enctype=#{enctype}>
+          ^{widget}
+          <p>
+          <input type=submit>
+    |]
+
+
+--saveResultCsv :: (PersistUniqueWrite backend, MonadIO m, BaseBackend backend ~ SqlBackend) =>
+--                    Key Qualification -> LmsResultTableCsv -> ReaderT backend m ()
+saveResultCsv :: QualificationId -> LmsResultTableCsv -> DB ()
+saveResultCsv qid LmsResultTableCsv{..} = do
+    now <- liftIO getCurrentTime
+    void $ upsert 
+      LmsResult
+        { lmsResultQualification  =  qid 
+        , lmsResultIdent          =  csvLRTident
+        , lmsResultSuccess        =  csvLRTsuccess & lms2day
+        , lmsResultTimestamp      =  now 
+        }
+      [ LmsResultSuccess          =. (csvLRTsuccess & lms2day)
+      , LmsResultTimestamp        =. now
+      ]
+
+postLmsResultUploadR :: SchoolId -> QualificationShorthand -> Handler Html
+postLmsResultUploadR sid qsh = do
+  ((result,widget), enctype) <- runFormPost makeResultUploadForm
+  case result of 
+    FormSuccess file -> do
+      -- content <- fileSourceByteString file 
+      -- return $ Just (fileName file, content)          
+      void $ runDB $ do 
+        qid <- getKeyBy404 $ UniqueSchoolShort sid qsh 
+        runConduit $ fileSource file 
+          .| decodeCsv
+          .| mapM_C (saveResultCsv qid)
+      addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file
+      redirect $ LmsResultR sid qsh 
+    FormFailure errs -> do
+      forM_ errs $ addMessage Error . toHtml
+      redirect $ LmsResultUploadR sid qsh 
+    FormMissing -> 
+      siteLayoutMsg MsgMenuLmsResult $ do
+        setTitleI MsgMenuLmsResult
+        [whamlet|$newline never
+          <form method=post enctype=#{enctype}>
+              ^{widget}
+              <p>
+              <input type=submit>
+        |]
+        
+makeResultUploadForm :: Form FileInfo
+makeResultUploadForm = renderAForm FormStandard $ fileAFormReq "ResultCSV"