Skip to content

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

Merge branch 'dev' into dev-corpus-query-async

parents 842067f6 6ec86879
Hide whitespace changes
Inline Side-by-side
Showing with 2635 additions and 1594 deletions
dist/styles/CodeEditor.css
View file @ 212708d7
.code-editor-heading {
display: flex;
}
.code-editor-heading .renameable {
flex-grow: 2;
}
.code-editor-heading .renameable .text {
padding-right: 10px;
}
.code-editor-heading .buttons-right {
display: flex;
justify-content: flex-end;
}
.code-editor .toolbar {
display: flex;
justify-content: flex-start;
......@@ -7,24 +21,101 @@
display: flex;
width: 100%;
}
.code-editor .editor .code {
.code-editor .editor .code-area {
flex-grow: 1;
max-height: 200px;
overflow: auto;
}
.code-editor .editor .code-area .code-container {
background-color: #fafafa;
box-sizing: border-box;
position: relative;
font-family: Fira code, Fira Mono, Consolas, Menlo, Courier, monospace;
font-size: 12px;
font-variant-ligatures: common-ligatures;
line-height: 1.5;
overflow: hidden;
padding: 0px;
text-align: left;
}
.code-editor .editor .code-area .code-container textarea {
border: 0px;
color: inherit;
position: absolute;
left: 0px;
top: 0px;
resize: none;
height: 100%;
overflow: hidden;
width: 100%;
-webkit-text-fill-color: transparent;
box-sizing: inherit;
display: inherit;
margin: 0px;
padding: 10px;
overflow-wrap: break-word;
white-space: pre-wrap;
word-break: keep-all;
font-family: inherit;
font-size: inherit;
font-style: inherit;
font-variant-ligatures: inherit;
font-weight: inherit;
letter-spacing: inherit;
line-height: inherit;
text-indent: inherit;
text-rendering: inherit;
text-transform: inherit;
}
.code-editor .editor .code code {
background-color: #f7f7f9;
.code-editor .editor .code-area .code-container pre {
background: rgba(0, 0, 0, 0) none repeat scroll 0% 0%;
border: 0px none;
color: #000;
display: block;
height: 500px;
pointer-events: none;
position: relative;
box-sizing: inherit;
display: inherit;
margin: 0px;
padding: 10px;
overflow-wrap: break-word;
white-space: pre-wrap;
word-break: keep-all;
font-family: inherit;
font-size: inherit;
font-style: inherit;
font-variant-ligatures: inherit;
font-weight: inherit;
letter-spacing: inherit;
line-height: inherit;
text-indent: inherit;
text-rendering: inherit;
text-transform: inherit;
}
.code-editor .editor .v-divider {
border-left: 1px solid gray;
cursor: sw-resize;
height: 100%;
margin-left: 5px;
margin-right: 5px;
width: 1px;
}
.code-editor .editor .html {
flex-grow: 2;
margin-left: 25px;
padding-left: 25px;
}
.code-editor .editor .html ul li {
.code-editor .editor .html.language-haskell {
font-family: Fira code, Fira Mono, Consolas, Menlo, Courier, monospace;
white-space: pre;
}
.code-editor .editor .html.language-json {
font-family: Fira code, Fira Mono, Consolas, Menlo, Courier, monospace;
white-space: pre;
}
.code-editor .editor .html.language-md ul li {
list-style: disc !important;
}
.code-editor .editor .html ol li {
.code-editor .editor .html.language-md ol li {
list-style: decimal !important;
}
......
dist/styles/CodeEditor.sass
View file @ 212708d7
@mixin font-inherit()
font-family: inherit
font-size: inherit
font-style: inherit
font-variant-ligatures: inherit
font-weight: inherit
letter-spacing: inherit
line-height: inherit
text-indent: inherit
text-rendering: inherit
text-transform: inherit
@mixin common-overlay-props()
box-sizing: inherit
display: inherit
margin: 0px
padding: 10px
overflow-wrap: break-word
white-space: pre-wrap
word-break: keep-all
.code-editor-heading
display: flex
//justify-content: space-between
.renameable
flex-grow: 2
.text
padding-right: 10px
.buttons-right
display: flex
justify-content: flex-end
.code-editor
.toolbar
display: flex
......@@ -6,20 +38,63 @@
.editor
display: flex
width: 100%
.code
.code-area
flex-grow: 1
code
background-color: #f7f7f9
color: #000
display: block
height: 500px
max-height: 200px
overflow: auto
.code-container
background-color: #fafafa
box-sizing: border-box
position: relative
font-family: Fira code,Fira Mono,Consolas,Menlo,Courier,monospace
font-size: 12px
font-variant-ligatures: common-ligatures
line-height: 1.5
overflow: hidden
padding: 0px
text-align: left
textarea
border: 0px
color: inherit
position: absolute
left: 0px
top: 0px
resize: none
height: 100%
overflow: hidden
width: 100%
-webkit-text-fill-color: transparent
@include common-overlay-props()
@include font-inherit()
pre
background: rgba(0, 0, 0, 0) none repeat scroll 0% 0%
border: 0px none
color: #000
pointer-events: none
position: relative
@include common-overlay-props()
@include font-inherit()
.v-divider
border-left: 1px solid gray
cursor: sw-resize
height: 100%
margin-left: 5px
margin-right: 5px
width: 1px
.html
flex-grow: 2
margin-left: 25px
padding-left: 25px
ul
li
list-style: disc !important
ol
li
list-style: decimal !important
&.language-haskell
font-family: Fira code,Fira Mono,Consolas,Menlo,Courier,monospace
white-space: pre
&.language-json
font-family: Fira code,Fira Mono,Consolas,Menlo,Courier,monospace
white-space: pre
&.language-md
ul
li
list-style: disc !important
ol
li
list-style: decimal !important
psc-package.json
View file @ 212708d7
......@@ -34,6 +34,7 @@
"spec-quickcheck",
"string-parsers",
"strings",
"stringutils",
"thermite",
"tuples-native",
"uint",
......
src/Gargantext/Components/App.purs
View file @ 212708d7
......@@ -57,7 +57,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
Home -> forested $ homeLayout EN
Login -> login { sessions, backends, visible: showLogin }
Folder sid _ -> withSession sid $ \_ -> forested (folder {})
Corpus sid nodeId -> withSession sid $ \_ -> forested $ corpusLayout { nodeId }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
Dashboard sid _nodeId -> withSession sid $ \session -> forested $ dashboardLayout {}
......
src/Gargantext/Components/CodeEditor.purs
View file @ 212708d7
......@@ -2,32 +2,33 @@ module Gargantext.Components.CodeEditor where
import Data.Argonaut.Parser (jsonParser)
import Data.Either (either, Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (fst, snd)
import Data.String.Utils (endsWith)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
import Effect (Effect)
import FFI.Simple ((.=), delay)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Reactix as R
import Reactix.DOM.HTML as H
import Text.Markdown.SlamDown.Parser (parseMd)
import Text.Markdown.SlamDown.Smolder as MD
import Text.Markdown.SlamDown.Syntax (SlamDownP(..))
import Text.Smolder.Renderer.String (render)
import Text.Markdown.SlamDown.Syntax (SlamDownP)
import Text.Smolder.Renderer.String as Smolder
import Gargantext.Prelude
import Gargantext.Utils.HighlightJS as HLJS
import Gargantext.Utils.Reactix as R2
type Code = String
type Html = String
type Error = String
data CodeType = JSON | Markdown
data CodeType = Haskell | JSON | Markdown
derive instance genericCodeType :: Generic CodeType _
instance eqCodeType :: Eq CodeType where
eq = genericEq
......@@ -42,120 +43,182 @@ instance showViewType :: Show ViewType where
show = genericShow
type Props =
( code :: String
( code :: Code
, defaultCodeType :: CodeType
, onChange :: String -> Effect Unit
, onChange :: CodeType -> Code -> Effect Unit
)
compile :: CodeType -> Code -> Either Error Html
compile JSON code = result
-- Fixes newlines in code
-- This is useful eg for proper rendering of the textarea overlay
codeNlFix :: CodeType -> Code -> Code
codeNlFix _ "" = " "
codeNlFix _ c = if endsWith "\n" c then (c <> " ") else c
render :: CodeType -> Code -> Either Error Html
render Haskell code = Right $ renderHaskell $ codeNlFix Haskell code
render 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
Right parsed -> Right $ R2.stringify parsed 2
render Markdown code = Right $ renderMd $ codeNlFix Markdown code
previewPostProcess :: CodeType -> Element -> Effect Unit
previewPostProcess Haskell htmlEl = do
HLJS.highlightBlock htmlEl
previewPostProcess JSON htmlEl = do
HLJS.highlightBlock htmlEl
previewPostProcess Markdown _ = pure unit
-- 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)
renderMd' :: forall e. MD.ToMarkupOptions e -> String -> String
renderMd' options input =
either identity (MD.toMarkup' options >>> Smolder.render)
(parseMd input :: Either String (SlamDownP String))
compileMd :: String -> String
compileMd = compileMd' MD.defaultToMarkupOptions
renderMd :: String -> String
renderMd = renderMd' MD.defaultToMarkupOptions
renderHaskell :: String -> String
renderHaskell s = s
codeEditor :: Record Props -> R.Element
codeEditor p = R.createElement codeEditorCpt p []
-- 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
codeEditorCpt :: R.Component Props
codeEditorCpt = R.hooksComponent "G.C.CodeEditor" cpt
codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt
where
cpt {code, defaultCodeType, onChange} _ = do
htmlRef <- R.useRef null
codeRef <- R.useRef null
editorCodeRef <- R.useRef code
codeType <- R.useState' defaultCodeType
error <- R.useState' Nothing
viewType <- R.useState' Both
controls <- initControls code defaultCodeType
-- Initial rendering of elements with given data
-- Note: delay is necessary here, otherwise initially the HTML won't get
-- rendered (mDiv is still null)
-- rendered (DOM Element refs are still null)
R.useEffectOnce $ delay unit $ \_ -> do
_ <- renderHtml (fst codeType) code htmlRef error
_ <- renderHtml code controls
pure $ pure unit
R.useEffectOnce $ delay unit $ \_ -> do
let mCodeEl = toMaybe $ R.readRef codeRef
case mCodeEl of
Nothing -> pure $ pure unit
Just codeEl -> do
_ <- pure $ (codeEl .= "innerText") code
pure $ pure unit
_ <- setCodeOverlay controls code
pure $ pure unit
pure $ H.div { className: "code-editor" } [
H.div { className: "row toolbar" } [
codeTypeSelector {codeType, onChange: onChangeCodeType editorCodeRef htmlRef error}
, viewTypeSelector {state: viewType}
]
toolbar {controls, onChange}
, H.div { className: "row error" } [
errorComponent {error}
errorComponent {error: controls.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 (fst codeType) codeRef htmlRef editorCodeRef error }
} []
]
, H.div { ref: htmlRef, className: "html " <> (previewHidden $ fst viewType) } []
H.div { className: "code-area " <> (codeHidden $ fst controls.viewType) } [
H.div { className: "code-container" } [
H.textarea { defaultValue: code
, on: { change: onEditChange controls onChange }
, placeholder: "Type some code..."
, ref: controls.codeElRef } [ ]
, H.pre { className: (langClass $ fst controls.codeType)
-- , contentEditable: "true"
, ref: controls.codeOverlayElRef
, rows: 30
--, on: { input: onEditChange (fst codeType) codeElRef htmlRef editorCodeRef error }
} []
]
]
, H.div { className: "v-divider " <> (dividerHidden $ fst controls.viewType) } [ H.text " " ]
, H.div { className: "html " <> (langClass $ fst controls.codeType) <> (previewHidden $ fst controls.viewType)
, ref: controls.htmlElRef
} []
]
]
codeHidden :: ViewType -> String
codeHidden Code = ""
codeHidden Both = ""
codeHidden _ = "hidden"
codeHidden _ = " hidden"
dividerHidden :: ViewType -> String
dividerHidden Both = ""
dividerHidden _ = " hidden"
langClass :: CodeType -> String
langClass Haskell = " language-haskell"
langClass JSON = " language-json"
langClass Markdown = " language-md"
previewHidden :: ViewType -> String
previewHidden Preview = ""
previewHidden Both = ""
previewHidden _ = "hidden"
previewHidden _ = " hidden"
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 codeType code
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
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
case render codeType code of
Left err -> do
setError $ const $ Just err
Right rendered -> do
setError $ const Nothing
_ <- pure $ (htmlEl .= "innerHTML") rendered
previewPostProcess codeType htmlEl
pure unit
type ToolbarProps = (
controls :: Record Controls
, onChange :: CodeType -> Code -> Effect Unit
)
toolbar :: Record ToolbarProps -> R.Element
toolbar p = R.createElement toolbarCpt p []
toolbarCpt :: R.Component ToolbarProps
toolbarCpt = R.hooksComponent "G.C.CE.toolbar" cpt
where
cpt props@{controls: {codeType, error, viewType}} _ = do
pure $
H.div { className: "row toolbar" } [
codeTypeSelector {
codeType
, onChange: onChangeCodeType props
}
, viewTypeSelector {state: viewType}
]
-- 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
Nothing -> log "[onChange] mCode = Nothing"
Just code -> do
R.setRef editorCodeRef $ R2.innerText code
pure unit
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 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
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 =
......@@ -167,7 +230,7 @@ errorComponent :: Record ErrorComponentProps -> R.Element
errorComponent p = R.createElement errorComponentCpt p []
errorComponentCpt :: R.Component ErrorComponentProps
errorComponentCpt = R.hooksComponent "G.C.ErrorComponent" cpt
errorComponentCpt = R.hooksComponent "G.C.CE.ErrorComponent" cpt
where
cpt {error: (Nothing /\ _)} _ = pure $ H.div {} []
cpt {error: ((Just error) /\ _)} _ = do
......@@ -184,14 +247,14 @@ codeTypeSelector :: Record CodeTypeSelectorProps -> R.Element
codeTypeSelector p = R.createElement codeTypeSelectorCpt p []
codeTypeSelectorCpt :: R.Component CodeTypeSelectorProps
codeTypeSelectorCpt = R.hooksComponent "G.C.CodeTypeSelector" cpt
codeTypeSelectorCpt = R.hooksComponent "G.C.CE.CodeTypeSelector" cpt
where
cpt {codeType, onChange} _ = do
pure $ R2.select { className: "form-control"
, on: { change: onSelectChange codeType onChange }
, style: { width: "150px" }
, value: show $ fst codeType }
(option <$> [JSON, Markdown])
(option <$> [Haskell, JSON, Markdown])
option :: CodeType -> R.Element
option value = H.option { value: show value } [ H.text $ show value ]
......@@ -199,6 +262,7 @@ codeTypeSelectorCpt = R.hooksComponent "G.C.CodeTypeSelector" cpt
onSelectChange :: forall e. R.State CodeType -> (CodeType -> Effect Unit) -> e -> Effect Unit
onSelectChange (_ /\ setCodeType) onChange e = do
let codeType = case value of
"Haskell" -> Haskell
"JSON" -> JSON
"Markdown" -> Markdown
_ -> Markdown
......@@ -217,7 +281,7 @@ viewTypeSelector :: Record ViewTypeSelectorProps -> R.Element
viewTypeSelector p = R.createElement viewTypeSelectorCpt p []
viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
viewTypeSelectorCpt = R.hooksComponent "G.C.ViewTypeSelector" cpt
viewTypeSelectorCpt = R.hooksComponent "G.C.CE.ViewTypeSelector" cpt
where
cpt {state} _ =
pure $ H.div { className: "btn-group" } [
......@@ -242,3 +306,34 @@ viewTypeSelectorCpt = R.hooksComponent "G.C.ViewTypeSelector" cpt
icon Preview = "glyphicon-eye-open"
icon Both = "glyphicon-transfer"
icon Code = "glyphicon-pencil"
type Controls =
(
codeElRef :: R.Ref (Nullable Element)
, codeType :: R.State CodeType
, codeOverlayElRef :: R.Ref (Nullable Element)
, editorCodeRef :: R.Ref Code
, 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
codeElRef <- R.useRef null
codeOverlayElRef <- R.useRef null
codeType <- R.useState' defaultCodeType
editorCodeRef <- R.useRef code
error <- R.useState' Nothing
viewType <- R.useState' Both
pure $ {
codeElRef
, codeType
, codeOverlayElRef
, editorCodeRef
, error
, htmlElRef
, viewType
}
src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs
View file @ 212708d7
......@@ -14,6 +14,7 @@ import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types as GT
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
......
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ 212708d7
......@@ -15,7 +15,6 @@ import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
......
src/Gargantext/Components/MarkdownEditor.purs deleted 100644 → 0
View file @ 842067f6
module Gargantext.Components.MarkdownEditor where
import Data.Either (either, Either(..))
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import DOM.Simple.Types (Element)
import Effect (Effect)
import FFI.Simple ((.=), delay)
import Prelude (($), (>>>), Unit, bind, const, discard, identity, pure, unit)
import Reactix as R
import Reactix.DOM.HTML as H
import Text.Markdown.SlamDown.Parser (parseMd)
import Text.Markdown.SlamDown.Smolder as MD
import Text.Markdown.SlamDown.Syntax (SlamDownP(..))
import Text.Smolder.Renderer.String (render)
import Gargantext.Utils.Reactix as R2
type Props =
( md :: String
, nodeId :: Int
)
compileMd' :: forall e. MD.ToMarkupOptions e -> String -> String
compileMd' options input =
either identity (MD.toMarkup' options >>> render)
(parseMd input :: Either String (SlamDownP String))
compileMd :: String -> String
compileMd = compileMd' MD.defaultToMarkupOptions
markdownEditor :: Record Props -> R.Element
markdownEditor p = R.createElement markdownEditorCpt p []
markdownEditorCpt :: R.Component Props
markdownEditorCpt = R.hooksComponent "G.C.MarkdownEditor" cpt
where
cpt {md, nodeId} _ = do
ref <- R.useRef null
editedMd <- R.useState' md
-- Note: delay is necessary here, otherwise initially the HTML won't get
-- rendered (mDiv is still null)
R.useEffect $ delay unit $ \_ -> do
let mDiv = toMaybe $ R.readRef ref
case mDiv of
Nothing -> pure $ pure unit
Just d -> do
_ <- pure $ (d .= "innerHTML") $ compileMd $ fst editedMd
pure $ pure unit
pure $ H.div { className: "markdown-editor" }
[ H.div { className: "row"}
[ H.div { className: "col-md-5" } [ H.div { ref, className: "html" } []]
, H.div { className: "col-md-5" }
[ H.div { className: "md" }
[ H.textarea { className: "form-control"
, rows: 10
, on: {change: onChange ref editedMd}
} [ H.text $ fst editedMd ]
]
]
]
]
onChange :: forall e. R.Ref (Nullable Element) -> R.State String -> e -> Effect Unit
onChange ref (_ /\ setEditedMd) e = do
setEditedMd $ const value
where
value = R2.unsafeEventValue e
src/Gargantext/Components/Nodes/Corpus.purs
View file @ 212708d7
module Gargantext.Components.Nodes.Corpus where
import Prelude ((<<<))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Array (head)
import Data.Argonaut (class DecodeJson, decodeJson, encodeJson)
import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, throwError)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Corpus.Types
import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session, get)
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..), AffTableResult)
import Gargantext.Utils.Reactix as R2
type Props = (
nodeId :: Int
, session :: Session
)
type Props = ( nodeId :: Int )
type Reload = R.State Int
corpusLayout :: Record Props -> R.Element
corpusLayout props = R.createElement corpusLayoutCpt props []
corpusLayoutCpt :: R.Component Props
corpusLayoutCpt = R.hooksComponent "G.P.Corpus.corpusLayout" cpt
corpusLayoutCpt = R.hooksComponent "G.C.N.C.corpusLayout" cpt
where
cpt {nodeId, session} _ = do
reload <- R.useState' 0
useLoader {nodeId, reload: fst reload, session} loadCorpusWithReload $
\corpus -> corpusLayoutView {corpus, nodeId, reload, session}
type ViewProps = (
corpus :: NodePoly Hyperdata
, reload :: Reload
| Props
)
-- We need FTFields with indices because it's the only way to identify the
-- FTField element inside a component (there are no UUIDs and such)
type Index = Int
type FTFieldWithIndex = Tuple Index FTField
corpusLayoutView :: Record ViewProps -> R.Element
corpusLayoutView props = R.createElement corpusLayoutViewCpt props []
corpusLayoutViewCpt :: R.Component ViewProps
corpusLayoutViewCpt = R.hooksComponent "G.C.N.C.corpusLayoutView" cpt
where
cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields}}), nodeId, reload, session} _ = do
let fieldsWithIndex = A.mapWithIndex (\idx -> \t -> Tuple idx t) fields
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 {} [ fieldsCodeEditor {nodeId, session, fields: fieldsS} ]
, H.div { className: "row" } [
H.div { className: "btn btn-default"
, on: { click: onClickAdd fieldsS }
} [
H.span { className: "glyphicon glyphicon-plus" } [ ]
]
]
]
saveEnabled :: Array FTFieldWithIndex -> R.State (Array FTFieldWithIndex) -> String
saveEnabled fs (fsS /\ _) = if fs == fsS then "disabled" else "enabled"
onClickSave :: forall e. { fields :: R.State (Array FTFieldWithIndex)
, nodeId :: Int
, reload :: R.State Int
, session :: Session } -> e -> Effect Unit
onClickSave {fields: (fieldsS /\ _), nodeId, reload: (_ /\ setReload), session} _ = do
log2 "[corpusLayoutViewCpt] onClickSave fieldsS" fieldsS
launchAff_ do
saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fieldsS}
, nodeId
, session }
liftEffect $ setReload $ (+) 1
onClickAdd :: forall e. R.State (Array FTFieldWithIndex) -> e -> Effect Unit
onClickAdd (_ /\ setFieldsS) _ = do
setFieldsS $ \fieldsS -> A.snoc fieldsS $ Tuple (A.length fieldsS) defaultField
type FieldsCodeEditorProps =
(
fields :: R.State (Array FTFieldWithIndex)
| LoadProps
)
fieldsCodeEditor :: Record FieldsCodeEditorProps -> R.Element
fieldsCodeEditor props = R.createElement fieldsCodeEditorCpt props []
fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
where
cpt {nodeId, fields: fS@(fields /\ _), session} _ = do
pure $ H.div {} $
(\(Tuple idx field) ->
fieldCodeEditorWrapper { canMoveDown: idx < (A.length fields - 1)
, canMoveUp: idx > 0
, field
, onChange: onChange fS idx
, onMoveDown: onMoveDown fS idx
, onMoveUp: onMoveUp fS idx
, onRemove: onRemove fS idx
, onRename: onRename fS idx
}) <$> fields
onChange :: R.State (Array FTFieldWithIndex) -> Index -> FieldType -> Effect Unit
onChange (_ /\ setFields) idx typ = do
setFields $ \fields ->
case A.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields of
Nothing -> fields
Just newFields -> newFields
onMoveDown :: R.State (Array FTFieldWithIndex) -> Index -> Unit -> Effect Unit
onMoveDown (fs /\ setFields) idx _ = do
setFields $ recomputeIndices <<< (GDA.swap idx (idx + 1))
onMoveUp :: R.State (Array FTFieldWithIndex) -> Index -> Unit -> Effect Unit
onMoveUp (_ /\ setFields) idx _ = do
setFields $ recomputeIndices <<< (GDA.swap idx (idx - 1))
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 -> recomputeIndices newFields
onRename :: R.State (Array FTFieldWithIndex) -> Index -> String -> Effect Unit
onRename (_ /\ setFields) idx newName = do
setFields $ \fields ->
case A.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fields of
Nothing -> fields
Just newFields -> newFields
recomputeIndices :: Array FTFieldWithIndex -> Array FTFieldWithIndex
recomputeIndices = A.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t
type FieldCodeEditorProps =
(
canMoveDown :: Boolean
, canMoveUp :: Boolean
, field :: FTField
, onChange :: FieldType -> Effect Unit
, onMoveDown :: Unit -> Effect Unit
, onMoveUp :: Unit -> Effect Unit
, onRemove :: Unit -> Effect Unit
, onRename :: String -> Effect Unit
)
fieldCodeEditorWrapper :: Record FieldCodeEditorProps -> R.Element
fieldCodeEditorWrapper props = R.createElement fieldCodeEditorWrapperCpt props []
fieldCodeEditorWrapperCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorWrapperCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorWrapperCpt" cpt
where
cpt props@{canMoveDown, canMoveUp, field: Field {name, typ}, onMoveDown, onMoveUp, onRemove, onRename} _ = do
pure $ H.div { className: "row panel panel-default" } [
H.div { className: "panel-heading" } [
H.div { className: "code-editor-heading" } [
renameable {onRename, text: name}
, H.div { className: "buttons-right" } [
H.div { className: "btn btn-danger"
, on: { click: \_ -> onRemove unit }
} [
H.span { className: "glyphicon glyphicon-trash" } [ ]
]
]
, moveDownButton canMoveDown
, moveUpButton canMoveUp
]
]
, H.div { className: "panel-body" } [
fieldCodeEditor props
]
]
where
moveDownButton false = H.div {} []
moveDownButton true =
H.div { className: "btn btn-default"
, on: { click: \_ -> onMoveDown unit }
} [
H.span { className: "glyphicon glyphicon-arrow-down" } [ ]
]
moveUpButton false = H.div {} []
moveUpButton true =
H.div { className: "btn btn-default"
, on: { click: \_ -> onMoveUp unit }
} [
H.span { className: "glyphicon glyphicon-arrow-up" } [ ]
]
type RenameableProps =
(
onRename :: String -> Effect Unit
, text :: String
)
renameable :: Record RenameableProps -> R.Element
renameable props = R.createElement renameableCpt props []
renameableCpt :: R.Component RenameableProps
renameableCpt = R.hooksComponent "G.C.N.C.renameableCpt" cpt
where
cpt {nodeId} _ = do
pure $ H.div {}
[
CE.codeEditor {code, defaultCodeType: CE.Markdown, onChange}
--H.iframe { src: gargMd , width: "100%", height: "100%", style: {"border-style": "none"}} []
cpt {onRename, text} _ = do
isEditing <- R.useState' false
state <- R.useState' text
pure $ H.div { className: "renameable" } [
textCpt isEditing onRename state
]
textCpt :: R.State Boolean -> (String -> Effect Unit) -> R.State String -> R.Element
textCpt (false /\ setIsEditing) _ (text /\ _) = H.div {} [
H.span { className: "text" } [ H.text text ]
, H.span { className: "btn btn-default"
, on: { click: \_ -> setIsEditing $ const true } } [
H.span { className: "glyphicon glyphicon-pencil" } []
]
]
textCpt (true /\ setIsEditing) onRename (text /\ setText) = H.div {} [
H.input { defaultValue: text
, className: "form-control text"
, on: { change: \e -> setText $ const $ R2.unsafeEventValue e } }
, H.span { className: "btn btn-default"
, on: { click: \_ -> do
setIsEditing $ const false
onRename text
} } [
H.span { className: "glyphicon glyphicon-save" } []
]
--gargMd = "https://hackmd.iscpif.fr/g9Aah4iwQtCayIzsKQjA0Q#"
code = "# Hello world\n\n## subtitle\n\n- item 1\n- item 2\n\n1. num 1\n2. num 2\n\n[purescript link](https://purescript.org)"
onChange c = do
log2 "[corpusLayoutCpt] c" c
newtype CorpusInfo =
CorpusInfo
{ title :: String
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int }
hyperdataDefault :: CorpusInfo
hyperdataDefault =
CorpusInfo
{ title : "Default title"
, desc : " Default desc"
, query : " Default Query"
, authors : " Author(s): default"
, chart : Nothing
, totalRecords : 0 }
corpusInfoDefault :: NodePoly CorpusInfo
corpusInfoDefault =
NodePoly
{ id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : " Default date"
, hyperdata : hyperdataDefault }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .: "title"
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .:? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly CorpusInfo
, defaultListId :: Int}
loadCorpus :: { session :: Session, nodeId :: Int } -> Aff CorpusData
loadCorpus {session, nodeId: listId} = do
]
fieldCodeEditor :: Record FieldCodeEditorProps -> R.Element
fieldCodeEditor props = R.createElement fieldCodeEditorCpt props []
fieldCodeEditorCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorCpt" cpt
where
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
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
, session :: Session
)
loadCorpus' :: Record LoadProps -> Aff (NodePoly Hyperdata)
loadCorpus' {nodeId, session} = get session $ NodeAPI Corpus (Just nodeId) ""
-- Just to make reloading effective
loadCorpusWithReload :: {reload :: Int | LoadProps} -> Aff (NodePoly Hyperdata)
loadCorpusWithReload {nodeId, session} = loadCorpus' {nodeId, session}
type SaveProps = (
hyperdata :: Hyperdata
| LoadProps
)
saveCorpus :: Record SaveProps -> Aff Unit
saveCorpus {hyperdata, nodeId, session} = do
id_ <- (put session (NodeAPI Corpus (Just nodeId) "") hyperdata) :: Aff Int
pure unit
loadCorpus :: Record LoadProps -> Aff CorpusData
loadCorpus {nodeId, session} = do
-- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- (get session $ defaultListIdsRoute corpusId) :: forall a. DecodeJson a => AffTableResult (NodePoly a)
case (head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a. DecodeJson a => AffTableResult (NodePoly a)
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
Nothing ->
throwError $ error "Missing default list"
where
nodePolyRoute = NodeAPI Corpus (Just nodeId) ""
corpusNodeRoute = NodeAPI Corpus <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
loadCorpusWithChild :: Record LoadProps -> Aff CorpusData
loadCorpusWithChild {nodeId:childId, session} = do
-- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session $ listNodeRoute childId ""
corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a. DecodeJson a => AffTableResult (NodePoly a)
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
Nothing ->
throwError $ error "Missing default list"
where
nodePolyRoute = NodeAPI Corpus (Just listId) ""
corpusNodeRoute = NodeAPI Corpus <<< Just
listNodeRoute = NodeAPI Node <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
src/Gargantext/Components/Nodes/Corpus/Types.purs 0 → 100644
View file @ 212708d7
module Gargantext.Components.Nodes.Corpus.Types where
import Data.Maybe (Maybe(..))
import Data.Array (head)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe)
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly)
type Author = String
type Description = String
type Query = String
type Tag = String
type Title = String
type HaskellCode = String
type MarkdownText = String
newtype Hyperdata =
Hyperdata
{ fields :: Array FTField
}
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
fields <- obj .: "fields"
pure $ Hyperdata {fields}
instance encodeHyperdata :: EncodeJson Hyperdata where
encodeJson (Hyperdata {fields}) = do
"fields" := fields
~> jsonEmptyObject
newtype Field a = Field {
name :: String
, typ :: a
}
type FTField = Field FieldType
derive instance genericFTField :: Generic (Field FieldType) _
instance eqFTField :: Eq (Field FieldType) where
eq = genericEq
data FieldType =
Haskell {
haskell :: HaskellCode
, tag :: Tag
}
| JSON {
authors :: Author
, desc :: Description
, query :: Query
, tag :: Tag
, title :: Title
}
| Markdown {
tag :: Tag
, text :: MarkdownText
}
isJSON :: FieldType -> Boolean
isJSON (JSON _) = true
isJSON _ = false
getCorpusInfo :: Array (Field FieldType) -> CorpusInfo
getCorpusInfo as = case head as of
Just (Field {typ: JSON {authors, desc,query,title}}) -> CorpusInfo { title
, desc
, query
, authors
, chart:Nothing
, totalRecords:0
}
_ -> CorpusInfo { title:"Empty"
, desc:""
, query:""
, authors:""
, chart:Nothing
, totalRecords:0
}
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
eq = genericEq
instance decodeFTField :: DecodeJson (Field FieldType) where
decodeJson json = do
obj <- decodeJson json
name <- obj .: "name"
type_ <- obj .: "type"
data_ <- obj .: "data"
typ <- case type_ of
"Haskell" -> do
haskell <- data_ .: "haskell"
tag <- data_ .: "tag"
pure $ Haskell {haskell, tag}
"JSON" -> do
authors <- data_ .: "authors"
desc <- data_ .: "desc"
query <- data_ .: "query"
tag <- data_ .: "tag"
title <- data_ .: "title"
pure $ JSON {authors, desc, query, tag, title}
"Markdown" -> do
tag <- data_ .: "tag"
text <- data_ .: "text"
pure $ Markdown {tag, text}
_ -> Left $ "Unsupported 'type' " <> type_
pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where
encodeJson (Field {name, typ}) =
"data" := typ
~> "name" := name
~> "type" := typ' typ
~> jsonEmptyObject
where
typ' (Haskell _) = "Haskell"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {haskell}) =
"haskell" := haskell
~> "tag" := "HaskellField"
~> jsonEmptyObject
encodeJson (JSON {authors, desc, query, tag, title}) =
"authors" := authors
~> "desc" := desc
~> "query" := query
~> "tag" := "JsonField"
~> "title" := title
~> jsonEmptyObject
encodeJson (Markdown {text}) =
"tag" := "MarkdownField"
~> "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: defaultMarkdown
}
newtype CorpusInfo =
CorpusInfo
{ title :: String
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .: "title"
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .:? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly Hyperdata -- CorpusInfo
, defaultListId :: Int}
src/Gargantext/Components/Nodes/Lists.purs
View file @ 212708d7
module Gargantext.Components.Nodes.Lists where
import Reactix as R
--------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus (CorpusInfo(..), loadCorpus)
------------------------------------------------------------------------
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..))
import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Prelude
import Gargantext.Sessions (Session)
------------------------------------------------------------------------
------------------------------------------------------------------------
type Props = ( session :: Session, nodeId :: Int )
......@@ -21,12 +22,13 @@ listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponent "G.P.Lists.listsLayout" cpt
where
cpt path@{session} _ =
useLoader path loadCorpus $
useLoader path loadCorpusWithChild $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} ->
let { name, date, hyperdata: CorpusInfo corpus } = poly
{ desc, query, authors: user } = corpus in
let { name, date, hyperdata : Hyperdata h} = poly
CorpusInfo {desc,query,authors} = getCorpusInfo h.fields
in
R.fragment
[ Table.tableHeaderLayout
{ title: "Corpus " <> name, desc, query, user, date }
{ title: "Corpus " <> name, desc, query, user:authors, date }
, Tabs.tabs {session, corpusId, corpusData}]
------------------------------------------------------------------------
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @ 212708d7
......@@ -6,7 +6,7 @@ import Data.Tuple.Nested ((/\))
import Reactix as R
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Corpus (CorpusData)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
......
src/Gargantext/Components/Nodes/Texts.purs
View file @ 212708d7
......@@ -7,18 +7,19 @@ import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
--------------------------------------------------------
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.Loader (loader)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (CorpusData, CorpusInfo(..), loadCorpus)
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..), getCorpusInfo, CorpusInfo(..))
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
--------------------------------------------------------
type Props = ( frontends :: Frontends, session :: Session, nodeId :: Int )
......@@ -29,16 +30,16 @@ textsLayout props = R.createElement textsLayoutCpt props []
textsLayoutCpt :: R.Component Props
textsLayoutCpt = R.hooksComponent "G.C.Nodes.Texts.textsLayout" cpt where
cpt {session,nodeId,frontends} _ = do
pure $ loader {session, nodeId} loadCorpus paint
pure $ loader {session, nodeId} loadCorpusWithChild paint
where
paint corpusData@{corpusId, corpusNode, defaultListId} =
R.fragment [ Table.tableHeaderLayout headerProps, tabs' ]
where
NodePoly { name, date, hyperdata: CorpusInfo corpus } = corpusNode
{desc, query, authors: user} = corpus
NodePoly { name, date, hyperdata: Hyperdata h } = corpusNode
CorpusInfo {desc,query,authors} = getCorpusInfo h.fields
tabs' = tabs {session, corpusId, corpusData, frontends}
title = "Corpus " <> name
headerProps = { title, desc, query, date, user }
headerProps = { title, desc, query, date, user:authors }
data Mode = MoreLikeFav | MoreLikeTrash
......
src/Gargantext/Data/Array.purs
View file @ 212708d7
......@@ -48,3 +48,13 @@ seqCatMaybes = seqMapMaybe identity
-- | Seq misc tools
seqConcatMap :: forall a b. (a -> Seq.Seq b) -> Seq.Seq a -> Seq.Seq b
seqConcatMap = flip bind
-- swap 2 array indices
swap :: forall a. Int -> Int -> Array a -> Array a
swap i j arr = DA.updateAtIndices updates arr
where
updates = case DA.index arr i of
Nothing -> []
Just iEl -> case DA.index arr j of
Nothing -> []
Just jEl -> [ Tuple i jEl, Tuple j iEl ]
src/Gargantext/Utils/HighlightJS.js 0 → 100644
View file @ 212708d7
'use strict';
const hljs = require('highlightjs/highlight.pack.min.js');
function highlightBlock(el) {
hljs.highlightBlock(el);
}
exports._highlightBlock = highlightBlock;
src/Gargantext/Utils/HighlightJS.purs 0 → 100644
View file @ 212708d7
module Gargantext.Utils.HighlightJS where
import DOM.Simple (Element)
import Effect (Effect)
import Effect.Uncurried (EffectFn1, runEffectFn1)
import Gargantext.Prelude
highlightBlock :: Element -> Effect Unit
highlightBlock el = runEffectFn1 _highlightBlock el
foreign import _highlightBlock :: EffectFn1 Element Unit
src/index.html
View file @ 212708d7
......@@ -11,6 +11,7 @@
<link href="styles/bootstrap.min.css" rel="stylesheet">
<link rel="stylesheet" type="text/css" href="styles/context-menu.css"/>
<link rel="stylesheet" type="text/css" href="styles/menu.css"/>
<link rel="stylesheet" type="text/css" href="styles/highlightjs-solarized-light.css"/>
<link href="styles/Graph.css" rel="stylesheet" type="text/css" />
<link href="styles/Login.css" rel="stylesheet" type="text/css" />
<link href="styles/CodeEditor.css" rel="stylesheet" type="text/css" />
......
test/Gargantext/Data/Spec.purs 0 → 100644
View file @ 212708d7
module Gargantext.Data.Spec where
import Prelude
import Data.Array (index)
import Data.Foldable (all)
import Data.Maybe (Maybe(..), isJust)
import Data.String (drop, stripPrefix, Pattern(..))
import Data.Tuple (Tuple(..))
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
import Test.Spec.QuickCheck (quickCheck')
import Gargantext.Data.Array as GDA
spec :: Spec Unit
spec =
describe "G.D.Array" do
it "swap works" do
GDA.swap 1 0 [0, 1, 2] `shouldEqual` [1, 0, 2]
GDA.swap 1 2 [0, 1, 2] `shouldEqual` [0, 2, 1]
yarn.lock
View file @ 212708d7
This source diff could not be displayed because it is too large. You can view the blob instead.
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