-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Handler.Admin.Crontab
  ( getAdminCrontabR
  , getAdminJobsR
  , postAdminJobsR
  ) where

import Import
import Jobs
import Handler.Utils

-- import Data.Aeson (fromJSON)
-- import qualified Data.Aeson as Aeson
-- import qualified Data.Aeson.Types as Aeson
import qualified Data.Aeson.Encode.Pretty as Pretty          

-- import qualified Data.CaseInsensitive as CI
import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as Text.Builder

import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict as HashMap

import qualified Data.UUID as UUID

import Database.Persist.Sql (deleteWhereCount)
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
-- import Database.Esqueleto.Utils.TH


deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1
  } ''CronNextMatch

  
getAdminCrontabR :: Handler TypedContent
getAdminCrontabR = do
  jState <- getsYesod appJobState
  mCrontab' <- atomically . runMaybeT $ do
    JobState{jobCurrentCrontab} <- MaybeT $ tryReadTMVar jState
    MaybeT $ readTVar jobCurrentCrontab

  let mCrontab = mCrontab' <&> _2 %~ filter (hasn't $ _3 . _MatchNone)

  instanceId <- getsYesod appInstanceID

  selectRep $ do
    provideRep $ do
      crontabBearer <- runMaybeT . hoist runDB $ do
        guardM $ hasGlobalGetParam GetGenerateToken
        uid <- MaybeT maybeAuthId
        guardM . lift . existsBy $ UniqueUserGroupMember UserGroupCrontab uid

        encodeBearer =<< bearerToken (HashSet.singleton . Left $ toJSON UserGroupCrontab) Nothing (HashMap.singleton BearerTokenRouteEval $ HashSet.singleton AdminCrontabR) Nothing (Just Nothing) Nothing

      
      siteLayoutMsg MsgHeadingAdminCrontab $ do
        setTitleI MsgHeadingAdminCrontab
        [whamlet|
          $newline never
          $maybe t <- crontabBearer
            <section>
              <pre .token>
                #{toPathPiece t}
          <section>
            <dl .deflist>
              <dt .deflist__dt>_{MsgAdminInstanceId}
              <dd .deflist__dd .uuid>#{UUID.toText instanceId}
          <section>
            $maybe (genTime, crontab) <- mCrontab
              <p>
                ^{formatTimeW SelFormatDateTime genTime}
              <table .table .table--striped .table--hover>
                $forall (job, lExec, match) <- crontab
                  <tr .table__row>
                    <td .table__td>
                      $case match
                        $of MatchAsap
                          _{MsgCronMatchAsap}
                        $of MatchNone
                          _{MsgCronMatchNone}
                        $of MatchAt t
                          ^{formatTimeW SelFormatDateTime t}
                    <td .table__td>
                      $maybe lT <- lExec
                        ^{formatTimeW SelFormatDateTime lT}
                    <td .table__td .json>
                      #{doEnc job}
            $nothing
              <p .explanation>
                _{MsgAdminCrontabNotGenerated}
        |]
    provideJson mCrontab'
    provideRep . return . Text.Builder.toLazyText $ doEnc mCrontab'
  where
    doEnc :: ToJSON a => a -> _
    doEnc = Pretty.encodePrettyToTextBuilder' Pretty.defConfig
      { Pretty.confIndent = Pretty.Spaces 2
      , Pretty.confCompare = comparing $ \t -> ( t `elem` ["instruction", "job", "notification"]
                                               , Text.splitOn "-" t
                                               )
      }


data JobTableAction = ActJobDelete
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)

instance Universe JobTableAction
instance Finite JobTableAction
nullaryPathPiece ''JobTableAction $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''JobTableAction id

data JobTableActionData = ActJobDeleteData
  deriving (Eq, Ord, Read, Show, Generic)


getAdminJobsR, postAdminJobsR :: Handler Html
getAdminJobsR = postAdminJobsR
postAdminJobsR = do
  let
    jobsDBTable = DBTable{..}
      where
        resultJob :: Lens' (DBRow (Entity QueuedJob)) (Entity QueuedJob)
        resultJob = _dbrOutput

        dbtIdent :: Text
        dbtIdent = "queued-jobs"

        dbtSQLQuery = return
        dbtRowKey = (E.^. QueuedJobId)
        dbtProj = dbtProjId
        dbtColonnade = mconcat
          [ dbSelect (applying _2) id (return . view (resultJob . _entityKey))
          , sortable (Just "job")               (i18nCell MsgTableJob)                  $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe textCell $ getJobName queuedJobContent
          , sortable (Just "creation-time")     (i18nCell MsgTableCreationTime)         $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> dateTimeCell queuedJobCreationTime
          , sortable (Just "content")           (i18nCell MsgTableJobContent)           $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cell [whamlet|#{doEnc queuedJobContent}|] & addCellClass ("json"::Text)
          , sortable (Just "lock-time")         (i18nCell MsgTableJobLockTime)          $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe dateTimeCell queuedJobLockTime
          , sortable (Just "lock-instance")     (i18nCell MsgTableJobLockInstance)      $ \(view $ resultJob . _entityVal -> QueuedJob{..}) -> cellMaybe (stringCell . show) queuedJobLockInstance
          , sortable (Just "creation-instance") (i18nCell MsgTableJobCreationInstance)  $ \(view $ resultJob . _entityVal -> QueuedJob{..}) ->            stringCell $ show  queuedJobCreationInstance
          ]
        dbtSorting = Map.fromList 
          [ ("creation-time"    , SortColumnNullsInv (E.^. QueuedJobCreationTime))
          , ("job"              , SortColumn         (\v -> v E.^. QueuedJobContent E.->>. "job"))
          , ("content"          , SortColumn         (E.^. QueuedJobContent))
          , ("lock-time"        , SortColumnNullsInv (E.^. QueuedJobLockTime))
          , ("lock-instance"    , SortColumn         (E.^. QueuedJobLockInstance))
          , ("creation-instance", SortColumn         (E.^. QueuedJobCreationInstance))
          ]
        dbtFilter = Map.fromList
          [
            ("job", FilterColumn $ E.mkContainsFilter (\v -> v E.^. QueuedJobContent E.->>. "job"))
          ]
        dbtFilterUI = \mPrev -> mconcat
          [
            prismAForm (singletonFilter "job" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableJob)
          ]
        dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
        acts :: Map JobTableAction (AForm Handler JobTableActionData)
        acts = Map.singleton ActJobDelete $ pure ActJobDeleteData
        dbtParams = DBParamsForm 
          { dbParamsFormAdditional = 
            renderAForm FormStandard
               $  (, mempty) . First . Just
              <$> multiActionA acts (fslI MsgTableAction) Nothing
          , dbParamsFormMethod    = POST
          , dbParamsFormAction    = Nothing -- Just $ SomeRoute currentRoute
          , dbParamsFormAttrs     = []
          , dbParamsFormSubmit    = FormSubmit
          , dbParamsFormEvaluate  = liftHandler . runFormPost
          , dbParamsFormResult    = id
          , dbParamsFormIdent     = def
          }
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []
    -- jobsDBTableValidator :: PSValidator (MForm Handler) (FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob))))
    jobsDBTableValidator = def 
      & defaultSorting [SortDescBy "creation-time"]
    postprocess :: FormResult (First JobTableActionData, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob))) 
                -> FormResult (JobTableActionData, Set QueuedJobId)
    postprocess inp = do 
      (First (Just act), jobMap) <- inp
      let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
      return (act, jobSet)
  (jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable)

  formResult jobActRes $ \case
    (ActJobDeleteData, jobIds) -> do
      let jobReq  = length jobIds
      rmvd <- runDB $ fromIntegral <$> deleteWhereCount
        [ QueuedJobLockTime ==. Nothing
        , QueuedJobLockInstance ==. Nothing
        , QueuedJobId <-. Set.toList jobIds
        ]
      addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq)
      reloadKeepGetParams AdminJobsR


  siteLayoutMsg MsgMenuAdminJobs $ do
    setTitleI MsgMenuAdminJobs
    [whamlet|
      ^{jobsTable}
    |]
  where
    doEnc :: ToJSON a => a -> _
    doEnc = Pretty.encodePrettyToTextBuilder' Pretty.defConfig
      { Pretty.confIndent = Pretty.Spaces 2
      , Pretty.confCompare = comparing $ \t -> ( t `elem` ["job", "notification"]
                                               , Text.splitOn "-" t
                                               )
      }
  
    getJobName :: Value -> Maybe Text
    getJobName (Object o) 
      | Just (String s) <- HashMap.lookup "job" o = Just s -- $ kebabToCamel s
    getJobName _ = Nothing