module Handler.Allocation.EditUser
  ( getAEditUserR, postAEditUserR
  , getADelUserR, postADelUserR
  ) where

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

import Handler.Utils

import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

import qualified Data.Conduit.Combinators as C

import Handler.Utils.Delete

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E

import Handler.Course.Register (deregisterParticipant)

import Jobs.Queue


data AllocationCourseParticipantFormDefaultReason = AllocationCourseParticipantFormDefaultReason 
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
  deriving anyclass (Universe, Finite)

embedRenderMessage ''UniWorX ''AllocationCourseParticipantFormDefaultReason id


getAEditUserR, postAEditUserR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDUser -> Handler Html
getAEditUserR = postAEditUserR
postAEditUserR tid ssh ash cID = do
  (Entity _ Allocation{..}, User{..}, editUserAct, editUserForm, regFormForm, formEnctype) <- runDBJobs $ do
    uid <- decrypt cID
    user <- get404 uid
    alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
    Entity auId oldAllocationUser@AllocationUser{..} <- getBy404 $ UniqueAllocationUser aId uid

    regState <- do
      courses <- E.select . E.from $ \((course `E.InnerJoin` allocationCourse) `E.LeftOuterJoin` courseParticipant `E.LeftOuterJoin` allocationDeregister) -> do
        E.on $ allocationDeregister E.?. AllocationDeregisterUser E.==. E.justVal uid
         E.&&. E.joinV (allocationDeregister E.?. AllocationDeregisterCourse) E.==. E.just (allocationCourse E.^. AllocationCourseCourse)
        E.on $ courseParticipant E.?. CourseParticipantUser E.==. E.justVal uid
         E.&&. courseParticipant E.?. CourseParticipantCourse E.==. E.just (allocationCourse E.^. AllocationCourseCourse)
        E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
         E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
        return ( course E.^. CourseId
               , ( ( course E.^. CourseTerm
                   , course E.^. CourseSchool
                   , course E.^. CourseShorthand
                   )
                 , course E.^. CourseName
                 , ( (       E.joinV (courseParticipant E.?. CourseParticipantAllocated) E.==. E.justVal aId
                       E.||. E.isNothing (courseParticipant E.?. CourseParticipantId)
                     , courseParticipant E.?. CourseParticipantState
                     )
                   , ( E.isJust $ allocationDeregister E.?. AllocationDeregisterId
                     , E.joinV $ allocationDeregister E.?. AllocationDeregisterReason
                     )
                   )
                 )
               )
      MsgRenderer mr <- getMsgRenderer
      return $
        let toRegState (E.Value cId, (ident, E.Value cname, regState'))
                = (cId, ((tid', ssh', csh), cname, courseRegState))
              where (E.Value tid', E.Value ssh', E.Value csh) = ident
                    ((E.Value isAlloc, E.Value mParState), (E.Value isDeregister, E.Value regReason)) = regState'
                    courseRegState
                      | not isAlloc = CourseParticipantFormNotAllocated
                      | isDeregister = CourseParticipantFormDeregistered
                          { cpfDeregisterReason = Just $ fromMaybe defReason regReason
                          , cpfEverRegistered = True
                          }
                      | mParState == Just CourseParticipantActive = CourseParticipantFormRegistered
                      | otherwise = CourseParticipantFormDeregistered
                          { cpfDeregisterReason = Nothing
                          , cpfEverRegistered = is _Just mParState
                          }
                    defReason = [st|<#{mr AllocationCourseParticipantFormDefaultReason}>|]
         in Map.fromList $ map toRegState courses

    ((formRes, (regFormForm, editUserForm)), formEnctype) <- runFormPost $ \csrf
      -> let allocForm = renderAForm FormStandard $ 
               allocationUserForm aId $ Just AllocationUserForm
                 { aauUser = uid
                 , aauTotalCourses = allocationUserTotalCourses
                 , aauPriority = allocationUserPriority
                 , aauApplications = Map.empty -- form collects existing applications itself
                 }
          in (\(regRes, regForm) (editUserRes, editUserForm) -> ((,) <$> regRes <*> editUserRes, (regForm, editUserForm))) <$> courseParticipantForm regState csrf <*> allocForm mempty

    editUserAct <- formResultMaybe formRes $ \(regState', AllocationUserForm{..}) -> Just <$> do
      now <- liftIO getCurrentTime

      iforM_ (Map.intersectionWith (,) regState' regState) $ \cId (cpf, (_, _, oldCPF)) -> when (cpf /= oldCPF) $ case cpf of
        CourseParticipantFormNotAllocated -> return ()
        CourseParticipantFormDeregistered mReason _ -> do
          hoist liftHandler $ deregisterParticipant uid =<< getJustEntity cId

          app <- getYesod
          let mReason' = mReason <&> \str -> maybe (Just str) (const Nothing) (listToMaybe $ unRenderMessageLenient @AllocationCourseParticipantFormDefaultReason app str)
          deleteWhere [AllocationDeregisterUser ==. uid, AllocationDeregisterCourse ==. Just cId]
          for_ mReason' $ \allocationDeregisterReason ->
            insert AllocationDeregister
              { allocationDeregisterCourse = Just cId
              , allocationDeregisterTime = now
              , allocationDeregisterUser = uid
              , allocationDeregisterReason
              }
        CourseParticipantFormRegistered -> do
          void $ upsert CourseParticipant
            { courseParticipantCourse = cId
            , courseParticipantUser = uid
            , courseParticipantAllocated = Just aId
            , courseParticipantState = CourseParticipantActive
            , courseParticipantRegistration = now
            }
            [ CourseParticipantRegistration =. now
            , CourseParticipantAllocated =. Just aId
            , CourseParticipantState =. CourseParticipantActive
            ]
          audit $ TransactionCourseParticipantEdit cId uid
          queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cId
          
      let newAllocationUser = AllocationUser
            { allocationUserAllocation = aId
            , allocationUserUser = aauUser
            , allocationUserTotalCourses = aauTotalCourses
            , allocationUserPriority = aauPriority
            }
      when (newAllocationUser /= oldAllocationUser) $ do
        replace auId newAllocationUser
        audit $ TransactionAllocationUserEdited aauUser aId

      -- Applications are complicated and it isn't easy to detect if something changed
      -- Therefore we just always replace...
      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 MsgAllocationEditUserUserEdited
        redirect . AllocationR tid ssh ash $ AEditUserR cID

    return (alloc, user, editUserAct, editUserForm, regFormForm, formEnctype)

  sequence_ editUserAct

  MsgRenderer mr <- getMsgRenderer
  let title = MsgAllocationEditUserTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationShorthand userDisplayName
      shortTitle = MsgAllocationEditUserShortTitle allocationTerm allocationSchool allocationShorthand userDisplayName

  siteLayoutMsg title $ do
    setTitleI shortTitle
    wrapForm $(widgetFile "allocation/edit-user") FormSettings
      { formMethod = POST
      , formAction = Just . SomeRoute . AllocationR tid ssh ash $ AEditUserR cID
      , formEncoding = formEnctype
      , formAttrs = []
      , formSubmit = FormSubmit
      , formAnchor = Nothing :: Maybe Text
      }

getADelUserR, postADelUserR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDUser -> Handler Html
getADelUserR = postADelUserR
postADelUserR tid ssh ash cID = do
  uid <- decrypt cID
  (aId, auId) <- runDB . maybeT notFound $ do
    aId <- MaybeT . getKeyBy $ TermSchoolAllocationShort tid ssh ash
    auId <- MaybeT . getKeyBy $ UniqueAllocationUser aId uid
    return (aId, auId)

  deleteR DeleteRoute
    { drRecords = Set.singleton auId
    , drGetInfo = \(allocationUser `E.InnerJoin` user) -> do
        E.on $ allocationUser E.^. AllocationUserUser E.==. user E.^. UserId

        let appsCount = E.subSelectCount . E.from $ \courseApplication ->
              E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
                   E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationUser E.^. AllocationUserAllocation)
            allocsCount = E.subSelectCount . E.from $ \courseParticipant ->
              E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. allocationUser E.^. AllocationUserUser
                   E.&&. courseParticipant E.^. CourseParticipantAllocated E.==. E.just (allocationUser E.^. AllocationUserAllocation)

        return ( ( user E.^. UserDisplayName, user E.^. UserSurname )
               , appsCount :: E.SqlExpr (E.Value Word64)
               , allocsCount :: E.SqlExpr (E.Value Word64)
               )
    , drUnjoin = \(allocationUser `E.InnerJoin` _user) -> allocationUser
    , drRenderRecord = \((E.Value dName, E.Value sName), E.Value (assertM' (> 0) -> appsCount), E.Value (assertM' (> 0) -> allocsCount)) -> return
        [whamlet|
          $newline never
          ^{nameWidget dName sName}
          $if is _Just appsCount || is _Just allocsCount
            \ (
            $maybe c <- appsCount
              _{MsgAllocationApplicationsCount c}
            $if is _Just appsCount || is _Just allocsCount
              , #
            $maybe c <- appsCount
              _{MsgAllocationAllocationsCount c}
            )
        |]
    , drRecordConfirmString = \((E.Value dName, _), _, _) -> return [st|#{dName}|]
    , drFormMessage = \_ -> return Nothing
    , drCaption = SomeMessage MsgAllocationUserDeleteQuestion
    , drSuccessMessage = SomeMessage MsgAllocationUserDeleted
    , drAbort = SomeRoute . AllocationR tid ssh ash $ AEditUserR cID
    , drSuccess = SomeRoute $ AllocationR tid ssh ash AUsersR
    , drDelete = \_k doDelete -> do
        res <- doDelete
        audit $ TransactionAllocationUserDeleted uid aId
        return res
    }
