{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiWayIf, LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}

module Handler.Profile where

import Import

import Handler.Utils
import Handler.Utils.Table.Convenience

import Utils.Lens
-- import Colonnade hiding (fromMaybe, singleton)
-- import Yesod.Colonnade
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Database.Esqueleto as E
-- import           Database.Esqueleto      ((^.))



data SettingsForm = SettingsForm
      { stgMaxFavourties :: Int
      , stgTheme         :: Theme
      , stgDateTime      :: DateTimeFormat
      , stgDate          :: DateTimeFormat
      , stgTime          :: DateTimeFormat
      , stgDownloadFiles :: Bool
      }

makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
makeSettingForm template = identForm FIDsettings $ \html -> do
    let themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
    (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
      <$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
            (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
      <*> areq (selectField . return $ mkOptionList themeList)
            (fslI  MsgTheme) { fsId = Just "theme-select" } (stgTheme         <$> template)
      <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
      <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
      <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
      <*> areq checkBoxField (fslI MsgDownloadFiles
                               & setTooltip MsgDownloadFilesTip
                             ) (stgDownloadFiles <$> template)
      <*  submitButton
    return (result, widget) -- no validation required here



getProfileR :: Handler Html
getProfileR = do
  (uid, User{..}) <- requireAuthPair
  let settingsTemplate = Just $ SettingsForm
        { stgMaxFavourties = userMaxFavourites
        , stgTheme         = userTheme
        , stgDateTime      = userDateTimeFormat
        , stgDate          = userDateFormat
        , stgTime          = userTimeFormat
        , stgDownloadFiles = userDownloadFiles
        }
  ((res,formWidget), formEnctype) <- runFormPost $ makeSettingForm settingsTemplate
  case res of
    (FormSuccess SettingsForm{..}) -> do
        runDB $ do
          update uid  [ UserMaxFavourites  =. stgMaxFavourties
                      , UserTheme          =. stgTheme
                      , UserDateTimeFormat =. stgDateTime
                      , UserDateFormat     =. stgDate
                      , UserTimeFormat     =. stgTime
                      , UserDownloadFiles  =. stgDownloadFiles
                      ]
          when (stgMaxFavourties < userMaxFavourites) $ do
            -- prune Favourites to user-defined size
            oldFavs <- selectKeysList [ CourseFavouriteUser ==. uid]
                                      [ Desc CourseFavouriteTime
                                      , OffsetBy $ stgMaxFavourties
                                      ]
            mapM_ delete oldFavs
        addMessageI "info" $ MsgSettingsUpdate
        redirect ProfileR -- TODO: them change does not happen without redirect

    (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
    _ -> return ()


  (admin_rights,lecturer_rights,lecture_owner,lecture_corrector,participant,studies) <- runDB $ (,,,,,) <$>
            (E.select $ E.from $ \(adright `E.InnerJoin` school) -> do
                E.where_ $ adright E.^. UserAdminUser E.==. E.val uid
                E.on $ adright E.^. UserAdminSchool E.==. school E.^. SchoolId
                return (school E.^. SchoolShorthand)
            )
            <*>
            (E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do
                E.where_ $ lecright E.^. UserLecturerUser E.==. E.val uid
                E.on $ lecright E.^. UserLecturerSchool E.==. school E.^. SchoolId
                return (school E.^. SchoolShorthand)
            )
            <*>
            (E.select $ E.from $ \(lecturer `E.InnerJoin` course) -> do
                E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
                E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
                return (course E.^. CourseTerm, course E.^.CourseSchool, course E.^. CourseShorthand)
            )
            <*>
            (E.select $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
                E.on $ sheet E.^. SheetCourse E.==. course    E.^. CourseId
                E.on $ sheet E.^. SheetId     E.==. corrector E.^. SheetCorrectorSheet
                E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid

                return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
            )
            <*>
            (E.select $ E.from $ \(participant `E.InnerJoin` course) -> do
                E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
                E.on $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
                return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand, participant E.^. CourseParticipantRegistration)
            )
            <*>
            (E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
                E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
                E.on $ studyfeat E.^. StudyFeaturesField  E.==. studyterms  E.^. StudyTermsId
                E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
                return  (studydegree E.^. StudyDegreeName
                        ,studyterms  E.^. StudyTermsName
                        ,studyfeat   E.^. StudyFeaturesType
                        ,studyfeat   E.^. StudyFeaturesSemester)
            )
  let formText  = Just MsgSettings
      actionUrl = ProfileR
      settingsForm = $(widgetFile "formPageI18n")
  defaultLayout $ do
    setTitle . toHtml $ userIdent <> "'s User page"
    $(widgetFile "profile")
    $(widgetFile "dsgvDisclaimer")

postProfileR :: Handler Html
postProfileR = do
  -- TODO
  getProfileR

----------------------------------------
-- TODO: Are these really a good idea?
--  If yes: Move to appropriate Place: Utils.Lens and Utils.Table.Convenience
--
-- Or Maybe make Course an instance of Data.Data and use biplate instead?
-- λ>  ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [String]
-- ["a","b","c","d","e","f"]
-- it :: [String]
-- *Main Control.Lens Data.Data.Lens
-- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [Int]
-- []
-- it :: [Int]
-- *Main Control.Lens Data.Data.Lens
-- λ> ("a",7,"b",["c","d"],(9,"e",8),"f",True) ^.. biplate :: [Integer]
-- [7,9,8]
-- it :: [Integer]



getProfileDataR  :: Handler Html
getProfileDataR = do
  (uid, User{..}) <- requireAuthPair
  --   mr <- getMessageRender

  -- Tabelle mit eigenen Kursen
  ownCourseTable <- do -- TODO: only display when non-empty
    let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
                 -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
        withType = id
    dbTableWidget' def $ DBTable
      { dbtIdent     = "courseOwnership" :: Text
      , dbtStyle     = def
      , dbtSQLQuery  = \(course `E.InnerJoin` lecturer) -> do
          E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
          E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
          return ( course E.^. CourseTerm
                 , course E.^. CourseSchool
                 , course E.^. CourseId
                 , course E.^. CourseShorthand
                 )
      , dbtColonnade = mconcat
          [ dbRow
          , colsCourseLink' $ _dbrOutput
--           [ colsCourseLink $ (over each _unValue) . _dbrOutput -- different types in Tuple prevents "over each"
          ]
      , dbtProj = return
      , dbtSorting = Map.fromList
          [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand) -- consider PatternSynonyms. Drawback: not enclosed with table, since they must be at Top-Level. Maybe make Lenses for InnerJoins then?
          , ( "term"  , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm     )
          , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool   )
          ]
      , dbtFilter  = Map.fromList
          [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
          , ( "term",   FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm     )
          , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool   )
          ]
      }

  -- Tabelle mit allen Teilnehmer: Kurs (link), Datum
  courseTable <- do
        let
            withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
                     -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
            withType = id

            -- should be inlined
--             courseCol :: IsDBTable m a => Colonnade Sortable (DBRow (Entity Course, E.Value UTCTime)) (DBCell m a)
--             courseCol = sortable (Just "course") (i18nCell MsgCourse) $ do -- (->) a Monad
--               course <- view $ _dbrOutput . _1 . _entityVal -- view == ^.
--               -- "preview _left" in order to match Either (result is Maybe)
--               return $ courseCell course

--             termCol = sortable (Just "school") (i18nCell MsgCourseSchool) $ do
--               Course{..} <- view $ _dbrOutput . _1 . _entityVal
--               return $ anchorCell (TermsSchoolCourseListR

--             courseData :: (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity CourseParticipant)))
--                             -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value UTCTime))
            courseData = \(course `E.InnerJoin` participant) -> do
              E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
              E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
              return (course, participant E.^. CourseParticipantRegistration)
        dbTableWidget' def $ DBTable
          { dbtIdent     = "courseMembership" :: Text
          , dbtSQLQuery  = courseData
          , dbtColonnade = mconcat
              [ dbRow
              , colCourseDescr $ _dbrOutput . _1 . _entityVal -- TODO
              , sortable (Just "time") (i18nCell MsgRegistered) $ do
                  regTime <- view $ _dbrOutput . _2 . _unValue
                  return $ timeCell regTime
              ]
          , dbtProj      = return
          , dbtSorting   = Map.fromList
              [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName  )
              , ( "term"  , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm  )
              , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool)
              , ( "time"  , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration)
              ]
          , dbtFilter    = Map.fromList
              [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName  )
              , ( "term"  , FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm  )
              , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool)
--               , ( "time"  , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration )
              ]
          , dbtStyle     = def
          }

  -- Tabelle mit allen Abgaben und Abgabe-Gruppen
  submissionTable <- do
    let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
                ->  ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
        withType = id
    let validator = def -- DUPLICATED CODE: Handler.Corrections
          & restrictFilter  (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
          & restrictSorting (\name _ -> name /= "corrector")
        lastSubEdit submission = -- latest Edit-Time of this user for submission
          E.sub_select . E.from $ \subEdit -> do
            E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
                E.&&.  subEdit E.^. SubmissionEditUser E.==. E.val uid
            return . E.max_ $ subEdit E.^. SubmissionEditTime
    dbTableWidget' validator $ DBTable
      { dbtIdent     = "submissions" :: Text
      , dbtStyle     = def
      , dbtSQLQuery  = \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) -> do
          E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
          E.on $ sheet  E.^. SheetId  E.==. submission E.^. SubmissionSheet
          E.on $ course E.^. CourseId E.==. sheet      E.^. SheetCourse
          E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
          let crse = ( course E.^. CourseTerm
                     , course E.^. CourseSchool
                     , course E.^. CourseId
                     , course E.^. CourseShorthand
                     )
          let sht  = ( sheet E.^. SheetName
                     )
          return (crse, sht, submission, lastSubEdit submission)
      , dbtColonnade = mconcat
          [ dbRow
          , colsCourseLink' $ _dbrOutput . _1
          , sortable (Just "sheet") (i18nCell MsgSheet) $ do
              shn  <- view $ _dbrOutput . _2 . _unValue
              crse <- view $ _dbrOutput . _1
              let tid = crse ^. _1 . _unValue
                  ssh = crse ^. _2 . _unValue
                  csh = crse ^. _4 . _unValue
                  link= CSheetR tid ssh csh shn SShowR
              return $ anchorCell link $ display2widget shn

          , sortable (toNothing "submission") (i18nCell MsgSubmission) $ do -- TODO: use submissionCell?!
              shn  <- view $ _dbrOutput . _2 . _unValue
              sid  <- view $ _dbrOutput . _3 . _entityKey
              crse <- view $ _dbrOutput . _1


              let tid = crse ^. _1 . _unValue
                  ssh = crse ^. _2 . _unValue
                  csh = crse ^. _4 . _unValue
                  mkCid = encrypt (sid :: SubmissionId) -- TODO: executed twice
                  mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR
              return $ anchorCellM' mkCid mkRoute display2widget
          , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do
              regTime <- view $ _dbrOutput . _4 . _unValue
              return $ maybe mempty timeCell regTime
          ]
      , dbtProj = return
      , dbtSorting = Map.fromList
          [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseShorthand)
          , ( "term"  , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseTerm     )
          , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseSchool   )
          , ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet E.^. SheetName    )
          , ( "edit"  , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) -> lastSubEdit submission )
          ]
      , dbtFilter = Map.fromList
          [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
          , ( "term",   FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm     )
          , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool   )
          ]
      }

  -- Tabelle mit allen Abgabegruppen
  --TODO
  -- Tabelle mit allen Tutorials
  tutorialTable <- return [whamlet| TOOD: Tutorials anzeigen |] -- TODO
  -- Tabelle mit allen Korrektor-Aufgaben
  correctorTable <- return [whamlet| TOOD: Korrekturen anzeigen |] -- TODO
  -- Tabelle mit allen Klausuren und Noten
  examTable <- return [whamlet| TOOD: Klausuranmeldungen anzeigen |] -- TODO
  defaultLayout $ do
    $(widgetFile "profileData")
    $(widgetFile "dsgvDisclaimer")