Skip to content

P
purescript-gargantext
Commit fe9ee546 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[REFACT] WIP generic encode/decode json

parent 15953f46
Hide whitespace changes
Inline Side-by-side
Showing with 163 additions and 93 deletions
src/Gargantext/Components/Forest/Tree.purs
View file @ fe9ee546
......@@ -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.Rename (RenameValue(..), rename)
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.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks, tasksStruct)
......@@ -244,14 +245,14 @@ performAction (DoSearch task) { reload: (_ /\ setReload)
liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] DoSearch task:" task
-------
performAction (UpdateNode task) { reload: (_ /\ setReload)
performAction (UpdateNode params) { reload: (_ /\ setReload)
, session
, tasks: {onTaskAdd}
, tree: (NTree (LNode {id}) _)
} =
do
task <- updateRequest params session id
liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] UpdateNode task:" task
......@@ -265,7 +266,6 @@ performAction (RenameNode name) p@{ reload: (_ /\ setReload)
void $ rename session id $ RenameValue {text:name}
performAction RefreshTree p
-------
performAction (ShareNode username) p@{ reload: (_ /\ setReload)
, session
......@@ -294,7 +294,7 @@ performAction (UploadFile nodeType fileType mName contents) { session
do
task <- uploadFile session nodeType id fileType {mName, contents}
liftEffect $ onTaskAdd task
liftEffect $ log2 "uploaded, task:" task
liftEffect $ log2 "Uploaded, task:" task
-------
performAction RefreshTree { reload: (_ /\ setReload) } = do
......
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ fe9ee546
......@@ -7,18 +7,23 @@ import Gargantext.Sessions (Session)
import Gargantext.Types as GT
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.Update.Types (UpdateNodeParams)
type Props =
( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
{-
type UpdateNodeProps =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, name :: GT.Name
, nodeType :: NodeType
, params :: UpdateNodeParams
)
-}
data Action = AddNode String GT.NodeType
| DeleteNode
| RenameNode String
| UpdateNode GT.AsyncTaskWithType
| UpdateNode UpdateNodeParams
| ShareNode String
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
......@@ -35,13 +40,19 @@ instance showShow :: Show Action where
show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree"
type Props =
( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
)
-----------------------------------------------------------------------
icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon DeleteNode = glyphiconNodeAction Delete
icon (RenameNode _) = glyphiconNodeAction Config
icon (UpdateNode _) = glyphiconNodeAction Refresh
icon (ShareNode _) = glyphiconNodeAction Share
icon (ShareNode _) = glyphiconNodeAction Share
icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
......
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ fe9ee546
......@@ -21,9 +21,9 @@ addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Array GT.ID)
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
addNodeAsync :: Session
-> GT.ID
-> AddNodeValue
-> Aff GT.AsyncTaskWithType
-> GT.ID
-> AddNodeValue
-> Aff GT.AsyncTaskWithType
addNodeAsync session parentId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode}
......
src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchBar.purs
View file @ fe9ee546
......@@ -28,10 +28,10 @@ searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
cpt {langs, onSearch, search: search@(s /\ _), session} _ = do
--onSearchChange session s
pure $ H.div {"style": {"margin" :"10px"}}
[ searchField { databases:allDatabases
, langs
, onSearch
, search
, session
}
]
[ searchField { databases:allDatabases
, langs
, onSearch
, search
, session
}
]
src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs
View file @ fe9ee546
......@@ -4,72 +4,51 @@ import Data.Tuple.Nested ((/\))
import Data.Maybe (Maybe(..))
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, formButton, panel)
import Gargantext.Types (NodeType(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
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.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 }
| UpdateNodeParamsGraph { method :: String }
| UpdateNodeParamsTexts { method :: Int }
updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType
updateRequest (UpdateNodeParamsList meth) session nodeId = do
task <- put session p meth
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode } -- TODO add NodeType
where
p = GR.NodeAPI GT.Node (Just nodeId) (GT.asyncTaskTypePath GT.UpdateNode)
instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
where
encodeJson (UpdateNodeParamsList { method })
= "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
read "Basic" = Just Basic
read "Advanced" = Just Advanced
read "WithModel" = Just WithModel
read _ = Nothing
updateRequest (UpdateNodeParamsGraph meth) session nodeId = do
task <- put session p meth
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode } -- TODO add NodeType
where
p = GR.NodeAPI GT.Node (Just nodeId) (GT.asyncTaskTypePath GT.UpdateNode)
instance showMethod :: Show Method where
show Basic = "Basic"
show Advanced = "Advanced"
show WithModel = "WithModel"
updateRequest (UpdateNodeParamsTexts meth) session nodeId = do
task <- put session p meth
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode } -- TODO add NodeType
where
p = GR.NodeAPI GT.Node (Just nodeId) (GT.asyncTaskTypePath GT.UpdateNode)
----------------------------------------------------------------------
update :: NodeType -> R.Hooks R.Element
update NodeList = do
update :: NodeType
-> (Action -> Aff Unit)
-> R.Hooks R.Element
update NodeList dispatch = do
method @( _ /\ setMethod ) <- R.useState' Basic
nodeType@( _ /\ setNodeType) <- R.useState' NodeList
pure $ panel [ -- H.text "Update with"
formChoiceSafe [Basic, Advanced, WithModel] Basic setMethod
]
(formButton NodeList setNodeType)
(submitButton (UpdateNode $ UpdateNodeParamsList method) dispatch)
update Graph = pure $ H.div {} []
update Texts = pure $ H.div {} []
update _ = pure $ H.div {} []
update Graph _ = pure $ H.div {} []
update Texts _ = pure $ H.div {} []
update _ _ = pure $ H.div {} []
-- fragmentPT $ "Update " <> show nodeType
src/Gargantext/Components/Forest/Tree/Node/Action/Update/Types.purs 0 → 100644
View file @ fe9ee546
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
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @ fe9ee546
......@@ -12,16 +12,16 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..),
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe)
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Prelude (class Show, Unit, discard, bind, const, id, map, pure, show, unit, void, ($), read)
import Gargantext.Routes as GR
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
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 React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsText)
-- UploadFile Action
......@@ -284,11 +284,10 @@ uploadFile session nodeType id fileType {mName, contents: UploadFileContents con
q = FileUploadQuery { fileType: fileType }
--p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
bodyParams = [
Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName
]
bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName
]
------------------------------------------------------------------------
......
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ fe9ee546
......@@ -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
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
pure $ fragmentPT $ "Config " <> show nodeType
......
src/Gargantext/Components/Forest/Tree/Node/Tools.purs
View file @ fe9ee546
module Gargantext.Components.Forest.Tree.Node.Tools where
module Gargantext.Components.Forest.Tree.Node.Tools
where
import Data.Maybe (fromMaybe)
import Data.String as S
......@@ -28,6 +29,7 @@ panel bodies submit =
, style: {"margin":"10px"}
}
[ H.div { className: "col-md-10" }
-- TODO add type for text or form here
[ H.form {className: "form-horizontal"} bs
]
]
......@@ -122,7 +124,7 @@ formEdit defaultValue setter =
]
-- | Form Choice input
-- if the list of options is not big enough, a button is used instead
formChoiceSafe :: forall a b c
. Read a
=> Show a
......@@ -138,7 +140,7 @@ formChoiceSafe [n] _defaultNodeType setNodeType =
formChoiceSafe nodeTypes defaultNodeType setNodeType =
formChoice nodeTypes defaultNodeType setNodeType
-- | List Form
formChoice :: forall a b c d
. Read b
=> Show d
......@@ -159,10 +161,9 @@ formChoice nodeTypes defaultNodeType setNodeType =
(map (\opt -> H.option {} [ H.text $ show opt ]) nodeTypes)
]
-- Buttons
-- | Button Form
formButton :: forall a b c
. a
. a
-> ((b -> a) -> Effect c)
-> R.Element
formButton nodeType setNodeType =
......@@ -170,10 +171,13 @@ formButton nodeType setNodeType =
, type : "button"
, title: "Form Button"
, style : { width: "50%" }
, onClick : mkEffectFn1
$ \_ -> setNodeType ( const nodeType)
, onClick : mkEffectFn1
$ \_ -> setNodeType ( const nodeType )
} [H.text $ "Go !"]
------------------------------------------------------------------------
------------------------------------------------------------------------
submitButton :: Action -> (Action -> Aff Unit) -> R.Element
submitButton action dispatch =
H.button { className : "btn btn-primary fa fa-" <> icon action
......
src/Gargantext/Types.purs
View file @ fe9ee546
......@@ -474,6 +474,7 @@ data AsyncTaskType = Form
| GraphT
| Query
| AddNode
| UpdateNode
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
instance eqAsyncTaskType :: Eq AsyncTaskType where
......@@ -497,6 +498,9 @@ asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "async/nobody/"
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