module Handler.Admin.Test
  ( getAdminTestR
  , postAdminTestR
  , getAdminTestPdfR
  ) where

import Import
import Utils.Print

import Handler.Utils
import Jobs

import Data.Char (isDigit)
import qualified Data.Text as Text
-- import qualified Data.Text.IO as Text
import qualified Data.ByteString.Lazy as L

import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Text.Pandoc        as P
import qualified Text.Pandoc.PDF    as P
import qualified Text.Pandoc.Builder  as P

import Handler.Admin.Test.Download (testDownload)


-- BEGIN - Buttons needed only here
data ButtonCreate = CreateMath | CreateInf | CrashApp -- Dummy for Example
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonCreate
instance Finite ButtonCreate

nullaryPathPiece ''ButtonCreate camelToPathPiece

instance Button UniWorX ButtonCreate where
  btnLabel CreateMath = [whamlet|Ma<i>thema</i>tik|]
  btnLabel CreateInf  = "Informatik"
  btnLabel CrashApp   = "Crash Application"

  btnClasses CreateMath = [BCIsButton, BCInfo]
  btnClasses CreateInf  = [BCIsButton, BCPrimary]
  btnClasses CrashApp   = [BCIsButton, BCDanger]
-- END Button needed only here

emailTestForm :: AForm (HandlerFor UniWorX) (Email, MailContext)
emailTestForm = (,)
            <$> areq emailField (fslI MsgMailTestFormEmail) Nothing
            <*> ( MailContext
                  <$> (Languages <$> areq (reorderField appLanguagesOpts) (fslI MsgMailTestFormLanguages) Nothing)
                  <*> (toMailDateTimeFormat
                        <$> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) Nothing
                        <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) Nothing
                        <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) Nothing
                      )
                  <*> pure def
                )
  where
    toMailDateTimeFormat dt d t = \case
      SelFormatDateTime -> dt
      SelFormatDate -> d
      SelFormatTime -> t

makeDemoForm :: Int -> Form (Int,Bool,Double)
makeDemoForm n = identifyForm ("adminTestForm" :: Text) $ \html -> do
    (result, widget) <- flip (renderAForm FormStandard) html $ (,,)
        <$> areq (minIntFieldI n ("Zahl" :: Text)) (fromString $ "Ganzzahl > " ++ show n) Nothing
        <*  aformSection MsgFormBehaviour
        <*> areq checkBoxField "Muss nächste Zahl größer sein?" (Just True)
        <*> areq doubleField "Fliesskommazahl" Nothing
        -- NO LONGER DESIRED IN AFORMS:
        -- <*  submitButton
    return $ case result of
      FormSuccess fsres
        | errorMsgs <- validateResult fsres
        , not $ null errorMsgs -> (FormFailure errorMsgs, widget)
      _otherwise -> (result, widget)
  where
    validateResult :: (Int,Bool,Double) -> [Text]
    validateResult (i,True,d) | fromIntegral i >= d = [tshow d <> " ist nicht größer als " <> tshow i, "Zweite Fehlermeldung", "Dritte Fehlermeldung"]
    validateResult _other = []


getAdminTestR, postAdminTestR :: Handler Html -- Demo Page. Referenzimplementierungen sollte hier gezeigt werden!
getAdminTestR = postAdminTestR
postAdminTestR = do
  ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonCreate)
  let btnForm = wrapForm btnWdgt def
        { formAction = Just $ SomeRoute AdminTestR
        , formEncoding = btnEnctype
        , formSubmit = FormNoSubmit
        }
  case btnResult of
    (FormSuccess CreateInf)  -> addMessage Info "Informatik-Knopf gedrückt"
    (FormSuccess CreateMath) -> addMessage Warning "Knopf Mathematik erkannt"
    (FormSuccess CrashApp)   -> addMessage Error "Crash Button betätigt" >> error "Crash Button"
    FormMissing -> return ()
    _other -> addMessage Warning "KEIN Knopf erkannt"

  ((emailResult, emailWidget), emailEnctype) <- runFormPost . identifyForm ("email" :: Text) $ renderAForm FormStandard emailTestForm
  formResultModal emailResult AdminTestR $ \(email, ls) -> do
    mapWriterT runDBJobs $ do
      lift . queueDBJob $ JobSendTestEmail email ls
      tell . pure $ Message Success [shamlet|Email-test gestartet|] (Just IconEmail)
    addMessage Warning [shamlet|Inkorrekt ausgegebener Alert|] -- For testing alert handling when short circuiting; for proper (not fallback-solution) handling always use `tell` within `formResultModal`

  let emailWidget' = wrapForm emailWidget def
        { formAction = Just . SomeRoute $ AdminTestR
        , formEncoding = emailEnctype
        , formAttrs = [("uw-async-form", "")]
        }


  let demoFormAction (_i,_b,_d) = addMessage Info "All ok."
  ((demoResult, formWidget),formEnctype) <- runFormPost $ makeDemoForm 7
  formResult demoResult demoFormAction
  let showDemoResult = [whamlet|
          $maybe (i,b,d) <- formResult' demoResult
            Received values:
              <ul>
                <li>#{show i}
                <li>#{show b}
                <li>#{show d}
          $nothing
            No form values received, due to #
            $# Using formResult' above means that we usually to not distinguish the following two cases here, sind formResult does this already:
            $case demoResult
              $of FormSuccess _
                $# Already dealt with above, to showecase usage of formResult' as normally done.
                success, which should not happen here.
              $of FormMissing
                Form data missing, probably empty.
              $of FormFailure msgs
                <ul>
                  $forall m <- msgs
                    <li>#{m}
        |]
  let testTooltipMsg = toWidget [whamlet| So sehen aktuell Tooltips via iconTooltip aus. |] :: WidgetFor UniWorX ()

  msgInfoTooltip    <- messageI Info ("Info-Tooltip via messageI" :: Text)
  msgSuccessTooltip <- messageI Success ("Success-Tooltip via messageI" :: Text)
  msgWarningTooltip <- messageI Warning ("Warning-Tooltip via messageI" :: Text)
  msgErrorTooltip   <- messageI Error ("Error-Tooltip via messageI" :: Text)

  msgNonDefaultIconTooltip <- messageIconI Info IconEmail ("Info-Tooltip mit lustigem Icon" :: Text)

  {- The following demonstrates the use of @massInput@.

     @massInput@ takes as arguments:
       - A configuration struct describing how the Widget should behave (how is the space of sub-forms structured, how many dimensions does it have, which additions/deletions are permitted, what data do they need to operate and what should their effect on the overall shape be?)
       - Information on how the resulting field fits into the form as a whole (@FieldSettings@ and whether the @massInput@ should be marked required)
       - An initial value to pre-fill the field with

     @massInput@ then returns an @MForm@ structured for easy downstream consumption of the result
   -}
  let
    -- We define the fields of the configuration struct @MassInput@:

    -- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell)
    --
    -- This /needs/ to replace all occurrences of @mreq@ with @mpreq@ (no fields should be /actually/ required)
    mkAddForm :: ListPosition -- ^ Approximate position of the add-widget
              -> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3
              -> ListLength -- ^ Previous shape of massinput
              -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
              -> FieldView UniWorX -- ^ Submit-Button for this add-widget
              -> Maybe (Form (Map ListPosition Int -> FormResult (Map ListPosition Int))) -- ^ Nothing iff adding further cells in this position/dimension makes no sense; returns callback to determine index of new cells and data needed to initialize cells
    mkAddForm 0 0 liveliness nudge submitBtn = guardOn (allowAdd 0 0 liveliness) $ \csrf -> do
      (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing -- Any old field; for demonstration
      let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes -- Do something semi-interesting on the result of the @textField@ to demonstrate that further processing can be done
          addRes'' = addRes' <&> \dat prev -> FormSuccess (Map.singleton (maybe 0 (succ . fst) $ Map.lookupMax prev) dat) -- Construct the callback to determine new cell positions and data within @FormResult@ as required, nested @FormResult@ allows aborting the add depending on previous data
      return (addRes'', toWidget csrf >> fvWidget addView >> fvWidget submitBtn)
    mkAddForm _pos _dim _ _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"

    -- | Make a single massInput-Cell
    --
    -- This /needs/ to use @nudge@ and deterministic field naming (this allows for correct value-shifting when cells are deleted)
    mkCellForm :: ListPosition -- ^ Position of this cell
               -> Int -- ^ Data needed to initialize the cell (see return of @mkAddForm@)
               -> Maybe Int -- ^ Initial cell result from Argument to `massInput`
               -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
               -> Form Int
    mkCellForm _pos cData initial nudge csrf = do -- Extremely simple cell
      (intRes, intView) <- mreq intField ("" & addName (nudge "int")) $ initial <|> Just cData
      return (intRes, toWidget csrf >> fvWidget intView)
    -- | How does the shape (`ListLength`) change if a certain cell is deleted?
    deleteCell :: Map ListPosition Int -- ^ Current shape, including initialisation data
               -> ListPosition -- ^ Coordinate to delete
               -> MaybeT (MForm (HandlerFor UniWorX)) (Map ListPosition ListPosition) -- ^ Monadically compute a set of new positions and their associated old positions
    deleteCell = miDeleteList
    -- | Make a decision on whether an add widget should be allowed to further cells, given the current @liveliness@ (i.e. before performing the addition)
    allowAdd :: ListPosition -> Natural -> ListLength -> Bool
    allowAdd _ _ l = l < 7 -- Limit list length; much more complicated checks are possible (this could in principle be monadic, but @massInput@ is probably already complicated enough to cover just current (2019-03) usecases)
    -- | Where to send the user when they click a shape-changing button, given the id of the Wrapper of the `massInput`-`Widget`
    buttonAction :: PathPiece p => p -> Maybe (SomeRoute UniWorX)
    buttonAction frag = Just . SomeRoute $ AdminTestR :#: frag

  -- The actual call to @massInput@ is comparatively simple:

  ((miResult, fvWidget -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing

  ((i18nResult, fvWidget -> i18nWidget), i18nEnc) <- runFormPost . identifyForm ("i18n-stored-markup" :: Text) $ i18nField htmlField True (\_ -> Nothing) ("i18n-stored-markup" :: Text) "" True Nothing

  testDownloadWidget <- testDownload

  let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
  siteLayout locallyDefinedPageHeading $ do
  -- defaultLayout $ do
    setTitle "Uni2work Admin Testpage"
    $(i18nWidgetFile "admin-test")

    [whamlet|<h2>Formular Demonstration|]
    wrapForm formWidget FormSettings
      { formMethod   = POST
      , formAction   = Just . SomeRoute $ AdminTestR :#: FIDAdminDemo
      , formEncoding = formEnctype
      , formAttrs    = []
      , formSubmit   = FormSubmit
      , formAnchor   = Just FIDAdminDemo
      }
    showDemoResult

    miIdent <- newIdent
    let miForm' = wrapForm miForm FormSettings
          { formMethod   = POST
          , formAction   = Just . SomeRoute $ AdminTestR :#: miIdent
          , formEncoding = miEnc
          , formAttrs    = []
          , formSubmit   = FormSubmit
          , formAnchor   = Just miIdent
          }
    [whamlet|
      <h2>Mass-Input
      ^{miForm'}
      $case miResult
        $of FormMissing
        $of FormFailure errs
          <ul>
            $forall err <- errs
              <li>#{err}
        $of FormSuccess res
          <p style="white-space:pre-wrap; font-family:var(--font-monospace);">
            #{tshow res}
    |]

    i18nIdent <- newIdent
    let i18nForm' = wrapForm i18nWidget FormSettings
          { formMethod   = POST
          , formAction   = Just . SomeRoute $ AdminTestR :#: i18nIdent
          , formEncoding = i18nEnc
          , formAttrs    = []
          , formSubmit   = FormSubmit
          , formAnchor   = Just i18nIdent
          }
    [whamlet|
      <h2>I18n-Form
      ^{i18nForm'}
      $case i18nResult
        $of FormMissing
        $of FormFailure errs
          <ul>
            $forall err <- errs
              <li>#{err}
        $of FormSuccess res
          <pre .json>
            #{toYAML res}
    |]

    [whamlet|
       <section>
         <h2>_{MsgTestDownload}
         ^{testDownloadWidget}
    |]

    i18n $ MsgPrintDebugForStupid "DebugForStupid"




getAdminTestPdfR :: Handler TypedContent
getAdminTestPdfR = do
  -- uUser <- maybeAuth -- to determine language for test
  templates <- liftIO $ do
    letter_tp <- P.compileTemplate "" templateRenewal
    din5008   <- P.compileTemplate "" templateDIN5008
    now       <- getCurrentTime
    return (now, letter_tp, din5008)
  case templates of
    (_,Left err,_) -> sendResponseStatus internalServerError500 $ "Markdown template error: \n" <> err
    (_,_,Left err) -> sendResponseStatus internalServerError500 $ "LaTeX template error: \n"    <> err
    (now, Right templ, Right latex) -> do
      content <- liftIO . P.runIO $ do
        let texopts = []
            readeropts  = def { P.readerExtensions = P.pandocExtensions }
            writeropts1 = def { P.writerTemplate = Just templ }
            writeropts2 = def { P.writerTemplate = Just latex }
          -- https://github.com/jgm/pandoc/issues/1950
          -- using markdown as a template for itself for interpolation:
        doc1 <- P.readMarkdown  readeropts  templateRenewal
        doc2 <- P.writeMarkdown writeropts1 doc1
        doc3 <- P.readMarkdown  readeropts  doc2
        P.makePDF "lualatex" texopts P.writeLaTeX writeropts2 $
          P.setDate (P.text . tshow $ utctDay now) doc3
      case content of
        Right (Right bs) -> do
          liftIO $ L.writeFile "/tmp/generated.pdf" bs
          sendByteStringAsFile "demoPDF.pdf" (L.toStrict bs) now
        Right (Left err) -> sendResponseStatus internalServerError500 $ decodeUtf8 $ L.toStrict $ "LaTeX compile error: \n" <> err
        Left        err  -> sendResponseStatus internalServerError500 $ "Pandoc error: \n" <> P.renderError err