-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}    -- !!! TODO REMOVE ME


module Handler.Health.Interface
  (
    getHealthInterfaceR
  )
 where

import Import

-- import qualified Data.Set as Set
import qualified Data.Text as Text
import Handler.Utils

import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E
import qualified Database.Esqueleto.Utils as E
import qualified Database.Esqueleto.Legacy as EL (on)


identifyInterfaces :: [Text] -> [Unique InterfaceHealth]
identifyInterfaces []        = []
identifyInterfaces [i]       = [UniqueInterfaceHealth i Nothing     Nothing]
identifyInterfaces [i,s]     = [UniqueInterfaceHealth i (wc2null s) Nothing]
identifyInterfaces (i:s:w:r) =  UniqueInterfaceHealth i (wc2null s) (pbool w) : identifyInterfaces r

-- | identify a wildcard argument
wc2null :: Text -> Maybe Text
wc2null "." = Nothing
-- wc2null "-" = Nothing -- used as wildcard subtype in lpr interface
wc2null "_" = Nothing
wc2null  o  = Just o

-- | sloppily parse a boolean, also see Model.Types.Avs.SloppyBool
pbool :: Text -> Maybe Bool
pbool (Text.toLower . Text.strip -> w)
  | w `elem` ["1", "t", "true" ,"wahr", "w"] = Just True
  | w `elem` ["0", "f", "false","falsch"]    = Just False
  | otherwise                                = Nothing

mkInterfaceLogTable :: [Unique InterfaceHealth] -> (Bool -> Widget) -> DB ([(Text,Bool)], Widget)
mkInterfaceLogTable interfs flagError = do
    now <- liftIO getCurrentTime
    dbTableDB ilvalidator DBTable{dbtColonnade=colonnade now, ..}
  where
    dbtIdent      = "interface-log" :: Text
    dbtProj       = dbtProjId
    dbtSQLQuery (ilog `E.LeftOuterJoin` ihealth) = do
      EL.on (       ilog E.^. InterfaceLogInterface E.=?.          ihealth E.?. InterfaceHealthInterface
              E.&&. ilog E.^. InterfaceLogSubtype   E.=~. E.joinV (ihealth E.?. InterfaceHealthSubtype)
              E.&&. ilog E.^. InterfaceLogWrite     E.=~. E.joinV (ihealth E.?. InterfaceHealthWrite  )
            )
      unless (null interfs) $
        E.where_ $ E.or [       ilog E.^. InterfaceLogInterface E.==. E.val ifce
                          E.&&. ilog E.^. InterfaceLogSubtype   E.=~. E.val subt
                          E.&&. ilog E.^. InterfaceLogWrite     E.=~. E.val writ
                        | (UniqueInterfaceHealth ifce subt writ) <- interfs
                        ]
      let ihour = E.coalesceDefault [ihealth E.?. InterfaceHealthHours] (E.val $ 3 * 24)  -- if no default time is set, use 3 days instead
      return (ilog, ihour, E.joinV $ ihealth E.?. InterfaceHealthMessage)

    queryILog     :: (E.SqlExpr (Entity InterfaceLog) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity InterfaceHealth))) -> E.SqlExpr (Entity InterfaceLog)
    queryILog     = $(E.sqlLOJproj 2 1)
    resultILog    :: Lens' (DBRow (Entity InterfaceLog, E.Value Int, E.Value (Maybe Text))) InterfaceLog
    resultILog    = _dbrOutput . _1 . _entityVal
    resultHours   :: Lens' (DBRow (Entity InterfaceLog, E.Value Int, E.Value (Maybe Text))) Int
    resultHours   = _dbrOutput . _2 . E._unValue
    -- resultErrMsg  :: Traversal' (DBRow (Entity InterfaceLog, E.Value Int, E.Value (Maybe Text))) Text
    -- resultErrMsg  = _dbrOutput . _3 . E._unValue . _Just

    dbtRowKey     = queryILog >>> (E.^.InterfaceLogId)
    colonnade now = mconcat
        [ sortable Nothing (i18nCell MsgInterfaceStatus) $ \row -> -- do
            let hours   = row ^. resultHours
                -- defmsg  = row ^? resultErrMsg
                logtime = row ^. resultILog . _interfaceLogTime
                success = row ^. resultILog . _interfaceLogSuccess
                iface   = row ^. resultILog . _interfaceLogInterface
                status  = success && now <= addHours hours logtime
            in tellCell [(iface,status)] $
                wgtCell $ flagError status
        , sortable (Just "interface") (i18nCell MsgInterfaceName      ) $ \(view (resultILog . _interfaceLogInterface) -> n) -> textCell n
        , sortable (Just "subtype")   (i18nCell MsgInterfaceSubtype   ) $ textCell . view (resultILog . _interfaceLogSubtype)
        , sortable (Just "write")     (i18nCell MsgInterfaceWrite     ) $ (`ifIconCell` IconEdit) . view (resultILog . _interfaceLogWrite)
        , sortable (Just "time")      (i18nCell MsgInterfaceLastSynch ) $ dateTimeCell . view (resultILog . _interfaceLogTime)
        , sortable (Just "rows")      (i18nCell MsgTableRows          ) $ cellMaybe numCell . view (resultILog . _interfaceLogRows)
        , sortable (Just "success")   (i18nCell MsgInterfaceSuccess   ) $ \(view (resultILog . _interfaceLogSuccess) -> s) -> iconBoolCell s
        , sortable Nothing            (i18nCell MsgInterfaceInfo      ) $ \(view resultILog -> ilt) -> case ilt of
            InterfaceLog "AVS" "Synch" True _ _ i _ -> anchorCell ProblemAvsErrorR  $ toWgt $ bool i "AVS-Log" $ null i
            InterfaceLog "LPR" _       _    _ _ i _ -> anchorCell PrintLogR         $ toWgt $ bool i "LPR-Log" $ null i
            InterfaceLog _     _       _    _ _ i _ -> textCell i
        ]
    dbtSorting    = mconcat
        [ singletonMap "interface" $ SortColumn $ queryILog >>> (E.^. InterfaceLogInterface)
        , singletonMap "subtype"   $ SortColumn $ queryILog >>> (E.^. InterfaceLogSubtype)
        , singletonMap "write"     $ SortColumn $ queryILog >>> (E.^. InterfaceLogWrite)
        , singletonMap "time"      $ SortColumn $ queryILog >>> (E.^. InterfaceLogTime)
        , singletonMap "rows"      $ SortColumn $ queryILog >>> (E.^. InterfaceLogRows)
        , singletonMap "success"   $ SortColumn $ queryILog >>> (E.^. InterfaceLogSuccess)
        ]
    ilvalidator   = def & defaultSorting [SortAscBy "interface", SortAscBy "subtype", SortAscBy "write"]
    dbtFilter     = mempty
    dbtFilterUI   = mempty
    dbtStyle      = def
    dbtParams     = def
    dbtCsvEncode  = noCsvEncode
    dbtCsvDecode  = Nothing
    dbtExtraReps  = []



getHealthInterfaceR :: [Text] -> Handler Html
getHealthInterfaceR ris = do
  let interfs = identifyInterfaces ris
  res <- runDB $ E.select $ do
      (ilog :& ihealth) <- E.from (E.table @InterfaceLog
            `E.leftJoin` E.table @InterfaceHealth
            `E.on` (\(ilog :& ihealth) ->
                      ilog E.^. InterfaceLogInterface E.=?.          ihealth E.?. InterfaceHealthInterface
                E.&&. ilog E.^. InterfaceLogSubtype   E.=~. E.joinV (ihealth E.?. InterfaceHealthSubtype)
                E.&&. ilog E.^. InterfaceLogWrite     E.=~. E.joinV (ihealth E.?. InterfaceHealthWrite  )
              ))
      unless (null interfs) $
        E.where_ $ E.or [       ilog E.^. InterfaceLogInterface E.==. E.val ifce
                          E.&&. ilog E.^. InterfaceLogSubtype   E.=~. E.val subt
                          E.&&. ilog E.^. InterfaceLogWrite     E.=~. E.val writ
                        | (UniqueInterfaceHealth ifce subt writ) <- interfs
                        ]
      let ihour = E.coalesceDefault [ihealth E.?. InterfaceHealthHours] (E.val 48)
      return (ilog, ihour, E.joinV $ ihealth E.?. InterfaceHealthMessage)
  siteLayoutMsg MsgMenuHealthInterface $ do
    setTitleI MsgMenuHealthInterface
    [whamlet|
      TODO This page is not yet fully implemented

      <ul>
        $forall i <- res
          <li>
            #{show i}
    |]