Skip to content

P
purescript-gargantext
Commit b8ed3d4b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

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

parent 59af3f6f
Hide whitespace changes
Inline Side-by-side
Showing with 117 additions and 55 deletions
src/Gargantext/Components/CodeEditor.purs
View file @ b8ed3d4b
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
View file @ b8ed3d4b
......@@ -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
View file @ b8ed3d4b
......@@ -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
View file @ b8ed3d4b
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment