{-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances

module Handler.LMS.Users
  ( getLmsUsersR
  , getLmsUsersDirectR
  )
  where

-- TODO: needs complete refactoring! Old RESULT templates follows

import Import

import Handler.Utils
import Handler.Utils.Csv
import Handler.Utils.LMS

import qualified Data.Map as Map
import qualified Data.Csv as Csv
import qualified Data.Conduit.List as C
-- import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E

data LmsUserTableCsv = LmsUserTableCsv -- for csv export only
  { csvLUTident :: LmsIdent
  , csvLUTpin   :: Text
  , csvLUTresetPin, csvLUTdelete, csvLUTstaff :: LmsBool
  }
  deriving Generic
makeLenses_ ''LmsUserTableCsv

-- | Mundane conversion needed for direct download without dbTable onlu
lmsUser2csv :: LmsUser -> LmsUserTableCsv
lmsUser2csv lu@LmsUser{..} = LmsUserTableCsv
  { csvLUTident     = lmsUserIdent
  , csvLUTpin       = lmsUserPin
  , csvLUTresetPin  = lmsUserResetPin    & LmsBool
  , csvLUTdelete    = lmsUserToDelete lu & LmsBool
  , csvLUTstaff     = False              & LmsBool
  }

-- csv without headers
instance Csv.ToRecord   LmsUserTableCsv
instance Csv.FromRecord LmsUserTableCsv

-- csv with headers
lmsUserTableCsvHeader :: Csv.Header
lmsUserTableCsvHeader = Csv.header [ csvLmsIdent, csvLmsPin, csvLmsResetPin, csvLmsDelete, csvLmsStaff ]

instance ToNamedRecord LmsUserTableCsv where
  toNamedRecord LmsUserTableCsv{..} = Csv.namedRecord
    [ csvLmsIdent     Csv..= csvLUTident
    , csvLmsPin       Csv..= csvLUTpin
    , csvLmsResetPin  Csv..= csvLUTresetPin
    , csvLmsDelete    Csv..= csvLUTdelete
    , csvLmsStaff     Csv..= csvLUTstaff
    ]
instance FromNamedRecord LmsUserTableCsv where
  parseNamedRecord (lsfHeaderTranslate -> csv)
    = LmsUserTableCsv
        <$> csv Csv..: csvLmsIdent
        <*> csv Csv..: csvLmsPin
        <*> csv Csv..: csvLmsResetPin
        <*> csv Csv..: csvLmsDelete
        <*> csv Csv..: csvLmsStaff

instance CsvColumnsExplained LmsUserTableCsv where
  csvColumnsExplanations _ = mconcat
    [ single csvLmsIdent    MsgCsvColumnLmsIdent
    , single csvLmsPin      MsgCsvColumnLmsPin
    , single csvLmsResetPin MsgCsvColumnLmsResetPin
    , single csvLmsDelete   MsgCsvColumnLmsDelete
    , single csvLmsStaff    MsgCsvColumnLmsStaff
    ]
    where
      single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget
      single k v = singletonMap k [whamlet|_{v}|]



mkUserTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget)
mkUserTable _sid qsh qid = do
  dbtCsvName <- csvFilenameLmsUser qsh
  let dbtCsvSheetName = dbtCsvName
  let
    userDBTable = DBTable{..}
      where
        dbtSQLQuery lmsuser = do
          E.where_ $ lmsuser E.^. LmsUserQualification E.==. E.val qid
              E.&&. E.isNothing (lmsuser E.^. LmsUserEnded)
          return lmsuser
        dbtRowKey = (E.^. LmsUserId)
        dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
        dbtColonnade = dbColonnade $ mconcat
          [ sortable (Just csvLmsIdent)     (i18nCell MsgTableLmsIdent)    $ \(view $ _dbrOutput . _entityVal . _lmsUserIdent . _getLmsIdent -> ident) -> textCell ident
          , sortable (Just csvLmsPin)       (i18nCell MsgTableLmsPin & cellAttrs <>~ [("uw-hide-column-default-hidden",mempty)]
                                                                         ) $ \(view $ _dbrOutput . _entityVal . _lmsUserPin                  -> pin  ) -> textCell pin
          , sortable (Just csvLmsResetPin)  (i18nCell MsgTableLmsResetPin) $ \(view $ _dbrOutput . _entityVal . _lmsUserResetPin             -> reset) -> ifIconCell reset IconReset
          , sortable (Just csvLmsDelete)    (i18nCell MsgTableLmsDelete)   $ \(view $ _dbrOutput . _entityVal . _lmsUserToDelete             -> del  ) -> ifIconCell del   IconRemoveUser
          , sortable Nothing                (i18nCell MsgTableLmsStaff)    $ const mempty
          ]
        dbtSorting = Map.fromList
          [ (csvLmsIdent    , SortColumn (E.^. LmsUserIdent))
          , (csvLmsPin      , SortColumn (E.^. LmsUserPin))
          , (csvLmsResetPin , SortColumn (E.^. LmsUserResetPin))
          , (csvLmsDelete   , SortColumn lmsUserToDeleteExpr)
          ]
        dbtFilter = Map.fromList
          [ (csvLmsIdent    , FilterColumn $ E.mkContainsFilterWith LmsIdent (E.^. LmsUserIdent ))
          , (csvLmsResetPin , FilterColumn $ E.mkExactFilter                 (E.^. LmsUserResetPin))
          ]
        dbtFilterUI = \mPrev -> mconcat
          [ prismAForm (singletonFilter csvLmsIdent    . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)     (fslI MsgTableLmsIdent)
          , prismAForm (singletonFilter csvLmsResetPin . maybePrism _PathPiece) mPrev $ aopt (hoistField lift checkBoxField) (fslI MsgTableLmsResetPin)
          ]
        dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
        dbtParams = def
        dbtIdent :: Text
        dbtIdent = "lms-user"
        dbtCsvEncode = Just DBTCsvEncode {..}
          where
            dbtCsvExportForm   = pure ()
            dbtCsvNoExportData = Just id
            dbtCsvExampleData  = Nothing
            dbtCsvHeader       = const $ return lmsUserTableCsvHeader
            dbtCsvDoEncode     = \() -> C.map (doEncode' . view _2)
            doEncode' = LmsUserTableCsv
              <$> view (_dbrOutput . _entityVal . _lmsUserIdent)
              <*> view (_dbrOutput . _entityVal . _lmsUserPin)
              <*> view (_dbrOutput . _entityVal . _lmsUserResetPin . _lmsBool)
              <*> view (_dbrOutput . _entityVal . _lmsUserToDelete . _lmsBool)
              <*> const (LmsBool False)

        dbtCsvDecode = Nothing
        dbtExtraReps = []

    userDBTableValidator = def
      & defaultSorting [SortAscBy csvLmsIdent]
  dbTable userDBTableValidator userDBTable

getLmsUsersR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsUsersR sid qsh = do
  lmsTable <- runDB $ do
    qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
    view _2 <$> mkUserTable sid qsh qid
  siteLayoutMsg MsgMenuLmsUsers $ do
    setTitleI MsgMenuLmsUsers
    $(widgetFile "lms-user")

getLmsUsersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
getLmsUsersDirectR sid qsh = do
  lms_users <- runDB $ do
    qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
    selectList [LmsUserQualification ==. qid, LmsUserEnded ==. Nothing] [Asc LmsUserStarted, Asc LmsUserIdent]
    {- To avoid exporting unneeded columns, we would need an SqlSelect instance for LmsUserTableCsv; probably not worth it
      Ex.select $ do
        lmsuser <- Ex.from $ Ex.table @LmsUser
        Ex.where_ $ lmsuser Ex.^. LmsUserQualification Ex.==. Ex.val qid
            Ex.&&. Ex.isNothing (lmsuser Ex.^. LmsUserEnded)
        pure $ LmsUserTableCsv
          { csvLUTident    = lmsuser Ex.^. LmsUserIdent
          , csvLUTpin      = lmsuser Ex.^. LmsUserPin
          , csvLUTresetPin = LmsBool . Ex.unValue $ lmsuser Ex.^. LmsUserResetPin
          , csvLUTdelete   = LmsBool . Ex.unValue $ Ex.isNothing (lmsuser Ex.^. LmsUserEnded) Ex.&&. Ex.not_ (Ex.isNothing $ lmsuser Ex.^. LmsUserStatus)
          , csvLUTstaff    = LmsBool False
          }
      -}
  LmsConf{..} <- getsYesod $ view _appLmsConf
  let --csvRenderedData = toNamedRecord . lmsUser2csv . entityVal <$> lms_users
      --csvRenderedHeader = lmsUserTableCsvHeader
      --cvsRendered = CsvRendered {..}
      csvRendered = toCsvRendered lmsUserTableCsvHeader $ lmsUser2csv . entityVal <$> lms_users
      fmtOpts = def { csvIncludeHeader  = lmsDownloadHeader
                    , csvDelimiter      = lmsDownloadDelimiter
                    , csvUseCrLf        = lmsDownloadCrLf
                    }
      csvOpts = def { csvFormat = fmtOpts }
  csvSheetName <- csvFilenameLmsUser qsh
  addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
  csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered

-- direct Download see:
-- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod