module Gargantext.Components.CodeEditor where

import Data.Argonaut.Parser (jsonParser)
import Data.Either (either, Either(..))
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.String.Utils (endsWith)
import DOM.Simple.Types (Element)
import Effect (Effect)
import FFI.Simple ((.=))
import Reactix as R
import Reactix.DOM.HTML as H
import Text.Markdown.SlamDown.Parser (parseMd)
import Text.Markdown.SlamDown.Smolder as MD
import Text.Markdown.SlamDown.Syntax (SlamDownP)
import Text.Smolder.Renderer.String as Smolder
import Toestand as T

import Gargantext.Prelude
import Gargantext.Utils.HighlightJS as HLJS
import Gargantext.Utils.Reactix as R2

here :: R2.Here
here = R2.here "Gargantext.Components.CodeEditor"

type Code = String
type Html = String
type Error = String
type ElRef = R.Ref (Nullable Element)

data CodeType = Haskell | JSON | Markdown | Python

derive instance Generic CodeType _
instance Eq CodeType where
  eq = genericEq
instance Show CodeType where
  show = genericShow

data ViewType = Code | Preview | Both
derive instance Generic ViewType _
instance Eq ViewType where
  eq = genericEq
instance Show ViewType where
  show = genericShow

type Props =
  ( code :: Code
  , defaultCodeType :: CodeType
  , onChange :: CodeType -> Code -> Effect Unit
  )

-- Fixes newlines in code
-- This is useful eg for proper rendering of the textarea overlay
codeNlFix :: CodeType -> Code -> Code
codeNlFix _ "" = " "
codeNlFix _ c = if endsWith "\n" c then (c <> " ") else c

render :: CodeType -> Code -> Either Error Html
render Haskell code = Right $ renderHaskell $ codeNlFix Haskell code
render Python  code = Right $ renderPython  $ codeNlFix Python code
render JSON code = result
  where
    parsedE = jsonParser code
    result = case parsedE of
      Left err -> Left err
      Right parsed -> Right $ R2.stringify parsed 2
render Markdown code = Right $ renderMd $ codeNlFix Markdown code

previewPostProcess :: CodeType -> Element -> Effect Unit
previewPostProcess Haskell htmlEl = do
  HLJS.highlightBlock htmlEl

previewPostProcess Python htmlEl = do
  HLJS.highlightBlock htmlEl

previewPostProcess JSON htmlEl = do
  HLJS.highlightBlock htmlEl

previewPostProcess Markdown _ = pure unit

-- TODO Replace with markdown-it?
-- https://pursuit.purescript.org/packages/purescript-markdown-it
renderMd' :: forall e. MD.ToMarkupOptions e -> String -> String
renderMd' options input =
  either identity (MD.toMarkup' options >>> Smolder.render)
  (parseMd input :: Either String (SlamDownP String))

renderMd :: String -> String
renderMd = renderMd' MD.defaultToMarkupOptions

renderHaskell :: String -> String
renderHaskell s = s

renderPython :: String -> String
renderPython s = s


codeEditor :: Record Props -> R.Element
codeEditor p = R.createElement codeEditorCpt p []

-- The code editor contains 3 components:
-- - a hidden textarea
-- - textarea code overlay
-- - html preview
-- The overlay is to provide seamless syntax highlighting on top of the textarea.
-- I took the idea from: https://github.com/satya164/react-simple-code-editor
codeEditorCpt :: R.Component Props
codeEditorCpt = here.component "codeEditor" cpt
  where
    cpt {code, defaultCodeType, onChange} _ = do
      controls <- initControls code defaultCodeType

      codeS' <- T.useLive T.unequal controls.codeS
      codeType' <- T.useLive T.unequal controls.codeType
      viewType' <- T.useLive T.unequal controls.viewType

      R.useEffect2' codeS' codeType' $ do
        setCodeOverlay controls.codeOverlayElRef codeType' codeS'
        renderHtml codeS' codeType' controls.htmlElRef controls.error

      pure $ H.div { className: "code-editor" }
        [ toolbar { controls, onChange }
        , H.div { className: "row no-gutters error" }
          [ errorComponent {error: controls.error} ]
        , H.div { className: "row no-gutters editor" }
          [ H.div { className: "code-area " <> (codeHidden viewType') }
            [ H.div { className: "code-container" }
              [ H.textarea { defaultValue: codeS'
                           , on: { change: onEditChange controls.codeS codeType' onChange }
                           , placeholder: "Type some code..."
                           , ref: controls.codeElRef } [ ]
              , H.pre  { className: (langClass codeType')
                         -- , contentEditable: "true"
                       , ref: controls.codeOverlayElRef
                       , rows: 30
                         --, on: { input: onEditChange (fst codeType) codeElRef htmlRef codeRef error }
                       } []
              ]
             ]
           , H.div { className: "v-divider " <> (dividerHidden viewType') } [ H.text " " ]
           , H.div { className: "html " <> (langClass codeType') <> (previewHidden viewType')
                   , ref: controls.htmlElRef
                   } []
           ]
        ]

    codeHidden :: ViewType -> String
    codeHidden Code = ""
    codeHidden Both = ""
    codeHidden _ = " d-none"

    dividerHidden :: ViewType -> String
    dividerHidden Both = ""
    dividerHidden _ = " d-none"

    langClass :: CodeType -> String
    langClass Haskell  = " language-haskell"
    langClass JSON     = " language-json"
    langClass Markdown = " language-md"
    langClass Python = " language-python"

    previewHidden :: ViewType -> String
    previewHidden Preview = ""
    previewHidden Both = ""
    previewHidden _ = " d-none"

    onEditChange :: forall e. T.Box Code -> CodeType -> OnChangeCodeType -> e -> Effect Unit
    onEditChange codeS codeType onChange e = do
      let code = R.unsafeEventValue e
      T.write_ code codeS
      onChange codeType code

setCodeOverlay :: ElRef -> CodeType -> Code -> Effect Unit
setCodeOverlay codeOverlayElRef codeType code = do
  let mCodeOverlayEl = toMaybe $ R.readRef codeOverlayElRef
  _ <- case mCodeOverlayEl of
    Nothing -> pure unit
    Just codeOverlayEl -> do
      _ <- pure $ (codeOverlayEl .= "innerText") $ codeNlFix codeType code
      HLJS.highlightBlock codeOverlayEl
      pure unit
  pure unit

renderHtml :: Code -> CodeType -> ElRef -> T.Box (Maybe Error) -> Effect Unit
renderHtml code codeType htmlElRef error =
  case (toMaybe $ R.readRef htmlElRef) of
    Nothing -> pure unit
    Just htmlEl -> do
      case render codeType code of
        Left err -> do
          T.write_ (Just err) error
        Right rendered -> do
          T.write_ Nothing error
          _ <- pure $ (htmlEl .= "innerHTML") rendered
          previewPostProcess codeType htmlEl
          pure unit

type OnChangeCodeType = CodeType -> Code -> Effect Unit

type ToolbarProps = (
    controls :: Record Controls
  , onChange :: OnChangeCodeType
  )

toolbar :: Record ToolbarProps -> R.Element
toolbar p = R.createElement toolbarCpt p []

toolbarCpt :: R.Component ToolbarProps
toolbarCpt = here.component "toolbar" cpt
  where
    cpt { controls: { codeS, codeType, viewType }
        , onChange } _ = do
      codeS' <- T.useLive T.unequal codeS
      codeType' <- T.useLive T.unequal codeType

      pure $
        H.div { className: "row no-gutters align-items-center mb-3 code-editor__toolbar" }
          [ H.div { className: "code-editor__toolbar__type" }
               [ codeTypeSelector {
                   codeType
                  -- Handle rerendering of preview when viewType changed
                 , onChange: \ct -> onChange ct codeS'
                 }
               ]
          , H.div {}
             [ viewTypeSelector {state: viewType} [] ]
          ]


type ErrorComponentProps =
  (
    error :: T.Box (Maybe Error)
  )

errorComponent :: Record ErrorComponentProps -> R.Element
errorComponent p = R.createElement errorComponentCpt p []

errorComponentCpt :: R.Component ErrorComponentProps
errorComponentCpt = here.component "errorComponent" cpt
  where
    cpt { error } _ = do
      error' <- T.useLive T.unequal error

      pure $ case error' of
        Nothing -> H.div {} []
        Just err -> H.div { className: "text-danger mb-3" } [ H.text err ]


type CodeTypeSelectorProps =
  (
    codeType :: T.Box CodeType
  , onChange :: CodeType -> Effect Unit
  )

codeTypeSelector :: Record CodeTypeSelectorProps -> R.Element
codeTypeSelector p = R.createElement codeTypeSelectorCpt p []

codeTypeSelectorCpt :: R.Component CodeTypeSelectorProps
codeTypeSelectorCpt = here.component "codeTypeSelector" cpt
  where
    cpt { codeType, onChange } _ = do
      codeType' <- T.useLive T.unequal codeType

      pure $ R2.select { className: "form-control"
                       , defaultValue: show codeType'
                       , on: { change: onSelectChange codeType onChange }
                       , style: { width: "150px" }
                       }
        (option <$> [JSON, Markdown, Haskell, Python])

    option :: CodeType -> R.Element
    option value = H.option { value: show value } [ H.text $ show value ]

    onSelectChange :: forall e. T.Box CodeType -> (CodeType -> Effect Unit) -> e -> Effect Unit
    onSelectChange codeType onChange e = do
      let ct = case value of
            "Haskell"  -> Haskell
            "JSON"     -> JSON
            "Markdown" -> Markdown
            "Python"   -> Python
            _          -> Markdown
      T.write_ ct codeType
      onChange ct
      where
        value = R.unsafeEventValue e


type ViewTypeSelectorProps =
  (
    state :: T.Box ViewType
  )

viewTypeSelector :: R2.Component ViewTypeSelectorProps
viewTypeSelector = R.createElement viewTypeSelectorCpt

viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
viewTypeSelectorCpt = here.component "viewTypeSelector" cpt
  where
    cpt { state } _ = do
      state' <- T.useLive T.unequal state

      pure $ H.div { className: "btn-group"
                   , role: "group" } [
          viewTypeButton Code state' state
        , viewTypeButton Both state' state
        , viewTypeButton Preview state' state
        ]

    viewTypeButton viewType state' state =
      H.button { className: "btn btn-primary" <> active
               , on: { click: \_ -> T.write viewType state }
               , type: "button"
               } [
        H.i { className: "fa " <> (icon viewType) } []
      ]
      where
        active = if viewType == state' then " active" else ""

    icon Preview = "fa-eye"
    icon Both = "fa-columns"
    icon Code = "fa-pencil"

type Controls =
  (
      codeElRef :: R.Ref (Nullable Element)
    , codeS :: T.Box Code
    , codeType :: T.Box CodeType
    , codeOverlayElRef :: R.Ref (Nullable Element)
    , error :: T.Box (Maybe Error)
    , htmlElRef :: R.Ref (Nullable Element)
    , viewType :: T.Box ViewType
  )

initControls :: Code -> CodeType -> R.Hooks (Record Controls)
initControls code defaultCodeType = do
  htmlElRef <- R.useRef null
  codeS <- T.useBox code
  codeElRef <- R.useRef null
  codeOverlayElRef <- R.useRef null
  codeType <- T.useBox defaultCodeType
  error <- T.useBox Nothing
  viewType <- T.useBox Preview

  pure $ {
      codeElRef
    , codeS
    , codeType
    , codeOverlayElRef
    , error
    , htmlElRef
    , viewType
    }

reinitControls :: Record Controls -> Code -> CodeType -> Effect Unit
reinitControls { codeType, codeS, error } code defaultCodeType = do
  T.write_ defaultCodeType codeType
  T.write_ code codeS
  T.write_ Nothing error