Skip to content

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

[CodeEditor] file removal, haskell fixed

parent 151471a3
Hide whitespace changes
Inline Side-by-side
Showing with 115 additions and 59 deletions
src/Gargantext/Components/CodeEditor.purs
View file @ 173a4d33
......@@ -45,7 +45,7 @@ instance showViewType :: Show ViewType where
type Props =
( code :: Code
, defaultCodeType :: CodeType
, onChange :: Code -> Effect Unit
, onChange :: CodeType -> Code -> Effect Unit
)
-- Fixes newlines in code
......@@ -112,7 +112,7 @@ codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt
pure $ pure unit
pure $ H.div { className: "code-editor" } [
toolbar controls
toolbar {controls, onChange}
, H.div { className: "row error" } [
errorComponent {error: controls.error}
]
......@@ -157,13 +157,13 @@ codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt
previewHidden Both = ""
previewHidden _ = " hidden"
onEditChange :: forall e. Record Controls -> (Code -> Effect Unit) -> e -> Effect Unit
onEditChange controls@{codeElRef, codeOverlayElRef, editorCodeRef} onChange e = do
onEditChange :: forall e. Record Controls -> (CodeType -> Code -> Effect Unit) -> e -> Effect Unit
onEditChange controls@{codeElRef, codeOverlayElRef, codeType: (codeType /\ _), editorCodeRef} onChange e = do
let code = R2.unsafeEventValue e
R.setRef editorCodeRef code
setCodeOverlay controls code
renderHtml (R.readRef controls.editorCodeRef) controls
onChange code
onChange codeType code
setCodeOverlay :: Record Controls -> Code -> Effect Unit
setCodeOverlay {codeOverlayElRef, codeType: (codeType /\ _)} code = do
......@@ -190,27 +190,35 @@ renderHtml code {codeType: (codeType /\ _), htmlElRef, error: (_ /\ setError)} =
previewPostProcess codeType htmlEl
pure unit
toolbar :: Record Controls -> R.Element
type ToolbarProps = (
controls :: Record Controls
, onChange :: CodeType -> Code -> Effect Unit
)
toolbar :: Record ToolbarProps -> R.Element
toolbar p = R.createElement toolbarCpt p []
toolbarCpt :: R.Component Controls
toolbarCpt :: R.Component ToolbarProps
toolbarCpt = R.hooksComponent "G.C.CE.toolbar" cpt
where
cpt controls@{codeType, error, viewType} _ = do
cpt props@{controls: {codeType, error, viewType}} _ = do
pure $
H.div { className: "row toolbar" } [
codeTypeSelector {
codeType
, onChange: onChangeCodeType controls
, onChange: onChangeCodeType props
}
, viewTypeSelector {state: viewType}
]
-- Handle rerendering of preview when viewType changed
onChangeCodeType :: forall e. Record Controls -> e -> Effect Unit
onChangeCodeType controls _ = do
setCodeOverlay controls (R.readRef controls.editorCodeRef)
renderHtml (R.readRef controls.editorCodeRef) controls
onChangeCodeType :: forall e. Record ToolbarProps -> e -> Effect Unit
onChangeCodeType {controls, onChange} _ = do
setCodeOverlay controls code
renderHtml code controls
onChange (fst controls.codeType) code
where
code = R.readRef controls.editorCodeRef
type ErrorComponentProps =
......
src/Gargantext/Components/Nodes/Corpus.purs
View file @ 173a4d33
......@@ -65,21 +65,21 @@ corpusLayoutViewCpt = R.hooksComponent "G.C.N.C.corpusLayoutView" cpt
fieldsS <- R.useState' fieldsWithIndex
pure $ H.div {} [
H.div { className: "row" } [
H.div { className: "btn btn-default " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave {fields: fieldsS, nodeId, reload, session} }
} [
H.span { className: "glyphicon glyphicon-save" } [ ]
]
]
H.div { className: "row" } [
H.div { className: "btn btn-default " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave {fields: fieldsS, nodeId, reload, session} }
} [
H.span { className: "glyphicon glyphicon-save" } [ ]
]
]
, H.div {} [ fieldsCodeEditor {nodeId, session, fields: fieldsS} ]
, H.div { className: "row" } [
H.div { className: "btn btn-default"
, on: { click: onClickAdd fieldsS }
} [
H.div { className: "btn btn-default"
, on: { click: onClickAdd fieldsS }
} [
H.span { className: "glyphicon glyphicon-plus" } [ ]
]
]
]
]
]
saveEnabled :: Array FTFieldWithIndex -> R.State (Array FTFieldWithIndex) -> String
......@@ -118,6 +118,7 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
(\(Tuple idx field) ->
fieldCodeEditorWrapper { field
, onChange: onChange fS idx
, onRemove: onRemove fS idx
}) <$> fields
onChange :: R.State (Array FTFieldWithIndex) -> Index -> FieldType -> Effect Unit
......@@ -127,10 +128,18 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
Nothing -> fields
Just newFields -> newFields
onRemove :: R.State (Array FTFieldWithIndex) -> Index -> Unit -> Effect Unit
onRemove (_ /\ setFields) idx _ = do
setFields $ \fields ->
case A.deleteAt idx fields of
Nothing -> fields
Just newFields -> newFields
type FieldCodeEditorProps =
(
field :: FTField
, onChange :: FieldType -> Effect Unit
, onRemove :: Unit -> Effect Unit
)
fieldCodeEditorWrapper :: Record FieldCodeEditorProps -> R.Element
......@@ -139,9 +148,18 @@ fieldCodeEditorWrapper props = R.createElement fieldCodeEditorWrapperCpt props [
fieldCodeEditorWrapperCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt" cpt
where
cpt props@{field: Field {name, typ}} _ = do
cpt props@{field: Field {name, typ}, onRemove} _ = do
pure $ H.div { className: "row panel panel-default" } [
H.div { className: "panel-heading" } [ H.text name ]
H.div { className: "panel-heading" } [
H.span {} [ H.text name ]
, H.div { className: "pull-right" } [
H.div { className: "btn btn-danger"
, on: { click: \_ -> onRemove unit }
} [
H.span { className: "glyphicon glyphicon-minus" } [ ]
]
]
]
, H.div { className: "panel-body" } [
fieldCodeEditor props
]
......@@ -153,30 +171,39 @@ fieldCodeEditor props = R.createElement fieldCodeEditorCpt props []
fieldCodeEditorCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorCpt" cpt
where
cpt {field: Field {typ: Haskell hs@{code}}, onChange} _ = do
pure $ CE.codeEditor {code, defaultCodeType: CE.Haskell, onChange: onChange'}
where
onChange' :: CE.Code -> Effect Unit
onChange' c = do
onChange $ Haskell $ hs { code = c }
cpt {field: Field {typ: JSON j}, onChange} _ = do
pure $ CE.codeEditor {code, defaultCodeType: CE.JSON, onChange: onChange'}
cpt {field: Field {typ: typ@(Haskell {haskell})}, onChange} _ = do
pure $ CE.codeEditor {code: haskell, defaultCodeType: CE.Haskell, onChange: changeCode onChange typ}
cpt {field: Field {typ: typ@(JSON j)}, onChange} _ = do
pure $ CE.codeEditor {code, defaultCodeType: CE.JSON, onChange: changeCode onChange typ}
where
code = R2.stringify (encodeJson j) 2
onChange' :: CE.Code -> Effect Unit
onChange' c = do
case jsonParser c of
Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
Right j' -> case decodeJson j' of
Left err -> log2 "[fieldCodeEditor'] cannot decode json" j'
Right j'' -> onChange $ JSON j''
cpt {field: Field {typ: Markdown md@{text}}, onChange} _ = do
pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: onChange'}
where
onChange' :: CE.Code -> Effect Unit
onChange' c = do
onChange $ Markdown $ md { text = c }
cpt {field: Field {typ: typ@(Markdown {text})}, onChange} _ = do
pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: changeCode onChange typ}
-- Perofrms the matrix of code type changes
-- (FieldType -> Effect Unit) is the callback function for fields array
-- FieldType is the current element that we will modify
-- CE.CodeType is the editor code type (might have been the cause of the trigger)
-- CE.Code is the editor code (might have been the cause of the trigger)
changeCode :: (FieldType -> Effect Unit) -> FieldType -> CE.CodeType -> CE.Code -> Effect Unit
changeCode onc (Haskell hs) CE.Haskell c = onc $ Haskell $ hs { haskell = c }
changeCode onc (Haskell {haskell}) CE.JSON c = onc $ JSON $ defaultJSON' { desc = haskell }
changeCode onc (Haskell {haskell}) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = haskell }
changeCode onc (JSON j@{desc}) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = haskell }
where
haskell = R2.stringify (encodeJson j) 2
changeCode onc (JSON j) CE.JSON c = do
case jsonParser c of
Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
Right j' -> case decodeJson j' of
Left err -> log2 "[fieldCodeEditor'] cannot decode json" j'
Right j'' -> onc $ JSON j''
changeCode onc (JSON j) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = text }
where
text = R2.stringify (encodeJson j) 2
changeCode onc (Markdown md) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = c }
changeCode onc (Markdown md) CE.JSON c = onc $ Markdown $ defaultMarkdown' { text = c }
changeCode onc (Markdown md) CE.Markdown c = onc $ Markdown $ md { text = c }
type LoadProps = (
nodeId :: Int
......
src/Gargantext/Components/Nodes/Corpus/Types.purs
View file @ 173a4d33
......@@ -44,7 +44,7 @@ instance eqFTField :: Eq (Field FieldType) where
data FieldType =
Haskell {
code :: HaskellCode
haskell :: HaskellCode
, tag :: Tag
}
| JSON {
......@@ -69,9 +69,9 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
data_ <- obj .: "data"
typ <- case type_ of
"Haskell" -> do
code <- data_ .: "code"
haskell <- data_ .: "haskell"
tag <- data_ .: "tag"
pure $ Haskell {code, tag}
pure $ Haskell {haskell, tag}
"JSON" -> do
authors <- data_ .: "authors"
desc <- data_ .: "desc"
......@@ -96,8 +96,8 @@ instance encodeFTField :: EncodeJson (Field FieldType) where
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {code}) =
"code" := code
encodeJson (Haskell {haskell}) =
"haskell" := haskell
~> "tag" := "HaskellField"
~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) =
......@@ -112,13 +112,34 @@ instance encodeFieldType :: EncodeJson FieldType where
~> "text" := text
~> jsonEmptyObject
defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' = {
haskell: ""
, tag: "HaskellField"
}
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' = {
authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' = {
tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField
defaultField = Field {
name: "New file"
, typ: Markdown {
tag: "MarkdownField"
, text: "# New file"
}
name: "New file"
, typ: defaultMarkdown
}
newtype CorpusInfo =
......
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