module Handler.Term where

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

import Utils.Lens

import qualified Database.Esqueleto as E

import qualified Data.Set as Set
  

-- | 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 :: Term -> [Text]
validateTerm Term{..} =
  [ msg  | (False, msg) <-
    [ --startOk
      ( termStart `withinTerm` termName
      , "Jahreszahl im Namenskürzel stimmt nicht mit Semesterbeginn überein."
      )
    , -- endOk
      ( termStart < termEnd
      , "Semester darf nicht enden, bevor es begann."
      )
    , -- startOk
      ( termLectureStart < termLectureEnd
      , "Vorlesungszeit muss vor ihrem Ende anfgangen."
      )
    , -- lecStartOk
      ( termStart <= termLectureStart
      , "Semester muss vor der Vorlesungszeit beginnen."
      )
    , -- lecEndOk
      ( termEnd >= termLectureEnd
      , "Vorlesungszeit muss vor dem Semester enden."
      )
  ] ]




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.sub_select . E.from $ \course -> do
            E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm
            return E.countRows
      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") "Kürzel" $ \(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") "Ende Vorlesungen"   $ \(Entity _ Term{..},_) ->
                cell $ formatTime SelFormatDate termLectureEnd >>= toWidget
            , sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) ->
                tickmarkCell termActive
            , sortable Nothing "Kurse" $ \(_, E.Value numCourses) ->
                cell [whamlet|_{MsgNumCourses numCourses}|]
            , sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) ->
                cell $ formatTime SelFormatDate termStart >>= toWidget
            , sortable (Just "end") "Semesterende"   $ \(Entity _ Term{..},_) ->
                cell $ formatTime SelFormatDate termEnd >>= toWidget
            , sortable Nothing "Feiertage im Semester" $ \(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
        }
      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
    Just eHandler <- getCurrentRoute
    ((result, formWidget), formEnctype) <- runFormPost $ newTermForm term
    case result of
      (FormSuccess res) -> do
          let tid = TermKey $ termName res
          -- term <- runDB $ get $ TermKey termName
          runDB $ repsert tid res
-- 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 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 = formToAForm . over (mapped._2) pure $ massInputList dayField (const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder)) (const Nothing) ("holidays" :: Text) (fslI MsgTermHolidays & setTooltip MsgMassInputTip) True (tftHolidays template) mempty
    (result, widget) <- 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)
    return $ case result of
      FormSuccess termResult
        | errorMsgs <- validateTerm termResult
        , not $ null errorMsgs ->
          (FormFailure errorMsgs,
                [whamlet|
                  <div class="alert alert-danger">
                    <div class="alert__content">
                      <h4> Fehler:
                      <ul>
                        $forall errmsg <- errorMsgs
                          <li> #{errmsg}
                  ^{widget}
                |]
              )
      _ -> (result, widget)
{-
  where
    set :: Text -> FieldSettings site
    set = bfs
-}