Merge branch 'master' into iframe-interaction

.psc-package/local/.set/packages.json

@@ -1475,6 +1475,21 @@
     "repo": "https://github.com/justinwoo/purescript-makkori.git",
     "version": "v1.0.0"
   },
+  "markdown": {
+    "dependencies": [
+      "precise"
+    ],
+    "repo": "https://github.com/poorscript/purescript-markdown",
+    "version": "master"
+  },
+  "markdown-smolder": {
+    "dependencies": [
+      "markdown",
+      "smolder"
+    ],
+    "repo": "https://github.com/poorscript/purescript-markdown-smolder",
+    "version": "master"
+  },
   "math": {
     "dependencies": [],
     "repo": "https://github.com/purescript/purescript-math.git",
@@ -2041,6 +2056,13 @@
     "repo": "https://github.com/purescript-node/purescript-posix-types.git",
     "version": "v4.0.0"
   },
+  "precise": {
+    "dependencies": [
+      "prelude"
+    ],
+    "repo": "https://github.com/purescript-contrib/purescript-precise",
+    "version": "master"
+  },
   "prelude": {
     "dependencies": [],
     "repo": "https://github.com/purescript/purescript-prelude.git",

dist/styles/CodeEditor.css

+.code-editor .toolbar {
+  display: flex;
+  justify-content: flex-start;
+  width: 100%;
+}
+.code-editor .editor {
+  display: flex;
+  width: 100%;
+}
+.code-editor .editor .code {
+  flex-grow: 1;
+}
+.code-editor .editor .code code {
+  background-color: #f7f7f9;
+  color: #000;
+  display: block;
+  height: 500px;
+}
+.code-editor .editor .html {
+  flex-grow: 2;
+  margin-left: 25px;
+  padding-left: 25px;
+}
+.code-editor .editor .html ul li {
+  list-style: disc !important;
+}
+.code-editor .editor .html ol li {
+  list-style: decimal !important;
+}
+
+/*# sourceMappingURL=CodeEditor.css.map */

dist/styles/CodeEditor.sass

+.code-editor
+  .toolbar
+    display: flex
+    justify-content: flex-start
+    width: 100%
+  .editor
+    display: flex
+    width: 100%
+    .code
+      flex-grow: 1
+      code
+        background-color: #f7f7f9
+        color: #000
+        display: block
+        height: 500px
+    .html
+      flex-grow: 2
+      margin-left: 25px
+      padding-left: 25px
+      ul
+        li
+          list-style: disc !important
+      ol
+        li
+          list-style: decimal !important

package.json

@@ -4,6 +4,7 @@
         "rebuild-set": "spago psc-package-insdhall",
         "install-ps": "psc-package install",
         "compile": "pulp --psc-package build",
+        "prebuild": "yarn compile",
         "build": "pulp --psc-package browserify -t dist/bundle.js",
         "sass": "sass dist/styles/",
         "predev": "yarn prestart",
@@ -50,7 +51,8 @@
         "psc": "^0.1.1",
         "psc-package": "^3.0.1",
         "pulp": "^13.0.0",
-        "purescript": "^0.13.5",
+        "purescript": "^0.13.6",
+        "purescript-language-server": "^0.12.7",
         "purs-loader": "^3.3.0",
         "react-testing-library": "^6.1.2",
         "sass": "^1.23.7",
@@ -59,6 +61,7 @@
         "style-loader": "^0.23.1",
         "uglify-js": "^3.4.9",
         "uglifyify": "^5.0.1",
+        "vscode-languageserver": "^6.0.0",
         "webpack": "^4.26.0",
         "webpack-cli": "^3.1.2",
         "webpack-dev-server": "^3.1.10",

packages.dhall

@@ -191,6 +191,27 @@ let additions =
           [ "aff", "arraybuffer-types", "web-file", "web-html" ]
           "https://github.com/nwolverson/purescript-dom-filereader"
           "v5.0.0"
+      , markdown =
+          mkPackage
+          [ "precise" ]
+          {- "https://github.com/slamdata/purescript-markdown"
+          "v12.0.0" -}
+          "https://github.com/poorscript/purescript-markdown"
+          "master"
+      , markdown-smolder =
+          mkPackage
+          [ "markdown"
+          , "smolder" ]
+          {- "https://github.com/hgiasac/purescript-markdown-smolder"
+          "v2.0.1" -}
+          "https://github.com/poorscript/purescript-markdown-smolder"
+          "master"
+      , precise =
+          mkPackage
+          [ "prelude" ]
+          "https://github.com/purescript-contrib/purescript-precise"
+          {- "v3.0.1" -}
+          "master"
       , reactix =
           mkPackage
           [ "aff"

psc-package.json

@@ -17,6 +17,7 @@
     "globals",
     "integers",
     "js-timers",
+    "markdown-smolder",
     "math",
     "maybe",
     "nonempty",
@@ -28,6 +29,7 @@
     "read",
     "routing",
     "sequences",
+    "smolder",
     "spec-discovery",
     "spec-quickcheck",
     "string-parsers",

src/Gargantext/Components/App.purs

@@ -44,7 +44,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
   cpt _ _ = do
     sessions   <- useSessions
     route      <- useHashRouter router Home
-    
+
     showLogin  <- R.useState' false
     showCorpus <- R.useState' false
     

src/Gargantext/Components/CodeEditor.purs

+module Gargantext.Components.CodeEditor where
+
+import Data.Argonaut.Parser (jsonParser)
+import Data.Either (either, Either(..))
+import Data.Maybe (Maybe(..))
+import Data.Nullable (Nullable, null, toMaybe)
+import Data.Tuple (fst, snd)
+import Data.Tuple.Nested ((/\))
+import DOM.Simple.Console (log, log2)
+import DOM.Simple.Types (Element)
+import Effect (Effect)
+import FFI.Simple ((.=), delay)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Eq (genericEq)
+import Data.Generic.Rep.Show (genericShow)
+import Reactix as R
+import Reactix.DOM.HTML as H
+import Text.Markdown.SlamDown.Parser (parseMd)
+import Text.Markdown.SlamDown.Smolder as MD
+import Text.Markdown.SlamDown.Syntax (SlamDownP(..))
+import Text.Smolder.Renderer.String (render)
+
+import Gargantext.Prelude
+import Gargantext.Utils.Reactix as R2
+
+type Code = String
+type Html = String
+type Error = String
+
+data CodeType = JSON | Markdown
+derive instance genericCodeType :: Generic CodeType _
+instance eqCodeType :: Eq CodeType where
+  eq = genericEq
+instance showCodeType :: Show CodeType where
+  show = genericShow
+
+data ViewType = Code | Preview | Both
+derive instance genericViewType :: Generic ViewType _
+instance eqViewType :: Eq ViewType where
+  eq = genericEq
+instance showViewType :: Show ViewType where
+  show = genericShow
+
+type Props =
+  ( code :: String
+  , defaultCodeType :: CodeType
+  , onChange :: String -> Effect Unit
+  )
+
+compile :: CodeType -> Code -> Either Error Html
+compile JSON code = result
+  where
+    parsedE = jsonParser code
+    result = case parsedE of
+      Left err -> Left err
+      Right parsed -> Right $ "<pre>" <> (R2.stringify parsed 2) <> "</pre>"
+compile Markdown code = Right $ compileMd code
+
+-- TODO Replace with markdown-it?
+-- https://pursuit.purescript.org/packages/purescript-markdown-it
+compileMd' :: forall e. MD.ToMarkupOptions e -> String -> String
+compileMd' options input =
+  either identity (MD.toMarkup' options >>> render)
+  (parseMd input :: Either String (SlamDownP String))
+
+compileMd :: String -> String
+compileMd = compileMd' MD.defaultToMarkupOptions
+
+codeEditor :: Record Props -> R.Element
+codeEditor p = R.createElement codeEditorCpt p []
+
+codeEditorCpt :: R.Component Props
+codeEditorCpt = R.hooksComponent "G.C.CodeEditor" cpt
+  where
+    cpt {code, defaultCodeType, onChange} _ = do
+      htmlRef <- R.useRef null
+      codeRef <- R.useRef null
+      editorCodeRef <- R.useRef code
+      codeType <- R.useState' defaultCodeType
+      error <- R.useState' Nothing
+      viewType <- R.useState' Both
+
+      -- Initial rendering of elements with given data
+
+      -- Note: delay is necessary here, otherwise initially the HTML won't get
+      -- rendered (mDiv is still null)
+      R.useEffectOnce $ delay unit $ \_ -> do
+        _ <- renderHtml (fst codeType) code htmlRef error
+        pure $ pure unit
+
+      R.useEffectOnce $ delay unit $ \_ -> do
+        let mCodeEl = toMaybe $ R.readRef codeRef
+        case mCodeEl of
+          Nothing -> pure $ pure unit
+          Just codeEl -> do
+            _ <- pure $ (codeEl .= "innerText") code
+            pure $ pure unit
+
+      pure $ H.div { className: "code-editor" } [
+        H.div { className: "row toolbar" } [
+             codeTypeSelector {codeType, onChange: onChangeCodeType editorCodeRef htmlRef error}
+           , viewTypeSelector {state: viewType}
+           ]
+        , H.div { className: "row error" } [
+           errorComponent {error}
+        ]
+        , H.div { className: "row editor" } [
+           H.div { className: "code " <> (codeHidden $ fst viewType) } [
+              H.code { className: ""
+                     , contentEditable: "true"
+                     , ref: codeRef
+                     , rows: 30
+                     , on: { input: onEditChange (fst codeType) codeRef htmlRef editorCodeRef error }
+                     } []
+              ]
+           , H.div { ref: htmlRef, className: "html " <> (previewHidden $ fst viewType) } []
+           ]
+        ]
+
+    codeHidden :: ViewType -> String
+    codeHidden Code = ""
+    codeHidden Both = ""
+    codeHidden _ = "hidden"
+
+    previewHidden :: ViewType -> String
+    previewHidden Preview = ""
+    previewHidden Both = ""
+    previewHidden _ = "hidden"
+
+    -- Handle rerendering of preview when viewType changed
+    onChangeCodeType :: R.Ref String -> R.Ref (Nullable Element) -> R.State (Maybe Error) -> CodeType -> Effect Unit
+    onChangeCodeType editorCodeRef htmlRef error codeType = do
+        _ <- renderHtml codeType (R.readRef editorCodeRef) htmlRef error
+        pure unit
+
+    onEditChange :: forall e. CodeType -> R.Ref (Nullable Element) -> R.Ref (Nullable Element) -> R.Ref String -> R.State (Maybe Error) -> e -> Effect Unit
+    onEditChange codeType codeRef htmlRef editorCodeRef error e = do
+      log2 "[onChange] e" e
+      let mCode = toMaybe $ R.readRef codeRef
+      case mCode of
+        Nothing -> log "[onChange] mCode = Nothing"
+        Just code -> do
+          R.setRef editorCodeRef $ R2.innerText code
+          pure unit
+      renderHtml codeType (R.readRef editorCodeRef) htmlRef error
+
+    renderHtml :: CodeType -> Code -> R.Ref (Nullable Element) -> R.State (Maybe Error) -> Effect Unit
+    renderHtml codeType code htmlRef (_ /\ setError) =
+      case (toMaybe $ R.readRef htmlRef) of
+        Nothing -> pure unit
+        Just htmlEl -> do
+          case compile codeType code of
+            Left err -> do
+              setError $ const $ Just err
+            Right compiled -> do
+              setError $ const Nothing
+              _ <- pure $ (htmlEl .= "innerHTML") compiled
+              pure unit
+
+
+type ErrorComponentProps =
+  (
+    error :: R.State (Maybe Error)
+  )
+
+errorComponent :: Record ErrorComponentProps -> R.Element
+errorComponent p = R.createElement errorComponentCpt p []
+
+errorComponentCpt :: R.Component ErrorComponentProps
+errorComponentCpt = R.hooksComponent "G.C.ErrorComponent" cpt
+  where
+    cpt {error: (Nothing /\ _)} _ = pure $ H.div {} []
+    cpt {error: ((Just error) /\ _)} _ = do
+      pure $ H.div { className: "text-danger" } [ H.text error ]
+
+
+type CodeTypeSelectorProps =
+  (
+    codeType :: R.State CodeType
+  , onChange :: CodeType -> Effect Unit
+  )
+
+codeTypeSelector :: Record CodeTypeSelectorProps -> R.Element
+codeTypeSelector p = R.createElement codeTypeSelectorCpt p []
+
+codeTypeSelectorCpt :: R.Component CodeTypeSelectorProps
+codeTypeSelectorCpt = R.hooksComponent "G.C.CodeTypeSelector" cpt
+  where
+    cpt {codeType, onChange} _ = do
+      pure $ R2.select { className: "form-control"
+                , on: { change: onSelectChange codeType onChange }
+                , style: { width: "150px" }
+                , value: show $ fst codeType }
+        (option <$> [JSON, Markdown])
+
+    option :: CodeType -> R.Element
+    option value = H.option { value: show value } [ H.text $ show value ]
+
+    onSelectChange :: forall e. R.State CodeType -> (CodeType -> Effect Unit) -> e -> Effect Unit
+    onSelectChange (_ /\ setCodeType) onChange e = do
+      let codeType = case value of
+            "JSON"     -> JSON
+            "Markdown" -> Markdown
+            _          -> Markdown
+      setCodeType $ const codeType
+      onChange codeType
+      where
+        value = R2.unsafeEventValue e
+
+
+type ViewTypeSelectorProps =
+  (
+    state :: R.State ViewType
+  )
+
+viewTypeSelector :: Record ViewTypeSelectorProps -> R.Element
+viewTypeSelector p = R.createElement viewTypeSelectorCpt p []
+
+viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
+viewTypeSelectorCpt = R.hooksComponent "G.C.ViewTypeSelector" cpt
+  where
+    cpt {state} _ =
+      pure $ H.div { className: "btn-group" } [
+          viewTypeButton Code state
+        , viewTypeButton Both state
+        , viewTypeButton Preview state
+        ]
+
+    viewTypeButton viewType (state /\ setState) =
+      H.label {
+        className: "btn btn-default" <> active
+        , on: { click: onClick }
+      } [
+        H.i { className: "glyphicon " <> (icon viewType) } []
+      ]
+      where
+        active = if viewType == state then " active" else ""
+
+        onClick _ = do
+          setState $ const viewType
+
+    icon Preview = "glyphicon-eye-open"
+    icon Both = "glyphicon-transfer"
+    icon Code = "glyphicon-pencil"

src/Gargantext/Components/Forest/Tree.purs

 module Gargantext.Components.Forest.Tree where
 
+import Data.Array as A
 import DOM.Simple.Console (log2)
 import Data.Maybe (Maybe)
 -- import Data.Newtype (class Newtype)
 import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
-import Data.Array as Array
+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.Box (nodeMainSpan)
@@ -14,9 +19,7 @@ import Gargantext.Ends (Frontends)
 import Gargantext.Components.Loader (loader)
 import Gargantext.Routes (AppRoute)
 import Gargantext.Sessions (Session)
-import Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>))
-import Reactix as R
-import Reactix.DOM.HTML as H
+import Gargantext.Types (AsyncTask(..))
 
 ------------------------------------------------------------------------
 type Props = ( root          :: ID
@@ -55,7 +58,7 @@ loadedTreeView reload p = R.createElement el p []
   where
     el = R.hooksComponent "LoadedTreeView" cpt
     cpt {tree, mCurrentRoute, session, frontends} _ = do
-      treeState <- R.useState' {tree}
+      treeState <- R.useState' {tree, asyncTasks: []}
 
       pure $ H.div {className: "tree"}
         [ toHtml reload treeState session frontends mCurrentRoute ]
@@ -67,7 +70,7 @@ toHtml :: R.State Reload
        -> Frontends
        -> Maybe AppRoute
        -> R.Element
-toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) session frontends mCurrentRoute = R.createElement el {} []
+toHtml reload treeState@(ts@{tree: (NTree (LNode {id, name, nodeType}) ary), asyncTasks} /\ setTreeState) session frontends mCurrentRoute = R.createElement el {} []
   where
     el = R.hooksComponent "NodeView" cpt
     pAction = performAction session reload treeState
@@ -79,11 +82,21 @@ toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _)
 
       pure $ H.ul {}
         [ H.li {}
-          ( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen session frontends ]
+          ( [ nodeMainSpan pAction { id
+                                   , asyncTasks
+                                   , mCurrentRoute
+                                   , name
+                                   , nodeType
+                                   , onAsyncTaskFinish
+                                   } folderOpen session frontends ]
             <> childNodes session frontends reload folderOpen mCurrentRoute ary
           )
         ]
 
+    onAsyncTaskFinish (AsyncTask {id}) = setTreeState $ const $ ts { asyncTasks = newAsyncTasks }
+      where
+        newAsyncTasks = A.filter (\(AsyncTask {id: id'}) -> id /= id') asyncTasks
+
 
 childNodes :: Session
            -> Frontends
@@ -95,15 +108,15 @@ childNodes :: Session
 childNodes _ _ _ _ _ [] = []
 childNodes _ _ _ (false /\ _) _ _ = []
 childNodes session frontends reload (true /\ _) mCurrentRoute ary =
-  map (\ctree -> childNode {tree: ctree}) $ sorted ary
+  map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted ary
     where
       sorted :: Array FTree -> Array FTree
-      sorted = Array.sortWith (\(NTree (LNode {id}) _) -> id)
+      sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
       childNode :: Tree -> R.Element
       childNode props = R.createElement el props []
       el = R.hooksComponent "ChildNodeView" cpt
-      cpt {tree} _ = do
-        treeState <- R.useState' {tree}
+      cpt {tree, asyncTasks} _ = do
+        treeState <- R.useState' {tree, asyncTasks}
         pure $ toHtml reload treeState session frontends mCurrentRoute
 
 
@@ -124,7 +137,7 @@ performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTre
   void $ createNode session id $ CreateValue {name, nodeType}
   liftEffect $ setReload (_ + 1)
 
-performAction session _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
-  hashes <- uploadFile session id fileType contents
-  liftEffect $ log2 "uploaded:" hashes
-
+performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (UploadFile fileType contents) = do
+  task <- uploadFile session id fileType contents
+  liftEffect $ setTree $ \t@{asyncTasks} -> t { asyncTasks = A.cons task asyncTasks }
+  liftEffect $ log2 "uploaded, task:" task

src/Gargantext/Components/Forest/Tree/Node/Action.purs

@@ -9,7 +9,7 @@ import Data.Newtype (class Newtype)
 import Effect.Aff (Aff)
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, get, put, post, delete)
-import Gargantext.Types (NodeType(..))
+import Gargantext.Types (NodeType(..), AsyncTask(..))
 import Prelude hiding (div)
 
 data Action = Submit       String
@@ -85,7 +85,7 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
 
 data NTree a = NTree a (Array (NTree a))
 type FTree = NTree LNode
-type Tree = { tree :: FTree }
+type Tree = { tree :: FTree, asyncTasks :: Array AsyncTask }
 
 instance ntreeFunctor :: Functor NTree where
   map f (NTree x ary) = NTree (f x) (map (map f) ary)

src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs

 module Gargantext.Components.Forest.Tree.Node.Action.Upload where
 
-import Prelude (class Show, Unit, const, discard, map, pure, show, ($), (<>), bind, void)
+import Prelude (class Show, Unit, bind, const, discard, map, pure, show, void, ($))
 import Data.Maybe (Maybe(..), fromJust)
 import Data.Newtype (class Newtype)
-import Data.Tuple (Tuple)
+import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff, launchAff)
 import Effect.Class (liftEffect)
-import Effect.Uncurried (mkEffectFn1)
 import Partial.Unsafe (unsafePartial)
 import React.SyntheticEvent as E
 import Reactix as R
 import Reactix.DOM.HTML as H
 import URI.Extra.QueryPairs as QP
-import URI.Query as Q
 import Web.File.FileReader.Aff (readAsText)
 
 import Gargantext.Components.Forest.Tree.Node.Action
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, postWwwUrlencoded)
-import Gargantext.Types (class ToQuery, toQuery, NodeType(..))
+import Gargantext.Types (class ToQuery, AsyncTask, NodeType(..))
 import Gargantext.Utils (id)
 import Gargantext.Utils.Reactix as R2
 
@@ -44,16 +42,17 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
       , H.div {} [ H.input {type: "file", placeholder: "Choose file", on: {change: onChangeContents mContents}} ]
       , H.div {}
         [ R2.select {className: "col-md-12 form-control"
-                    , onChange: onChangeFileType fileType}
+                    , on: {change: onChangeFileType fileType}
+                    }
           (map renderOption [CSV, PresseRIS])
         ]
       , H.div {}
-        [ uploadButton id mContents fileType ]
+        [ uploadButton d id mContents fileType ]
       ]
 
     renderOption opt = H.option {} [ H.text $ show opt ]
 
-    onChangeContents (mContents /\ setMContents) = mkEffectFn1 $ \e -> do
+    onChangeContents (mContents /\ setMContents) e = do
       blob <- R2.inputFileBlob e
       E.preventDefault e
       E.stopPropagation e
@@ -62,24 +61,24 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
         liftEffect $ do
           setMContents $ const $ Just $ UploadFileContents contents
 
-    onChangeFileType (fileType /\ setFileType) = mkEffectFn1 $ \e -> do
+    onChangeFileType (fileType /\ setFileType) e = do
       setFileType $ const $ unsafePartial $ fromJust $ readFileType $ R2.unsafeEventValue e
 
-    uploadButton :: Int -> R.State (Maybe UploadFileContents) -> R.State FileType -> R.Element
-    uploadButton id (mContents /\ setMContents) (fileType /\ setFileType) =
-      H.button {className: "btn btn-primary", disabled, onClick} [ H.text "Upload" ]
-      where
-        disabled = case mContents of
-          Nothing -> "1"
-          Just _ -> ""
-
-        onClick = mkEffectFn1 $ \e -> do
-          let contents = unsafePartial $ fromJust mContents
-          void $ launchAff do
-            _ <- d $ UploadFile fileType contents
-            liftEffect $ do
-              setMContents $ const $ Nothing
-              setFileType $ const $ CSV
+uploadButton :: (Action -> Aff Unit) -> Int -> R.State (Maybe UploadFileContents) -> R.State FileType -> R.Element
+uploadButton d id (mContents /\ setMContents) (fileType /\ setFileType) =
+  H.button {className: "btn btn-primary", disabled, on: {click: onClick}} [ H.text "Upload" ]
+  where
+    disabled = case mContents of
+      Nothing -> "1"
+      Just _ -> ""
+
+    onClick e = do
+      let contents = unsafePartial $ fromJust mContents
+      void $ launchAff do
+        _ <- d $ UploadFile fileType contents
+        liftEffect $ do
+          setMContents $ const $ Nothing
+          setFileType $ const $ CSV
 
 -- START File Type View
 type FileTypeProps =
@@ -115,9 +114,10 @@ fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_
               [ H.h5 {} [H.text "Choose file type"] ]
             , H.div {className: "col-md-2"}
               [ H.a {className: "btn glyphitem glyphicon glyphicon-remove-circle"
-                    , onClick: mkEffectFn1 $ \_ -> do
-                        setDroppedFile $ const Nothing
-                        setIsDragOver $ const false
+                    , on: {click: \_ -> do
+                              setDroppedFile $ const Nothing
+                              setIsDragOver $ const false
+                          }
                     , title: "Close"} []
               ]
             ]
@@ -125,11 +125,12 @@ fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_
         panelBody =
           H.div {className: "panel-body"}
           [ R2.select {className: "col-md-12 form-control"
-                      , onChange: onChange}
+                      , on: {change: onChange}
+                      }
             (map renderOption [CSV, PresseRIS])
           ]
           where
-            onChange = mkEffectFn1 $ \e ->
+            onChange e =
               setDroppedFile $ const $ Just $ DroppedFile $ {contents, fileType: readFileType $ R2.unsafeEventValue e}
         renderOption opt = H.option {} [ H.text $ show opt ]
         panelFooter =
@@ -139,9 +140,10 @@ fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_
               Just ft ->
                 H.button {className: "btn btn-success"
                          , type: "button"
-                         , onClick: mkEffectFn1 $ \_ -> do
-                             setDroppedFile $ const Nothing
-                             launchAff $ d $ UploadFile ft contents
+                         , on: {click: \_ -> do
+                                   setDroppedFile $ const Nothing
+                                   launchAff $ d $ UploadFile ft contents
+                               }
                          } [H.text "Upload"]
               Nothing ->
                 H.button {className: "btn btn-success disabled"
@@ -164,9 +166,15 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
     where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
           pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
 
-uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
+uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff AsyncTask
 uploadFile session id fileType (UploadFileContents fileContents) =
-    postWwwUrlencoded session p fileContents
+    postWwwUrlencoded session p bodyParams
+    --postMultipartFormData session p fileContents
   where
     q = FileUploadQuery { fileType: fileType }
-    p = NodeAPI Node (Just id) $ "add/file" <> Q.print (toQuery q)
+    --p = NodeAPI Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
+    p = NodeAPI Corpus (Just id) $ "add/form/async" -- <> Q.print (toQuery q)
+    bodyParams = [
+        Tuple "_wf_data" (Just fileContents)
+      , Tuple "_wf_filetype" (Just $ show fileType)
+      ]

src/Gargantext/Components/Forest/Tree/Node/Box.purs

@@ -3,14 +3,25 @@ module Gargantext.Components.Forest.Tree.Node.Box where
 import Data.Maybe (Maybe(..))
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
+import Effect (Effect)
 import Effect.Aff (Aff, launchAff)
 import Effect.Class (liftEffect)
 import Effect.Uncurried (mkEffectFn1)
+import React.SyntheticEvent as E
+import Reactix as R
+import Reactix.DOM.HTML as H
+import URI.Extra.QueryPairs as NQP
+import URI.Query as Query
+import Web.File.FileReader.Aff (readAsText)
+
+import Gargantext.Prelude
+
 import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
 import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
 import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
 import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox)
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView)
+import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar)
 import Gargantext.Components.Search.Types (allLangs)
 import Gargantext.Components.Search.SearchBar (searchBar)
 import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex)
@@ -19,16 +30,9 @@ import Gargantext.Ends (Frontends, url)
 import Gargantext.Routes (AppRoute)
 import Gargantext.Routes as Routes
 import Gargantext.Sessions (Session, sessionId)
-import Gargantext.Types (NodeType(..), NodePath(..), fldr)
+import Gargantext.Types (NodeType(..), NodePath(..), fldr, AsyncTask(..))
 import Gargantext.Utils (glyphicon, glyphiconActive)
 import Gargantext.Utils.Reactix as R2
-import Prelude (Unit, bind, const, discard, identity, map, pure, show, void, ($), (<>), (==), (-), (+))
-import React.SyntheticEvent as E
-import Reactix as R
-import Reactix.DOM.HTML as H
-import URI.Extra.QueryPairs as NQP
-import URI.Query as Query
-import Web.File.FileReader.Aff (readAsText)
 
 
 import DOM.Simple.Types
@@ -39,9 +43,11 @@ import Effect.Console
 -- Main Node
 type NodeMainSpanProps =
   ( id            :: ID
+  , asyncTasks    :: Array AsyncTask
+  , mCurrentRoute :: Maybe AppRoute
   , name          :: Name
   , nodeType      :: NodeType
-  , mCurrentRoute :: Maybe AppRoute
+  , onAsyncTaskFinish :: AsyncTask -> Effect Unit
   )
 
 nodeMainSpan :: (Action -> Aff Unit)
@@ -53,7 +59,7 @@ nodeMainSpan :: (Action -> Aff Unit)
 nodeMainSpan d p folderOpen session frontends = R.createElement el p []
   where
     el = R.hooksComponent "NodeMainSpan" cpt
-    cpt props@{id, name, nodeType, mCurrentRoute} _ = do
+    cpt props@{id, asyncTasks, mCurrentRoute, name, nodeType, onAsyncTaskFinish} _ = do
       -- only 1 popup at a time is allowed to be opened
       popupOpen   <- R.useState' (Nothing :: Maybe NodePopup)
       popupPosition <- R.useState' (Nothing :: Maybe R2.Point)
@@ -70,6 +76,10 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p []
         , popOverIcon showBox popupOpen popupPosition
         , mNodePopupView props showBox popupOpen popupPosition
         , fileTypeView   d {id, nodeType} droppedFile isDragOver
+        , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
+                                                , corpusId: id
+                                                , onFinish: \_ -> onAsyncTaskFinish t
+                                                , session }) asyncTasks)
         ]
           where
             SettingsBox {show: showBox} = settingsBox nodeType

src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs

+module Gargantext.Components.Forest.Tree.Node.ProgressBar where
+
+import Gargantext.Prelude
+
+import Data.Int (fromNumber)
+import Data.Maybe (Maybe(..), fromJust)
+import Data.Tuple.Nested ((/\))
+import Effect (Effect)
+import Effect.Aff (Aff, launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Timer (clearInterval, setInterval)
+import Gargantext.Components.Forest.Tree.Node.Action (ID)
+import Gargantext.Routes (SessionRoute(..))
+import Gargantext.Sessions (Session, get)
+import Gargantext.Types (AsyncProgress(..), AsyncTask(..), AsyncTaskStatus(..), NodeType(..), progressPercent)
+import Partial.Unsafe (unsafePartial)
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+
+type Props =
+  (
+    asyncTask :: AsyncTask
+  , corpusId  :: ID
+  , onFinish  :: Unit -> Effect Unit
+  , session   :: Session
+  )
+
+
+asyncProgressBar :: Record Props -> R.Element
+asyncProgressBar p = R.createElement asyncProgressBarCpt p []
+
+asyncProgressBarCpt :: R.Component Props
+asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.asyncProgressBar" cpt
+  where
+    cpt props@{asyncTask: (AsyncTask {id}), corpusId, onFinish} _ = do
+      (progress /\ setProgress) <- R.useState' 0.0
+      intervalIdRef <- R.useRef Nothing
+
+      R.useEffectOnce' $ do
+        intervalId <- setInterval 1000 $ do
+          launchAff_ $ do
+            asyncProgress@(AsyncProgress {status}) <- queryProgress props
+            liftEffect do
+              setProgress \p -> min 100.0 $ progressPercent asyncProgress
+              if (status == Finished) || (status == Killed) || (status == Failed) then do
+                _ <- case R.readRef intervalIdRef of
+                  Nothing -> pure unit
+                  Just iid -> clearInterval iid
+                onFinish unit
+              else
+                pure unit
+
+        R.setRef intervalIdRef $ Just intervalId
+
+        pure unit
+
+
+      pure $
+        H.div { className: "progress" } [
+          H.div { className: "progress-bar"
+                , role: "progressbar"
+                , style: { width: (show $ toInt progress) <> "%" }
+                } [ H.text id ]
+        ]
+
+    toInt :: Number -> Int
+    toInt n = unsafePartial $ fromJust $ fromNumber n
+
+queryProgress :: Record Props -> Aff AsyncProgress
+queryProgress {asyncTask: AsyncTask {id}, corpusId, session} = get session p
+  where
+    p = NodeAPI Corpus (Just corpusId) $ "add/form/async/" <> id <> "/poll?limit=1"

src/Gargantext/Components/Login.purs

@@ -204,7 +204,7 @@ termsLink _ =
 requestAccessLink :: {} -> R.Element
 requestAccessLink _ =
   H.a { target: "_blank", href: applyUrl } [ H.text " request access" ]
-  where applyUrl = "https://iscpif.fr/services/applyforourservices/"
+  where applyUrl = "https://iscpif.fr/apply-for-a-services-account/"
 
 usernameInput :: R.State String -> R.Element
 usernameInput username =

src/Gargantext/Components/MarkdownEditor.purs

+module Gargantext.Components.MarkdownEditor where
+
+import Data.Either (either, Either(..))
+import Data.Maybe (Maybe(..))
+import Data.Nullable (Nullable, null, toMaybe)
+import Data.Tuple (fst)
+import Data.Tuple.Nested ((/\))
+import DOM.Simple.Console (log2)
+import DOM.Simple.Types (Element)
+import Effect (Effect)
+import FFI.Simple ((.=), delay)
+import Prelude (($), (>>>), Unit, bind, const, discard, identity, pure, unit)
+import Reactix as R
+import Reactix.DOM.HTML as H
+import Text.Markdown.SlamDown.Parser (parseMd)
+import Text.Markdown.SlamDown.Smolder as MD
+import Text.Markdown.SlamDown.Syntax (SlamDownP(..))
+import Text.Smolder.Renderer.String (render)
+
+import Gargantext.Utils.Reactix as R2
+
+type Props =
+  ( md :: String
+  , nodeId :: Int
+  )
+
+compileMd' :: forall e. MD.ToMarkupOptions e -> String -> String
+compileMd' options input =
+  either identity (MD.toMarkup' options >>> render)
+  (parseMd input :: Either String (SlamDownP String))
+
+compileMd :: String -> String
+compileMd = compileMd' MD.defaultToMarkupOptions
+
+markdownEditor :: Record Props -> R.Element
+markdownEditor p = R.createElement markdownEditorCpt p []
+
+markdownEditorCpt :: R.Component Props
+markdownEditorCpt = R.hooksComponent "G.C.MarkdownEditor" cpt
+  where
+    cpt {md, nodeId} _ = do
+      ref <- R.useRef null
+      editedMd <- R.useState' md
+
+      -- Note: delay is necessary here, otherwise initially the HTML won't get
+      -- rendered (mDiv is still null)
+      R.useEffect $ delay unit $ \_ -> do
+        let mDiv = toMaybe $ R.readRef ref
+        case mDiv of
+          Nothing -> pure $ pure unit
+          Just d -> do
+            _ <- pure $ (d .= "innerHTML") $ compileMd $ fst editedMd
+            pure $ pure unit
+
+      pure $ H.div { className: "markdown-editor" }
+                   [ H.div { className: "row"}
+                     [ H.div { className: "col-md-5" } [ H.div { ref, className: "html" } []]
+                     , H.div { className: "col-md-5" }
+                             [ H.div { className: "md" }
+                              [ H.textarea { className: "form-control"
+                                           , rows: 10
+                                           , on: {change: onChange ref editedMd}
+                                           } [ H.text $ fst editedMd ]
+                              ]
+                             ]
+                     ]
+                   ]
+
+    onChange :: forall e. R.Ref (Nullable Element) -> R.State String -> e -> Effect Unit
+    onChange ref (_ /\ setEditedMd) e = do
+      setEditedMd $ const value
+      where
+        value = R2.unsafeEventValue e

src/Gargantext/Components/Nodes/Corpus.purs

@@ -4,15 +4,18 @@ import Prelude ((<<<))
 import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
 import Data.Array (head)
 import Data.Maybe (Maybe(..))
+import DOM.Simple.Console (log2)
 import Effect.Aff (Aff, throwError)
 import Effect.Exception (error)
 import Reactix as R
 import Reactix.DOM.HTML as H
+
 import Gargantext.Prelude
+import Gargantext.Components.CodeEditor as CE
 import Gargantext.Components.Node (NodePoly(..), HyperdataList)
-import Gargantext.Types (NodeType(..), AffTableResult)
 import Gargantext.Routes (SessionRoute(NodeAPI, Children))
 import Gargantext.Sessions (Session, get)
+import Gargantext.Types (NodeType(..), AffTableResult)
 
 type Props = ( nodeId :: Int )
 
@@ -20,13 +23,19 @@ corpusLayout :: Record Props -> R.Element
 corpusLayout props = R.createElement corpusLayoutCpt props []
 
 corpusLayoutCpt :: R.Component Props
-corpusLayoutCpt = R.staticComponent "G.P.Corpus.corpusLayout" cpt
+corpusLayoutCpt = R.hooksComponent "G.P.Corpus.corpusLayout" cpt
   where
-    cpt {nodeId} _ =
-      H.div {}
-      [ H.iframe { src: gargMd , width: "100%", height: "100%", style: {"border-style": "none"}} []
-      ]
-    gargMd = "https://hackmd.iscpif.fr/g9Aah4iwQtCayIzsKQjA0Q#"
+    cpt {nodeId} _ = do
+      pure $ H.div {}
+        [
+          CE.codeEditor {code, defaultCodeType: CE.Markdown, onChange}
+          --H.iframe { src: gargMd , width: "100%", height: "100%", style: {"border-style": "none"}} []
+        ]
+    --gargMd = "https://hackmd.iscpif.fr/g9Aah4iwQtCayIzsKQjA0Q#"
+    code = "# Hello world\n\n## subtitle\n\n- item 1\n- item 2\n\n1. num 1\n2. num 2\n\n[purescript link](https://purescript.org)"
+    onChange c = do
+      log2 "[corpusLayoutCpt] c" c
+
 newtype CorpusInfo =
   CorpusInfo
   { title        :: String

src/Gargantext/Config/REST.purs

 module Gargantext.Config.REST where
 
-import Prelude (Unit, bind, pure, ($), (<$>), (<<<), (<>))
-
 import Affjax (defaultRequest, printResponseFormatError, request)
-import Affjax.RequestBody (RequestBody(..), string)
+import Affjax.RequestBody (RequestBody(..), formData, formURLEncoded, string)
 import Affjax.RequestHeader (RequestHeader(..))
 import Affjax.ResponseFormat as ResponseFormat
-import Effect.Class (liftEffect)
+import DOM.Simple.Console (log)
 import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
 import Data.Either (Either(..))
+import Data.Foldable (foldMap)
+import Data.FormURLEncoded as FormURLEncoded
 import Data.HTTP.Method (Method(..))
 import Data.Maybe (Maybe(..))
-import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON)
-import Data.Foldable (foldMap)
-import DOM.Simple.Console (log)
+import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
+import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff, throwError)
+import Effect.Class (liftEffect)
 import Effect.Exception (error)
+import Prelude (Unit, bind, pure, ($), (<$>), (<<<), (<>))
+import Web.XHR.FormData as XHRFormData
 
 type Token = String
 
@@ -67,9 +69,11 @@ deleteWithBody mtoken url = send DELETE mtoken url <<< Just
 post :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
 post mtoken url = send POST mtoken url <<< Just
 
+type FormDataParams = Array (Tuple String (Maybe String))
+
 -- TODO too much duplicate code with `send`
-postWwwUrlencoded :: forall b. DecodeJson b => Maybe Token -> String -> String -> Aff b
-postWwwUrlencoded mtoken url body = do
+postWwwUrlencoded :: forall b. DecodeJson b => Maybe Token -> String -> FormDataParams -> Aff b
+postWwwUrlencoded mtoken url bodyParams = do
   affResp <- request $ defaultRequest
              { url = url
              , responseFormat = ResponseFormat.json
@@ -80,7 +84,7 @@ postWwwUrlencoded mtoken url body = do
                           foldMap (\token ->
                             [RequestHeader "Authorization" $  "Bearer " <> token]
                           ) mtoken
-             , content  = Just $ string body
+             , content  = Just $ formURLEncoded urlEncodedBody
              }
   case affResp.body of
     Left err -> do
@@ -93,3 +97,30 @@ postWwwUrlencoded mtoken url body = do
       case decodeJson json of
         Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
         Right b -> pure b
+  where
+    urlEncodedBody = FormURLEncoded.fromArray bodyParams
+
+postMultipartFormData :: forall b. DecodeJson b => Maybe Token -> String -> String -> Aff b
+postMultipartFormData mtoken url body = do
+  fd <- liftEffect $ XHRFormData.new
+  _ <- liftEffect $ XHRFormData.append (XHRFormData.EntryName "body") body fd
+  affResp <- request $ defaultRequest
+             { url = url
+             , responseFormat = ResponseFormat.json
+             , method = Left POST
+             , headers = [ ContentType multipartFormData
+                         , Accept applicationJSON
+                         ] <>
+                         foldMap (\token ->
+                           [ RequestHeader "Authorization" $ "Bearer " <> token ]
+                         ) mtoken
+             , content = Just $ formData fd
+             }
+  case affResp.body of
+    Left err -> do
+      _ <-  liftEffect $ log $ printResponseFormatError err
+      throwError $ error $ printResponseFormatError err
+    Right json -> do
+      case decodeJson json of
+        Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
+        Right b -> pure b

src/Gargantext/Sessions.purs

@@ -223,8 +223,11 @@ deleteWithBody session@(Session {token}) p = REST.deleteWithBody (Just token) (t
 post :: forall a b p. EncodeJson a => DecodeJson b => ToUrl Session p => Session -> p -> a -> Aff b
 post session@(Session {token}) p = REST.post (Just token) (toUrl session p)
 
-postWwwUrlencoded :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> String -> Aff b
+postWwwUrlencoded :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> REST.FormDataParams -> Aff b
 postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p)
 
+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)
+
 getls :: Effect Storage
 getls = window >>= localStorage

src/Gargantext/Types.purs

 module Gargantext.Types where
 
 import Prelude
-import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject)
+import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
+import Data.Array as A
 import Data.Either (Either(..))
+import Data.Int (toNumber)
 import Data.Maybe (Maybe(..), maybe)
 import Effect.Aff (Aff)
 import Prim.Row (class Union)
@@ -434,3 +436,73 @@ modeFromString "Sources" = Just Sources
 modeFromString "Institutes" = Just Institutes
 modeFromString "Terms" = Just Terms
 modeFromString _ = Nothing
+
+type AsyncTaskID = String
+
+data AsyncTaskStatus = Running | Failed | Finished | Killed
+derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
+derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
+instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
+  decodeJson json = do
+    obj <- decodeJson json
+    pure $ readAsyncTaskStatus obj
+
+readAsyncTaskStatus :: String -> AsyncTaskStatus
+readAsyncTaskStatus "failed"   = Failed
+readAsyncTaskStatus "finished" = Finished
+readAsyncTaskStatus "killed"   = Killed
+readAsyncTaskStatus "running"  = Running
+readAsyncTaskStatus _ = Running
+
+newtype AsyncTask = AsyncTask {
+    id :: AsyncTaskID
+  , status :: AsyncTaskStatus
+  }
+derive instance genericAsyncTask :: Generic AsyncTask _
+
+instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
+  decodeJson json = do
+    obj <- decodeJson json
+    id <- obj .: "id"
+    status <- obj .: "status"
+    pure $ AsyncTask {id, status}
+
+newtype AsyncProgress = AsyncProgress {
+    id :: AsyncTaskID
+  , log :: Array AsyncTaskLog
+  , status :: AsyncTaskStatus
+  }
+derive instance genericAsyncProgress :: Generic AsyncProgress _
+instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where
+  decodeJson json = do
+    obj <- decodeJson json
+    id <- obj .: "id"
+    log <- obj .: "log"
+    status <- obj .: "status"
+    pure $ AsyncProgress {id, log, status}
+
+newtype AsyncTaskLog = AsyncTaskLog {
+    events :: Array String
+  , failed :: Int
+  , remaining :: Int
+  , succeeded :: Int
+  }
+derive instance genericAsyncTaskLog :: Generic AsyncTaskLog _
+instance decodeJsonAsyncTaskLog :: DecodeJson AsyncTaskLog where
+  decodeJson json = do
+    obj <- decodeJson json
+    events <- obj .: "events"
+    failed <- obj .: "failed"
+    remaining <- obj .: "remaining"
+    succeeded <- obj .: "succeeded"
+    pure $ AsyncTaskLog {events, failed, remaining, succeeded}
+
+progressPercent :: AsyncProgress -> Number
+progressPercent (AsyncProgress {log}) = perc
+  where
+    perc = case A.head log of
+      Nothing -> 0.0
+      Just (AsyncTaskLog {failed, remaining, succeeded}) -> 100.0*nom/denom
+        where
+          nom = toNumber $ failed + succeeded
+          denom = toNumber $ failed + succeeded + remaining

src/Gargantext/Utils/Array.js

-function _push(a, i) { a.push(i); }
-module.exports={
-    _push: _push
-};
+function _push(a, i) {
+  a.push(i);
+}
+exports._push = _push;

src/Gargantext/Utils/Reactix.js

@@ -7,4 +7,14 @@ function addRootElement(rootElem) {
   );
 }
 
+function getSelection(_u) {
+  return window.getSelection();
+}
+
+function stringify(j, indent) {
+  return JSON.stringify(j, null, indent);
+}
+
 exports._addRootElement = addRootElement;
+exports._getSelection = getSelection;
+exports._stringify = stringify;

src/Gargantext/Utils/Reactix.purs

@@ -2,21 +2,23 @@ module Gargantext.Utils.Reactix where
 
 import Prelude
 
+import Data.Argonaut.Core (Json)
+import Data.Function.Uncurried (Fn2, runFn2)
+import Data.Maybe (Maybe(..), fromJust)
+import Data.Nullable (Nullable, null, toMaybe)
+import Data.Tuple (Tuple)
+import Data.Tuple.Nested ((/\))
 import DOM.Simple as DOM
 import DOM.Simple.Console (log2)
 import DOM.Simple.Document (document)
 import DOM.Simple.Element as Element
 import DOM.Simple.Event as DE
 import DOM.Simple.Types (class IsNode)
-import Data.Maybe (Maybe(..), fromJust)
-import Data.Nullable (Nullable, null, toMaybe)
-import Data.Tuple (Tuple)
-import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
 import Effect.Class (liftEffect)
 import Effect.Exception (error)
-import Effect.Uncurried (EffectFn1, runEffectFn1, mkEffectFn1, mkEffectFn2)
+import Effect.Uncurried (EffectFn1, runEffectFn1, mkEffectFn1, EffectFn2, runEffectFn2, mkEffectFn2)
 import FFI.Simple ((..), (...), defineProperty, delay, args2, args3)
 import Partial.Unsafe (unsafePartial)
 import React (class ReactPropFields, Children, ReactClass, ReactElement)
@@ -232,3 +234,18 @@ row children = H.div { className: "row" } children
 
 col12 :: Array R.Element -> R.Element
 col12 children = H.div { className: "col-md-12" } children
+
+innerText :: DOM.Element -> String
+innerText e = e .. "innerText"
+
+foreign import data Selection :: Type
+
+getSelection :: Unit -> Effect Selection
+getSelection = runEffectFn1 _getSelection
+
+foreign import _getSelection :: EffectFn1 Unit Selection
+
+stringify :: Json -> Int -> String
+stringify j indent = runFn2 _stringify j indent
+
+foreign import _stringify :: Fn2 Json Int String

src/Gargantext/Utils/Regex.js

-function _cloneRegex(r) { return new RegExp(r.source, r.flags); }
-function _getRegexLastIndex(r) { return r.lastIndex; }
-function _execRegex(r, s) { return r.exec(s); }
-module.exports={
-    _cloneRegex: _cloneRegex,
-    _getRegexLastIndex: _getRegexLastIndex,
-    _execRegex: _execRegex
-};
+function _cloneRegex(r) {
+  return new RegExp(r.source, r.flags);
+}
+function _getRegexLastIndex(r) {
+  return r.lastIndex;
+}
+function _execRegex(r, s) {
+  return r.exec(s);
+}
+exports._cloneRegex = _cloneRegex;
+exports._getRegexLastIndex = _getRegexLastIndex;
+exports._execRegex = _execRegex;

src/index.html

@@ -13,6 +13,7 @@
         <link rel="stylesheet" type="text/css" href="styles/menu.css"/>
         <link href="styles/Graph.css" rel="stylesheet" type="text/css" />
         <link href="styles/Login.css" rel="stylesheet" type="text/css" />
+        <link href="styles/CodeEditor.css" rel="stylesheet" type="text/css" />
         <link href="styles/range-slider.css" rel="stylesheet" type="text/css" />
         <style>
          * {margin: 0; padding: 0; list-style: none;}

src/index.js

 // This file is just a wrapper so that webpack will call our main function
-require('./Main.purs').main();
+require('../output/Main').main();

webpack.config.js

@@ -8,33 +8,11 @@ let HtmlWebpackPlugin = require('html-webpack-plugin');
 let CleanWebpackPlugin = require('clean-webpack-plugin');
 let isWatch = process.argv.some(a => a === '--watch');
 
-// TODO: We have agreed to move to spago, but not done it yet
-// let spago_sources = async () =>
-//   exec.quiet(
-//     "psc-package sources",
-//     { options: 'strict' }
-//   ).then(function (res) {
-//     let sources = res.stdout.split(/\r?\n/);
-//     sources.pop(); // extra newline at the end of output
-//     return sources;
-//   });
-
 let dist = path.join(__dirname, 'dist');
 let src = path.join(__dirname, 'src');
 let test = path.join(__dirname, 'test');
 
-// kill when spago
-let futured = async () => new Promise((resolve, _) => resolve([]));
-
-module.exports = (env) =>
-  // spago_sources()
-  futured()
-  .then(function (ps_sources) {
-
-    ps_sources.push('src/**/*.purs');
-    // TODO: testing in browser and headless
-    // if (env === "browser" || env === "headless")
-    //   ps_sources.push('test/Main.purs');
+module.exports = (env) =>{
     let config = {
       cache: true,
       mode: 'development',
@@ -52,22 +30,6 @@ module.exports = (env) =>
       },
       module: {
         rules: [
-          {test: /\.purs$/,
-           exclude: /(node_modules)/,
-           use: [
-             {loader: "purs-loader",
-              options: {
-                src: ps_sources,
-                output: dist,
-                pscIde: true,
-                pscIdeClientArgs: {port: 4002},
-                pscIdeServerArgs: {port: 4002},
-                pscArgs: {codegen: "js,sourcemaps"},
-                pscPackage: true,
-                bundle: false,
-                watch: isWatch}},
-             {loader: "source-map-loader"},
-           ]},
           {test: /\.css$/,
            exclude: /(node_modules)/,
            use: ["style-loader", "css-loader"]},
@@ -75,13 +37,13 @@ module.exports = (env) =>
            exclude: /(node_modules)/,
            use: [ "file-loader" ]},
           {test: /\.js$/,
-           exclude: /(node_modules)/,
+           exclude: [/(node_modules)/, /(output)/],
            use: ["babel-loader", "source-map-loader"]}
         ]
       },
       resolve: {
         modules: [ 'node_modules' ],
-        extensions: [ '.purs', '.js']
+        extensions: [ '.js']
       },
       plugins: [
       // TODO: can we put the checked-in assets in dist somewhere else
@@ -110,4 +72,4 @@ module.exports = (env) =>
       console.log("unknown env: ", env);
     }
     return config;
-  });
+  };

yarn.lock

@@ -5177,10 +5177,19 @@ purescript-installer@^0.2.0:
     which "^1.3.1"
     zen-observable "^0.8.14"
 
-purescript@^0.13.5:
-  version "0.13.5"
-  resolved "https://registry.yarnpkg.com/purescript/-/purescript-0.13.5.tgz#0b1621577c64390ee34908d772679b1e23b8edd1"
-  integrity sha512-nwCqlhPZKfm1HkZzEy91dC9vIoRcah226OkIfW0kiz7tPl+LddwAIVT2bdhfQwzu2XUhgOKmYbvn9nlbHlOGMQ==
+purescript-language-server@^0.12.7:
+  version "0.12.7"
+  resolved "https://registry.yarnpkg.com/purescript-language-server/-/purescript-language-server-0.12.7.tgz#0edc0536b46ad0f9cfd93d85c62c4bbb3d22a5e2"
+  integrity sha512-uXYrzoKPjlgEOgJqctqcfddtkCa57N3/1t2wENxS8TnxJnZt1j/LVQCWMhrEUfw90DPohhRKaaQmdrWrCpq9ow==
+  dependencies:
+    vscode-languageserver "^3.2.0"
+    vscode-uri "^1.0.0"
+    which "^1.2.9"
+
+purescript@^0.13.6:
+  version "0.13.6"
+  resolved "https://registry.yarnpkg.com/purescript/-/purescript-0.13.6.tgz#f5f77680dd7a50b7e63ba671bd85e2ac121318b0"
+  integrity sha512-PC93xqr0zDs5l5xnfTlptKzv5jBWbML+dwtpDCZkOOH7h9wgLusQfU4PNfHvdwrSmsBntalGm+Cbd6VrokN7Sg==
   dependencies:
     purescript-installer "^0.2.0"
 
@@ -6614,6 +6623,62 @@ vm-browserify@^1.0.0, vm-browserify@^1.0.1:
   resolved "https://registry.yarnpkg.com/vm-browserify/-/vm-browserify-1.1.0.tgz#bd76d6a23323e2ca8ffa12028dc04559c75f9019"
   integrity sha512-iq+S7vZJE60yejDYM0ek6zg308+UZsdtPExWP9VZoCFCz1zkJoXFnAX7aZfd/ZwrkidzdUZL0C/ryW+JwAiIGw==
 
+vscode-jsonrpc@3.5.0:
+  version "3.5.0"
+  resolved "https://registry.yarnpkg.com/vscode-jsonrpc/-/vscode-jsonrpc-3.5.0.tgz#87239d9e166b2d7352245b8a813597804c1d63aa"
+  integrity sha1-hyOdnhZrLXNSJFuKgTWXgEwdY6o=
+
+vscode-jsonrpc@^5.0.0:
+  version "5.0.0"
+  resolved "https://registry.yarnpkg.com/vscode-jsonrpc/-/vscode-jsonrpc-5.0.0.tgz#445be9fb404e2793a91b9c0cef3c52dec3e02b89"
+  integrity sha512-QeAniC/xTWauVQgyNgEqNJ0Qm/Jw8QySGRQhRFPwb8c4FPp9k6QNgJp0ayXWws5qhdaHkiXkGPlzjOPZFQQKLw==
+
+vscode-languageserver-protocol@3.5.1:
+  version "3.5.1"
+  resolved "https://registry.yarnpkg.com/vscode-languageserver-protocol/-/vscode-languageserver-protocol-3.5.1.tgz#5144a3a9eeccbd83fe2745bd4ed75fad6cc45f0d"
+  integrity sha512-1fPDIwsAv1difCV+8daOrJEGunClNJWqnUHq/ncWrjhitKWXgGmRCjlwZ3gDUTt54yRcvXz1PXJDaRNvNH6pYA==
+  dependencies:
+    vscode-jsonrpc "3.5.0"
+    vscode-languageserver-types "3.5.0"
+
+vscode-languageserver-protocol@^3.15.0:
+  version "3.15.0"
+  resolved "https://registry.yarnpkg.com/vscode-languageserver-protocol/-/vscode-languageserver-protocol-3.15.0.tgz#7f306dc337a72e4d84882bd952db51e084fef8fe"
+  integrity sha512-PZEopQzHR3Lo422HeDxCpGN0sYz+kReO+du3F/AcFT1cCPunoVsDJv7ikEolFRKEn+hEIZiAaIX4yoSZ+ip5Nw==
+  dependencies:
+    vscode-jsonrpc "^5.0.0"
+    vscode-languageserver-types "3.15.0"
+
+vscode-languageserver-types@3.15.0:
+  version "3.15.0"
+  resolved "https://registry.yarnpkg.com/vscode-languageserver-types/-/vscode-languageserver-types-3.15.0.tgz#c45a23308ec0967135c483b759dfaf97978d9e0a"
+  integrity sha512-AXteNagMhBWnZ6gNN0UB4HTiD/7TajgfHl6jaM6O7qz3zDJw0H3Jf83w05phihnBRCML+K6Ockh8f8bL0OObPw==
+
+vscode-languageserver-types@3.5.0:
+  version "3.5.0"
+  resolved "https://registry.yarnpkg.com/vscode-languageserver-types/-/vscode-languageserver-types-3.5.0.tgz#e48d79962f0b8e02de955e3f524908e2b19c0374"
+  integrity sha1-5I15li8LjgLelV4/UkkI4rGcA3Q=
+
+vscode-languageserver@^3.2.0:
+  version "3.5.1"
+  resolved "https://registry.yarnpkg.com/vscode-languageserver/-/vscode-languageserver-3.5.1.tgz#e0044b7df4d2447ce12632dfc98f1ab0afacbdff"
+  integrity sha512-RYUKn0DgHTFcS8kS4VaNCjNMaQXYqiXdN9bKrFjXzu5RPKfjIYcoh47oVWwZj4L3R/DPB0Se7HPaDatvYY2XgQ==
+  dependencies:
+    vscode-languageserver-protocol "3.5.1"
+    vscode-uri "^1.0.1"
+
+vscode-languageserver@^6.0.0:
+  version "6.0.0"
+  resolved "https://registry.yarnpkg.com/vscode-languageserver/-/vscode-languageserver-6.0.0.tgz#4b6fa593422a68bab3c5e92f1d50af3a7cb770f8"
+  integrity sha512-QihKytod/PApM+wU9qmjxjGT+p4vYDJCbMcdwol55QeE80DCMyls6yxJzTn8SNCNpP4JZin8SIZp1zpumfktQg==
+  dependencies:
+    vscode-languageserver-protocol "^3.15.0"
+
+vscode-uri@^1.0.0, vscode-uri@^1.0.1:
+  version "1.0.8"
+  resolved "https://registry.yarnpkg.com/vscode-uri/-/vscode-uri-1.0.8.tgz#9769aaececae4026fb6e22359cb38946580ded59"
+  integrity sha512-obtSWTlbJ+a+TFRYGaUumtVwb+InIUVI0Lu0VBUAPmj2cU5JutEXg3xUE0c2J5Tcy7h2DEKVJBFi+Y9ZSFzzPQ==
+
 wait-for-expect@^1.1.1:
   version "1.2.0"
   resolved "https://registry.yarnpkg.com/wait-for-expect/-/wait-for-expect-1.2.0.tgz#fdab6a26e87d2039101db88bff3d8158e5c3e13f"