[CodeEditor] first version with saving to corpus endpoint

src/Gargantext/Components/CodeEditor.purs

@@ -43,9 +43,9 @@ instance showViewType :: Show ViewType where
   show = genericShow
 
 type Props =
-  ( code :: String
+  ( code :: Code
   , defaultCodeType :: CodeType
-  , onChange :: String -> Effect Unit
+  , onChange :: Code -> Effect Unit
   )
 
 -- Fixes newlines in code
@@ -114,7 +114,7 @@ codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt
            H.div { className: "code-area " <> (codeHidden $ fst controls.viewType) } [
              H.div { className: "code-container" } [
                H.textarea { defaultValue: code
-                          , on: { change: onEditChange controls }
+                          , on: { change: onEditChange controls onChange }
                           , placeholder: "Type some code..."
                           , ref: controls.codeElRef } [ ]
                , H.pre  { className: (langClass $ fst controls.codeType)
@@ -150,12 +150,13 @@ codeEditorCpt = R.hooksComponent "G.C.CE.CodeEditor" cpt
     previewHidden Both = ""
     previewHidden _ = " hidden"
 
-    onEditChange :: forall e. Record Controls -> e -> Effect Unit
-    onEditChange controls@{codeElRef, codeOverlayElRef, editorCodeRef} e = do
+    onEditChange :: forall e. Record Controls -> (Code -> Effect Unit) -> e -> Effect Unit
+    onEditChange controls@{codeElRef, codeOverlayElRef, editorCodeRef} onChange e = do
       let code = R2.unsafeEventValue e
       R.setRef editorCodeRef code
       setCodeOverlay controls code
       renderHtml (R.readRef controls.editorCodeRef) controls
+      onChange code
 
 setCodeOverlay :: Record Controls -> Code -> Effect Unit
 setCodeOverlay {codeOverlayElRef, codeType: (codeType /\ _)} code = do

src/Gargantext/Components/Nodes/Corpus.purs

 module Gargantext.Components.Nodes.Corpus where
 
-import Data.Argonaut (class DecodeJson, encodeJson)
+import Data.Argonaut (class DecodeJson, decodeJson, encodeJson)
+import Data.Argonaut.Parser (jsonParser)
 import Data.Array as A
+import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
-import Data.Tuple (fst)
+import Data.Tuple (Tuple(..), fst)
 import Data.Tuple.Nested ((/\))
 import DOM.Simple.Console (log2)
-import Effect.Aff (Aff, throwError)
+import Effect.Aff (Aff, launchAff_, throwError)
+import Effect (Effect)
 import Effect.Exception (error)
 import Reactix as R
 import Reactix.DOM.HTML as H
@@ -18,7 +21,7 @@ import Gargantext.Components.Node (NodePoly(..), HyperdataList)
 import Gargantext.Components.Nodes.Corpus.Types
 import Gargantext.Hooks.Loader (useLoader)
 import Gargantext.Routes (SessionRoute(NodeAPI, Children))
-import Gargantext.Sessions (Session, get)
+import Gargantext.Sessions (Session, get, put)
 import Gargantext.Types (NodeType(..), AffTableResult)
 import Gargantext.Utils.Reactix as R2
 
@@ -38,70 +41,148 @@ corpusLayoutCpt = R.hooksComponent "G.C.N.C.corpusLayout" cpt
         \corpus -> corpusLayoutView {corpus, nodeId, session}
 
 type ViewProps = (
-    corpus  :: NodePoly CorpusHyperdata
+    corpus  :: NodePoly Hyperdata
   | Props
   )
 
+type Index = Int
+type FTFieldWithIndex = Tuple Index FTField
+
 corpusLayoutView :: Record ViewProps -> R.Element
 corpusLayoutView props = R.createElement corpusLayoutViewCpt props []
 
 corpusLayoutViewCpt :: R.Component ViewProps
 corpusLayoutViewCpt = R.hooksComponent "G.C.N.C.corpusLayoutView" cpt
   where
-    cpt {corpus: (NodePoly {hyperdata: CorpusHyperdata {fields}}), nodeId, session} _ = do
-      fieldsS <- R.useState' fields
+    cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields}}), nodeId, session} _ = do
+      let fieldsWithIndex = A.mapWithIndex (\idx -> \t -> Tuple idx t) fields
+      fieldsS <- R.useState' fieldsWithIndex
 
       pure $ H.div {} [
-          H.div {} (corpusFieldCodeEditor {nodeId, session} <$> (fst fieldsS))
+          H.div { className: "row" } [
+            H.div { className: "btn btn-default " <> (saveEnabled fieldsWithIndex fieldsS)
+                  , on: { click: onClickSave {fields: fieldsS, nodeId, session} }
+                  } [
+               H.span { className: "glyphicon glyphicon-save" } [  ]
+            ]
+          ]
+        , H.div {} [ fieldsCodeEditor {nodeId, session, fields: fieldsS} ]
         , H.div { className: "row" } [
             H.div { className: "btn btn-default"
-                  , on: { click: onClick fieldsS }
+                  , on: { click: onClickAdd fieldsS }
                   } [
               H.span { className: "glyphicon glyphicon-plus" } [  ]
             ]
           ]
         ]
-          --H.iframe { src: gargMd , width: "100%", height: "100%", style: {"border-style": "none"}} []
-    --gargMd = "https://hackmd.iscpif.fr/g9Aah4iwQtCayIzsKQjA0Q#"
-    onClick (_ /\ setFieldsS) _ = do
-      setFieldsS $ \fieldsS -> A.snoc fieldsS $ CorpusField {
-          name: "New file"
-        , typ: Markdown {
-            tag: "MarkdownField"
-          , text: "# New file"
-          }
-        }
-
-corpusFieldCodeEditor :: Record LoadProps -> CorpusField CorpusFieldType -> R.Element
-corpusFieldCodeEditor p (CorpusField {name, typ}) =
-  H.div { className: "row panel panel-default" } [
-      H.div { className: "panel-heading" } [ H.text name ]
-    , H.div { className: "panel-body" } [
-        corpusFieldCodeEditor' typ
-      ]
-    ]
-
-corpusFieldCodeEditor' :: CorpusFieldType -> R.Element
-corpusFieldCodeEditor' (Markdown {text}) =
-  CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange}
+
+    saveEnabled :: Array FTFieldWithIndex -> R.State (Array FTFieldWithIndex) -> String
+    saveEnabled fs (fsS /\ _) = if fs == fsS then "disabled" else "enabled"
+
+    onClickSave :: forall e. { fields :: R.State (Array FTFieldWithIndex)
+                             , nodeId :: Int
+                             , session :: Session } -> e -> Effect Unit
+    onClickSave {fields: (fieldsS /\ _), nodeId, session} _ = do
+      log2 "[corpusLayoutViewCpt] onClickSave fieldsS" fieldsS
+      launchAff_ do
+        saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fieldsS}
+                     , nodeId
+                     , session }
+
+    onClickAdd :: forall e. R.State (Array FTFieldWithIndex) -> e -> Effect Unit
+    onClickAdd (_ /\ setFieldsS) _ = do
+      setFieldsS $ \fieldsS -> A.snoc fieldsS $ Tuple (A.length fieldsS) defaultField
+
+type FieldsCodeEditorProps =
+  (
+    fields :: R.State (Array FTFieldWithIndex)
+    | LoadProps
+  )
+
+fieldsCodeEditor :: Record FieldsCodeEditorProps -> R.Element
+fieldsCodeEditor props = R.createElement fieldsCodeEditorCpt props []
+
+fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
+fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
+  where
+    cpt {nodeId, fields: fS@(fields /\ setFields), session} _ = do
+      pure $ H.div {} $
+        (\(Tuple idx field) ->
+          fieldCodeEditorWrapper { field
+                                 , onChange: onChange fS idx
+                                 }) <$> fields
+
+    onChange :: R.State (Array FTFieldWithIndex) -> Index -> FieldType -> Effect Unit
+    onChange (_ /\ setFields) idx typ = do
+      log2 "[fieldsCodeEditorCpt] onChange" typ
+      setFields $ \fields ->
+        case A.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields of
+          Nothing -> fields
+          Just newFields -> newFields
+
+type FieldCodeEditorProps =
+  (
+    field :: FTField
+  , onChange :: FieldType -> 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
-    onChange c = do
-      log2 "[corpusFieldCodeEditor'] Markdown c" c
-corpusFieldCodeEditor' (JSON j) = do
-  CE.codeEditor {code, defaultCodeType: CE.JSON, onChange}
+    cpt props@{field: Field {name, typ}} _ = do
+      pure $ H.div { className: "row panel panel-default" } [
+        H.div { className: "panel-heading" } [ H.text name ]
+        , H.div { className: "panel-body" } [
+           fieldCodeEditor props
+           ]
+        ]
+
+fieldCodeEditor :: Record FieldCodeEditorProps -> R.Element
+fieldCodeEditor props = R.createElement fieldCodeEditorCpt props []
+
+fieldCodeEditorCpt :: R.Component FieldCodeEditorProps
+fieldCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldCodeEditorCpt" cpt
   where
-    code = R2.stringify (encodeJson j) 2
-    onChange c = do
-      log2 "[corpusFieldCodeEditor'] JSON c" c
+    cpt {field: Field {typ: Markdown md@{text}}, onChange} _ = do
+      pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: onChange'}
+      where
+        onChange' :: CE.Code -> Effect Unit
+        onChange' c = do
+          log2 "[fieldCodeEditor'] Markdown c" c
+          onChange $ Markdown $ md { text = c }
+    cpt {field: Field {typ: JSON j}, onChange} _ = do
+      pure $ CE.codeEditor {code, defaultCodeType: CE.JSON, onChange: onChange'}
+      where
+        code = R2.stringify (encodeJson j) 2
+
+        onChange' :: CE.Code -> Effect Unit
+        onChange' c = do
+          log2 "[fieldCodeEditor'] JSON c" c
+          case jsonParser c of
+            Left err -> log2 "[fieldCodeEditor'] cannot parse json" c
+            Right j' -> case decodeJson j' of
+              Left err -> log2 "[fieldCodeEditor'] cannot decode json" j'
+              Right j'' -> onChange $ JSON j''
 
 type LoadProps = (
     nodeId  :: Int
   , session :: Session
   )
 
-loadCorpus' :: Record LoadProps -> Aff (NodePoly CorpusHyperdata)
+loadCorpus' :: Record LoadProps -> Aff (NodePoly Hyperdata)
 loadCorpus' {nodeId, session} = get session $ NodeAPI Corpus (Just nodeId) ""
 
+type SaveProps = (
+  hyperdata :: Hyperdata
+  | LoadProps
+  )
+
+saveCorpus :: Record SaveProps -> Aff Unit
+saveCorpus {hyperdata, nodeId, session} = put session (NodeAPI Corpus (Just nodeId) "") hyperdata
+
 loadCorpus :: Record LoadProps -> Aff CorpusData
 loadCorpus {nodeId, session} = do
   -- fetch corpus via lists parentId

src/Gargantext/Components/Nodes/Corpus/Types.purs

 module Gargantext.Components.Nodes.Corpus.Types where
 
-import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject)
 import Data.Either (Either(..))
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Eq (genericEq)
 import Data.Maybe (Maybe)
 
 import Gargantext.Prelude
@@ -15,23 +17,31 @@ type Tag = String
 type Title = String
 type MarkdownText = String
 
-newtype CorpusHyperdata =
-  CorpusHyperdata
+newtype Hyperdata =
+  Hyperdata
   {
-    fields :: Array (CorpusField CorpusFieldType)
+    fields :: Array FTField
   }
-instance decodeCorpusHyperdata :: DecodeJson CorpusHyperdata where
+instance decodeHyperdata :: DecodeJson Hyperdata where
   decodeJson json = do
     obj <- decodeJson json
     fields <- obj .: "fields"
-    pure $ CorpusHyperdata {fields}
+    pure $ Hyperdata {fields}
+instance encodeHyperdata :: EncodeJson Hyperdata where
+  encodeJson (Hyperdata {fields}) = do
+       "fields"  := fields
+    ~> jsonEmptyObject
 
-newtype CorpusField a = CorpusField {
+newtype Field a = Field {
     name :: String
   , typ  :: a
   }
+type FTField = Field FieldType
+derive instance genericFTField :: Generic (Field FieldType) _
+instance eqFTField :: Eq (Field FieldType) where
+  eq = genericEq
 
-data CorpusFieldType = JSON {
+data FieldType = JSON {
     authors        :: Author
   , desc           :: Description
   , query          :: Query
@@ -42,7 +52,10 @@ data CorpusFieldType = JSON {
     tag              :: Tag
   , text             :: MarkdownText
   }
-instance decodeCorpusField :: DecodeJson (CorpusField CorpusFieldType) where
+derive instance genericFieldType :: Generic FieldType _
+instance eqFieldType :: Eq FieldType where
+  eq = genericEq
+instance decodeFTField :: DecodeJson (Field FieldType) where
   decodeJson json = do
     obj <- decodeJson json
     name <- obj .: "name"
@@ -61,7 +74,37 @@ instance decodeCorpusField :: DecodeJson (CorpusField CorpusFieldType) where
         text <- data_ .: "text"
         pure $ Markdown {tag, text}
       _ -> Left $ "Unsupported 'type' " <> type_
-    pure $ CorpusField {name, typ}
+    pure $ Field {name, typ}
+instance encodeFTField :: EncodeJson (Field FieldType) where
+  encodeJson (Field {name, typ}) =
+        "data"  := typ
+    ~>  "name"  := name
+    ~> "type"   := typ' typ
+    ~> jsonEmptyObject
+    where
+      typ' (JSON _) = "JSON"
+      typ' (Markdown _) = "Markdown"
+instance encodeFieldType :: EncodeJson FieldType where
+  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
+
+defaultField :: FTField
+defaultField = Field {
+  name: "New file"
+  , typ: Markdown {
+    tag: "MarkdownField"
+    , text: "# New file"
+    }
+  }
 
 newtype CorpusInfo =
   CorpusInfo