OwOpointTracker/src/Handler/Station.hs

{-# 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]