module Handler.Term where

import Import
import Handler.Utils
import qualified Data.Map as Map

import qualified Database.Esqueleto as E

import qualified Data.Set as Set

import qualified Control.Monad.State.Class as State
  

-- | Default start day of term for season,
--   @True@: start of term, @False@: end of term
defaultDay :: Bool -> Season -> Day
defaultDay True  Winter = fromGregorian 2020 10  1
defaultDay False Winter = fromGregorian 2020  3 31
defaultDay True  Summer = fromGregorian 2020  4  1
defaultDay False Summer = fromGregorian 2020  9 30


validateTerm :: (MonadHandler m, HandlerSite m ~ UniWorX)
             => FormValidator Term m ()
validateTerm = do
  Term{..} <- State.get
  guardValidation MsgTermStartMustMatchName $ termStart `withinTerm` termName
  guardValidation MsgTermEndMustBeAfterStart $ termStart < termEnd
  guardValidation MsgTermLectureEndMustBeAfterStart $ termLectureStart < termLectureEnd
  guardValidation MsgTermStartMustBeBeforeLectureStart $ termStart <= termLectureStart
  guardValidation MsgTermEndMustBeAfterLectureEnd $ termEnd >= termLectureEnd


getTermShowR :: Handler TypedContent
getTermShowR = do
--   terms <- runDB $ selectList [] [Desc TermStart]
-------   ÄQUIVALENT:
--   term <- runDB $ E.select . E.from $ \(term) -> do
--              E.orderBy [E.desc $ term E.^. TermStart ]
--              return term
--
  let
    termData :: E.SqlExpr (Entity Term) -> E.SqlQuery (E.SqlExpr (Entity Term), E.SqlExpr (E.Value Int64))
    termData term = do
      -- E.orderBy [E.desc $ term E.^. TermStart ]
      let courseCount = E.subSelectCount . E.from $ \course ->
            E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm
      return (term, courseCount)
  selectRep $ do
    provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData)
    provideRep $ do
      let colonnadeTerms = widgetColonnade $ mconcat
            [ sortable (Just "term-id") (i18nCell MsgTermShort) $ \(Entity tid _, _) -> anchorCell
                (TermCourseListR tid)
                [whamlet|#{toPathPiece tid}|]
            , sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_) ->
                cell $ formatTime SelFormatDate termLectureStart >>= toWidget
            , sortable (Just "lecture-end") (i18nCell MsgTermLectureEnd) $ \(Entity _ Term{..},_) ->
                cell $ formatTime SelFormatDate termLectureEnd >>= toWidget
            , sortable Nothing (i18nCell MsgTermActive) $ \(Entity _ Term{..},_) ->
                tickmarkCell termActive
            , sortable Nothing (i18nCell MsgTermCourseCount) $ \(_, E.Value numCourses) ->
                cell [whamlet|_{MsgNumCourses numCourses}|]
            , sortable (Just "start") (i18nCell MsgTermStart) $ \(Entity _ Term{..},_) ->
                cell $ formatTime SelFormatDate termStart >>= toWidget
            , sortable (Just "end") (i18nCell MsgTermEnd) $ \(Entity _ Term{..},_) ->
                cell $ formatTime SelFormatDate termEnd >>= toWidget
            , sortable Nothing (i18nCell MsgTermHolidays) $ \(Entity _ Term{..},_) ->
                cell $ do
                  termHolidays' <- mapM (formatTime SelFormatDate) termHolidays
                  [whamlet|
                    $newline never
                    <ul .list--inline .list--comma-separated>
                      $forall holiday <- termHolidays'
                        <li>#{holiday}
                  |]
            ]
--       let adminColonnade =
--           [ sortable Nothing "Edit" $ \(Entity tid Term{..},_) -> cell $ do
--                 -- Scrap this if to slow, create term edit page instead
--                 adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False
--                 [whamlet|
--                   $if adminLink == Authorized
--                     <a href=@{TermEditExistR tid}>
--                       #{termToText termName}
--                   $else
--                       #{termToText termName}
--                 |]
--           ]
      let validator = def & defaultSorting [SortDescBy "term-id"]
      table <- runDB $ dbTableWidget' validator DBTable
        { dbtSQLQuery = termData
        , dbtRowKey = (E.^. TermId)
        , dbtColonnade = colonnadeTerms
        , dbtProj = return . dbrOutput
        , dbtSorting = Map.fromList
            [ ( "start"
              , SortColumn $ \term -> term E.^. TermStart
              )
            , ( "end"
              , SortColumn $ \term -> term E.^. TermEnd
              )
            , ( "lecture-start"
              , SortColumn $ \term -> term E.^. TermLectureStart
              )
            , ( "lecture-end"
              , SortColumn $ \term -> term E.^. TermLectureEnd
              )
            , ( "term-id"
              , SortColumn $ \term -> term E.^. TermId
              )
            ]
        , dbtFilter = Map.fromList
            [ ( "active"
              , FilterColumn $ \term -> term E.^. TermActive :: E.SqlExpr (E.Value Bool)
              )
            , ( "course"
              , FilterColumn $ \term csh -> case csh of -- FilterColumn-Lambdas are
                  []   -> E.val True :: E.SqlExpr (E.Value Bool)
                  cshs -> E.exists . E.from $ \course ->
                    E.where_ $ course E.^. CourseTerm E.==. term E.^. TermId
                         E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs
              )
            ]
        , dbtFilterUI = mempty
        , dbtStyle = def
        , dbtParams = def
        , dbtIdent = "terms" :: Text
        , dbtCsvEncode = noCsvEncode
        , dbtCsvDecode = Nothing
        }
      defaultLayout $ do
        setTitleI MsgTermsHeading
        $(widgetFile "terms")

getTermEditR, postTermEditR :: Handler Html
getTermEditR = do
  mbLastTerm <- runDB $ selectFirst [] [Desc TermName]
  let template = case mbLastTerm of
        Nothing -> mempty
        (Just Entity{ entityVal=Term{..}}) -> let
            ntid = succ termName
            seas = season ntid
            yr   = year   ntid
            yr'  = if seas == Summer then yr else succ yr
          in mempty
              { tftName  = Just   ntid
              , tftStart = Just $ defaultDay True  seas & setYear yr
              , tftEnd   = Just $ defaultDay False seas & setYear yr'
              }
  termEditHandler template
postTermEditR = termEditHandler mempty

getTermEditExistR, postTermEditExistR :: TermId -> Handler Html
getTermEditExistR = postTermEditExistR
postTermEditExistR tid = do
  term <- runDB $ get tid
  termEditHandler $ termToTemplate term


termEditHandler :: TermFormTemplate -> Handler Html
termEditHandler term = do
    eHandler <- fromMaybe (error "termEditHandler called from 404-handler") <$> getCurrentRoute
    ((result, formWidget), formEnctype) <- runFormPost $ newTermForm term
    case result of
      (FormSuccess res) -> do
          let tid = TermKey $ termName res
          -- term <- runDB $ get $ TermKey termName
          runDB $ do
            repsert tid res
            audit $ TransactionTermEdit tid
-- VOR INTERNATIONALISIERUNG:
--           let tid = termToText $ termName res
--           let msg = "Semester " `T.append` tid `T.append` " erfolgreich editiert."
--           addMessage Success [shamlet| #{msg} |]
-- MIT INTERNATIONALISIERUNG:
          addMessageI Success $ MsgTermEdited tid
          redirect TermShowR
      FormMissing     -> return ()
      (FormFailure _) -> addMessageI Warning MsgInvalidInput
    defaultLayout $ do
      setTitleI MsgTermEditHeading
      wrapForm formWidget def
        { formAction = Just $ SomeRoute eHandler
        , formEncoding = formEnctype
        }

data TermFormTemplate = TermFormTemplate
      { tftName         :: Maybe TermIdentifier
      , tftStart        :: Maybe Day
      , tftEnd          :: Maybe Day
      , tftHolidays     :: Maybe [Day]
      , tftLectureStart :: Maybe Day
      , tftLectureEnd   :: Maybe Day
      , tftActive       :: Maybe Bool
      }

-- | TermFormTemplates form a pointwise-left biased Semigroup
instance Semigroup TermFormTemplate where
  left <> right = TermFormTemplate
    { tftName         = tftName         left <|> tftName         right
    , tftStart        = tftStart        left <|> tftStart        right
    , tftEnd          = tftEnd          left <|> tftEnd          right
    , tftHolidays     = tftHolidays     left <|> tftHolidays     right
    , tftLectureStart = tftLectureStart left <|> tftLectureStart right
    , tftLectureEnd   = tftLectureEnd   left <|> tftLectureEnd   right
    , tftActive       = tftActive       left <|> tftActive       right
    }

instance Monoid TermFormTemplate where
  mappend = (<>)
  mempty  = TermFormTemplate
    { tftName         = Nothing
    , tftStart        = Nothing
    , tftEnd          = Nothing
    , tftHolidays     = Nothing
    , tftLectureStart = Nothing
    , tftLectureEnd   = Nothing
    , tftActive       = Nothing
    }

termToTemplate ::Maybe Term -> TermFormTemplate
termToTemplate Nothing = mempty
termToTemplate (Just Term{..}) = TermFormTemplate
    { tftName         = Just termName
    , tftStart        = Just termStart
    , tftEnd          = Just termEnd
    , tftHolidays     = Just termHolidays
    , tftLectureStart = Just termLectureStart
    , tftLectureEnd   = Just termLectureEnd
    , tftActive       = Just termActive
    }

newTermForm :: TermFormTemplate -> Form Term
newTermForm template = validateForm validateTerm $ \html -> do
    mr <- getMessageRender
    let
      tidForm
        | Just tid <- tftName template
        = aforced termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) tid
        | otherwise
        = areq termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) Nothing
      holidayForm = massInputListA
        dayField
        (const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder))
        (const Nothing)
        ("holidays" :: Text)
        (fslI MsgTermHolidays & setTooltip MsgMassInputTip)
        True
        (tftHolidays template)
    flip (renderAForm FormStandard) html $ Term
      <$> tidForm
      <*> areq dayField  (fslI MsgTermStartDay & setTooltip MsgTermStartDayTooltip) (tftStart template)
      <*> areq dayField  (fslI MsgTermEndDay   & setTooltip MsgTermEndDayTooltip)   (tftEnd   template)
      <*> (Set.toList . Set.fromList <$> holidayForm)
      <*> areq dayField  (fslI MsgTermLectureStart) (tftLectureStart template)
      <*> areq dayField  (fslI MsgTermLectureEnd & setTooltip MsgTermLectureEndTooltip) (tftLectureEnd template)
      <*> areq checkBoxField (fslI MsgTermActive) (tftActive template)