fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Creating and editing terms: basic functionality, still bery ugly

Browse Source
This commit is contained in:
SJost 2017-10-06 17:14:56 +02:00
parent 6d3df4f30b
commit a871725d9c
2 changed files with 26 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
models
View File

@ -8,8 +8,7 @@ Term json
start Day start Day
end Day end Day
holidays [Day] holidays [Day]
active Bool active Bool
UniqueTerm name
Primary name Primary name
deriving Show deriving Show
School json School json

37
src/Handler/Assist.hs
View File

@ -14,8 +14,14 @@ import Database.Persist.Class as K (Key)
-- import Text.Julius (RawJS (..)) -- import Text.Julius (RawJS (..))
-- TODO: Move elsewhere -- TODO: Move elsewhere
termField :: Field (HandlerT UniWorX IO) TermIdentifier termExistsField :: Field (HandlerT UniWorX IO) TermIdentifier
termField = checkMMap checkTerm termToText textField termExistsField = termField True
termNewField :: Field (HandlerT UniWorX IO) TermIdentifier
termNewField = termField False
termField :: Bool -> Field (HandlerT UniWorX IO) TermIdentifier
termField mustexist = checkMMap checkTerm termToText textField
where where
errTextParse :: Text errTextParse :: Text
errTextParse = "Semester: S oder W gefolgt von Jahreszahl" errTextParse = "Semester: S oder W gefolgt von Jahreszahl"
@ -27,9 +33,8 @@ termField = checkMMap checkTerm termToText textField
checkTerm t = case termFromText t of checkTerm t = case termFromText t of
Left _ -> return $ Left errTextParse Left _ -> return $ Left errTextParse
res@(Right ti) -> do res@(Right ti) -> do
-- term <- runDB $ get $ Key ti -- TODO: membershiptest instead? term <- runDB $ get $ TermKey ti -- TODO: membershiptest instead?
term <- runDB $ getBy $ UniqueTerm ti -- TODO: use get instead of getBy? return $ if mustexist && isNothing term
return $ if isNothing term
then Left $ errTextFreigabe ti then Left $ errTextFreigabe ti
else res else res
@ -51,7 +56,7 @@ data NewCourseForm = NewCourseForm
newCourseForm :: UserId -> Form NewCourseForm newCourseForm :: UserId -> Form NewCourseForm
newCourseForm uid = renderBootstrap3 BootstrapBasicForm $ NewCourseForm newCourseForm uid = renderBootstrap3 BootstrapBasicForm $ NewCourseForm
<$> pure uid <$> pure uid
<*> areq termField (set "Semester") Nothing <*> areq termExistsField (set "Semester") Nothing
-- <*> areq textField (set "Semester") Nothing -- <*> areq textField (set "Semester") Nothing
<*> areq textField (set "Name des Kurses") Nothing <*> areq textField (set "Name des Kurses") Nothing
<*> areq textField (set "Kurs Kürzel (3-4 Zeichen)") Nothing <*> areq textField (set "Kurs Kürzel (3-4 Zeichen)") Nothing
@ -121,15 +126,23 @@ getShowTermR = do
terms <- runDB $ selectList [] [Desc TermStart] terms <- runDB $ selectList [] [Desc TermStart]
defaultLayout $ do defaultLayout $ do
setTitle "Freigeschaltete Semester" setTitle "Freigeschaltete Semester"
-- TODO: provide common utility function for formatting Times
-- TODO: turn into proper table
[whamlet| [whamlet|
<h2> <h2>
Liste der freigeschalteten Semeser: Liste der freigeschalteten Semester:
$if null terms $if null terms
<p> Es wurden noch kein Semester freigeschaltetet. <p> Es wurden noch kein Semester freigeschaltetet.
$else $else
<ul> <ul>
$forall term <- terms $forall Entity _ term <- terms
<li> #{show term} <li>
<a href=@{NewTermR}>
#{termToText $ termName term}
from #{formatTime defaultTimeLocale "%d.%m.%Y" $ termStart term}
to: #{formatTime defaultTimeLocale "%d.%m.%Y" $ termEnd term}
$if termActive term
(Semester ist aktiv)
|] |]
getNewTermR :: Handler Html getNewTermR :: Handler Html
@ -152,8 +165,8 @@ postNewTermR = do
((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing ((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing
case result of case result of
FormSuccess res -> do FormSuccess res -> do
-- term <- runDB $ getBy UniqueTerm $ termName -- term <- runDB $ get $ TermKey termName
runDB $ insert res runDB $ repsert (TermKey $ termName res) res
let tid = termToText $ termName res let tid = termToText $ termName res
let msg = "Semester " `T.append` tid `T.append` " wurde angelegt!" let msg = "Semester " `T.append` tid `T.append` " wurde angelegt!"
-- setMessage $ toHtml msg -- FIXME -- setMessage $ toHtml msg -- FIXME
@ -173,7 +186,7 @@ postNewTermR = do
newTermForm :: Maybe Term -> Form Term newTermForm :: Maybe Term -> Form Term
newTermForm template = newTermForm template =
renderBootstrap3 BootstrapBasicForm $ Term renderBootstrap3 BootstrapBasicForm $ Term
<$> areq termField (set "Semester") (termName <$> template) <$> areq termNewField (set "Semester") (termName <$> template)
<*> areq dayField (set "Erster Tag") (termStart <$> template) <*> areq dayField (set "Erster Tag") (termStart <$> template)
<*> areq dayField (set "Letzer Tag") (termEnd <$> template) <*> areq dayField (set "Letzer Tag") (termEnd <$> template)
<*> pure [] -- TODO: List of Day field required, must probably be done as its own form and then combined <*> pure [] -- TODO: List of Day field required, must probably be done as its own form and then combined