{-# 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

module Handler.LMS.Userlist
  ( getLmsUserlistR, postLmsUserlistR 
  )
  where

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.Legacy as E
import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH

data LmsUserlistTableCsv = LmsUserlistTableCsv
  { csvLULident  :: LmsIdent
  , csvLULfailed :: Bool 
  }
  deriving Generic
makeLenses_ ''LmsUserlistTableCsv

-- csv without headers -- TODO not yet supported
instance Csv.ToRecord LmsUserlistTableCsv
instance Csv.FromRecord LmsUserlistTableCsv

-- csv with headers 
lmsUserlistTableCsvHeader :: Csv.Header
lmsUserlistTableCsvHeader = Csv.header [ csvUserlistIdent, csvUserlistBlocked ]

instance ToNamedRecord LmsUserlistTableCsv where 
  toNamedRecord LmsUserlistTableCsv{..} = Csv.namedRecord
    [ csvUserlistIdent    Csv..= csvLULident
    , csvUserlistBlocked  Csv..= csvLULfailed
    ]
instance FromNamedRecord LmsUserlistTableCsv where
  parseNamedRecord (lsfHeaderTranslate -> csv)
    = LmsUserlistTableCsv
        <$> csv Csv..: csvUserlistIdent
        <*> csv Csv..: csvUserlistBlocked

instance CsvColumnsExplained LmsUserlistTableCsv where
  csvColumnsExplanations _ = mconcat
    [ single csvUserlistIdent     MsgCsvColumnLmsIdent
    , single csvUserlistBlocked   MsgCsvColumnLmsFailed
    ]
    where
      single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget
      single k v = singletonMap k [whamlet|_{v}|]


data LmsUserlistCsvActionClass = LmsUserlistInsert | LmsUserlistUpdate 
  deriving (Eq, Ord, Read, Show, Generic, Typeable, Enum, Bounded)
embedRenderMessage ''UniWorX ''LmsUserlistCsvActionClass id

data LmsUserlistCsvAction = LmsUserlistInsertData { lmsUserlistInsertIdent :: LmsIdent, lmsUserlistInsertFailed :: Bool }
                          | LmsUserlistUpdateData { lmsUserlistInsertIdent :: LmsIdent, lmsUserlistInsertFailed :: Bool }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece'' 2 1   -- LmsUserlistInsertData -> insert
  , fieldLabelModifier = camelToPathPiece' 2          -- lmsUserlistInsertIdent -> insert-ident | lmsUserlistInsertFailed -> insert-failed
  , sumEncoding = TaggedObject "action" "data"
  } ''LmsUserlistCsvAction


data LmsUserlistCsvException 
  = LmsUserlistCsvExceptionDuplicatedKey -- TODO: this is not used anywhere?!
  deriving (Show, Generic, Typeable)

instance Exception LmsUserlistCsvException
embedRenderMessage ''UniWorX ''LmsUserlistCsvException id 

mkUserlistTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget)
mkUserlistTable sid qsh qid = do
  dbtCsvName <- csvFilenameLmsUserlist qsh
  let dbtCsvSheetName = dbtCsvName
  let
    userlistTable = DBTable{..}
      where
        dbtSQLQuery lmslist = do
          E.where_ $ lmslist E.^. LmsUserlistQualification E.==. E.val qid
          return lmslist
        dbtRowKey = (E.^. LmsUserlistId)
        dbtProj   = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
        dbtColonnade = dbColonnade $ mconcat
          [ sortable (Just csvUserlistIdent)   (i18nCell MsgTableLmsIdent)    $ \DBRow{ dbrOutput = Entity _ LmsUserlist{..} } -> textCell    $ lmsUserlistIdent & getLmsIdent
          , sortable (Just csvUserlistBlocked) (i18nCell MsgTableLmsFailed)   $ \DBRow{ dbrOutput = Entity _ LmsUserlist{..} } -> isBadCell     lmsUserlistFailed
          , sortable (Just "timestamp")        (i18nCell MsgTableLmsReceived) $ \DBRow{ dbrOutput = Entity _ LmsUserlist{..} } -> dateTimeCell  lmsUserlistTimestamp
          ]
        dbtSorting = Map.fromList
          [ (csvUserlistIdent  , SortColumn $ \lmslist -> lmslist E.^. LmsUserlistIdent)
          , (csvUserlistBlocked, SortColumn $ \lmslist -> lmslist E.^. LmsUserlistFailed)
          , ("timestamp"       , SortColumn $ \lmslist -> lmslist E.^. LmsUserlistTimestamp)
          ]
        dbtFilter = Map.fromList
          [ (csvUserlistIdent  , FilterColumn $ E.mkContainsFilterWith LmsIdent (E.^. LmsUserlistIdent ))
          , (csvUserlistBlocked, FilterColumn $ E.mkExactFilter                 (E.^. LmsUserlistFailed))
          ]
        dbtFilterUI =  \mPrev -> mconcat 
          [ prismAForm (singletonFilter csvUserlistIdent   . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)     (fslI MsgTableLmsIdent)
          , prismAForm (singletonFilter csvUserlistBlocked . maybePrism _PathPiece) mPrev $ aopt (hoistField lift checkBoxField) (fslI MsgTableLmsFailed)
          ]
        dbtStyle = def
        dbtParams = def
        dbtIdent :: Text
        dbtIdent = "lms-userlist"
        dbtCsvEncode = Just DBTCsvEncode {..}
          where 
            dbtCsvExportForm    = pure ()
            dbtCsvNoExportData  = Just id
            dbtCsvExampleData   = Nothing 
            dbtCsvHeader        = const $ return lmsUserlistTableCsvHeader
            dbtCsvDoEncode      = \() -> C.map (doEncode' . view _2)
            doEncode' = LmsUserlistTableCsv
              <$> view (_dbrOutput . _entityVal . _lmsUserlistIdent)
              <*> view (_dbrOutput . _entityVal . _lmsUserlistFailed)
        dbtCsvDecode = Just DBTCsvDecode {..}
          where
            dbtCsvRowKey = \LmsUserlistTableCsv{csvLULident} -> 
              fmap E.Value . MaybeT . getKeyBy $ UniqueLmsUserlist qid csvLULident
            dbtCsvComputeActions = \case -- shows a diff first
              DBCsvDiffNew{dbCsvNew} -> do 
                yield $ LmsUserlistInsertData 
                          { lmsUserlistInsertIdent  = csvLULident   dbCsvNew
                          , lmsUserlistInsertFailed = csvLULfailed  dbCsvNew
                          }
              DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}} -> do 
                yield $ LmsUserlistUpdateData 
                          { lmsUserlistInsertIdent  = csvLULident 
                          , lmsUserlistInsertFailed = csvLULfailed
                          }
              DBCsvDiffMissing{} -> return () -- no deletion 
            dbtCsvClassifyAction = \case 
               LmsUserlistInsertData{} -> LmsUserlistInsert
               LmsUserlistUpdateData{} -> LmsUserlistUpdate 
            dbtCsvCoarsenActionClass = \case 
               LmsUserlistInsert -> DBCsvActionNew 
               LmsUserlistUpdate -> DBCsvActionExisting
            dbtCsvValidateActions = return ()  -- no validation, since this is an automatic upload, i.e. no user to review error              
            dbtCsvExecuteActions = do
              C.mapM_ $ \actionData -> do
                now <- liftIO getCurrentTime
                void $ upsert LmsUserlist
                  {
                    lmsUserlistQualification  = qid 
                  , lmsUserlistIdent          = lmsUserlistInsertIdent   actionData
                  , lmsUserlistFailed         = lmsUserlistInsertFailed  actionData
                  , lmsUserlistTimestamp      = now 
                  }
                  [
                    LmsUserlistFailed         =. lmsUserlistInsertFailed  actionData -- TODO: should we allow a reset from failed: True to False?
                  , LmsUserlistTimestamp      =. now
                  ]      
              return $ LmsUserlistR sid qsh
            dbtCsvRenderKey = const $ \case 
              LmsUserlistInsertData{..} -> do -- TODO: i18n
                [whamlet|
                  $newline never
                  Insert: Course for Ident #{getLmsIdent lmsUserlistInsertIdent} #
                  $if lmsUserlistInsertFailed
                    is closed due to failure.
                  $else
                    is open.
                |]
              LmsUserlistUpdateData{..} -> do -- TODO: i18n
                [whamlet|
                  $newline never
                  Update: Course for Ident #{getLmsIdent lmsUserlistInsertIdent} #
                  $if lmsUserlistInsertFailed
                    is now closed due to failure.
                  $else
                    is still open.
                |]
            dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
            dbtCsvRenderException = ap getMessageRender . pure :: LmsUserlistCsvException -> DB Text
        dbtExtraReps = []

    userlistDBTableValidator = def
      & defaultSorting [SortAscBy csvUserlistIdent]

  dbTable userlistDBTableValidator userlistTable


getLmsUserlistR, postLmsUserlistR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsUserlistR = postLmsUserlistR 
postLmsUserlistR sid qsh = do
  lmsTable <- runDB $ do
    qid <- getKeyBy404 $ UniqueSchoolShort sid qsh
    view _2 <$> mkUserlistTable sid qsh qid
  siteLayoutMsg MsgMenuLmsUserlist $ do
    setTitleI MsgMenuLmsUserlist
    $(widgetFile "lms-userlist")