Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
133
Issues
133
List
Board
Labels
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
173a4d33
Commit
173a4d33
authored
Jan 24, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[CodeEditor] file removal, haskell fixed
parent
151471a3
Changes
3
Show whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
115 additions
and
59 deletions
+115
-59
CodeEditor.purs
src/Gargantext/Components/CodeEditor.purs
+21
-13
Corpus.purs
src/Gargantext/Components/Nodes/Corpus.purs
+63
-36
Types.purs
src/Gargantext/Components/Nodes/Corpus/Types.purs
+31
-10
No files found.
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 :: Code
Type -> 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 -> (Code
Type -> 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 code
Type 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
Control
s
toolbarCpt :: R.Component
ToolbarProp
s
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
control
s
, onChange: onChangeCodeType
prop
s
}
, 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
...
...
@@ -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
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'' -> onChange $ JSON j''
cpt {field: Field {typ: Markdown md@{text}}, onChange} _ = do
pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: onChange'}
Right j'' -> onc $ JSON j''
changeCode onc (JSON j) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = text }
where
onChange' :: CE.Code -> Effect Unit
onChange' c = do
onChange $ Markdown $ md { text = c }
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
defaultField :: FTField
defaultField = Field {
name: "New file"
, typ: Markdown {
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: defaultMarkdown
}
newtype CorpusInfo =
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment