Commit fe9ee546 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[REFACT] WIP generic encode/decode json

parent 15953f46
...@@ -16,6 +16,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (getNodeTree) ...@@ -16,6 +16,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (getNodeTree)
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode) import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename) import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
import Gargantext.Components.Forest.Tree.Node.Action.Share (ShareValue(..), share) import Gargantext.Components.Forest.Tree.Node.Action.Share (ShareValue(..), share)
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..)) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks, tasksStruct) import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks, tasksStruct)
...@@ -244,14 +245,14 @@ performAction (DoSearch task) { reload: (_ /\ setReload) ...@@ -244,14 +245,14 @@ performAction (DoSearch task) { reload: (_ /\ setReload)
liftEffect $ onTaskAdd task liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] DoSearch task:" task liftEffect $ log2 "[performAction] DoSearch task:" task
------- -------
performAction (UpdateNode task) { reload: (_ /\ setReload) performAction (UpdateNode params) { reload: (_ /\ setReload)
, session , session
, tasks: {onTaskAdd} , tasks: {onTaskAdd}
, tree: (NTree (LNode {id}) _) , tree: (NTree (LNode {id}) _)
} = } =
do do
task <- updateRequest params session id
liftEffect $ onTaskAdd task liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] UpdateNode task:" task liftEffect $ log2 "[performAction] UpdateNode task:" task
...@@ -265,7 +266,6 @@ performAction (RenameNode name) p@{ reload: (_ /\ setReload) ...@@ -265,7 +266,6 @@ performAction (RenameNode name) p@{ reload: (_ /\ setReload)
void $ rename session id $ RenameValue {text:name} void $ rename session id $ RenameValue {text:name}
performAction RefreshTree p performAction RefreshTree p
------- -------
performAction (ShareNode username) p@{ reload: (_ /\ setReload) performAction (ShareNode username) p@{ reload: (_ /\ setReload)
, session , session
...@@ -294,7 +294,7 @@ performAction (UploadFile nodeType fileType mName contents) { session ...@@ -294,7 +294,7 @@ performAction (UploadFile nodeType fileType mName contents) { session
do do
task <- uploadFile session nodeType id fileType {mName, contents} task <- uploadFile session nodeType id fileType {mName, contents}
liftEffect $ onTaskAdd task liftEffect $ onTaskAdd task
liftEffect $ log2 "uploaded, task:" task liftEffect $ log2 "Uploaded, task:" task
------- -------
performAction RefreshTree { reload: (_ /\ setReload) } = do performAction RefreshTree { reload: (_ /\ setReload) } = do
......
...@@ -7,18 +7,23 @@ import Gargantext.Sessions (Session) ...@@ -7,18 +7,23 @@ import Gargantext.Sessions (Session)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction) import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents)
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
type Props = {-
( dispatch :: Action -> Aff Unit type UpdateNodeProps =
, id :: Int ( id :: GT.ID
, nodeType :: GT.NodeType , dispatch :: Action -> Aff Unit
, session :: Session , name :: GT.Name
, nodeType :: NodeType
, params :: UpdateNodeParams
) )
-}
data Action = AddNode String GT.NodeType data Action = AddNode String GT.NodeType
| DeleteNode | DeleteNode
| RenameNode String | RenameNode String
| UpdateNode GT.AsyncTaskWithType | UpdateNode UpdateNodeParams
| ShareNode String | ShareNode String
| DoSearch GT.AsyncTaskWithType | DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents | UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
...@@ -35,6 +40,12 @@ instance showShow :: Show Action where ...@@ -35,6 +40,12 @@ instance showShow :: Show Action where
show (UploadFile _ _ _ _)= "UploadFile" show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree" show RefreshTree = "RefreshTree"
type Props =
( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
)
----------------------------------------------------------------------- -----------------------------------------------------------------------
icon :: Action -> String icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add []) icon (AddNode _ _) = glyphiconNodeAction (Add [])
......
...@@ -4,72 +4,51 @@ import Data.Tuple.Nested ((/\)) ...@@ -4,72 +4,51 @@ import Data.Tuple.Nested ((/\))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>)) import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, formButton, panel) import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Gargantext.Types (NodeType(..)) import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Prelude (Unit, class Show, class Read, show, bind, ($), pure) import Gargantext.Prelude (Unit, class Show, class Read, show, bind, ($), pure)
import Gargantext.Sessions (Session, put)
import Gargantext.Routes as GR
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
{-
updateNode :: Session -> ID -> UpdateNodeParams -> Aff (Array ID)
updateNode session nodeId params = post session $ GR.NodeAPI GT.Node (Just nodeId) ""
-}
data UpdateNodeParams = UpdateNodeParamsList { method :: Method } updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType
| UpdateNodeParamsGraph { method :: String } updateRequest (UpdateNodeParamsList meth) session nodeId = do
| UpdateNodeParamsTexts { method :: Int } task <- put session p meth
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode } -- TODO add NodeType
instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
where where
encodeJson (UpdateNodeParamsList { method }) p = GR.NodeAPI GT.Node (Just nodeId) (GT.asyncTaskTypePath GT.UpdateNode)
= "method" := show method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsGraph { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsTexts { method })
= "method" := method
~> jsonEmptyObject
----------------------------------------------------------------------
type UpdateNodeProps =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, name :: GT.Name
, nodeType :: NodeType
, params :: UpdateNodeParams
)
----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel
instance readMethod :: Read Method where updateRequest (UpdateNodeParamsGraph meth) session nodeId = do
read "Basic" = Just Basic task <- put session p meth
read "Advanced" = Just Advanced pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode } -- TODO add NodeType
read "WithModel" = Just WithModel where
read _ = Nothing p = GR.NodeAPI GT.Node (Just nodeId) (GT.asyncTaskTypePath GT.UpdateNode)
instance showMethod :: Show Method where updateRequest (UpdateNodeParamsTexts meth) session nodeId = do
show Basic = "Basic" task <- put session p meth
show Advanced = "Advanced" pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode } -- TODO add NodeType
show WithModel = "WithModel" where
p = GR.NodeAPI GT.Node (Just nodeId) (GT.asyncTaskTypePath GT.UpdateNode)
---------------------------------------------------------------------- ----------------------------------------------------------------------
update :: NodeType -> R.Hooks R.Element update :: NodeType
update NodeList = do -> (Action -> Aff Unit)
-> R.Hooks R.Element
update NodeList dispatch = do
method @( _ /\ setMethod ) <- R.useState' Basic method @( _ /\ setMethod ) <- R.useState' Basic
nodeType@( _ /\ setNodeType) <- R.useState' NodeList
pure $ panel [ -- H.text "Update with" pure $ panel [ -- H.text "Update with"
formChoiceSafe [Basic, Advanced, WithModel] Basic setMethod formChoiceSafe [Basic, Advanced, WithModel] Basic setMethod
] ]
(formButton NodeList setNodeType) (submitButton (UpdateNode $ UpdateNodeParamsList method) dispatch)
update Graph = pure $ H.div {} [] update Graph _ = pure $ H.div {} []
update Texts = pure $ H.div {} [] update Texts _ = pure $ H.div {} []
update _ = pure $ H.div {} [] update _ _ = pure $ H.div {} []
-- fragmentPT $ "Update " <> show nodeType -- fragmentPT $ "Update " <> show nodeType
module Gargantext.Components.Forest.Tree.Node.Action.Update.Types where
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Tuple.Nested ((/\))
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Data.Maybe (Maybe(..))
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Effect.Aff (Aff)
import Gargantext.Types (NodeType(..))
import Gargantext.Types as GT
import Gargantext.Prelude (Unit, class Eq, class Show, class Read, class Read, show, bind, ($), pure)
import Reactix as R
import Reactix.DOM.HTML as H
data UpdateNodeParams = UpdateNodeParamsList { method :: Method }
| UpdateNodeParamsGraph { method :: String }
| UpdateNodeParamsTexts { method :: Int }
derive instance eqUpdateNodeParams :: Eq UpdateNodeParams
derive instance genericUpdateNodeParams :: Generic UpdateNodeParams _
instance showUpdateNodeParams :: Show UpdateNodeParams where
show = genericShow
instance decodeJsonUpdateNodeParams :: Argonaut.DecodeJson UpdateNodeParams where
decodeJson = genericSumDecodeJson
instance encodeJsonUpdateNodeParams :: Argonaut.EncodeJson UpdateNodeParams where
encodeJson = genericSumEncodeJson
{-
instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
where
encodeJson (UpdateNodeParamsList { method })
= "method" := show method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsGraph { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsTexts { method })
= "method" := method
~> jsonEmptyObject
-}
----------------------------------------------------------------------
----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel
derive instance genericMethod :: Generic Method _
derive instance eqMethod :: Eq Method
instance showMethod :: Show Method where
show = genericShow
instance readMethod :: Read Method where
read "Basic" = Just Basic
read "Advanced" = Just Advanced
read "WithModel" = Just WithModel
read _ = Nothing
instance decodeJsonMethod :: Argonaut.DecodeJson Method where
decodeJson = genericSumDecodeJson
instance encodeJsonMethod :: Argonaut.EncodeJson Method where
encodeJson = genericSumEncodeJson
...@@ -284,8 +284,7 @@ uploadFile session nodeType id fileType {mName, contents: UploadFileContents con ...@@ -284,8 +284,7 @@ uploadFile session nodeType id fileType {mName, contents: UploadFileContents con
q = FileUploadQuery { fileType: fileType } q = FileUploadQuery { fileType: fileType }
--p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q) --p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
bodyParams = [ bodyParams = [ Tuple "_wf_data" (Just contents)
Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType) , Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName , Tuple "_wf_name" mName
] ]
......
...@@ -240,7 +240,7 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt ...@@ -240,7 +240,7 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
cpt {action: Add xs, dispatch, id, name, nodePopup: p, nodeType} _ = do cpt {action: Add xs, dispatch, id, name, nodePopup: p, nodeType} _ = do
pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs}
cpt {action: Refresh , dispatch, id, nodeType, session} _ = update nodeType cpt {action: Refresh , dispatch, id, nodeType, session} _ = update nodeType dispatch
cpt {action: Config , dispatch, id, nodeType, session} _ = do cpt {action: Config , dispatch, id, nodeType, session} _ = do
pure $ fragmentPT $ "Config " <> show nodeType pure $ fragmentPT $ "Config " <> show nodeType
......
module Gargantext.Components.Forest.Tree.Node.Tools where module Gargantext.Components.Forest.Tree.Node.Tools
where
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.String as S import Data.String as S
...@@ -28,6 +29,7 @@ panel bodies submit = ...@@ -28,6 +29,7 @@ panel bodies submit =
, style: {"margin":"10px"} , style: {"margin":"10px"}
} }
[ H.div { className: "col-md-10" } [ H.div { className: "col-md-10" }
-- TODO add type for text or form here
[ H.form {className: "form-horizontal"} bs [ H.form {className: "form-horizontal"} bs
] ]
] ]
...@@ -122,7 +124,7 @@ formEdit defaultValue setter = ...@@ -122,7 +124,7 @@ formEdit defaultValue setter =
] ]
-- | Form Choice input -- | Form Choice input
-- if the list of options is not big enough, a button is used instead
formChoiceSafe :: forall a b c formChoiceSafe :: forall a b c
. Read a . Read a
=> Show a => Show a
...@@ -138,7 +140,7 @@ formChoiceSafe [n] _defaultNodeType setNodeType = ...@@ -138,7 +140,7 @@ formChoiceSafe [n] _defaultNodeType setNodeType =
formChoiceSafe nodeTypes defaultNodeType setNodeType = formChoiceSafe nodeTypes defaultNodeType setNodeType =
formChoice nodeTypes defaultNodeType setNodeType formChoice nodeTypes defaultNodeType setNodeType
-- | List Form
formChoice :: forall a b c d formChoice :: forall a b c d
. Read b . Read b
=> Show d => Show d
...@@ -159,8 +161,7 @@ formChoice nodeTypes defaultNodeType setNodeType = ...@@ -159,8 +161,7 @@ formChoice nodeTypes defaultNodeType setNodeType =
(map (\opt -> H.option {} [ H.text $ show opt ]) nodeTypes) (map (\opt -> H.option {} [ H.text $ show opt ]) nodeTypes)
] ]
-- Buttons -- | Button Form
formButton :: forall a b c formButton :: forall a b c
. a . a
-> ((b -> a) -> Effect c) -> ((b -> a) -> Effect c)
...@@ -171,9 +172,12 @@ formButton nodeType setNodeType = ...@@ -171,9 +172,12 @@ formButton nodeType setNodeType =
, title: "Form Button" , title: "Form Button"
, style : { width: "50%" } , style : { width: "50%" }
, onClick : mkEffectFn1 , onClick : mkEffectFn1
$ \_ -> setNodeType ( const nodeType) $ \_ -> setNodeType ( const nodeType )
} [H.text $ "Go !"] } [H.text $ "Go !"]
------------------------------------------------------------------------
------------------------------------------------------------------------
submitButton :: Action -> (Action -> Aff Unit) -> R.Element submitButton :: Action -> (Action -> Aff Unit) -> R.Element
submitButton action dispatch = submitButton action dispatch =
H.button { className : "btn btn-primary fa fa-" <> icon action H.button { className : "btn btn-primary fa fa-" <> icon action
......
...@@ -474,6 +474,7 @@ data AsyncTaskType = Form ...@@ -474,6 +474,7 @@ data AsyncTaskType = Form
| GraphT | GraphT
| Query | Query
| AddNode | AddNode
| UpdateNode
derive instance genericAsyncTaskType :: Generic AsyncTaskType _ derive instance genericAsyncTaskType :: Generic AsyncTaskType _
instance eqAsyncTaskType :: Eq AsyncTaskType where instance eqAsyncTaskType :: Eq AsyncTaskType where
...@@ -497,6 +498,9 @@ asyncTaskTypePath Form = "add/form/async/" ...@@ -497,6 +498,9 @@ asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/" asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/" asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath AddNode = "async/nobody/" asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "async/nobody/"
type AsyncTaskID = String type AsyncTaskID = String
......
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