content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE ExtendedDefaultRules #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecursiveDo #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeFamilies #-}
  
  -- |
  -- Copyright   :  (C) 2020-2022 Kadena
  -- License     :  BSD-style (see the file LICENSE)
  --
  
  module Frontend.UI.Repl where
  
  ------------------------------------------------------------------------------
  import           Control.Lens
  import           Control.Monad.State.Strict
  import qualified Data.List.Zipper            as Z
  import           Data.Maybe
  import           Data.Text                   (Text)
  import           Language.Javascript.JSaddle hiding (Object)
  import           Reflex
  import           Reflex.Dom.Core
  import           GHC.Exts (toList)
  import           GHCJS.DOM.Element (scrollIntoView)
  ------------------------------------------------------------------------------
  import           Frontend.Repl
  import           Frontend.UI.Widgets (addNoAutofillAttrs, setFocusOn)
  ------------------------------------------------------------------------------
  
  data ClickState = DownAt (Int, Int) | Clicked | Selected
    deriving (Eq,Ord,Show,Read)
  
  data DisplayedSnippet
    = InputSnippet Text
    | OutputSnippet Text
    | OldOutputSnippet Text
    deriving (Eq,Ord,Show,Read)
  
  staticReplHeader :: DomBuilder t m => m ()
  staticReplHeader = divClass "repl__header" $ do
    let
      section = divClass "repl__header-section"
      separator = divClass "repl__header-separator" $ el "hr" blank
  
      code = divClass "repl__header-code" . text
      plain = divClass "repl__header-plain" . text
      quote = divClass "repl__header-quote" . text
      bannerText = divClass "repl__header-banner repl__header-banner-text" . text
      bannerDecoration = divClass "repl__header-banner repl__header-banner-decoration" . text
  
    section $ do
      bannerDecoration ".::"
      bannerText " Welcome to the Pact interactive REPL "
      bannerDecoration "::."
    section $ do
      plain "Use"
      quote " 'LOAD into REPL' "
      plain "button to execute editor text. Then just type at the "
      code " \"pact>\" "
      plain "prompt to interact!"
    section $ do
      plain "To reset the REPL type "
      code "'reset'"
    section separator
  
  snippetWidget' :: MonadWidget t m => DisplayedSnippet -> m (Element EventResult (DomBuilderSpace m) t)
  snippetWidget' = fmap fst . \case
    InputSnippet t
      -> elAttr' "code" ("class" =: "code-font code-font_block") $ replPrompt *> text t
    OutputSnippet t
      -> elAttr' "code" ("class" =: "code-font code-font_block") $ text t
    OldOutputSnippet t
      -> elAttr' "code" ("class" =: "code-font code-font_block code-font_old") $ text t
  
  snippetWidget :: MonadWidget t m => DisplayedSnippet -> m ()
  snippetWidget = void . snippetWidget'
  
  displayReplOutput :: MonadWidget t m => ReplOutput -> m ()
  displayReplOutput = snippetWidget . replOutToDisplayed
    where
      replOutToDisplayed = \case
        ReplOutput_Cmd t -> InputSnippet t
        ReplOutput_Res t -> OutputSnippet t
  
  replWidget
      :: (MonadWidget t m, HasWebRepl model t, HasReplCfg mConf t, Monoid mConf)
      => model
      -> m mConf
  replWidget m = do
    (e, onNewInput) <- elClass' "div" "repl" $ do
      staticReplHeader
      void $ simpleList (toList <$> m ^. repl_output) (dyn . fmap displayReplOutput)
      replInput m
  
    clickType <- foldDyn ($) Nothing $ leftmost
      [ setDown <$> domEvent Mousedown e
      , clickClassifier <$> domEvent Mouseup e
      ]
    let
      replClick = () <$
        ffilter (== Just Clicked) (updated clickType)
    setFocusOn e "input" replClick
  
    let
      onReset = () <$ ffilter (== "reset") onNewInput
      onCmd   = ffilter (/= "reset") onNewInput
    pure $ mempty
      & replCfg_sendCmd .~ onCmd
      & replCfg_reset   .~ onReset
  
  replPrompt :: DomBuilder t m => m ()
  replPrompt = elClass "div" "repl__prompt" $ text "pact>"
  
  replInput :: (MonadWidget t m, HasWebRepl model t) => model -> m (Event t Text)
  replInput m = do
      divClass "repl__input-controls" $ mdo
        replPrompt
        let sv = leftmost
              [ mempty <$ enterPressed
              , fromMaybe "" . Z.safeCursor <$> tagPromptlyDyn commandHistory key
              ]
        ti <- textInput (def & textInputConfig_setValue .~ sv
                             & textInputConfig_attributes .~ pure (addNoAutofillAttrs $ "class" =: "code-font repl__input")
                        )
        let key = ffilter isMovement $ domEvent Keydown ti
        let enterPressed = keypress Enter ti
        let newCommand = tag (current $ value ti) enterPressed
        commandHistory <- foldDyn ($) Z.empty $ leftmost
          [ addToHistory <$> newCommand
          , moveHistory <$> key
          ]
  
        doScrollIntoView ti
  
        return newCommand
    where
      doScrollIntoView ti = do
        onPostBuild <- getPostBuild
        onReady <- delay 0.1 $ leftmost [onPostBuild, () <$ m ^. repl_newOutput]
        performEvent_ $ ffor onReady $ \_ -> liftJSM $
          scrollIntoView (_textInput_element ti) True
  
  addToHistory :: Eq a => a -> Z.Zipper a -> Z.Zipper a
  addToHistory a z =
      if Just a == Z.safeCursor (Z.left zEnd) then zEnd else Z.push a zEnd
    where
      zEnd = Z.end z
  
  isMovement :: (Num a, Eq a) => a -> Bool
  isMovement 38 = True
  isMovement 40 = True
  isMovement _  = False
  
  moveHistory :: (Num a1, Eq a1) => a1 -> Z.Zipper a -> Z.Zipper a
  moveHistory 38 = Z.left
  moveHistory 40 = Z.right
  moveHistory _  = id
  
  setDown :: (Int, Int) -> t -> Maybe ClickState
  setDown clickLoc _ = Just $ DownAt clickLoc
  
  clickClassifier :: (Int, Int) -> Maybe ClickState -> Maybe ClickState
  clickClassifier clickLoc (Just (DownAt loc1)) =
    if clickLoc == loc1 then Just Clicked else Just Selected
  clickClassifier _ _ = Nothing
  