{-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
{-# OPTIONS -Wno-unused-top-binds #-}      -- TODO: remove me, for debugging only
{-# OPTIONS -Wno-unused-imports #-}        -- TODO: remove me, for debugging only
{-# OPTIONS -Wno-redundant-constraints #-} -- TODO: remove me, for debugging only


module Handler.LMS.Result
  ( getLmsResultR
  )
  where

import Import

import Handler.Utils
import Handler.Utils.Csv

import qualified Data.Map as Map
import qualified Data.Csv as Csv
import qualified Data.Conduit.List as C
import qualified Data.CaseInsensitive as CI
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lens as Text
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH



type LmsResultTableExpr = (             E.SqlExpr (Entity Qualification)
                          `E.InnerJoin` E.SqlExpr (Entity LmsResult)
                          ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser))
                            `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))

queryQualification :: LmsResultTableExpr -> E.SqlExpr (Entity Qualification)
queryQualification = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)

queryLmsResult :: LmsResultTableExpr -> E.SqlExpr (Entity LmsResult)
queryLmsResult = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)

queryLmsUser :: LmsResultTableExpr -> E.SqlExpr (Maybe (Entity LmsUser))
queryLmsUser = $(sqlLOJproj 3 2)

queryUser :: LmsResultTableExpr -> E.SqlExpr (Maybe (Entity User))
queryUser = $(sqlLOJproj 3 3)

type LmsResultTableData = DBRow (Entity Qualification, Entity LmsResult, Maybe (Entity LmsUser), Maybe (Entity User))

instance HasEntity LmsResultTableData LmsResult where
  hasEntity = _dbrOutput . _2

{- MaybeHasUser only!
instance HasUser LmsResultTableData where
  hasUser = _dbrOutput . _4 . _entityVal
-}

resultQualification :: Lens' LmsResultTableData (Entity Qualification)
resultQualification = _dbrOutput . _1

resultLmsResult :: Lens' LmsResultTableData (Entity LmsResult)
resultLmsResult = _dbrOutput . _2

resultLmsUser :: Traversal' LmsResultTableData (Entity LmsUser)
resultLmsUser = _dbrOutput . _3 . _Just

resultUser :: Traversal' LmsResultTableData (Entity User)
resultUser = _dbrOutput . _4 . _Just

-- required for import only
data LmsResultTableCsv = LmsResultTableCsv
  { csvLRTident   :: LmsIdent
  , csvLRTsuccess :: Day
  }
  deriving Generic
makeLenses_ ''LmsResultTableCsv

-- csv without headers
instance Csv.ToRecord   LmsResultTableCsv -- default suffices
instance Csv.FromRecord LmsResultTableCsv -- default suffices

-- csv with headers
lmsResultTableCsvHeader :: Csv.Header
lmsResultTableCsvHeader = Csv.header [ "identification", "day-success" ]

instance ToNamedRecord LmsResultTableCsv where
  toNamedRecord LmsResultTableCsv{..} = Csv.namedRecord
    [ "identification" Csv..= csvLRTident
    , "day-success"    Csv..= csvLRTsuccess
    ]

instance FromNamedRecord LmsResultTableCsv where
  parseNamedRecord (lsfHeaderTranslate -> csv)
    = LmsResultTableCsv
        <$> csv Csv..: "identification"
        <*> csv Csv..: "day-success"


instance CsvColumnsExplained LmsResultTableCsv where
  csvColumnsExplanations _ = mconcat
    [ single "identification"     MsgCsvColumnLmsResultIdent
    , single "timestamp-success"  MsgCsvColumnLmsResultSuccess
    ]
    where
      single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget
      single k v = singletonMap k [whamlet|_{v}|]


mkResultTable :: QualificationId -> DB (Any, Widget)
mkResultTable qid = do
  let
    resultDBTable = DBTable{..}
      where
        dbtSQLQuery = runReaderT $ do
          qualification <- asks queryQualification
          lmsResult     <- asks queryLmsResult
          lmsUser       <- asks queryLmsUser
          user          <- asks queryUser
          lift $ do
            E.on $ qualification E.^. QualificationId E.==. lmsResult E.^. LmsResultQualification
            E.on $ lmsUser E.?. LmsUserIdent E.==. E.just (lmsResult E.^. LmsResultIdent)
            E.on $ lmsUser E.?. LmsUserUser  E.==. user E.?. UserId
            E.where_ $ qualification E.^. QualificationId E.==. E.val qid
          return (qualification, lmsResult, lmsUser, user)
        dbtRowKey = queryLmsResult >>> (E.^. LmsResultId)
        dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
        dbtColonnade = dbColonnade $ mconcat
          [ sortable (Just "ident")  (i18nCell MsgTableLmsIdent)   $ \(view $ resultLmsResult . _entityVal . _lmsResultIdent . _getLmsIdent -> ident) -> textCell ident
          , sortable (Just "sucess") (i18nCell MsgTableLmsSuccess) $ \(view $ resultLmsResult . _entityVal . _lmsResultSuccess -> success) -> dayCell success
          ] -- TODO: add more columns for manual debugging view !!!
        dbtSorting = Map.fromList
          [ ("ident"  , SortColumn $ queryLmsResult >>> (E.^. LmsResultIdent))
          , ("success", SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess))
          -- , ("success", SortColumn . views queryLmsResult (E.^. LmsResultSuccess))
          ]
        dbtFilter = Map.fromList
          [ -- ("ident"  , FilterColumn $ queryLmsResult >>> (E.^. LmsResultIdent))
          ]
        dbtFilterUI = const mempty  -- TODO !!! continue here !!! Manual filtering useful to deal with user complaints!
        dbtStyle = def
        dbtParams = def
        dbtIdent :: Text
        dbtIdent = "lms-userlist"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing      -- TODO !!! continue here !!! CSV Import is the purpose of this page! Just save to DB, create Job to deal with it later!
        dbtExtraReps = []

    resultDBTableValidator = def
      & defaultSorting [SortAscBy "ident"]
  dbTable resultDBTableValidator resultDBTable

getLmsResultR :: QualificationId -> Handler Html
getLmsResultR qid = do
  lmsTable <- runDB $ view _2 <$> mkResultTable qid
  siteLayoutMsg MsgMenuLmsResult $ do
    setTitleI MsgMenuLmsResult
    $(widgetFile "lms-result")