module Handler.Allocation.Prios
  ( getAPriosR, postAPriosR
  ) where

import Import

import Handler.Utils
import Handler.Utils.Csv
import Handler.Utils.Allocation

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

import qualified Data.Conduit.List as C

import qualified Data.Csv as Csv


data AllocationPrioritiesMode
  = AllocationPrioritiesNumeric
  | AllocationPrioritiesOrdinal
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
instance Universe AllocationPrioritiesMode
instance Finite AllocationPrioritiesMode

nullaryPathPiece ''AllocationPrioritiesMode $ camelToPathPiece' 2

embedRenderMessage ''UniWorX ''AllocationPrioritiesMode id
  

getAPriosR, postAPriosR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
getAPriosR = postAPriosR
postAPriosR tid ssh ash = do
  doNumericPrios <- runDB $ do
    Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash

    numericPrios <- E.selectCountRows . E.from $ \allocationUser -> do
      E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
      E.where_ . E.maybe E.false sqlAllocationPriorityNumeric $ allocationUser E.^. AllocationUserPriority
  
    ordinalPrios <- E.selectCountRows . E.from $ \allocationUser -> do
      E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
      E.where_ . E.maybe E.false (E.not_ . sqlAllocationPriorityNumeric) $ allocationUser E.^. AllocationUserPriority
    let doNumericPrios = ((>=) :: Int64 -> Int64 -> Bool) numericPrios ordinalPrios

    return doNumericPrios

  let explainAllocationPrioMode = \case
        AllocationPrioritiesNumeric -> return $(i18nWidgetFile "allocation-priority-explanation/numeric")
        AllocationPrioritiesOrdinal -> return $(i18nWidgetFile "allocation-priority-explanation/ordinal")

  ((priosRes, priosView), priosEnctype) <- runFormPost . renderAForm FormStandard $ (,)
    <$> apopt (explainedSelectionField Nothing (explainOptionList optionsFinite explainAllocationPrioMode)) (fslI MsgAllocationPrioritiesMode) (Just $ bool AllocationPrioritiesOrdinal AllocationPrioritiesNumeric doNumericPrios)
    <*> areq fileField (fslI MsgAllocationPrioritiesFile) Nothing

  formResult priosRes $ \(mode, fInfo) -> do
    let sourcePrios = case mode of
          AllocationPrioritiesNumeric -> fileSourceCsvPositional Csv.NoHeader fInfo
          AllocationPrioritiesOrdinal -> fileSourceCsvPositional Csv.NoHeader fInfo .| C.map Csv.fromOnly .| ordinalPriorities
    
    (matrSunk, matrMissing) <- runDB $ do
      Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash
      updateWhere
        [ AllocationUserAllocation ==. aId ]
        [ AllocationUserPriority =. Nothing ]
      matrSunk <- runConduit $ sourcePrios .| sinkAllocationPriorities aId
      matrMissing <- fromIntegral <$> count [ AllocationUserAllocation ==. aId, AllocationUserPriority ==. Nothing ]
      return (matrSunk, matrMissing)

    when (matrSunk > 0) $ 
      addMessageI Success $ MsgAllocationPrioritiesSunk matrSunk
    when (matrMissing > 0) $
      addMessageI Error $ MsgAllocationPrioritiesMissing matrMissing
    redirect $ AllocationR tid ssh ash AUsersR

  siteLayoutMsg MsgMenuAllocationPriorities $ do
    setTitleI $ MsgAllocationPrioritiesTitle tid ssh ash

    wrapForm priosView def
      { formEncoding = priosEnctype
      , formAction = Just . SomeRoute $ AllocationR tid ssh ash APriosR
      }