{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} module Handler.Station where import Import import Json import qualified Data.Map as M --import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3) --import Text.Julius (RawJS (..)) checkStation :: Text -> Handler Text checkStation stationIdentifier = do stationMap <- getsYesod (appStations . appSettings) let stat = stationMap M.!? stationIdentifier :: Maybe Text case stat of Nothing -> notFound Just m -> return m -- TODO works without the type annotation, but I don't know why this one is wrong. No time to find out now -- repsertBy :: (MonadIO m, PersistUniqueRead backend, PersistRecordBackend record backend, AtLeastOneUniqueKey record, SafeToInsert record) => record -> ReaderT backend m () repsertBy val = do valM <- getByValue val case valM of Nothing -> insert_ val Just (Entity key _) -> replace key val getStationR :: Text -> Handler Html getStationR stationIdentifier = do station <- checkStation stationIdentifier rounds <- runDB $ do rou <- selectList [RoundStationId ==. stationIdentifier] [] return (fmap entityVal rou :: [Round]) defaultLayout $ do setTitle $ "OwO Station" $(widgetFile "station") -- postStationR :: Text -> Handler Html -- postStationR stationIdentifier = do -- station <- checkStation stationIdentifier -- ((result,widget),enctype) <- runFormPost (roundForm Nothing Nothing Nothing) -- case result of -- FormSuccess roundFormD -> do -- runDB $ upsertBy (UniqueRoundStation (roundNumberForm roundFormD) stationIdentifier) ( Round (stationIdentifier)(tutorPointsForm roundFormD)(erstiePointsForm roundFormD)(roundNumberForm roundFormD)) -- redirect $ StationRoundR stationIdentifier (roundNumberForm roundFormD) -- FormFailure errors -> error "Form Failure" -- FormMissing -> error "Form Missing" data RoundForm = RoundForm { tutorPointsForm :: Int , erstiePointsForm :: Int } deriving Show roundForm :: Maybe Int -> Maybe Int -> Form RoundForm roundForm v w = renderDivs $ RoundForm <$> areq intField "Tutor Points" v <*> areq intField "Erstie Points" w getStationRoundR :: Text -> Int -> Handler Html getStationRoundR stationIdentifier roundNumber = do station <- checkStation stationIdentifier mRoundEntity <- runDB $ getBy $ UniqueRoundStation roundNumber stationIdentifier case mRoundEntity of Nothing -> do (roundFormWidget,roundFormEnctype) <- generateFormPost (roundForm Nothing Nothing) defaultLayout $ do setTitle $ "OwO Round" $(widgetFile "round") Just roundEntity -> do let round = entityVal roundEntity (roundFormWidget,roundFormEnctype) <- generateFormPost (roundForm (Just $ roundTutorPoints round) (Just $ roundErstiePoints round)) defaultLayout $ do setTitle $ "OwO Round" $(widgetFile "round") postStationRoundR :: Text -> Int -> Handler Html postStationRoundR stationIdentifier roundNumber = do station <- checkStation stationIdentifier ((result,widget),enctype) <- runFormPost (roundForm Nothing Nothing) case result of FormSuccess roundFormD -> do runDB $ repsertBy $ Round (stationIdentifier)(tutorPointsForm roundFormD)(erstiePointsForm roundFormD) roundNumber redirect $ StationRoundR stationIdentifier (roundNumber + 1) FormFailure errors -> error "Form Failure" FormMissing -> error "Form Missing" -- Define our data that will be used for creating the form. --data FileForm = FileForm -- { fileInfo :: FileInfo -- , fileDescription :: Text -- } -- This is a handler function for the GET request method on the HomeR -- resource pattern. All of your resource patterns are defined in -- config/routes.yesodroutes -- -- The majority of the code you will write in Yesod lives in these handler -- functions. You can spread them across multiple files if you are so -- inclined, or create a single monolithic file. --getHomeR :: Handler Html --getHomeR = do -- (formWidget, formEnctype) <- generateFormPost sampleForm -- let submission = Nothing :: Maybe FileForm -- handlerName = "getHomeR" :: Text -- allComments <- runDB $ getAllComments -- defaultLayout $ do -- let (commentFormId, commentTextareaId, commentListId) = commentIds -- aDomId <- newIdent -- setTitle "OwO Geländespielpunkte" -- let tutorPoints = 5 :: Int -- let erstiePoints = 3 :: Int -- $(widgetFile "homepage") --postHomeR :: Handler Html --postHomeR = do -- ((result, formWidget), formEnctype) <- runFormPost sampleForm -- let handlerName = "postHomeR" :: Text -- submission = case result of -- FormSuccess res -> Just res -- _ -> Nothing -- allComments <- runDB $ getAllComments -- -- defaultLayout $ do -- let (commentFormId, commentTextareaId, commentListId) = commentIds -- aDomId <- newIdent -- setTitle "Welcome To Yesod!" -- $(widgetFile "homepage") -- --sampleForm :: Form FileForm --sampleForm = renderBootstrap3 BootstrapBasicForm $ FileForm -- <$> fileAFormReq "Choose a file" -- <*> areq textField textSettings Nothing -- -- Add attributes like the placeholder and CSS classes. -- where textSettings = FieldSettings -- { fsLabel = "What's on the file?" -- , fsTooltip = Nothing -- , fsId = Nothing -- , fsName = Nothing -- , fsAttrs = -- [ ("class", "form-control") -- , ("placeholder", "File description") -- ] -- } -- --commentIds :: (Text, Text, Text) --commentIds = ("js-commentForm", "js-createCommentTextarea", "js-commentList") -- --getAllComments :: DB [Entity Comment] --getAllComments = selectList [] [Asc CommentId]