Commit 5d5d668f authored by Mudada's avatar Mudada

Merge remote-tracking branch 'origin/0.2.6-dom-simple' into iframe-interaction

parents 77d76224 83b6dd0d
...@@ -637,7 +637,7 @@ ...@@ -637,7 +637,7 @@
"unsafe-coerce" "unsafe-coerce"
], ],
"repo": "https://github.com/irresponsible/purescript-dom-simple", "repo": "https://github.com/irresponsible/purescript-dom-simple",
"version": "v0.2.4" "version": "v0.2.6"
}, },
"dotenv": { "dotenv": {
"dependencies": [ "dependencies": [
...@@ -3336,4 +3336,4 @@ ...@@ -3336,4 +3336,4 @@
"repo": "https://github.com/paf31/purescript-yargs.git", "repo": "https://github.com/paf31/purescript-yargs.git",
"version": "v4.0.0" "version": "v4.0.0"
} }
} }
\ No newline at end of file
.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 { .code-editor .toolbar {
display: flex; display: flex;
justify-content: flex-start; justify-content: flex-start;
...@@ -7,24 +21,101 @@ ...@@ -7,24 +21,101 @@
display: flex; display: flex;
width: 100%; width: 100%;
} }
.code-editor .editor .code { .code-editor .editor .code-area {
flex-grow: 1; 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 { .code-editor .editor .code-area .code-container pre {
background-color: #f7f7f9; background: rgba(0, 0, 0, 0) none repeat scroll 0% 0%;
border: 0px none;
color: #000; color: #000;
display: block; pointer-events: none;
height: 500px; 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 { .code-editor .editor .html {
flex-grow: 2; flex-grow: 2;
margin-left: 25px; margin-left: 25px;
padding-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; list-style: disc !important;
} }
.code-editor .editor .html ol li { .code-editor .editor .html.language-md ol li {
list-style: decimal !important; list-style: decimal !important;
} }
......
@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 .code-editor
.toolbar .toolbar
display: flex display: flex
...@@ -6,20 +38,63 @@ ...@@ -6,20 +38,63 @@
.editor .editor
display: flex display: flex
width: 100% width: 100%
.code .code-area
flex-grow: 1 flex-grow: 1
code max-height: 200px
background-color: #f7f7f9 overflow: auto
color: #000 .code-container
display: block background-color: #fafafa
height: 500px 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 .html
flex-grow: 2 flex-grow: 2
margin-left: 25px margin-left: 25px
padding-left: 25px padding-left: 25px
ul &.language-haskell
li font-family: Fira code,Fira Mono,Consolas,Menlo,Courier,monospace
list-style: disc !important white-space: pre
ol &.language-json
li font-family: Fira code,Fira Mono,Consolas,Menlo,Courier,monospace
list-style: decimal !important white-space: pre
&.language-md
ul
li
list-style: disc !important
ol
li
list-style: decimal !important
...@@ -185,7 +185,7 @@ let additions = ...@@ -185,7 +185,7 @@ let additions =
, "unsafe-coerce" , "unsafe-coerce"
] ]
"https://github.com/irresponsible/purescript-dom-simple" "https://github.com/irresponsible/purescript-dom-simple"
"v0.2.4" "v0.2.6"
, dom-filereader = , dom-filereader =
mkPackage mkPackage
[ "aff", "arraybuffer-types", "web-file", "web-html" ] [ "aff", "arraybuffer-types", "web-file", "web-html" ]
......
...@@ -34,6 +34,7 @@ ...@@ -34,6 +34,7 @@
"spec-quickcheck", "spec-quickcheck",
"string-parsers", "string-parsers",
"strings", "strings",
"stringutils",
"thermite", "thermite",
"tuples-native", "tuples-native",
"uint", "uint",
......
module Gargantext.Components.App where module Gargantext.Components.App where
import Prelude import Prelude
import Data.Array (fromFoldable) import Data.Array (fromFoldable)
import Data.Foldable (intercalate) import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe') import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Data.Lang (Lang(..)) import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Folder (folder)
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout) import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Login (login) import Gargantext.Components.Login (login)
-- import Gargantext.Components.Search.SearchBar as SB
-- import Gargantext.Components.Search.Types (allDatabases)
import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Components.Folder (folder)
import Gargantext.Components.Nodes.Annuaire (annuaireLayout) import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout) import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout) import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout) import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout) import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout) import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Components.Nodes.Home (homeLayout) import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.Router (router) import Gargantext.Router (router)
import Gargantext.Routes (AppRoute(..)) import Gargantext.Routes (AppRoute(..))
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (Sessions, useSessions) import Gargantext.Sessions (Sessions, useSessions)
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
-- TODO (what does this mean?) -- TODO (what does this mean?)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc -- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
...@@ -47,7 +45,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -47,7 +45,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
showLogin <- R.useState' false showLogin <- R.useState' false
showCorpus <- R.useState' false showCorpus <- R.useState' false
let forested = forestLayout frontends (fst sessions) (fst route) (snd showLogin) let forested = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
let mCurrentRoute = fst route let mCurrentRoute = fst route
let backends = fromFoldable defaultBackends let backends = fromFoldable defaultBackends
...@@ -59,7 +57,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -59,7 +57,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
Home -> forested $ homeLayout EN Home -> forested $ homeLayout EN
Login -> login { sessions, backends, visible: showLogin } Login -> login { sessions, backends, visible: showLogin }
Folder sid _ -> withSession sid $ \_ -> forested (folder {}) 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 } Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session } Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
Dashboard sid _nodeId -> withSession sid $ \session -> forested $ dashboardLayout {} Dashboard sid _nodeId -> withSession sid $ \session -> forested $ dashboardLayout {}
...@@ -77,16 +75,16 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -77,16 +75,16 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
simpleLayout $ simpleLayout $
explorerLayout { graphId, mCurrentRoute, session explorerLayout { graphId, mCurrentRoute, session
, sessions: (fst sessions), frontends , sessions: (fst sessions), frontends
, showLogin} , showLogin }
forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element
forestLayout frontends sessions route showLogin child = forestLayout frontends sessions route showLogin child = do
R.fragment [ topBar {}, R2.row [main], footer {} ] R.fragment [ topBar {}, R2.row [main], footer {} ]
where where
main = main =
R.fragment R.fragment
[ H.div {className: "col-md-2", style: {paddingTop: "60px"}} [ H.div {className: "col-md-2", style: {paddingTop: "60px"}}
[ forest {sessions, route, frontends, showLogin} ] [ forest {sessions, route, frontends, showLogin } ]
, mainPage child , mainPage child
] ]
......
...@@ -2,32 +2,33 @@ module Gargantext.Components.CodeEditor where ...@@ -2,32 +2,33 @@ module Gargantext.Components.CodeEditor where
import Data.Argonaut.Parser (jsonParser) import Data.Argonaut.Parser (jsonParser)
import Data.Either (either, Either(..)) 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.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe) 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 Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import Effect (Effect) import Effect (Effect)
import FFI.Simple ((.=), delay) 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 as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Text.Markdown.SlamDown.Parser (parseMd) import Text.Markdown.SlamDown.Parser (parseMd)
import Text.Markdown.SlamDown.Smolder as MD import Text.Markdown.SlamDown.Smolder as MD
import Text.Markdown.SlamDown.Syntax (SlamDownP(..)) import Text.Markdown.SlamDown.Syntax (SlamDownP)
import Text.Smolder.Renderer.String (render) import Text.Smolder.Renderer.String as Smolder
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.HighlightJS as HLJS
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type Code = String type Code = String
type Html = String type Html = String
type Error = String type Error = String
data CodeType = JSON | Markdown data CodeType = Haskell | JSON | Markdown
derive instance genericCodeType :: Generic CodeType _ derive instance genericCodeType :: Generic CodeType _
instance eqCodeType :: Eq CodeType where instance eqCodeType :: Eq CodeType where
eq = genericEq eq = genericEq
...@@ -42,120 +43,182 @@ instance showViewType :: Show ViewType where ...@@ -42,120 +43,182 @@ instance showViewType :: Show ViewType where
show = genericShow show = genericShow
type Props = type Props =
( code :: String ( code :: Code
, defaultCodeType :: CodeType , defaultCodeType :: CodeType
, onChange :: String -> Effect Unit , onChange :: CodeType -> Code -> Effect Unit
) )
compile :: CodeType -> Code -> Either Error Html -- Fixes newlines in code
compile JSON code = result -- 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 where
parsedE = jsonParser code parsedE = jsonParser code
result = case parsedE of result = case parsedE of
Left err -> Left err Left err -> Left err
Right parsed -> Right $ "<pre>" <> (R2.stringify parsed 2) <> "</pre>" Right parsed -> Right $ R2.stringify parsed 2
compile Markdown code = Right $ compileMd code 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? -- TODO Replace with markdown-it?
-- https://pursuit.purescript.org/packages/purescript-markdown-it -- https://pursuit.purescript.org/packages/purescript-markdown-it
compileMd' :: forall e. MD.ToMarkupOptions e -> String -> String renderMd' :: forall e. MD.ToMarkupOptions e -> String -> String
compileMd' options input = renderMd' options input =
either identity (MD.toMarkup' options >>> render) either identity (MD.toMarkup' options >>> Smolder.render)
(parseMd input :: Either String (SlamDownP String)) (parseMd input :: Either String (SlamDownP String))
compileMd :: String -> String renderMd :: String -> String
compileMd = compileMd' MD.defaultToMarkupOptions renderMd = renderMd' MD.defaultToMarkupOptions
renderHaskell :: String -> String
renderHaskell s = s
codeEditor :: Record Props -> R.Element codeEditor :: Record Props -> R.Element
codeEditor p = R.createElement codeEditorCpt p [] 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.Component Props
codeEditorCpt = R.hooksComponent "G.C.CodeEditor" cpt codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt
where where
cpt {code, defaultCodeType, onChange} _ = do cpt {code, defaultCodeType, onChange} _ = do
htmlRef <- R.useRef null controls <- initControls code defaultCodeType
codeRef <- R.useRef null
editorCodeRef <- R.useRef code
codeType <- R.useState' defaultCodeType
error <- R.useState' Nothing
viewType <- R.useState' Both
-- Initial rendering of elements with given data -- Initial rendering of elements with given data
-- Note: delay is necessary here, otherwise initially the HTML won't get -- 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 R.useEffectOnce $ delay unit $ \_ -> do
_ <- renderHtml (fst codeType) code htmlRef error _ <- renderHtml code controls
pure $ pure unit pure $ pure unit
R.useEffectOnce $ delay unit $ \_ -> do R.useEffectOnce $ delay unit $ \_ -> do
let mCodeEl = toMaybe $ R.readRef codeRef _ <- setCodeOverlay controls code
case mCodeEl of pure $ pure unit
Nothing -> pure $ pure unit
Just codeEl -> do
_ <- pure $ (codeEl .= "innerText") code
pure $ pure unit
pure $ H.div { className: "code-editor" } [ pure $ H.div { className: "code-editor" } [
H.div { className: "row toolbar" } [ toolbar {controls, onChange}
codeTypeSelector {codeType, onChange: onChangeCodeType editorCodeRef htmlRef error}
, viewTypeSelector {state: viewType}
]
, H.div { className: "row error" } [ , H.div { className: "row error" } [
errorComponent {error} errorComponent {error: controls.error}
] ]
, H.div { className: "row editor" } [ , H.div { className: "row editor" } [
H.div { className: "code " <> (codeHidden $ fst viewType) } [ H.div { className: "code-area " <> (codeHidden $ fst controls.viewType) } [
H.code { className: "" H.div { className: "code-container" } [
, contentEditable: "true" H.textarea { defaultValue: code
, ref: codeRef , on: { change: onEditChange controls onChange }
, rows: 30 , placeholder: "Type some code..."
, on: { input: onEditChange (fst codeType) codeRef htmlRef editorCodeRef error } , ref: controls.codeElRef } [ ]
} [] , H.pre { className: (langClass $ fst controls.codeType)
] -- , contentEditable: "true"
, H.div { ref: htmlRef, className: "html " <> (previewHidden $ fst viewType) } [] , 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 :: ViewType -> String
codeHidden Code = "" codeHidden Code = ""
codeHidden Both = "" 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 :: ViewType -> String
previewHidden Preview = "" previewHidden Preview = ""
previewHidden Both = "" 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 -- Handle rerendering of preview when viewType changed
onChangeCodeType :: R.Ref String -> R.Ref (Nullable Element) -> R.State (Maybe Error) -> CodeType -> Effect Unit onChangeCodeType :: forall e. Record ToolbarProps -> e -> Effect Unit
onChangeCodeType editorCodeRef htmlRef error codeType = do onChangeCodeType {controls, onChange} _ = do
_ <- renderHtml codeType (R.readRef editorCodeRef) htmlRef error setCodeOverlay controls code
pure unit renderHtml code controls
onChange (fst controls.codeType) code
onEditChange :: forall e. CodeType -> R.Ref (Nullable Element) -> R.Ref (Nullable Element) -> R.Ref String -> R.State (Maybe Error) -> e -> Effect Unit where
onEditChange codeType codeRef htmlRef editorCodeRef error e = do code = R.readRef controls.editorCodeRef
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
type ErrorComponentProps = type ErrorComponentProps =
...@@ -167,7 +230,7 @@ errorComponent :: Record ErrorComponentProps -> R.Element ...@@ -167,7 +230,7 @@ errorComponent :: Record ErrorComponentProps -> R.Element
errorComponent p = R.createElement errorComponentCpt p [] errorComponent p = R.createElement errorComponentCpt p []
errorComponentCpt :: R.Component ErrorComponentProps errorComponentCpt :: R.Component ErrorComponentProps
errorComponentCpt = R.hooksComponent "G.C.ErrorComponent" cpt errorComponentCpt = R.hooksComponent "G.C.CE.ErrorComponent" cpt
where where
cpt {error: (Nothing /\ _)} _ = pure $ H.div {} [] cpt {error: (Nothing /\ _)} _ = pure $ H.div {} []
cpt {error: ((Just error) /\ _)} _ = do cpt {error: ((Just error) /\ _)} _ = do
...@@ -184,14 +247,14 @@ codeTypeSelector :: Record CodeTypeSelectorProps -> R.Element ...@@ -184,14 +247,14 @@ codeTypeSelector :: Record CodeTypeSelectorProps -> R.Element
codeTypeSelector p = R.createElement codeTypeSelectorCpt p [] codeTypeSelector p = R.createElement codeTypeSelectorCpt p []
codeTypeSelectorCpt :: R.Component CodeTypeSelectorProps codeTypeSelectorCpt :: R.Component CodeTypeSelectorProps
codeTypeSelectorCpt = R.hooksComponent "G.C.CodeTypeSelector" cpt codeTypeSelectorCpt = R.hooksComponent "G.C.CE.CodeTypeSelector" cpt
where where
cpt {codeType, onChange} _ = do cpt {codeType, onChange} _ = do
pure $ R2.select { className: "form-control" pure $ R2.select { className: "form-control"
, on: { change: onSelectChange codeType onChange } , on: { change: onSelectChange codeType onChange }
, style: { width: "150px" } , style: { width: "150px" }
, value: show $ fst codeType } , value: show $ fst codeType }
(option <$> [JSON, Markdown]) (option <$> [Haskell, JSON, Markdown])
option :: CodeType -> R.Element option :: CodeType -> R.Element
option value = H.option { value: show value } [ H.text $ show value ] option value = H.option { value: show value } [ H.text $ show value ]
...@@ -199,6 +262,7 @@ codeTypeSelectorCpt = R.hooksComponent "G.C.CodeTypeSelector" cpt ...@@ -199,6 +262,7 @@ codeTypeSelectorCpt = R.hooksComponent "G.C.CodeTypeSelector" cpt
onSelectChange :: forall e. R.State CodeType -> (CodeType -> Effect Unit) -> e -> Effect Unit onSelectChange :: forall e. R.State CodeType -> (CodeType -> Effect Unit) -> e -> Effect Unit
onSelectChange (_ /\ setCodeType) onChange e = do onSelectChange (_ /\ setCodeType) onChange e = do
let codeType = case value of let codeType = case value of
"Haskell" -> Haskell
"JSON" -> JSON "JSON" -> JSON
"Markdown" -> Markdown "Markdown" -> Markdown
_ -> Markdown _ -> Markdown
...@@ -217,7 +281,7 @@ viewTypeSelector :: Record ViewTypeSelectorProps -> R.Element ...@@ -217,7 +281,7 @@ viewTypeSelector :: Record ViewTypeSelectorProps -> R.Element
viewTypeSelector p = R.createElement viewTypeSelectorCpt p [] viewTypeSelector p = R.createElement viewTypeSelectorCpt p []
viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
viewTypeSelectorCpt = R.hooksComponent "G.C.ViewTypeSelector" cpt viewTypeSelectorCpt = R.hooksComponent "G.C.CE.ViewTypeSelector" cpt
where where
cpt {state} _ = cpt {state} _ =
pure $ H.div { className: "btn-group" } [ pure $ H.div { className: "btn-group" } [
...@@ -242,3 +306,34 @@ viewTypeSelectorCpt = R.hooksComponent "G.C.ViewTypeSelector" cpt ...@@ -242,3 +306,34 @@ viewTypeSelectorCpt = R.hooksComponent "G.C.ViewTypeSelector" cpt
icon Preview = "glyphicon-eye-open" icon Preview = "glyphicon-eye-open"
icon Both = "glyphicon-transfer" icon Both = "glyphicon-transfer"
icon Code = "glyphicon-pencil" 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
}
module Gargantext.Components.Forest where module Gargantext.Components.Forest where
import Prelude (const, pure, ($), (<$>)) import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested((/\)) import Data.Set (Set)
import Reactix as R import Data.Set as Set
import Reactix.DOM.HTML as H import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, unSessions) import Gargantext.Sessions (Session(..), Sessions, unSessions)
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
type Props = type Props =
( frontends :: Frontends ( frontends :: Frontends
...@@ -24,13 +29,15 @@ forest props = R.createElement forestCpt props [] ...@@ -24,13 +29,15 @@ forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props forestCpt :: R.Component Props
forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
cpt {frontends, route, sessions, showLogin} _ = R2.useCache (frontends /\ route /\ sessions) (cpt' showLogin) cpt {frontends, route, sessions, showLogin } _ = do
cpt' showLogin (frontends /\ route /\ sessions) = openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: Set TreeId)
R2.useCache (frontends /\ route /\ sessions /\ fst openNodes) (cpt' openNodes showLogin)
cpt' openNodes showLogin (frontends /\ route /\ sessions /\ openNodesState) = do
pure $ R.fragment $ A.cons (plus showLogin) trees pure $ R.fragment $ A.cons (plus showLogin) trees
where where
trees = tree <$> unSessions sessions trees = tree <$> unSessions sessions
tree s@(Session {treeId}) = tree s@(Session {treeId}) =
treeView { root: treeId, frontends, mCurrentRoute: Just route, session: s } treeView { root: treeId, frontends, mCurrentRoute: Just route, session: s, openNodes }
plus :: R2.Setter Boolean -> R.Element plus :: R2.Setter Boolean -> R.Element
plus showLogin = plus showLogin =
......
module Gargantext.Components.Forest.Tree where module Gargantext.Components.Forest.Tree where
import Data.Array as A import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Prelude
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Data.Array as A
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
-- import Data.Newtype (class Newtype) import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan) import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
import Gargantext.Ends (Frontends)
import Gargantext.Components.Loader (loader) import Gargantext.Components.Loader (loader)
import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (AsyncTask(..)) import Gargantext.Types (AsyncTask(..))
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
type Props = ( root :: ID type Props = ( root :: ID
, mCurrentRoute :: Maybe AppRoute , mCurrentRoute :: Maybe AppRoute
, session :: Session , session :: Session
, frontends :: Frontends , frontends :: Frontends
, openNodes :: R.State (Set TreeId)
) )
treeView :: Record Props -> R.Element treeView :: Record Props -> R.Element
...@@ -34,34 +37,50 @@ treeView props = R.createElement treeViewCpt props [] ...@@ -34,34 +37,50 @@ treeView props = R.createElement treeViewCpt props []
treeViewCpt :: R.Component Props treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where where
cpt props _children = do cpt { root, mCurrentRoute, session, frontends, openNodes } _children = do
-- NOTE: this is a hack to reload the tree view on demand -- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload) reload <- R.useState' (0 :: Reload)
pure $ treeLoadView reload props pure $ treeLoadView
{ root, mCurrentRoute, session, frontends, openNodes, reload }
treeLoadView :: R.State Reload -> Record Props -> R.Element
treeLoadView reload p = R.createElement el p [] type Props' = ( root :: ID
, mCurrentRoute :: Maybe AppRoute
, session :: Session
, frontends :: Frontends
, openNodes :: R.State (Set TreeId)
, reload :: R.State Reload
)
treeLoadView :: Record Props' -> R.Element
treeLoadView p = R.createElement treeLoadView' p []
treeLoadView' :: R.Component Props'
treeLoadView' = R.staticComponent "TreeLoadView" cpt
where where
el = R.staticComponent "TreeLoadView" cpt cpt {root, mCurrentRoute, session, frontends, openNodes, reload} _ = do
cpt {root, mCurrentRoute, session, frontends} _ = do
loader root (loadNode session) $ \loaded -> loader root (loadNode session) $ \loaded ->
loadedTreeView reload {tree: loaded, mCurrentRoute, session, frontends} loadedTreeView {tree: loaded, mCurrentRoute, session, frontends, openNodes, reload}
type TreeViewProps = ( tree :: FTree type TreeViewProps = ( tree :: FTree
, mCurrentRoute :: Maybe AppRoute , mCurrentRoute :: Maybe AppRoute
, frontends :: Frontends , frontends :: Frontends
, session :: Session , session :: Session
, openNodes :: R.State (Set TreeId)
, reload :: R.State Reload
) )
loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element
loadedTreeView reload p = R.createElement el p [] loadedTreeView :: Record TreeViewProps -> R.Element
loadedTreeView p = R.createElement loadedTreeView' p []
loadedTreeView' :: R.Component TreeViewProps
loadedTreeView' = R.hooksComponent "LoadedTreeView" cpt
where where
el = R.hooksComponent "LoadedTreeView" cpt cpt {tree, mCurrentRoute, session, frontends, openNodes, reload} _ = do
cpt {tree, mCurrentRoute, session, frontends} _ = do
treeState <- R.useState' {tree, asyncTasks: []} treeState <- R.useState' {tree, asyncTasks: []}
pure $ H.div {className: "tree"} pure $ H.div {className: "tree"}
[ toHtml reload treeState session frontends mCurrentRoute ] [ toHtml reload treeState session frontends mCurrentRoute openNodes ]
------------------------------------------------------------------------ ------------------------------------------------------------------------
toHtml :: R.State Reload toHtml :: R.State Reload
...@@ -69,14 +88,18 @@ toHtml :: R.State Reload ...@@ -69,14 +88,18 @@ toHtml :: R.State Reload
-> Session -> Session
-> Frontends -> Frontends
-> Maybe AppRoute -> Maybe AppRoute
-> R.State (Set TreeId)
-> R.Element -> R.Element
toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asyncTasks} /\ setTreeState) session frontends mCurrentRoute = R.createElement el {} [] toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asyncTasks} /\ setTreeState) session frontends mCurrentRoute openNodes = R.createElement el {} []
where where
el = R.hooksComponent "NodeView" cpt el = R.hooksComponent "NodeView" cpt
pAction = performAction session reload treeState pAction = performAction session reload treeState
cpt props _ = do cpt props _ = do
folderOpen <- R.useState' true let folderIsOpen = Set.member id (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert
let toggleFolderIsOpen _ = (snd openNodes) (setFn id)
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
let withId (NTree (LNode {id: id'}) _) = id' let withId (NTree (LNode {id: id'}) _) = id'
...@@ -89,13 +112,13 @@ toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asy ...@@ -89,13 +112,13 @@ toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asy
, nodeType , nodeType
, onAsyncTaskFinish , onAsyncTaskFinish
} folderOpen session frontends ] } folderOpen session frontends ]
<> childNodes session frontends reload folderOpen mCurrentRoute ary <> childNodes session frontends reload folderOpen mCurrentRoute openNodes ary
) )
] ]
onAsyncTaskFinish (AsyncTask {id}) = setTreeState $ const $ ts { asyncTasks = newAsyncTasks } onAsyncTaskFinish (AsyncTask {id: id_}) = setTreeState $ const $ ts { asyncTasks = newAsyncTasks }
where where
newAsyncTasks = A.filter (\(AsyncTask {id: id'}) -> id /= id') asyncTasks newAsyncTasks = A.filter (\(AsyncTask {id: id'}) -> id_ /= id') asyncTasks
childNodes :: Session childNodes :: Session
...@@ -103,11 +126,12 @@ childNodes :: Session ...@@ -103,11 +126,12 @@ childNodes :: Session
-> R.State Reload -> R.State Reload
-> R.State Boolean -> R.State Boolean
-> Maybe AppRoute -> Maybe AppRoute
-> R.State (Set TreeId)
-> Array FTree -> Array FTree
-> Array R.Element -> Array R.Element
childNodes _ _ _ _ _ [] = [] childNodes _ _ _ _ _ _ [] = []
childNodes _ _ _ (false /\ _) _ _ = [] childNodes _ _ _ (false /\ _) _ _ _ = []
childNodes session frontends reload (true /\ _) mCurrentRoute ary = childNodes session frontends reload (true /\ _) mCurrentRoute openNodes ary =
map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted ary map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted ary
where where
sorted :: Array FTree -> Array FTree sorted :: Array FTree -> Array FTree
...@@ -117,8 +141,7 @@ childNodes session frontends reload (true /\ _) mCurrentRoute ary = ...@@ -117,8 +141,7 @@ childNodes session frontends reload (true /\ _) mCurrentRoute ary =
el = R.hooksComponent "ChildNodeView" cpt el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, asyncTasks} _ = do cpt {tree, asyncTasks} _ = do
treeState <- R.useState' {tree, asyncTasks} treeState <- R.useState' {tree, asyncTasks}
pure $ toHtml reload treeState session frontends mCurrentRoute pure $ toHtml reload treeState session frontends mCurrentRoute openNodes
performAction :: Session performAction :: Session
-> R.State Int -> R.State Int
......
...@@ -20,7 +20,7 @@ data Action = Submit String ...@@ -20,7 +20,7 @@ data Action = Submit String
----------------------------------------------------- -----------------------------------------------------
-- UploadFile Action -- UploadFile Action
-- file upload types -- file upload types
data FileType = CSV | PresseRIS data FileType = CSV | CSV_HAL | PresseRIS
derive instance genericFileType :: Generic FileType _ derive instance genericFileType :: Generic FileType _
...@@ -31,6 +31,7 @@ instance showFileType :: Show FileType where ...@@ -31,6 +31,7 @@ instance showFileType :: Show FileType where
show = genericShow show = genericShow
readFileType :: String -> Maybe FileType readFileType :: String -> Maybe FileType
readFileType "CSV_HAL" = Just CSV_HAL
readFileType "CSV" = Just CSV readFileType "CSV" = Just CSV
readFileType "PresseRIS" = Just PresseRIS readFileType "PresseRIS" = Just PresseRIS
readFileType _ = Nothing readFileType _ = Nothing
......
...@@ -30,7 +30,7 @@ import Gargantext.Ends (Frontends, url) ...@@ -30,7 +30,7 @@ import Gargantext.Ends (Frontends, url)
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (NodeType(..), NodePath(..), fldr, AsyncTask(..)) import Gargantext.Types (AsyncTask, NodePath(..), NodeType(..), fldr)
import Gargantext.Utils (glyphicon, glyphiconActive) import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
......
...@@ -14,6 +14,7 @@ import Gargantext.Routes (SessionRoute(..)) ...@@ -14,6 +14,7 @@ import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (AsyncProgress(..), AsyncTask(..), AsyncTaskStatus(..), NodeType(..), progressPercent) import Gargantext.Types (AsyncProgress(..), AsyncTask(..), AsyncTaskStatus(..), NodeType(..), progressPercent)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
......
...@@ -2,6 +2,7 @@ module Gargantext.Components.GraphExplorer where ...@@ -2,6 +2,7 @@ module Gargantext.Components.GraphExplorer where
import Gargantext.Prelude hiding (max,min) import Gargantext.Prelude hiding (max,min)
import DOM.Simple.Types (Element)
import Data.Array as A import Data.Array as A
import Data.FoldableWithIndex (foldMapWithIndex) import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Int (toNumber) import Data.Int (toNumber)
...@@ -12,13 +13,7 @@ import Data.Sequence as Seq ...@@ -12,13 +13,7 @@ import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst, snd, Tuple(..)) import Data.Tuple (fst, snd, Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Types (Element)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Math (log)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Components.Graph as Graph import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls import Gargantext.Components.GraphExplorer.Controls as Controls
...@@ -35,6 +30,10 @@ import Gargantext.Sessions (Session, Sessions, get) ...@@ -35,6 +30,10 @@ import Gargantext.Sessions (Session, Sessions, get)
import Gargantext.Types as Types import Gargantext.Types as Types
import Gargantext.Utils.Range as Range import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Math (log)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
type GraphId = Int type GraphId = Int
...@@ -70,7 +69,7 @@ explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element ...@@ -70,7 +69,7 @@ explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element
explorerLayoutView graphVersion p = R.createElement el p [] explorerLayoutView graphVersion p = R.createElement el p []
where where
el = R.hooksComponent "G.C.GE.explorerLayoutView" cpt el = R.hooksComponent "G.C.GE.explorerLayoutView" cpt
cpt {frontends, graphId, mCurrentRoute, session, sessions, showLogin} _ = do cpt {frontends, graphId, mCurrentRoute, session, sessions, showLogin } _ = do
useLoader graphId (getNodes session graphVersion) handler useLoader graphId (getNodes session graphVersion) handler
where where
handler loaded = handler loaded =
...@@ -82,7 +81,7 @@ explorerLayoutView graphVersion p = R.createElement el p [] ...@@ -82,7 +81,7 @@ explorerLayoutView graphVersion p = R.createElement el p []
, mMetaData , mMetaData
, session , session
, sessions , sessions
, showLogin} , showLogin }
where (Tuple mMetaData graph) = convert loaded where (Tuple mMetaData graph) = convert loaded
-------------------------------------------------------------- --------------------------------------------------------------
...@@ -92,7 +91,7 @@ explorer props = R.createElement explorerCpt props [] ...@@ -92,7 +91,7 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props explorerCpt :: R.Component Props
explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where where
cpt {frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin} _ = do cpt {frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin } _ = do
dataRef <- R.useRef graph dataRef <- R.useRef graph
graphRef <- R.useRef null graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion) graphVersionRef <- R.useRef (fst graphVersion)
...@@ -167,7 +166,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -167,7 +166,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
-> R.Element -> R.Element
tree false _ _ = RH.div { id: "tree" } [] tree false _ _ = RH.div { id: "tree" } []
tree true {sessions, mCurrentRoute: route, frontends} showLogin = tree true {sessions, mCurrentRoute: route, frontends} showLogin =
RH.div {className: "col-md-2 graph-tree"} [forest {sessions, route, frontends, showLogin}] RH.div {className: "col-md-2 graph-tree"} [forest {sessions, route, frontends, showLogin }]
mSidebar :: Maybe GET.MetaData mSidebar :: Maybe GET.MetaData
-> { frontends :: Frontends -> { frontends :: Frontends
......
...@@ -15,7 +15,6 @@ import Data.Tuple (fst, snd) ...@@ -15,7 +15,6 @@ import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
......
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
module Gargantext.Components.Nodes.Corpus where module Gargantext.Components.Nodes.Corpus where
import Prelude ((<<<)) import Data.Argonaut (class DecodeJson, decodeJson, encodeJson)
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) import Data.Argonaut.Parser (jsonParser)
import Data.Array (head) import Data.Array as A
import Data.Either (Either(..))
import Data.List as List
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2) 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 Effect.Exception (error)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.CodeEditor as CE import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.Node (NodePoly(..), HyperdataList) import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, FTField, Field(..), FieldType(..), Hash, Hyperdata(..), defaultField, defaultHaskell', defaultJSON', defaultMarkdown')
import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI, Children)) import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..), AffTableResult) import Gargantext.Types (NodeType(..), AffTableResult)
import Gargantext.Utils.Crypto as GUC
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 :: Record Props -> R.Element
corpusLayout props = R.createElement corpusLayoutCpt props [] corpusLayout props = R.createElement corpusLayoutCpt props []
corpusLayoutCpt :: R.Component 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
type FTFieldsWithIndex = List.List FTFieldWithIndex
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 = List.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-floppy-disk" } [ ]
]
]
, H.div {} [ fieldsCodeEditor { fields: fieldsS
, nodeId
, session } ]
, H.div { className: "row" } [
H.div { className: "btn btn-default"
, on: { click: onClickAdd fieldsS }
} [
H.span { className: "glyphicon glyphicon-plus" } [ ]
]
]
]
saveEnabled :: FTFieldsWithIndex -> R.State FTFieldsWithIndex -> String
saveEnabled fs (fsS /\ _) = if fs == fsS then "disabled" else "enabled"
onClickSave :: forall e. { fields :: R.State FTFieldsWithIndex
, 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 FTFieldsWithIndex -> e -> Effect Unit
onClickAdd (_ /\ setFieldsS) _ = do
setFieldsS $ \fieldsS -> List.snoc fieldsS $ Tuple (List.length fieldsS) defaultField
type FieldsCodeEditorProps =
(
fields :: R.State FTFieldsWithIndex
| 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 {} $ List.toUnfoldable editors
where
editors = (\idxField@(Tuple idx field) ->
fieldCodeEditorWrapper { canMoveDown: idx < (List.length fields - 1)
, canMoveUp: idx > 0
, field
, hash: hash idxField
, onChange: onChange fS idx
, onMoveDown: onMoveDown fS idx
, onMoveUp: onMoveUp fS idx
, onRemove: onRemove fS idx
, onRename: onRename fS idx
}) <$> fields
onChange :: R.State FTFieldsWithIndex -> Index -> FieldType -> Effect Unit
onChange (_ /\ setFields) idx typ = do
setFields $ \fields ->
case List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields of
Nothing -> fields
Just newFields -> newFields
onMoveDown :: R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onMoveDown (fs /\ setFields) idx _ = do
setFields $ recomputeIndices <<< (GDA.swapList idx (idx + 1))
onMoveUp :: R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onMoveUp (_ /\ setFields) idx _ = do
setFields $ recomputeIndices <<< (GDA.swapList idx (idx - 1))
onRemove :: R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onRemove (_ /\ setFields) idx _ = do
setFields $ \fields ->
case List.deleteAt idx fields of
Nothing -> fields
Just newFields -> recomputeIndices newFields
onRename :: R.State FTFieldsWithIndex -> Index -> String -> Effect Unit
onRename (_ /\ setFields) idx newName = do
setFields $ \fields ->
case List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fields of
Nothing -> fields
Just newFields -> newFields
recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex
recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t
hash :: FTFieldWithIndex -> Hash
hash (Tuple idx f) = GUC.md5 $ "--idx--" <> (show idx) <> "--field--" <> (show f)
type FieldCodeEditorProps =
(
canMoveDown :: Boolean
, canMoveUp :: Boolean
, field :: FTField
, hash :: Hash
, 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}, hash, onMoveDown, onMoveUp, onRemove, onRename} _ = do
pure $ H.div { className: "row panel panel-default hash-" <> hash } [
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 where
cpt {nodeId} _ = do cpt {onRename, text} _ = do
pure $ H.div {} isEditing <- R.useState' false
[ state <- R.useState' text
CE.codeEditor {code, defaultCodeType: CE.Markdown, onChange}
--H.iframe { src: gargMd , width: "100%", height: "100%", style: {"border-style": "none"}} [] pure $ H.div { className: "renameable" } [
textCpt isEditing state
]
where
textCpt :: R.State Boolean -> 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) (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-floppy-disk" } []
]
] ]
--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)" fieldCodeEditor :: Record FieldCodeEditorProps -> R.Element
onChange c = do fieldCodeEditor props = R.createElement fieldCodeEditorCpt props []
log2 "[corpusLayoutCpt] c" c
fieldCodeEditorCpt :: R.Component FieldCodeEditorProps
newtype CorpusInfo = fieldCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorCpt" cpt
CorpusInfo where
{ title :: String cpt {field: Field {typ: typ@(Haskell {haskell})}, onChange} _ = do
, desc :: String pure $ CE.codeEditor {code: haskell, defaultCodeType: CE.Haskell, onChange: changeCode onChange typ}
, query :: String cpt {field: Field {typ: typ@(JSON j)}, onChange} _ = do
, authors :: String pure $ CE.codeEditor {code, defaultCodeType: CE.JSON, onChange: changeCode onChange typ}
, chart :: (Maybe (Array Number)) where
, totalRecords :: Int } code = R2.stringify (encodeJson j) 2
cpt {field: Field {typ: typ@(Markdown {text})}, onChange} _ = do
hyperdataDefault :: CorpusInfo pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: changeCode onChange typ}
hyperdataDefault =
CorpusInfo -- Perofrms the matrix of code type changes
{ title : "Default title" -- (FieldType -> Effect Unit) is the callback function for fields array
, desc : " Default desc" -- FieldType is the current element that we will modify
, query : " Default Query" -- CE.CodeType is the editor code type (might have been the cause of the trigger)
, authors : " Author(s): default" -- CE.Code is the editor code (might have been the cause of the trigger)
, chart : Nothing changeCode :: (FieldType -> Effect Unit) -> FieldType -> CE.CodeType -> CE.Code -> Effect Unit
, totalRecords : 0 } changeCode onc (Haskell hs) CE.Haskell c = onc $ Haskell $ hs { haskell = c }
changeCode onc (Haskell {haskell}) CE.JSON c = onc $ JSON $ defaultJSON' { desc = haskell }
corpusInfoDefault :: NodePoly CorpusInfo changeCode onc (Haskell {haskell}) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = haskell }
corpusInfoDefault = changeCode onc (JSON j@{desc}) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = haskell }
NodePoly where
{ id : 0 haskell = R2.stringify (encodeJson j) 2
, typename : 0 changeCode onc (JSON j) CE.JSON c = do
, userId : 0 case jsonParser c of
, parentId : 0 Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
, name : "Default name" Right j' -> case decodeJson j' of
, date : " Default date" Left err -> log2 "[fieldCodeEditor'] cannot decode json" j'
, hyperdata : hyperdataDefault } Right j'' -> onc $ JSON j''
changeCode onc (JSON j) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = text }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where where
decodeJson json = do text = R2.stringify (encodeJson j) 2
obj <- decodeJson json changeCode onc (Markdown md) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = c }
title <- obj .: "title" changeCode onc (Markdown md) CE.JSON c = onc $ Markdown $ defaultMarkdown' { text = c }
desc <- obj .: "desc" changeCode onc (Markdown md) CE.Markdown c = onc $ Markdown $ md { text = c }
query <- obj .: "query"
authors <- obj .: "authors" type LoadProps = (
chart <- obj .:? "chart" nodeId :: Int
let totalRecords = 47361 -- TODO , session :: Session
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords} )
type CorpusData = { corpusId :: Int loadCorpus' :: Record LoadProps -> Aff (NodePoly Hyperdata)
, corpusNode :: NodePoly CorpusInfo loadCorpus' {nodeId, session} = get session $ NodeAPI Corpus (Just nodeId) ""
, defaultListId :: Int}
-- Just to make reloading effective
loadCorpus :: { session :: Session, nodeId :: Int } -> Aff CorpusData loadCorpusWithReload :: {reload :: Int | LoadProps} -> Aff (NodePoly Hyperdata)
loadCorpus {session, nodeId: listId} = do 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 -- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute (NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
corpusNode <- get session $ corpusNodeRoute corpusId "" corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- (get session $ defaultListIdsRoute corpusId) :: forall a. DecodeJson a => AffTableResult (NodePoly a) defaultListIds <- (get session $ defaultListIdsRoute corpusId)
case (head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of :: 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 }) -> Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId} pure {corpusId, corpusNode, defaultListId}
Nothing -> Nothing ->
throwError $ error "Missing default list" throwError $ error "Missing default list"
where where
nodePolyRoute = NodeAPI Corpus (Just listId) ""
corpusNodeRoute = NodeAPI Corpus <<< Just corpusNodeRoute = NodeAPI Corpus <<< Just
listNodeRoute = NodeAPI Node <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
module Gargantext.Components.Nodes.Corpus.Types where
import Data.Maybe (Maybe(..))
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.Generic.Rep.Show (genericShow)
import Data.List as List
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
type Hash = String
newtype Hyperdata =
Hyperdata
{
fields :: List.List 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
instance showFTField :: Show (Field FieldType) where
show = genericShow
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 :: List.List (Field FieldType) -> CorpusInfo
getCorpusInfo as = case List.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 showFieldType :: Show FieldType where
show = genericShow
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}
module Gargantext.Components.Nodes.Lists where module Gargantext.Components.Nodes.Lists where
import Reactix as R import Reactix as R
-------------------------------------------------------- ------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus (CorpusInfo(..), loadCorpus)
import Gargantext.Components.Node (NodePoly(..)) 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.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Lists.Tabs as Tabs import Gargantext.Prelude
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
type Props = ( session :: Session, nodeId :: Int ) type Props = ( session :: Session, nodeId :: Int )
...@@ -21,12 +22,13 @@ listsLayoutCpt :: R.Component Props ...@@ -21,12 +22,13 @@ listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponent "G.P.Lists.listsLayout" cpt listsLayoutCpt = R.hooksComponent "G.P.Lists.listsLayout" cpt
where where
cpt path@{session} _ = cpt path@{session} _ =
useLoader path loadCorpus $ useLoader path loadCorpusWithChild $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} -> \corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} ->
let { name, date, hyperdata: CorpusInfo corpus } = poly let { name, date, hyperdata : Hyperdata h} = poly
{ desc, query, authors: user } = corpus in CorpusInfo {desc,query,authors} = getCorpusInfo h.fields
in
R.fragment R.fragment
[ Table.tableHeaderLayout [ Table.tableHeaderLayout
{ title: "Corpus " <> name, desc, query, user, date } { title: "Corpus " <> name, desc, query, user:authors, date }
, Tabs.tabs {session, corpusId, corpusData}] , Tabs.tabs {session, corpusId, corpusData}]
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -6,7 +6,7 @@ import Data.Tuple.Nested ((/\)) ...@@ -6,7 +6,7 @@ import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab 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.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
......
...@@ -7,18 +7,19 @@ import Data.Maybe (Maybe(..)) ...@@ -7,18 +7,19 @@ import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
-------------------------------------------------------- --------------------------------------------------------
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.Loader (loader) import Gargantext.Components.Loader (loader)
import Gargantext.Components.Node (NodePoly(..)) 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.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..), getCorpusInfo, CorpusInfo(..))
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..)) import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
--------------------------------------------------------
type Props = ( frontends :: Frontends, session :: Session, nodeId :: Int ) type Props = ( frontends :: Frontends, session :: Session, nodeId :: Int )
...@@ -29,16 +30,16 @@ textsLayout props = R.createElement textsLayoutCpt props [] ...@@ -29,16 +30,16 @@ textsLayout props = R.createElement textsLayoutCpt props []
textsLayoutCpt :: R.Component Props textsLayoutCpt :: R.Component Props
textsLayoutCpt = R.hooksComponent "G.C.Nodes.Texts.textsLayout" cpt where textsLayoutCpt = R.hooksComponent "G.C.Nodes.Texts.textsLayout" cpt where
cpt {session,nodeId,frontends} _ = do cpt {session,nodeId,frontends} _ = do
pure $ loader {session, nodeId} loadCorpus paint pure $ loader {session, nodeId} loadCorpusWithChild paint
where where
paint corpusData@{corpusId, corpusNode, defaultListId} = paint corpusData@{corpusId, corpusNode, defaultListId} =
R.fragment [ Table.tableHeaderLayout headerProps, tabs' ] R.fragment [ Table.tableHeaderLayout headerProps, tabs' ]
where where
NodePoly { name, date, hyperdata: CorpusInfo corpus } = corpusNode NodePoly { name, date, hyperdata: Hyperdata h } = corpusNode
{desc, query, authors: user} = corpus CorpusInfo {desc,query,authors} = getCorpusInfo h.fields
tabs' = tabs {session, corpusId, corpusData, frontends} tabs' = tabs {session, corpusId, corpusData, frontends}
title = "Corpus " <> name title = "Corpus " <> name
headerProps = { title, desc, query, date, user } headerProps = { title, desc, query, date, user:authors }
data Mode = MoreLikeFav | MoreLikeTrash data Mode = MoreLikeFav | MoreLikeTrash
......
...@@ -2,10 +2,11 @@ module Gargantext.Data.Array ...@@ -2,10 +2,11 @@ module Gargantext.Data.Array
where where
import Data.Array as DA import Data.Array as DA
import Data.List as List
import Data.Maybe import Data.Maybe
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Prelude (bind, flip, identity, (<<<)) import Prelude (bind, flip, identity, (<<<), ($))
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | Split arrays tools -- | Split arrays tools
...@@ -48,3 +49,19 @@ seqCatMaybes = seqMapMaybe identity ...@@ -48,3 +49,19 @@ seqCatMaybes = seqMapMaybe identity
-- | Seq misc tools -- | Seq misc tools
seqConcatMap :: forall a b. (a -> Seq.Seq b) -> Seq.Seq a -> Seq.Seq b seqConcatMap :: forall a b. (a -> Seq.Seq b) -> Seq.Seq a -> Seq.Seq b
seqConcatMap = flip bind 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 ]
swapList :: forall a. Int -> Int -> List.List a -> List.List a
swapList i j seq = List.fromFoldable $ swap i j $ List.toUnfoldable seq
swapSeq :: forall a. Int -> Int -> Seq.Seq a -> Seq.Seq a
swapSeq i j seq = Seq.fromFoldable $ swap i j $ Seq.toUnfoldable seq
-- | A module for authenticating to create sessions and handling them -- | A module for authenticating to create sessions and handling them
module Gargantext.Sessions where module Gargantext.Sessions where
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind) import DOM.Simple.Console (log2)
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:)) import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify) import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify)
import Data.Argonaut.Parser (jsonParser) import Data.Argonaut.Parser (jsonParser)
import Data.Array as A import Data.Array as A
import Data.Traversable (traverse)
import DOM.Simple.Console (log2)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Sequence (Seq) import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Traversable (traverse)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Gargantext.Components.Login.Types (AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..))
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (Storage, getItem, setItem, removeItem)
import Gargantext.Components.Login.Types
(AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..))
import Gargantext.Config.REST as REST import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath) import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath)
import Gargantext.Routes (SessionRoute) import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath) import Gargantext.Types (NodePath, SessionId(..), nodePath)
import Gargantext.Utils.Reactix (getls)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind)
import Reactix as R
import Web.Storage.Storage (getItem, removeItem, setItem)
-- | A Session represents an authenticated session for a user at a -- | A Session represents an authenticated session for a user at a
...@@ -228,6 +226,3 @@ postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just tok ...@@ -228,6 +226,3 @@ postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just tok
postMultipartFormData :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> String -> Aff b postMultipartFormData :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> String -> Aff b
postMultipartFormData session@(Session {token}) p = REST.postMultipartFormData (Just token) (toUrl session p) postMultipartFormData session@(Session {token}) p = REST.postMultipartFormData (Just token) (toUrl session p)
getls :: Effect Storage
getls = window >>= localStorage
'use strict';
// http://www.myersdaily.org/joseph/javascript/md5.js
function md5cycle(x, k) {
var a = x[0], b = x[1], c = x[2], d = x[3];
a = ff(a, b, c, d, k[0], 7, -680876936);
d = ff(d, a, b, c, k[1], 12, -389564586);
c = ff(c, d, a, b, k[2], 17, 606105819);
b = ff(b, c, d, a, k[3], 22, -1044525330);
a = ff(a, b, c, d, k[4], 7, -176418897);
d = ff(d, a, b, c, k[5], 12, 1200080426);
c = ff(c, d, a, b, k[6], 17, -1473231341);
b = ff(b, c, d, a, k[7], 22, -45705983);
a = ff(a, b, c, d, k[8], 7, 1770035416);
d = ff(d, a, b, c, k[9], 12, -1958414417);
c = ff(c, d, a, b, k[10], 17, -42063);
b = ff(b, c, d, a, k[11], 22, -1990404162);
a = ff(a, b, c, d, k[12], 7, 1804603682);
d = ff(d, a, b, c, k[13], 12, -40341101);
c = ff(c, d, a, b, k[14], 17, -1502002290);
b = ff(b, c, d, a, k[15], 22, 1236535329);
a = gg(a, b, c, d, k[1], 5, -165796510);
d = gg(d, a, b, c, k[6], 9, -1069501632);
c = gg(c, d, a, b, k[11], 14, 643717713);
b = gg(b, c, d, a, k[0], 20, -373897302);
a = gg(a, b, c, d, k[5], 5, -701558691);
d = gg(d, a, b, c, k[10], 9, 38016083);
c = gg(c, d, a, b, k[15], 14, -660478335);
b = gg(b, c, d, a, k[4], 20, -405537848);
a = gg(a, b, c, d, k[9], 5, 568446438);
d = gg(d, a, b, c, k[14], 9, -1019803690);
c = gg(c, d, a, b, k[3], 14, -187363961);
b = gg(b, c, d, a, k[8], 20, 1163531501);
a = gg(a, b, c, d, k[13], 5, -1444681467);
d = gg(d, a, b, c, k[2], 9, -51403784);
c = gg(c, d, a, b, k[7], 14, 1735328473);
b = gg(b, c, d, a, k[12], 20, -1926607734);
a = hh(a, b, c, d, k[5], 4, -378558);
d = hh(d, a, b, c, k[8], 11, -2022574463);
c = hh(c, d, a, b, k[11], 16, 1839030562);
b = hh(b, c, d, a, k[14], 23, -35309556);
a = hh(a, b, c, d, k[1], 4, -1530992060);
d = hh(d, a, b, c, k[4], 11, 1272893353);
c = hh(c, d, a, b, k[7], 16, -155497632);
b = hh(b, c, d, a, k[10], 23, -1094730640);
a = hh(a, b, c, d, k[13], 4, 681279174);
d = hh(d, a, b, c, k[0], 11, -358537222);
c = hh(c, d, a, b, k[3], 16, -722521979);
b = hh(b, c, d, a, k[6], 23, 76029189);
a = hh(a, b, c, d, k[9], 4, -640364487);
d = hh(d, a, b, c, k[12], 11, -421815835);
c = hh(c, d, a, b, k[15], 16, 530742520);
b = hh(b, c, d, a, k[2], 23, -995338651);
a = ii(a, b, c, d, k[0], 6, -198630844);
d = ii(d, a, b, c, k[7], 10, 1126891415);
c = ii(c, d, a, b, k[14], 15, -1416354905);
b = ii(b, c, d, a, k[5], 21, -57434055);
a = ii(a, b, c, d, k[12], 6, 1700485571);
d = ii(d, a, b, c, k[3], 10, -1894986606);
c = ii(c, d, a, b, k[10], 15, -1051523);
b = ii(b, c, d, a, k[1], 21, -2054922799);
a = ii(a, b, c, d, k[8], 6, 1873313359);
d = ii(d, a, b, c, k[15], 10, -30611744);
c = ii(c, d, a, b, k[6], 15, -1560198380);
b = ii(b, c, d, a, k[13], 21, 1309151649);
a = ii(a, b, c, d, k[4], 6, -145523070);
d = ii(d, a, b, c, k[11], 10, -1120210379);
c = ii(c, d, a, b, k[2], 15, 718787259);
b = ii(b, c, d, a, k[9], 21, -343485551);
x[0] = add32(a, x[0]);
x[1] = add32(b, x[1]);
x[2] = add32(c, x[2]);
x[3] = add32(d, x[3]);
}
function cmn(q, a, b, x, s, t) {
a = add32(add32(a, q), add32(x, t));
return add32((a << s) | (a >>> (32 - s)), b);
}
function ff(a, b, c, d, x, s, t) {
return cmn((b & c) | ((~b) & d), a, b, x, s, t);
}
function gg(a, b, c, d, x, s, t) {
return cmn((b & d) | (c & (~d)), a, b, x, s, t);
}
function hh(a, b, c, d, x, s, t) {
return cmn(b ^ c ^ d, a, b, x, s, t);
}
function ii(a, b, c, d, x, s, t) {
return cmn(c ^ (b | (~d)), a, b, x, s, t);
}
function md51(s) {
var txt = '';
var n = s.length,
state = [1732584193, -271733879, -1732584194, 271733878], i;
for (i=64; i<=s.length; i+=64) {
md5cycle(state, md5blk(s.substring(i-64, i)));
}
s = s.substring(i-64);
var tail = [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0];
for (i=0; i<s.length; i++)
tail[i>>2] |= s.charCodeAt(i) << ((i%4) << 3);
tail[i>>2] |= 0x80 << ((i%4) << 3);
if (i > 55) {
md5cycle(state, tail);
for (i=0; i<16; i++) tail[i] = 0;
}
tail[14] = n*8;
md5cycle(state, tail);
return state;
}
/* there needs to be support for Unicode here,
* unless we pretend that we can redefine the MD-5
* algorithm for multi-byte characters (perhaps
* by adding every four 16-bit characters and
* shortening the sum to 32 bits). Otherwise
* I suggest performing MD-5 as if every character
* was two bytes--e.g., 0040 0025 = @%--but then
* how will an ordinary MD-5 sum be matched?
* There is no way to standardize text to something
* like UTF-8 before transformation; speed cost is
* utterly prohibitive. The JavaScript standard
* itself needs to look at this: it should start
* providing access to strings as preformed UTF-8
* 8-bit unsigned value arrays.
*/
function md5blk(s) { /* I figured global was faster. */
var md5blks = [], i; /* Andy King said do it this way. */
for (i=0; i<64; i+=4) {
md5blks[i>>2] = s.charCodeAt(i)
+ (s.charCodeAt(i+1) << 8)
+ (s.charCodeAt(i+2) << 16)
+ (s.charCodeAt(i+3) << 24);
}
return md5blks;
}
var hex_chr = '0123456789abcdef'.split('');
function rhex(n)
{
var s='', j=0;
for(; j<4; j++)
s += hex_chr[(n >> (j * 8 + 4)) & 0x0F]
+ hex_chr[(n >> (j * 8)) & 0x0F];
return s;
}
function hex(x) {
for (var i=0; i<x.length; i++)
x[i] = rhex(x[i]);
return x.join('');
}
function md5(s) {
return hex(md51(s));
}
/* this function is much faster,
so if possible we use it. Some IEs
are the only ones I know of that
need the idiotic second function,
generated by an if clause. */
function add32(a, b) {
return (a + b) & 0xFFFFFFFF;
}
/*
if (md5('hello') != '5d41402abc4b2a76b9719d911017c592') {
function add32(x, y) {
var lsw = (x & 0xFFFF) + (y & 0xFFFF),
msw = (x >> 16) + (y >> 16) + (lsw >> 16);
return (msw << 16) | (lsw & 0xFFFF);
}
}
*/
exports.md5 = md5;
module Gargantext.Utils.Crypto where
foreign import md5 :: String -> String
'use strict';
const hljs = require('highlightjs/highlight.pack.min.js');
function highlightBlock(el) {
hljs.highlightBlock(el);
}
exports._highlightBlock = highlightBlock;
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
...@@ -2,23 +2,27 @@ module Gargantext.Utils.Reactix where ...@@ -2,23 +2,27 @@ module Gargantext.Utils.Reactix where
import Prelude 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 as DOM
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import DOM.Simple.Document (document) import DOM.Simple.Document (document)
import DOM.Simple.Element as Element import DOM.Simple.Element as Element
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import DOM.Simple.Types (class IsNode) import DOM.Simple.Types (class IsNode)
import Data.Argonaut as Argonaut
import Data.Argonaut as Json
import Data.Argonaut.Core (Json)
import Data.Either (hush)
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber) import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Effect.Uncurried (EffectFn1, runEffectFn1, mkEffectFn1, EffectFn2, runEffectFn2, mkEffectFn2) import Effect.Uncurried (EffectFn1, mkEffectFn1, mkEffectFn2, runEffectFn1)
import Effect.Unsafe (unsafePerformEffect)
import FFI.Simple ((..), (...), defineProperty, delay, args2, args3) import FFI.Simple ((..), (...), defineProperty, delay, args2, args3)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (class ReactPropFields, Children, ReactClass, ReactElement) import React (class ReactPropFields, Children, ReactClass, ReactElement)
...@@ -32,6 +36,9 @@ import Reactix.Utils (currySecond, hook, tuple) ...@@ -32,6 +36,9 @@ import Reactix.Utils (currySecond, hook, tuple)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Web.File.File (toBlob) import Web.File.File (toBlob)
import Web.File.FileList (FileList, item) import Web.File.FileList (FileList, item)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (Storage, getItem, setItem)
newtype Point = Point { x :: Number, y :: Number } newtype Point = Point { x :: Number, y :: Number }
...@@ -249,3 +256,30 @@ stringify :: Json -> Int -> String ...@@ -249,3 +256,30 @@ stringify :: Json -> Int -> String
stringify j indent = runFn2 _stringify j indent stringify j indent = runFn2 _stringify j indent
foreign import _stringify :: Fn2 Json Int String foreign import _stringify :: Fn2 Json Int String
getls :: Effect Storage
getls = window >>= localStorage
openNodesKey :: LocalStorageKey
openNodesKey = "garg-open-nodes"
type LocalStorageKey = String
useLocalStorageState :: forall s. Argonaut.DecodeJson s => Argonaut.EncodeJson s => LocalStorageKey -> s -> R.Hooks (R.State s)
useLocalStorageState key s = do
-- we need to synchronously get the initial state from local storage
Tuple state setState' <- R.useState \_ -> unsafePerformEffect do
item :: Maybe String <- getItem key =<< getls
let json = hush <<< Argonaut.jsonParser =<< item
let parsed = hush <<< Argonaut.decodeJson =<< json
pure $ fromMaybe s parsed
let
setState update = do
let new = update state
setState' (\_ -> new)
let json = Json.stringify $ Argonaut.encodeJson new
storage <- getls
setItem key json storage
pure (Tuple state setState)
...@@ -11,6 +11,7 @@ ...@@ -11,6 +11,7 @@
<link href="styles/bootstrap.min.css" rel="stylesheet"> <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/context-menu.css"/>
<link rel="stylesheet" type="text/css" href="styles/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/Graph.css" rel="stylesheet" type="text/css" />
<link href="styles/Login.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" /> <link href="styles/CodeEditor.css" rel="stylesheet" type="text/css" />
......
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]
...@@ -6,8 +6,9 @@ import Data.Foldable (all) ...@@ -6,8 +6,9 @@ import Data.Foldable (all)
import Data.Maybe (Maybe(..), isJust) import Data.Maybe (Maybe(..), isJust)
import Data.String (drop, stripPrefix, Pattern(..)) import Data.String (drop, stripPrefix, Pattern(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Utils as U import Gargantext.Utils as GU
import Gargantext.Utils.Math as UM import Gargantext.Utils.Crypto as GUC
import Gargantext.Utils.Math as GUM
-- import Test.QuickCheck ((===), (/==), (<?>), Result(..)) -- import Test.QuickCheck ((===), (/==), (<?>), Result(..))
import Test.Spec (Spec, describe, it) import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual) import Test.Spec.Assertions (shouldEqual)
...@@ -17,21 +18,25 @@ spec :: Spec Unit ...@@ -17,21 +18,25 @@ spec :: Spec Unit
spec = spec =
describe "G.Utils" do describe "G.Utils" do
it "zeroPad 1 works" do it "zeroPad 1 works" do
U.zeroPad 1 0 `shouldEqual` "0" GU.zeroPad 1 0 `shouldEqual` "0"
U.zeroPad 1 1 `shouldEqual` "1" GU.zeroPad 1 1 `shouldEqual` "1"
U.zeroPad 1 10 `shouldEqual` "10" GU.zeroPad 1 10 `shouldEqual` "10"
it "zeroPad 2 works" do it "zeroPad 2 works" do
U.zeroPad 2 0 `shouldEqual` "00" GU.zeroPad 2 0 `shouldEqual` "00"
U.zeroPad 2 1 `shouldEqual` "01" GU.zeroPad 2 1 `shouldEqual` "01"
U.zeroPad 2 10 `shouldEqual` "10" GU.zeroPad 2 10 `shouldEqual` "10"
U.zeroPad 2 100 `shouldEqual` "100" GU.zeroPad 2 100 `shouldEqual` "100"
it "zeroPad 3 works" do it "zeroPad 3 works" do
U.zeroPad 3 0 `shouldEqual` "000" GU.zeroPad 3 0 `shouldEqual` "000"
U.zeroPad 3 1 `shouldEqual` "001" GU.zeroPad 3 1 `shouldEqual` "001"
U.zeroPad 3 10 `shouldEqual` "010" GU.zeroPad 3 10 `shouldEqual` "010"
U.zeroPad 3 99 `shouldEqual` "099" GU.zeroPad 3 99 `shouldEqual` "099"
U.zeroPad 3 100 `shouldEqual` "100" GU.zeroPad 3 100 `shouldEqual` "100"
U.zeroPad 3 101 `shouldEqual` "101" GU.zeroPad 3 101 `shouldEqual` "101"
U.zeroPad 3 1000 `shouldEqual` "1000" GU.zeroPad 3 1000 `shouldEqual` "1000"
it "log10 10" do it "log10 10" do
UM.log10 10.0 `shouldEqual` 1.0 GUM.log10 10.0 `shouldEqual` 1.0
it "md5 works" do
let text = "The quick brown fox jumps over the lazy dog"
let textMd5 = "9e107d9d372bb6826bd81d3542a419d6"
GUC.md5 text `shouldEqual` textMd5
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