module Handler.Allocation.AddUser
  ( getAAddUserR, postAAddUserR
  ) where

import Import
import Handler.Allocation.Application
import Handler.Allocation.UserForm

import Handler.Utils

import qualified Data.Map.Strict as Map

import qualified Data.Conduit.Combinators as C


getAAddUserR, postAAddUserR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
getAAddUserR = postAAddUserR
postAAddUserR tid ssh ash = do
  (Entity _ Allocation{..}, (addUserAct, addUserForm, addUserEnctype)) <- runDB $ do
    alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash

    ((addUserRes, addUserForm), addUserEnctype) <- runFormPost . renderAForm FormStandard $ 
      allocationUserForm aId Nothing

    addUserAct <- formResultMaybe addUserRes $ \AllocationUserForm{..} -> Just <$> do
      now <- liftIO getCurrentTime
      
      didInsert <- is _Just <$> insertUnique AllocationUser
        { allocationUserAllocation = aId
        , allocationUserUser = aauUser
        , allocationUserTotalCourses = aauTotalCourses
        , allocationUserPriority = aauPriority
        }

      if
        | didInsert -> do
            oldApps <- selectList [CourseApplicationUser ==. aauUser, CourseApplicationAllocation ==. Just aId] []
            forM_ oldApps $ \(Entity appId CourseApplication{..}) -> do
              deleteWhere [ CourseApplicationFileApplication ==. appId ]
              delete appId
              unless (courseApplicationCourse `Map.member` aauApplications) $ 
                audit $ TransactionCourseApplicationDeleted courseApplicationCourse courseApplicationUser appId

            iforM_ aauApplications $ \cId ApplicationForm{..} -> maybeT_ $ do
              prio <- hoistMaybe afPriority
              let rated = afRatingVeto || is _Just afRatingPoints
              appId <- lift $ insert CourseApplication
                { courseApplicationCourse = cId
                , courseApplicationUser = aauUser
                , courseApplicationText = afText
                , courseApplicationRatingVeto = afRatingVeto
                , courseApplicationRatingPoints = afRatingPoints
                , courseApplicationRatingComment = afRatingComment
                , courseApplicationAllocation = Just aId
                , courseApplicationAllocationPriority = Just prio
                , courseApplicationTime = now
                , courseApplicationRatingTime = guardOn rated now
                }
              lift . runConduit $ transPipe liftHandler (sequence_ afFiles) .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId))
              lift . audit $ TransactionCourseApplicationEdit cId aauUser appId

            return $ do
              addMessageI Success MsgAllocationAddUserUserAdded
              redirect $ AllocationR tid ssh ash AAddUserR
        | otherwise -> return $ addMessageI Error MsgAllocationAddUserUserExists
  
    return (alloc, (addUserAct, addUserForm, addUserEnctype))

  sequence_ addUserAct

  MsgRenderer mr <- getMsgRenderer
  let title = MsgAllocationAddUserTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName
      shortTitle = MsgAllocationAddUserShortTitle allocationTerm allocationSchool allocationShorthand

  siteLayoutMsg title $ do
    setTitleI shortTitle
    wrapForm addUserForm FormSettings
      { formMethod = POST
      , formAction = Just . SomeRoute $ AllocationR tid ssh ash AAddUserR
      , formEncoding = addUserEnctype
      , formAttrs = []
      , formSubmit = FormSubmit
      , formAnchor = Nothing :: Maybe Text
      }