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

import Import
import Handler.Utils
import Jobs

import Control.Monad.Trans.Writer (mapWriterT)

import Data.Char (isDigit)
import qualified Data.Text as Text

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

import Database.Persist.Sql (fromSqlKey)


-- BEGIN - Buttons needed only here
data ButtonCreate = CreateMath | CreateInf  -- 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"

  btnClasses CreateMath = [BCIsButton, BCInfo]
  btnClasses CreateInf  = [BCIsButton, BCPrimary]
-- 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
                      )
                )
  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"
    FormMissing -> return ()
    _other -> addMessage Warning "KEIN Knopf erkannt"

  ((emailResult, emailWidget), emailEnctype) <- runFormPost . identifyForm ("email" :: Text) $ renderAForm FormStandard emailTestForm
  formResultModal emailResult AdminTestR $ \(email, ls) -> do
    jId <- mapWriterT runDB $ do
      jId <- queueJob $ JobSendTestEmail email ls
      tell . pure $ Message Success [shamlet|Email-test gestartet (Job ##{tshow (fromSqlKey jId)})|] (Just IconEmail)
      return jId
    runReaderT (writeJobCtl $ JobCtlPerform jId) =<< getYesod
    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
              -> (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 nudge submitBtn = Just $ \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 . fmap 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 >> fvInput addView >> fvInput 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 >> fvInput 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, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing


  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:monospace;">
            #{tshow res}
    |]