[CodeEditor] more improvements, JSON renders with indent now, errors shown

src/Gargantext/Components/CodeEditor.purs

 module Gargantext.Components.CodeEditor where
 
+import Data.Argonaut.Parser (jsonParser)
 import Data.Either (either, Either(..))
 import Data.Maybe (Maybe(..))
 import Data.Nullable (Nullable, null, toMaybe)
-import Data.Tuple (fst)
+import Data.Tuple (fst, snd)
 import Data.Tuple.Nested ((/\))
 import DOM.Simple.Console (log, log2)
 import DOM.Simple.Types (Element)
@@ -22,6 +23,10 @@ import Text.Smolder.Renderer.String (render)
 import Gargantext.Prelude
 import Gargantext.Utils.Reactix as R2
 
+type Code = String
+type Html = String
+type Error = String
+
 data CodeType = JSON | Markdown
 derive instance genericCodeType :: Generic CodeType _
 instance eqCodeType :: Eq CodeType where
@@ -38,14 +43,21 @@ instance showViewType :: Show ViewType where
 
 type Props =
   ( code :: String
-  , codeType :: CodeType
+  , defaultCodeType :: CodeType
   , onChange :: String -> Effect Unit
   )
 
-compile :: CodeType -> String -> String
-compile JSON code = code
-compile Markdown code = compileMd code
-
+compile :: CodeType -> Code -> Either Error Html
+compile JSON code = result
+  where
+    parsedE = jsonParser code
+    result = case parsedE of
+      Left err -> Left err
+      Right parsed -> Right $ "<pre>" <> (R2.stringify parsed 2) <> "</pre>"
+compile Markdown code = Right $ compileMd code
+
+-- TODO Replace with markdown-it?
+-- https://pursuit.purescript.org/packages/purescript-markdown-it
 compileMd' :: forall e. MD.ToMarkupOptions e -> String -> String
 compileMd' options input =
   either identity (MD.toMarkup' options >>> render)
@@ -60,22 +72,21 @@ codeEditor p = R.createElement codeEditorCpt p []
 codeEditorCpt :: R.Component Props
 codeEditorCpt = R.hooksComponent "G.C.CodeEditor" cpt
   where
-    cpt {code, codeType, onChange} _ = do
+    cpt {code, defaultCodeType, onChange} _ = do
       htmlRef <- R.useRef null
       codeRef <- R.useRef null
       editorCodeRef <- R.useRef code
-      codeTypeS <- R.useState' codeType
+      codeType <- R.useState' defaultCodeType
+      error <- R.useState' Nothing
       viewType <- R.useState' Both
 
+      -- Initial rendering of elements with given data
+
       -- Note: delay is necessary here, otherwise initially the HTML won't get
       -- rendered (mDiv is still null)
-      R.useEffect $ delay unit $ \_ -> do
-        let mHtmlEl = toMaybe $ R.readRef htmlRef
-        case mHtmlEl of
-          Nothing -> pure $ pure unit
-          Just htmlEl -> do
-            _ <- pure $ (htmlEl .= "innerHTML") $ compile codeType code
-            pure $ pure unit
+      R.useEffectOnce $ delay unit $ \_ -> do
+        _ <- renderHtml (fst codeType) code htmlRef error
+        pure $ pure unit
 
       R.useEffectOnce $ delay unit $ \_ -> do
         let mCodeEl = toMaybe $ R.readRef codeRef
@@ -87,20 +98,19 @@ codeEditorCpt = R.hooksComponent "G.C.CodeEditor" cpt
 
       pure $ H.div { className: "code-editor" } [
         H.div { className: "row toolbar" } [
-           codeTypeSelector {codeType: codeTypeS}
-           , H.div { className: "btn-group" } [
-               viewTypeButton {viewType: Code, state: viewType}
-             , viewTypeButton {viewType: Both, state: viewType}
-             , viewTypeButton {viewType: Preview, state: viewType}
-             ]
+             codeTypeSelector {codeType, onChange: onChangeCodeType editorCodeRef htmlRef error}
+           , viewTypeSelector {state: viewType}
            ]
+        , H.div { className: "row error" } [
+           errorComponent {error}
+        ]
         , H.div { className: "row editor" } [
            H.div { className: "code " <> (codeHidden $ fst viewType) } [
               H.code { className: ""
                      , contentEditable: "true"
                      , ref: codeRef
                      , rows: 30
-                     , on: { input: onEditChange codeType codeRef htmlRef editorCodeRef }
+                     , on: { input: onEditChange (fst codeType) codeRef htmlRef editorCodeRef error }
                      } []
               ]
            , H.div { ref: htmlRef, className: "html " <> (previewHidden $ fst viewType) } []
@@ -117,8 +127,14 @@ codeEditorCpt = R.hooksComponent "G.C.CodeEditor" cpt
     previewHidden Both = ""
     previewHidden _ = "hidden"
 
-    onEditChange :: forall e. CodeType -> R.Ref (Nullable Element) -> R.Ref (Nullable Element) -> R.Ref String -> e -> Effect Unit
-    onEditChange codeType codeRef htmlRef editorCodeRef e = do
+    -- Handle rerendering of preview when viewType changed
+    onChangeCodeType :: R.Ref String -> R.Ref (Nullable Element) -> R.State (Maybe Error) -> CodeType -> Effect Unit
+    onChangeCodeType editorCodeRef htmlRef error codeType = do
+        _ <- renderHtml codeType (R.readRef editorCodeRef) htmlRef error
+        pure unit
+
+    onEditChange :: forall e. CodeType -> R.Ref (Nullable Element) -> R.Ref (Nullable Element) -> R.Ref String -> R.State (Maybe Error) -> e -> Effect Unit
+    onEditChange codeType codeRef htmlRef editorCodeRef error e = do
       log2 "[onChange] e" e
       let mCode = toMaybe $ R.readRef codeRef
       case mCode of
@@ -126,18 +142,42 @@ codeEditorCpt = R.hooksComponent "G.C.CodeEditor" cpt
         Just code -> do
           R.setRef editorCodeRef $ R2.innerText code
           pure unit
-      let mHtml = toMaybe $ R.readRef htmlRef
-      case mHtml of
+      renderHtml codeType (R.readRef editorCodeRef) htmlRef error
+
+    renderHtml :: CodeType -> Code -> R.Ref (Nullable Element) -> R.State (Maybe Error) -> Effect Unit
+    renderHtml codeType code htmlRef (_ /\ setError) =
+      case (toMaybe $ R.readRef htmlRef) of
         Nothing -> pure unit
-        Just html -> do
-          _ <- pure $ (html .= "innerHTML") $ compile codeType $ R.readRef editorCodeRef
-          pure unit
-      pure unit
+        Just htmlEl -> do
+          case compile codeType code of
+            Left err -> do
+              setError $ const $ Just err
+            Right compiled -> do
+              setError $ const Nothing
+              _ <- pure $ (htmlEl .= "innerHTML") compiled
+              pure unit
+
+
+type ErrorComponentProps =
+  (
+    error :: R.State (Maybe Error)
+  )
+
+errorComponent :: Record ErrorComponentProps -> R.Element
+errorComponent p = R.createElement errorComponentCpt p []
+
+errorComponentCpt :: R.Component ErrorComponentProps
+errorComponentCpt = R.hooksComponent "G.C.ErrorComponent" cpt
+  where
+    cpt {error: (Nothing /\ _)} _ = pure $ H.div {} []
+    cpt {error: ((Just error) /\ _)} _ = do
+      pure $ H.div { className: "text-danger" } [ H.text error ]
 
 
 type CodeTypeSelectorProps =
   (
     codeType :: R.State CodeType
+  , onChange :: CodeType -> Effect Unit
   )
 
 codeTypeSelector :: Record CodeTypeSelectorProps -> R.Element
@@ -146,49 +186,59 @@ codeTypeSelector p = R.createElement codeTypeSelectorCpt p []
 codeTypeSelectorCpt :: R.Component CodeTypeSelectorProps
 codeTypeSelectorCpt = R.hooksComponent "G.C.CodeTypeSelector" cpt
   where
-    cpt {codeType} _ = do
+    cpt {codeType, onChange} _ = do
       pure $ R2.select { className: "form-control"
-                , on: { change: onSelectChange codeType }
+                , on: { change: onSelectChange codeType onChange }
                 , style: { width: "150px" }
                 , value: show $ fst codeType }
         (option <$> [JSON, Markdown])
 
     option :: CodeType -> R.Element
     option value = H.option { value: show value } [ H.text $ show value ]
-    onSelectChange (_ /\ setCodeType) e = do
+
+    onSelectChange :: forall e. R.State CodeType -> (CodeType -> Effect Unit) -> e -> Effect Unit
+    onSelectChange (_ /\ setCodeType) onChange e = do
       let codeType = case value of
             "JSON"     -> JSON
             "Markdown" -> Markdown
             _          -> Markdown
       setCodeType $ const codeType
+      onChange codeType
       where
         value = R2.unsafeEventValue e
 
 
-type ViewTypeProps =
+type ViewTypeSelectorProps =
   (
-    viewType :: ViewType
-  , state :: R.State ViewType
+    state :: R.State ViewType
   )
 
-viewTypeButton :: Record ViewTypeProps -> R.Element
-viewTypeButton p = R.createElement viewTypeButtonCpt p []
+viewTypeSelector :: Record ViewTypeSelectorProps -> R.Element
+viewTypeSelector p = R.createElement viewTypeSelectorCpt p []
 
-viewTypeButtonCpt :: R.Component ViewTypeProps
-viewTypeButtonCpt = R.hooksComponent "G.C.ViewTypeButton" cpt
+viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
+viewTypeSelectorCpt = R.hooksComponent "G.C.ViewTypeSelector" cpt
   where
-    cpt {viewType, state: (state /\ setState)} _ =
-      pure $ H.label {
-                className: "btn btn-default" <> (active viewType state)
-              , on: { click: onClick viewType setState }
-              } [
-                H.i { className: "glyphicon " <> (icon viewType) } []
-              ]
+    cpt {state} _ =
+      pure $ H.div { className: "btn-group" } [
+          viewTypeButton Code state
+        , viewTypeButton Both state
+        , viewTypeButton Preview state
+        ]
 
-    active viewType state = if viewType == state then " active" else ""
+    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
 
     icon Preview = "glyphicon-eye-open"
     icon Both = "glyphicon-transfer"
     icon Code = "glyphicon-pencil"
-
-    onClick viewType setState _ = setState $ const viewType

src/Gargantext/Components/Nodes/Corpus.purs

@@ -28,7 +28,7 @@ corpusLayoutCpt = R.hooksComponent "G.P.Corpus.corpusLayout" cpt
     cpt {nodeId} _ = do
       pure $ H.div {}
         [
-          CE.codeEditor {code, codeType: CE.Markdown, onChange}
+          CE.codeEditor {code, defaultCodeType: CE.Markdown, onChange}
           --H.iframe { src: gargMd , width: "100%", height: "100%", style: {"border-style": "none"}} []
         ]
     --gargMd = "https://hackmd.iscpif.fr/g9Aah4iwQtCayIzsKQjA0Q#"

src/Gargantext/Utils/Reactix.js

@@ -11,5 +11,10 @@ function getSelection(_u) {
   return window.getSelection();
 }
 
+function stringify(j, indent) {
+  return JSON.stringify(j, null, indent);
+}
+
 exports._addRootElement = addRootElement;
 exports._getSelection = getSelection;
+exports._stringify = stringify;

src/Gargantext/Utils/Reactix.purs

@@ -2,16 +2,18 @@ module Gargantext.Utils.Reactix where
 
 import Prelude
 
+import Data.Argonaut.Core (Json)
+import Data.Function.Uncurried (Fn2, runFn2)
+import Data.Maybe (Maybe(..), fromJust)
+import Data.Nullable (Nullable, null, toMaybe)
+import Data.Tuple (Tuple)
+import Data.Tuple.Nested ((/\))
 import DOM.Simple as DOM
 import DOM.Simple.Console (log2)
 import DOM.Simple.Document (document)
 import DOM.Simple.Element as Element
 import DOM.Simple.Event as DE
 import DOM.Simple.Types (class IsNode)
-import Data.Maybe (Maybe(..), fromJust)
-import Data.Nullable (Nullable, null, toMaybe)
-import Data.Tuple (Tuple)
-import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
 import Effect.Class (liftEffect)
@@ -242,3 +244,8 @@ getSelection :: Unit -> Effect Selection
 getSelection = runEffectFn1 _getSelection
 
 foreign import _getSelection :: EffectFn1 Unit Selection
+
+stringify :: Json -> Int -> String
+stringify j indent = runFn2 _stringify j indent
+
+foreign import _stringify :: Fn2 Json Int String