module Handler.Allocation.Show
  ( getAShowR
  ) where

import Import
import Handler.Utils
import Utils.Lens

import Handler.Allocation.Register

import qualified Database.Esqueleto as E
  

getAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
getAShowR tid ssh ash = do
  muid <- maybeAuthId

  let
    resultCourse :: Lens' (Entity Course, _, _) (Entity Course)
    resultCourse = _1
    -- resultCourseApplication = _2
    resultHasTemplate = _3 . _Value

  (Entity _ Allocation{..}, courses, registration) <- runDB $ do
    alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash

    courses <- E.select . E.from $ \((allocationCourse `E.InnerJoin` course) `E.LeftOuterJoin` courseApplication) -> do
      E.on $ courseApplication E.?. CourseApplicationCourse E.==. E.just (course E.^. CourseId)
       E.&&. courseApplication E.?. CourseApplicationUser E.==. E.val muid
       E.&&. courseApplication E.?. CourseApplicationAllocation E.==. E.just (E.just $ E.val aId)
      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
      E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
      let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
            E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
      return (course, courseApplication, hasTemplate)

    registration <- fmap join . for muid $ getBy . UniqueAllocationUser aId

    return (alloc, nubOn (view $ resultCourse . _entityKey) courses, registration)

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

  staffInformation <- anyM courses $ \(view $ resultCourse . _entityVal -> Course{..}) ->
    hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CApplicationsR
  mayRegister <- hasWriteAccessTo $ AllocationR tid ssh ash ARegisterR
  (registerForm, registerEnctype) <- generateFormPost . renderAForm FormStandard . allocationRegisterForm $ allocationUserToForm . entityVal <$> registration
  let
    registerBtn = bool BtnAllocationRegister BtnAllocationRegistrationEdit $ is _Just registration
    registerForm' = wrapForm' registerBtn registerForm FormSettings
      { formMethod = POST
      , formAction = Just . SomeRoute $ AllocationR tid ssh ash ARegisterR
      , formEncoding = registerEnctype
      , formAttrs = []
      , formSubmit = FormSubmit
      , formAnchor = Nothing :: Maybe Text
      }

  siteLayoutMsg title $ do
    setTitleI shortTitle

    let courseWidgets = flip map courses $ \cEntry -> do
          let Entity cid Course{..}  = cEntry ^. resultCourse
              hasApplicationTemplate = cEntry ^. resultHasTemplate
          cID <- encrypt cid :: WidgetT UniWorX IO CryptoUUIDCourse
          mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID
          $(widgetFile "allocation/show/course")
  
    $(widgetFile "allocation/show")