CodeEditor.purs 11.2 KB
Newer Older
1 2
module Gargantext.Components.CodeEditor where

Alexandre Delanoë's avatar
Alexandre Delanoë committed
3
import DOM.Simple.Types (Element)
4
import Data.Argonaut.Parser (jsonParser)
5
import Data.Either (either, Either(..))
6 7 8
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
9 10
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
11
import Data.String.Utils (endsWith)
12
import Data.Tuple (fst, snd)
13 14
import Data.Tuple.Nested ((/\))
import Effect (Effect)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
15
import FFI.Simple ((.=))
16 17 18 19
import Reactix as R
import Reactix.DOM.HTML as H
import Text.Markdown.SlamDown.Parser (parseMd)
import Text.Markdown.SlamDown.Smolder as MD
20
import Text.Markdown.SlamDown.Syntax (SlamDownP)
21
import Text.Smolder.Renderer.String as Smolder
22

23
import Gargantext.Prelude
24
import Gargantext.Utils.HighlightJS as HLJS
25 26
import Gargantext.Utils.Reactix as R2

27 28
thisModule = "Gargantext.Components.CodeEditor"

29 30 31 32
type Code = String
type Html = String
type Error = String

33 34
data CodeType = Haskell | JSON | Markdown | Python

35 36 37 38 39 40 41 42 43 44 45 46
derive instance genericCodeType :: Generic CodeType _
instance eqCodeType :: Eq CodeType where
  eq = genericEq
instance showCodeType :: Show CodeType where
  show = genericShow

data ViewType = Code | Preview | Both
derive instance genericViewType :: Generic ViewType _
instance eqViewType :: Eq ViewType where
  eq = genericEq
instance showViewType :: Show ViewType where
  show = genericShow
47 48

type Props =
49
  ( code :: Code
50
  , defaultCodeType :: CodeType
51
  , onChange :: CodeType -> Code -> Effect Unit
52 53
  )

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

60 61
render :: CodeType -> Code -> Either Error Html
render Haskell code = Right $ renderHaskell $ codeNlFix Haskell code
62
render Python  code = Right $ renderPython  $ codeNlFix Python code
63
render JSON code = result
64 65 66 67
  where
    parsedE = jsonParser code
    result = case parsedE of
      Left err -> Left err
68
      Right parsed -> Right $ R2.stringify parsed 2
69
render Markdown code = Right $ renderMd $ codeNlFix Markdown code
70

71
previewPostProcess :: CodeType -> Element -> Effect Unit
72 73
previewPostProcess Haskell htmlEl = do
  HLJS.highlightBlock htmlEl
74 75 76 77

previewPostProcess Python htmlEl = do
  HLJS.highlightBlock htmlEl

78 79
previewPostProcess JSON htmlEl = do
  HLJS.highlightBlock htmlEl
80

81
previewPostProcess Markdown _ = pure unit
82

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

90 91 92 93 94
renderMd :: String -> String
renderMd = renderMd' MD.defaultToMarkupOptions

renderHaskell :: String -> String
renderHaskell s = s
95

96 97 98 99
renderPython :: String -> String
renderPython s = s


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

103 104 105 106 107 108
-- 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
109
codeEditorCpt :: R.Component Props
110
codeEditorCpt = R2.hooksComponent thisModule "codeEditor" cpt
111
  where
112
    cpt {code, defaultCodeType, onChange} _ = do
113
      controls <- initControls code defaultCodeType
114 115 116 117 118

      R.useEffect2' (fst controls.codeS) (fst controls.codeType) $ do
        let code' = fst controls.codeS
        setCodeOverlay controls code'
        renderHtml code' controls
119 120

      pure $ H.div { className: "code-editor" } [
121
          toolbar {controls, onChange}
122
        , H.div { className: "row error" } [
123
           errorComponent {error: controls.error}
124
        ]
125
        , H.div { className: "row editor" } [
126 127 128
           H.div { className: "code-area " <> (codeHidden $ fst controls.viewType) } [
             H.div { className: "code-container" } [
               H.textarea { defaultValue: code
129
                          , on: { change: onEditChange controls onChange }
130 131
                          , placeholder: "Type some code..."
                          , ref: controls.codeElRef } [ ]
132
               , H.pre  { className: (langClass $ fst controls.codeType)
133 134 135
                          -- , contentEditable: "true"
                        , ref: controls.codeOverlayElRef
                        , rows: 30
136
                          --, on: { input: onEditChange (fst codeType) codeElRef htmlRef codeRef error }
137 138 139
                        } []
               ]
             ]
140
           , H.div { className: "v-divider " <> (dividerHidden $ fst controls.viewType) } [ H.text " " ]
141
           , H.div { className: "html " <> (langClass $ fst controls.codeType) <> (previewHidden $ fst controls.viewType)
142 143
                   , ref: controls.htmlElRef
                   } []
144
           ]
145 146
        ]

147 148 149
    codeHidden :: ViewType -> String
    codeHidden Code = ""
    codeHidden Both = ""
150
    codeHidden _ = " hidden"
151

152 153
    dividerHidden :: ViewType -> String
    dividerHidden Both = ""
154
    dividerHidden _ = " hidden"
155

156
    langClass :: CodeType -> String
157 158
    langClass Haskell  = " language-haskell"
    langClass JSON     = " language-json"
159
    langClass Markdown = " language-md"
160
    langClass Python = " language-python"
161

162 163 164
    previewHidden :: ViewType -> String
    previewHidden Preview = ""
    previewHidden Both = ""
165
    previewHidden _ = " hidden"
166

167
    onEditChange :: forall e. Record Controls -> (CodeType -> Code -> Effect Unit) -> e -> Effect Unit
168
    onEditChange controls@{codeElRef, codeOverlayElRef, codeType: (codeType /\ _), codeS} onChange e = do
169
      let code = R2.unsafeEventValue e
170
      snd codeS $ const code
171
      onChange codeType code
172

173 174 175 176 177 178 179 180 181 182 183
setCodeOverlay :: Record Controls -> Code -> Effect Unit
setCodeOverlay {codeOverlayElRef, codeType: (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

184 185 186 187 188
renderHtml :: Code -> Record Controls -> Effect Unit
renderHtml code {codeType: (codeType /\ _), htmlElRef, error: (_ /\ setError)} =
  case (toMaybe $ R.readRef htmlElRef) of
    Nothing -> pure unit
    Just htmlEl -> do
189
      case render codeType code of
190 191
        Left err -> do
          setError $ const $ Just err
192
        Right rendered -> do
193
          setError $ const Nothing
194
          _ <- pure $ (htmlEl .= "innerHTML") rendered
195
          previewPostProcess codeType htmlEl
196
          pure unit
197

198 199 200 201 202 203
type ToolbarProps = (
    controls :: Record Controls
  , onChange :: CodeType -> Code -> Effect Unit
  )

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

206
toolbarCpt :: R.Component ToolbarProps
207
toolbarCpt = R2.hooksComponent thisModule "toolbar" cpt
208
  where
209
    cpt props@{controls: {codeType, error, viewType}} _ = do
210 211 212 213
      pure $
        H.div { className: "row toolbar" } [
             codeTypeSelector {
                  codeType
214
                , onChange: onChangeCodeType props
215 216 217 218 219
                }
           , viewTypeSelector {state: viewType}
           ]

    -- Handle rerendering of preview when viewType changed
220 221 222 223
    onChangeCodeType :: forall e. Record ToolbarProps -> e -> Effect Unit
    onChangeCodeType {controls, onChange} _ = do
      onChange (fst controls.codeType) code
      where
224
        code = fst controls.codeS
225

226 227 228 229 230 231 232 233 234 235

type ErrorComponentProps =
  (
    error :: R.State (Maybe Error)
  )

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

errorComponentCpt :: R.Component ErrorComponentProps
236
errorComponentCpt = R2.hooksComponent thisModule "errorComponent" cpt
237 238 239 240
  where
    cpt {error: (Nothing /\ _)} _ = pure $ H.div {} []
    cpt {error: ((Just error) /\ _)} _ = do
      pure $ H.div { className: "text-danger" } [ H.text error ]
241 242 243 244 245


type CodeTypeSelectorProps =
  (
    codeType :: R.State CodeType
246
  , onChange :: CodeType -> Effect Unit
247 248 249 250 251 252
  )

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

codeTypeSelectorCpt :: R.Component CodeTypeSelectorProps
253
codeTypeSelectorCpt = R2.hooksComponent thisModule "codeTypeSelector" cpt
254
  where
255
    cpt {codeType, onChange} _ = do
256
      pure $ R2.select { className: "form-control"
257 258 259 260
                       , defaultValue: show $ fst codeType
                       , on: { change: onSelectChange codeType onChange }
                       , style: { width: "150px" }
                       }
261
        (option <$> [JSON, Markdown, Haskell, Python])
262 263 264

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

    onSelectChange :: forall e. R.State CodeType -> (CodeType -> Effect Unit) -> e -> Effect Unit
    onSelectChange (_ /\ setCodeType) onChange e = do
268
      let codeType = case value of
269
            "Haskell"  -> Haskell
270 271
            "JSON"     -> JSON
            "Markdown" -> Markdown
272
            "Python"   -> Python
273 274
            _          -> Markdown
      setCodeType $ const codeType
275
      onChange codeType
276 277 278 279
      where
        value = R2.unsafeEventValue e


280
type ViewTypeSelectorProps =
281
  (
282
    state :: R.State ViewType
283 284
  )

285 286
viewTypeSelector :: Record ViewTypeSelectorProps -> R.Element
viewTypeSelector p = R.createElement viewTypeSelectorCpt p []
287

288
viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
289
viewTypeSelectorCpt = R2.hooksComponent thisModule "viewTypeSelector" cpt
290
  where
291 292 293 294 295 296
    cpt {state} _ =
      pure $ H.div { className: "btn-group" } [
          viewTypeButton Code state
        , viewTypeButton Both state
        , viewTypeButton Preview state
        ]
297

298 299 300 301 302 303 304 305 306 307 308 309
    viewTypeButton viewType (state /\ setState) =
      H.label {
        className: "btn btn-default" <> active
        , on: { click: onClick }
      } [
        H.i { className: "glyphicon " <> (icon viewType) } []
      ]
      where
        active = if viewType == state then " active" else ""

        onClick _ = do
          setState $ const viewType
310 311 312 313

    icon Preview = "glyphicon-eye-open"
    icon Both = "glyphicon-transfer"
    icon Code = "glyphicon-pencil"
314 315 316 317

type Controls =
  (
      codeElRef :: R.Ref (Nullable Element)
318
    , codeS :: R.State Code
319 320 321 322 323 324 325 326 327 328
    , codeType :: R.State CodeType
    , codeOverlayElRef :: R.Ref (Nullable Element)
    , error :: R.State (Maybe Error)
    , htmlElRef :: R.Ref (Nullable Element)
    , viewType :: R.State ViewType
  )

initControls :: Code -> CodeType -> R.Hooks (Record Controls)
initControls code defaultCodeType = do
  htmlElRef <- R.useRef null
329
  codeS <- R.useState' code
330 331 332 333
  codeElRef <- R.useRef null
  codeOverlayElRef <- R.useRef null
  codeType <- R.useState' defaultCodeType
  error <- R.useState' Nothing
334
  viewType <- R.useState' Preview
335 336 337

  pure $ {
      codeElRef
338
    , codeS
339 340 341 342 343 344
    , codeType
    , codeOverlayElRef
    , error
    , htmlElRef
    , viewType
    }
345 346 347 348 349 350

reinitControls :: Record Controls -> Code -> CodeType -> Effect Unit
reinitControls c@{codeType, codeS, error} code defaultCodeType = do
  snd codeType $ const defaultCodeType
  snd codeS $ const code
  snd error $ const Nothing