Commit 20baab9e authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/dev-tree-fixes' into dev-demo-merge

parents f061407f 37febcb1
...@@ -570,6 +570,16 @@ ...@@ -570,6 +570,16 @@
"repo": "https://github.com/purescript/purescript-distributive.git", "repo": "https://github.com/purescript/purescript-distributive.git",
"version": "v4.0.0" "version": "v4.0.0"
}, },
"dom-filereader": {
"dependencies": [
"aff",
"arraybuffer-types",
"web-file",
"web-html"
],
"repo": "https://github.com/nwolverson/purescript-dom-filereader",
"version": "v5.0.0"
},
"dom-indexed": { "dom-indexed": {
"dependencies": [ "dependencies": [
"media-types", "media-types",
......
...@@ -82,7 +82,7 @@ li#rename #rename-a{ ...@@ -82,7 +82,7 @@ li#rename #rename-a{
} }
#rename-tooltip { #node-popup-tooltip {
position : absolute; position : absolute;
left : 96px; left : 96px;
top:-64px; top:-64px;
...@@ -90,6 +90,28 @@ li#rename #rename-a{ ...@@ -90,6 +90,28 @@ li#rename #rename-a{
z-index: 1000; z-index: 1000;
} }
#create-node-tooltip {
position : absolute;
left : 96px;
top:-64px;
background-color: white;
z-index: 1000;
}
#create-node-tooltip .panel-body input {
min-width: 200px;
}
#file-type-tooltip {
position : absolute;
left : 96px;
top:-64px;
background-color: white;
z-index: 1000;
}
#file-type-tooltip .panel-body select {
min-width: 200px;
}
li a#rename { li a#rename {
display:none; display:none;
...@@ -106,6 +128,7 @@ li a#rename-leaf { ...@@ -106,6 +128,7 @@ li a#rename-leaf {
display:none; display:none;
position:absolute; position:absolute;
text-decoration:none; text-decoration:none;
margin-left: 20px;
} }
li:hover a#rename-leaf { li:hover a#rename-leaf {
...@@ -139,7 +162,7 @@ text-align: center; ...@@ -139,7 +162,7 @@ text-align: center;
transform: scale(1.4); transform: scale(1.4);
} }
#rename-tooltip:hover { #node-popup-tooltip:hover {
border:none; border:none;
} }
...@@ -155,7 +178,7 @@ text-align: center; ...@@ -155,7 +178,7 @@ text-align: center;
left: -9px; left: -9px;
} }
#rename-tooltip a:hover #node-popup-tooltip a:hover
{ {
text-decoration:none; text-decoration:none;
} }
...@@ -184,3 +207,12 @@ text-align: center; ...@@ -184,3 +207,12 @@ text-align: center;
#graph-tree .tree { #graph-tree .tree {
margin-top: 27px; margin-top: 27px;
} }
.nopadding {
padding: 0 !important;
margin: 0 !important;
}
.row-no-padding > [class*="col-"] {
padding-left: 0 !important;
padding-right: 0 !important;
}
...@@ -173,6 +173,15 @@ let additions = ...@@ -173,6 +173,15 @@ let additions =
] ]
"https://github.com/irresponsible/purescript-dom-simple" "https://github.com/irresponsible/purescript-dom-simple"
"v0.2.4" "v0.2.4"
, dom-filereader =
mkPackage
[ "aff"
, "arraybuffer-types"
, "web-file"
, "web-html"
]
"https://github.com/nwolverson/purescript-dom-filereader"
"v5.0.0"
, reactix = , reactix =
mkPackage mkPackage
[ "console" [ "console"
......
...@@ -3,30 +3,31 @@ ...@@ -3,30 +3,31 @@
"set": "local", "set": "local",
"source": ".psc-package", "source": ".psc-package",
"depends": [ "depends": [
"numbers", "affjax",
"spec-quickcheck",
"spec-discovery",
"uint",
"js-timers",
"psci-support",
"css",
"generics-rep",
"maybe",
"routing",
"foreign-object",
"argonaut", "argonaut",
"console",
"css",
"dom-filereader",
"dom-simple",
"effect", "effect",
"web-html", "foreign-object",
"thermite", "generics-rep",
"integers", "integers",
"random", "js-timers",
"affjax", "maybe",
"console", "numbers",
"strings",
"string-parsers",
"prelude", "prelude",
"dom-simple", "psci-support",
"random",
"reactix", "reactix",
"uri" "routing",
"spec-discovery",
"spec-quickcheck",
"string-parsers",
"strings",
"thermite",
"uint",
"uri",
"web-html"
] ]
} }
...@@ -24,7 +24,7 @@ import Reactix as R ...@@ -24,7 +24,7 @@ import Reactix as R
import Reactix.DOM.HTML as HTML import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E import Reactix.SyntheticEvent as E
import Gargantext.Utils.Reactix as R' import Gargantext.Utils.Reactix as R2
type Props t = ( x :: Number, y :: Number, setMenu :: Maybe t -> Effect Unit) type Props t = ( x :: Number, y :: Number, setMenu :: Maybe t -> Effect Unit)
...@@ -71,14 +71,14 @@ contextMenuEffect setMenu rootRef _ = ...@@ -71,14 +71,14 @@ contextMenuEffect setMenu rootRef _ =
documentClickHandler :: forall t. (Maybe t -> Effect Unit) -> DOM.Element -> Callback DE.MouseEvent documentClickHandler :: forall t. (Maybe t -> Effect Unit) -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler hide menu = documentClickHandler hide menu =
R'.named "hideMenuOnClickOutside" $ callback $ \e -> R2.named "hideMenuOnClickOutside" $ callback $ \e ->
if Element.contains menu (DE.target e) if Element.contains menu (DE.target e)
then pure unit then pure unit
else hide Nothing else hide Nothing
documentScrollHandler :: forall t. (Maybe t -> Effect Unit) -> Callback DE.MouseEvent documentScrollHandler :: forall t. (Maybe t -> Effect Unit) -> Callback DE.MouseEvent
documentScrollHandler hide = documentScrollHandler hide =
R'.named "hideMenuOnScroll" $ callback $ \e -> hide Nothing R2.named "hideMenuOnScroll" $ callback $ \e -> hide Nothing
position :: forall t. Record (Props t) -> DOMRect -> { left :: Number, top :: Number } position :: forall t. Record (Props t) -> DOMRect -> { left :: Number, top :: Number }
position mouse {width: menuWidth, height: menuHeight} = {left, top} position mouse {width: menuWidth, height: menuHeight} = {left, top}
......
...@@ -93,4 +93,3 @@ submitButton (database /\ _) (term /\ _) (_ /\ setSearch) = ...@@ -93,4 +93,3 @@ submitButton (database /\ _) (term /\ _) (_ /\ setSearch) =
case term of case term of
"" -> setSearch Nothing "" -> setSearch Nothing
_ -> setSearch $ Just { database, term } _ -> setSearch $ Just { database, term }
module Gargantext.Components.Tree where module Gargantext.Components.Tree where
import Prelude hiding (div) import Prelude hiding (div)
import Unsafe.Coerce
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import CSS (backgroundColor, borderRadius, boxShadow, justifyContent, marginTop)
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter) import Data.Array (filter)
import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Generic.Rep (class Generic)
import Data.Argonaut.Core (Json) import Data.Generic.Rep.Eq (genericEq)
import Data.Either (Either(..)) import Data.Generic.Rep.Show (genericShow)
import Data.HTTP.Method (Method(..)) import Data.Maybe (Maybe(..), fromJust)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff, runAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log) import Effect.Exception (error)
import Prelude (identity) import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..), (.=))
import Gargantext.Components.Loader as Loader
import Gargantext.Config (toUrl, End(..), NodeType(..), readNodeType)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial)
import React (ReactClass, ReactElement) import React (ReactClass, ReactElement)
import React as React import React as React
import React.DOM (a, button, div, h5, i, input, li, span, text, ul, b, u) import React.DOM (a, div, i)
import React.DOM.Props (_id, _type, className, href, title, onClick, onInput, placeholder, style, defaultValue, _data) import React.DOM.Props (className, style)
import React.DOM.Props as DOM import React.SyntheticEvent as E
import Thermite (PerformAction, Render, Spec, createClass, defaultPerformAction, defaultRender, modifyState_, simpleSpec, modifyState) import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Config (toUrl, End(..), NodeType(..)) import Thermite (PerformAction, Render, Spec, createClass, defaultPerformAction, simpleSpec, modifyState_)
import Gargantext.Config.REST (get, put, post, delete, deleteWithBody) import URI.Extra.QueryPairs as QP
import Gargantext.Components.Loader as Loader import URI.Query as Q
import Unsafe.Coerce (unsafeCoerce)
import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText)
type Name = String type Name = String
type Open = Boolean type Open = Boolean
...@@ -49,64 +59,92 @@ filterNTree :: forall a. (a -> Boolean) -> NTree a -> NTree a ...@@ -49,64 +59,92 @@ filterNTree :: forall a. (a -> Boolean) -> NTree a -> NTree a
filterNTree p (NTree x ary) = filterNTree p (NTree x ary) =
NTree x $ map (filterNTree p) $ filter (\(NTree a _) -> p a) ary NTree x $ map (filterNTree p) $ filter (\(NTree a _) -> p a) ary
newtype LNode = LNode { id :: ID
, name :: String
, nodeType :: NodeType
, popOver :: Boolean
, nodeValue :: String
, createOpen :: Boolean}
derive instance newtypeLNode :: Newtype LNode _
instance decodeJsonLNode :: DecodeJson LNode where
decodeJson json = do
obj <- decodeJson json
id_ <- obj .: "id"
name <- obj .: "name"
nodeType <- obj .: "type"
pure $ LNode { id : id_
, name
, nodeType
, popOver : false
, nodeValue : ""
, createOpen : false}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
obj <- decodeJson json
node <- obj .: "node"
nodes <- obj .: "children"
node' <- decodeJson node
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
type FTree = NTree LNode type FTree = NTree LNode
data Action = ShowPopOver ID setName v (NTree (LNode s@{name}) ary) = NTree (LNode $ s {name = v}) ary
| ToggleFolder ID setPopOver v (NTree (LNode s@{popOver}) ary) = NTree (LNode $ s {popOver = v}) ary
| RenameNode String ID setCreateOpen v (NTree (LNode s@{createOpen}) ary) = NTree (LNode $ s {createOpen = v}) ary
| Submit ID String
-- file upload types
data FileType = CSV | PresseRIS
derive instance genericFileType :: Generic FileType _
instance eqFileType :: Eq FileType where
eq = genericEq
instance showFileType :: Show FileType where
show = genericShow
readFileType :: String -> Maybe FileType
readFileType "CSV" = Just CSV
readFileType "PresseRIS" = Just PresseRIS
readFileType _ = Nothing
newtype UploadFileContents = UploadFileContents String
data DroppedFile = DroppedFile {
contents :: UploadFileContents
, fileType :: Maybe FileType
}
type FileHash = String
data Action = Submit ID String
| DeleteNode ID | DeleteNode ID
| Create ID | CreateSubmit ID String NodeType
| SetNodeValue String ID | SetNodeValue String ID
| ToggleCreateNode ID
| ShowRenameBox ID
| CancelRename ID
| CurrentNode ID | CurrentNode ID
| UploadFile ID FileType UploadFileContents
type State = { state :: FTree type State = { state :: FTree
, currentNode :: Maybe Int , currentNode :: Maybe ID
} }
-- TODO remove
initialState :: State
initialState = { state: NTree (LNode {id : 3, name : "hello", nodeType : Node, open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "InitialNode", showRenameBox : false}) [] , currentNode : Nothing}
mapFTree :: (FTree -> FTree) -> State -> State mapFTree :: (FTree -> FTree) -> State -> State
mapFTree f {state, currentNode} = {state: f state, currentNode: currentNode} mapFTree f {state, currentNode} = {state: f state, currentNode: currentNode}
-- TODO: make it a local function -- TODO: make it a local function
performAction :: forall props. PerformAction State props Action performAction :: forall props. PerformAction State props Action
performAction (ToggleFolder i) _ _ =
modifyState_ $ mapFTree $ toggleNode i
performAction (ShowPopOver id) _ _ =
modifyState_ $ mapFTree $ map $ popOverNode id
performAction (ShowRenameBox id) _ _ =
modifyState_ $ mapFTree $ map $ showPopOverNode id
performAction (CancelRename id) _ _ =
modifyState_ $ mapFTree $ map $ showPopOverNode id
performAction (ToggleCreateNode id) _ _ =
modifyState_ $ mapFTree $ showCreateNode id
performAction (DeleteNode nid) _ _ = do performAction (DeleteNode nid) _ _ = do
void $ lift $ deleteNode nid void $ lift $ deleteNode nid
modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid) modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
performAction (Submit rid name) _ _ = do performAction (Submit rid name) _ _ = do
void $ lift $ renameNode rid $ RenameValue {name} void $ lift $ renameNode rid $ RenameValue {name}
modifyState_ $ mapFTree $ map $ popOverNode rid
<<< onNode rid (\(LNode node) -> LNode (node { name = name }))
performAction (RenameNode r nid) _ _ = performAction (CreateSubmit nid name nodeType) _ _ = do
modifyState_ $ mapFTree $ rename nid r void $ lift $ createNode nid $ CreateValue {name, nodeType}
--modifyState_ $ mapFTree $ map $ hidePopOverNode nid
performAction (Create nid) _ _ =
modifyState_ $ mapFTree $ showCreateNode nid
performAction (SetNodeValue v nid) _ _ = performAction (SetNodeValue v nid) _ _ =
modifyState_ $ mapFTree $ setNodeValue nid v modifyState_ $ mapFTree $ setNodeValue nid v
...@@ -114,88 +152,33 @@ performAction (SetNodeValue v nid) _ _ = ...@@ -114,88 +152,33 @@ performAction (SetNodeValue v nid) _ _ =
performAction (CurrentNode nid) _ _ = performAction (CurrentNode nid) _ _ =
modifyState_ $ \{state: s} -> {state: s, currentNode : Just nid} modifyState_ $ \{state: s} -> {state: s, currentNode : Just nid}
performAction (UploadFile nid fileType contents) _ _ = do
hashes <- lift $ uploadFile nid fileType contents
liftEffect $ log2 "uploaded:" hashes
toggleIf :: Boolean -> Boolean -> Boolean toggleIf :: Boolean -> Boolean -> Boolean
toggleIf true = not toggleIf true = not
toggleIf false = const false toggleIf false = const false
onNode :: Int -> (LNode -> LNode) -> LNode -> LNode onNode :: ID -> (LNode -> LNode) -> LNode -> LNode
onNode id f l@(LNode node) onNode id f l@(LNode node)
| node.id == id = f l | node.id == id = f l
| otherwise = l | otherwise = l
popOverNode :: Int -> LNode -> LNode --toggleFileTypeBox :: ID -> UploadFileContents -> LNode -> LNode
popOverNode sid (LNode node) = --toggleFileTypeBox sid contents (LNode node@{id, droppedFile: Nothing}) | sid == id = LNode $ node {droppedFile = droppedFile}
LNode $ node { popOver = toggleIf (sid == node.id) node.popOver -- where
, showRenameBox = false } -- droppedFile = Just $ DroppedFile {contents: contents, fileType: Nothing}
--toggleFileTypeBox sid _ (LNode node) = LNode $ node {droppedFile = Nothing}
showPopOverNode :: Int -> LNode -> LNode
showPopOverNode sid (LNode node) =
LNode $ node {showRenameBox = toggleIf (sid == node.id) node.showRenameBox}
-- TODO: DRY, NTree.map -- TODO: DRY, NTree.map
showCreateNode :: Int -> NTree LNode -> NTree LNode setNodeValue :: ID -> String -> NTree LNode -> NTree LNode
showCreateNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) = setNodeValue sid v (NTree (LNode node@{id}) ary) =
NTree (LNode {id,name, nodeType, open , popOver, renameNodeValue, createNode : createNode', nodeValue, showRenameBox}) $ map (showCreateNode sid) ary NTree (LNode $ node {nodeValue = nvalue}) $ map (setNodeValue sid v) ary
where
createNode' = if sid == id then not createNode else createNode
----TODO get id and value to send API to call
-- getCreateNode :: Int -> NTree LNode -> String
-- getCreateNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue}) ary) =
-- createNode
-- where
-- NTree (LNode {id,name, nodeType, open , popOver, renameNodeValue, createNode , nodeValue}) $ map (getCreateNode sid) ary
-- createNode' = if sid == id then nodeValue else ""
-- TODO: DRY, NTree.map
rename :: Int -> String -> NTree LNode -> NTree LNode
rename sid v (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open , popOver , renameNodeValue : rvalue, createNode, nodeValue, showRenameBox}) $ map (rename sid v) ary
where
rvalue = if sid == id then v else ""
-- TODO: DRY, NTree.map
setNodeValue :: Int -> String -> NTree LNode -> NTree LNode
setNodeValue sid v (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open , popOver , renameNodeValue , createNode, nodeValue : nvalue, showRenameBox}) $ map (setNodeValue sid v) ary
where where
nvalue = if sid == id then v else "" nvalue = if sid == id then v else ""
-- TODO: DRY, NTree.map
toggleNode :: Int -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open : nopen, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) $ map (toggleNode sid) ary
where
nopen = if sid == id then not open else open
------------------------------------------------------------------------
-- Realistic Tree for the UI
exampleTree :: NTree LNode
exampleTree = NTree (LNode {id : 1, name : "", nodeType : Node, open : false, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : false}) []
-- exampleTree :: NTree LNode
-- exampleTree =
-- NTree 1 true "françois.pineau"
-- [ --annuaire 2 "Annuaire"
-- --, corpus 3 "IMT publications"
-- ]
-- annuaire :: Int -> String -> NTree (Tuple String String)
-- annuaire n name = NTree n false name
-- [ NTree (Tuple "IMT community" "#/docView")
-- ]
-- corpus :: Int -> String -> NTree (Tuple String String)
-- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false})
-- [ NTree (Tuple "Facets" "#/corpus") []
-- , NTree (Tuple "Dashboard" "#/dashboard") []
-- , NTree (Tuple "Graph" "#/graphExplorer") []
-- ]
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -234,8 +217,8 @@ loadedTreeview = simpleSpec performAction render ...@@ -234,8 +217,8 @@ loadedTreeview = simpleSpec performAction render
render :: Render State LoadedTreeViewProps Action render :: Render State LoadedTreeViewProps Action
render dispatch _ {state, currentNode} _ = render dispatch _ {state, currentNode} _ =
[ div [className "tree"] [ div [className "tree"]
[ toHtml dispatch state currentNode [ --toHtml dispatch state currentNode
(R2.scuff $ toHtml dispatch state currentNode)
] ]
] ]
...@@ -257,172 +240,350 @@ treeview = simpleSpec defaultPerformAction render ...@@ -257,172 +240,350 @@ treeview = simpleSpec defaultPerformAction render
, component: treeViewClass , component: treeViewClass
} ] } ]
renameTreeView :: (Action -> Effect Unit) -> FTree -> Int -> ReactElement
renameTreeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, showRenameBox }) ary) nid =
div [className "col-md-12", _id "rename-tooltip",className "btn btn-secondary", _data {toggle : "tooltip", placement : "right"}, title "Settings on right"]
[ div [_id "arrow"] []
, div [className "panel panel-default", style {border:"1px solid rgba(0,0,0,0.2)", boxShadow : "0 2px 5px rgba(0,0,0,0.2)"}]
[
div [className "panel-heading", style {float:"left", width: "100%"}]
[
if (showRenameBox) then div [_id "afterClick"]
[
div [className "col-md-12"]
[
input [ _type "text"
, placeholder "Rename Node"
, defaultValue $ name
, style {float: "left"}
, className "col-md-2 form-control"
, onInput \e -> d (RenameNode (unsafeEventValue e) nid)
]
]
, div [className "col-md-12"]
[ div [className "row", style {marginTop : "11px"}]
[ div [className "col-md-6"] [
a [className "btn btn-danger"
, _type "button"
, onClick \_ -> d $ (Submit nid renameNodeValue)
, style {float:"left"}
] [text "Rename"]
]
, div [className "col-md-6"]
[a [className "btn btn-primary"
, _type "button"
, onClick \_ -> d $ (CancelRename nid)
, style {float:"left", backgroundColor: "white", color:"black"}
] [text "cancel"]
]
]
--nodePopupView :: forall s. (Action -> Effect Unit) -> FTree -> RAction s -> R.Element
nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}) _) /\ setNodeState) = R.createElement el {} []
where
el = R.hooksComponent "NodePopupView" cpt
cpt props _ = do
renameBoxOpen <- R.useState $ \_ -> pure false
pure $ H.div tooltipProps $
[ H.div {id: "arrow"} []
, H.div { className: "panel panel-default"
, style: { border:"1px solid rgba(0,0,0,0.2)"
, boxShadow : "0 2px 5px rgba(0,0,0,0.2)"}
}
[ panelHeading renameBoxOpen
, panelBody
]
]
where
tooltipProps = ({ className: ""
, id: "node-popup-tooltip"
, title: "Node settings"
} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right"
iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"}
panelHeading renameBoxOpen@(open /\ _) =
H.div {className: "panel-heading"}
[ H.div {className: "row" }
(
[ H.div {className: if (open) then "col-md-10" else "col-md-8"}
[ renameBox d nodeState renameBoxOpen ]
] <> [ editIcon renameBoxOpen ] <> [
H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setNodeState $ setPopOver false s
, title: "Close"} []
] ]
]
)
]
glyphicon t = "glyphitem glyphicon glyphicon-" <> t
editIcon (false /\ setRenameBoxOpen) =
H.div {className: "col-md-2"}
[ H.a {style: {color: "black"}
, className: "btn glyphitem glyphicon glyphicon-pencil"
, id: "rename1"
, title: "Rename"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen true
}
[]
]
editIcon (true /\ _) = H.div {} []
panelBody =
H.div {className: "panel-body"
, style: { display:"flex"
, justifyContent : "center"
, backgroundColor: "white"
, border: "none"}}
[ createButton
, H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "download-alt")
, id: "download"
, title: "Download [WIP]"}
[]
] ]
else , H.div {className: "col-md-4"}
div [ _id "beforeClick", className "col-md-12"] [ H.a {style: iconAStyle
[ div [className "row"] , className: (glyphicon "duplicate")
[ div [className "col-md-6"] [text name] , id: "duplicate"
, a [ style {color:"black"},className "glyphitem glyphicon glyphicon-pencil col-md-2", _id "rename1", title "Rename", onClick $ (\_-> d $ (ShowRenameBox id))] [ ] , title: "Duplicate [WIP]"}
] []
] ]
] , H.div {className: "col-md-4"}
,div [className "panel-body", style {display:"flex", justifyContent : "center", backgroundColor: "white", border: "none"}] [ H.a {style: iconAStyle
[ div [className "col-md-4"] [a [ style {color:"black", paddingTop: "6px", paddingBottom: "6px"},className "glyphitem glyphicon glyphicon-download-alt", _id "rename1", title "Download [WIP]"] [ ]] , className: (glyphicon "trash")
, div [className "col-md-4"] [a [ style {color:"black", paddingTop: "6px", paddingBottom: "6px"},className "glyphitem glyphicon glyphicon-duplicate", _id "rename1", title "Duplicate [WIP]"] [ ]] , id: "rename2"
, div [className "col-md-4"] [ a [style {color:"black", paddingTop: "6px", paddingBottom: "6px"}, className "glyphitem glyphicon glyphicon-trash", _id "rename2",title "Delete", onClick $ (\_-> d $ (DeleteNode id))] [ ]] , title: "Delete"
, onClick: mkEffectFn1 $ (\_-> d $ (DeleteNode id))}
[]
]
]
where
createButton =
H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "plus")
, id: "create"
, title: "Create"
, onClick: mkEffectFn1 $ \_ -> setNodeState $ setCreateOpen (not createOpen) $ setPopOver false s
}
[]
]
nodePopupView _ _ = R.createElement el {} []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} []
]
] renameBox d (s@(NTree (LNode {id, name}) _) /\ setNodeState) (true /\ setRenameBoxOpen) = R.createElement el {} []
where
el = R.hooksComponent "RenameBox" cpt
cpt props _ = do
renameNodeName <- R.useState $ \_ -> pure name
pure $ H.div {className: "from-group row-no-padding"}
[ renameInput renameNodeName
, renameBtn renameNodeName
, cancelBtn
] ]
where
renameInput (_ /\ setRenameNodeName) =
H.div {className: "col-md-8"}
[ H.input { type: "text"
, placeholder: "Rename Node"
, defaultValue: name
, className: "form-control"
, onInput: mkEffectFn1 $ \e -> setRenameNodeName $ e .. "target" .. "value"
}
]
renameBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setNodeState $ setPopOver false $ setName newName s
d $ (Submit id newName)
, title: "Rename"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen false
, title: "Cancel"
} []
renameBox _ (s@(NTree (LNode {name}) _) /\ _) (false /\ _) = R.createElement el {} []
where
el = R.hooksComponent "RenameBox" cpt
cpt props _ = pure $ H.div {} [ H.text name ]
--createNodeView :: (Action -> Effect Unit) -> FTree -> R.Element
createNodeView :: (Action -> Effect Unit) -> FTree -> Int -> ReactElement createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNodeState) = R.createElement el {} []
createNodeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) nid = where
div [className ""] el = R.hooksComponent "CreateNodeView" cpt
[ div [className "panel panel-default"] cpt props _ = do
[ nodeName <- R.useState $ \_ -> pure ""
div [className "panel-heading"] nodeType <- R.useState $ \_ -> pure Corpus
[ pure $ H.div tooltipProps $
h5 [] [text "Create Node"] [ H.div {className: "panel panel-default"}
] [ panelHeading
,div [className "panel-body"] , panelBody nodeName nodeType
[ , panelFooter nodeName nodeType
input [ _type "text" ]
, placeholder "Create Node" ]
, defaultValue $ getCreateNodeValue s where
, className "col-md-12 form-control" tooltipProps = ({ className: ""
, onInput \e -> d (SetNodeValue (unsafeEventValue e) nid) , id: "create-node-tooltip"
] , title: "Create new node"} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right"
panelHeading =
H.div {className: "panel-heading"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
[ H.h5 {} [H.text "Create Node"] ]
, H.div {className: "col-md-2"}
[ H.a { className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setNodeState $ setCreateOpen false s
, title: "Close"} []
]
] ]
, div [className "panel-footer"] ]
[ button [className "btn btn-success" panelBody (_ /\ setNodeName) (nt /\ setNodeType) =
, _type "button" H.div {className: "panel-body"}
, onClick \_ -> d $ (Create nid ) [ H.div {className: "row"}
] [text "Create"] [ H.div {className: "col-md-12"}
[ H.form {className: "form-horizontal"}
[ H.div {className: "form-group"}
[ H.input { type: "text"
, placeholder: "Node name"
, defaultValue: getCreateNodeValue s
, className: "form-control"
, onInput: mkEffectFn1 $ \e -> setNodeName $ e .. "target" .. "value"
}
]
, H.div {className: "form-group"}
[ R2.select { className: "form-control"
, onChange: mkEffectFn1 $ \e -> setNodeType $ readNodeType $ e .. "target" .. "value"
}
(map renderOption [Corpus, Folder])
]
]
]
] ]
] ]
] renderOption (opt :: NodeType) = H.option {} [ H.text $ show opt ]
panelFooter (name /\ _) (nt /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> d $ (CreateSubmit id name nt)
} [H.text "Create"]
]
createNodeView _ _ = R.createElement el {} []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} []
renameTreeViewDummy :: (Action -> Effect Unit) -> FTree -> ReactElement
renameTreeViewDummy d s = div [] []
popOverValue :: FTree -> Boolean --fileTypeView :: (Action -> Effect Unit) -> FTree -> R.Element
popOverValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, showRenameBox }) ary) = popOver fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) = R.createElement el {} []
where
el = R.hooksComponent "FileTypeView" cpt
cpt props _ = do
pure $ H.div tooltipProps $
[ H.div {className: "panel panel-default"}
[ panelHeading
, panelBody
, panelFooter
]
]
where
tooltipProps = ({ className: ""
, id: "file-type-tooltip"
, title: "Choose file type"} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right"
panelHeading =
H.div {className: "panel-heading"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
[ H.h5 {} [H.text "Choose file type"] ]
, H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setDroppedFile $ Nothing
, title: "Close"} []
]
]
]
panelBody =
H.div {className: "panel-body"}
[ R2.select {className: "col-md-12 form-control"
, onChange: onChange}
(map renderOption [CSV, PresseRIS])
]
where
onChange = mkEffectFn1 $ \e ->
setDroppedFile $ Just $ DroppedFile $ {contents, fileType: readFileType $ e .. "target" .. "value"}
renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter =
H.div {className: "panel-footer"}
[
case fileType of
Just ft ->
H.button {className: "btn btn-success"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile $ Nothing
d $ (UploadFile id ft contents)
} [H.text "Upload"]
Nothing ->
H.button {className: "btn btn-success disabled"
, type: "button"
} [H.text "Upload"]
]
fileTypeView _ _ (Nothing /\ _) = R.createElement el {} []
where
el = R.hooksComponent "FileTypeView" cpt
cpt props _ = pure $ H.div {} []
getCreateNodeValue :: FTree -> String getCreateNodeValue :: FTree -> String
getCreateNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, nodeValue, showRenameBox}) ary) = nodeValue getCreateNodeValue (NTree (LNode {nodeValue}) ary) = nodeValue
toHtml :: (Action -> Effect Unit) -> FTree -> Maybe Int -> ReactElement toHtml :: (Action -> Effect Unit) -> FTree -> Maybe ID -> R.Element
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode,nodeValue, showRenameBox }) []) n = toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
ul [] where
[ el = R.hooksComponent "NodeView" cpt
li [] $ cpt props _ = do
[ a [className "glyphicon glyphicon-cog", _id "rename-leaf",onClick $ (\_-> d $ (ShowPopOver id))] [] nodeState <- R.useState $ \_ -> pure s
, a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"} folderOpen <- R.useState $ \_ -> pure true
, onClick $ (\e -> d $ CurrentNode id) droppedFile <- R.useState $ \_ -> pure (Nothing :: Maybe DroppedFile)
pure $ H.ul {}
[ H.li {}
( [H.span (dropProps droppedFile)
[ folderIcon folderOpen
, H.a { href: (toUrl Front nodeType (Just id))
, style: {"margin-left": "22px"}
, onClick: mkEffectFn1 $ (\e -> d $ CurrentNode id)
}
[ nodeText s n ]
, popOverIcon nodeState
, nodePopupView d nodeState
, createNodeView d nodeState
, fileTypeView d nodeState droppedFile
]
] <> childNodes d n ary folderOpen
)
] ]
[ if n == (Just id) then u [] [b [] [text ("| " <> name <> " | ")]] else text (name <> " ") ] where
, if (popOver == true) then (renameTreeView d s id) else (renameTreeViewDummy d s) folderIcon folderOpen@(open /\ _) =
, if (createNode == true) then (createNodeView d s id) else (renameTreeViewDummy d s) H.a {onClick: R2.effToggler folderOpen}
] [ H.i {className: fldr open} [] ]
] dropProps (_ /\ setDroppedFile) = {
--- need to add renameTreeview value to this function onDrop: dropHandler
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue,createNode, nodeValue, showRenameBox}) ary) n= , onDragOver: onDragOverHandler
ul [] }
[ li [] $ where
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []] dropHandler = mkEffectFn1 $ \e -> unsafePartial $ do
, a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"} let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
, onClick $ (\e -> d $ CurrentNode id) liftEffect $ log2 "drop:" ff
] -- prevent redirection when file is dropped
--[ text name ] E.preventDefault e
[ if n == (Just id) then u [] [b [] [text $ "| " <> name <> " |"]] else text name ] E.stopPropagation e
, a [className "glyphicon glyphicon-cog", _id "rename",onClick $ (\_-> d $ (ShowPopOver id))] let blob = toBlob $ ff
[ void $ runAff (\_ -> pure unit) do
] contents <- readAsText blob
, if (popOver == true) then (renameTreeView d s id) else (renameTreeViewDummy d s) liftEffect $ setDroppedFile $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
, if (createNode == true) then (createNodeView d s id) else (renameTreeViewDummy d s) onDragOverHandler = mkEffectFn1 $ \e -> do
-- prevent redirection when file is dropped
] <> -- https://stackoverflow.com/a/6756680/941471
if open then E.preventDefault e
map (\s -> toHtml d s n) ary E.stopPropagation e
else []
)
] childNodes :: forall s. (Action -> Effect Unit) -> Maybe ID -> (Array (NTree LNode)) -> Tuple Boolean (Boolean -> Effect s) -> Array R.Element
childNodes d n [] _ = []
childNodes d n _ (false /\ _) = []
childNodes d n ary (true /\ _) = map (\cs -> toHtml d cs n) ary
fldr :: Boolean -> DOM.Props
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"
nodeText (NTree (LNode {id, name}) _) n = if n == (Just id) then
H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
newtype LNode = LNode {id :: Int, name :: String, nodeType :: NodeType, open :: Boolean, popOver :: Boolean, renameNodeValue :: String, nodeValue :: String, createNode :: Boolean, showRenameBox :: Boolean} else
H.text (name <> " ")
derive instance newtypeLNode :: Newtype LNode _
instance decodeJsonLNode :: DecodeJson LNode where popOverIcon (s@(NTree (LNode {popOver}) _) /\ setNodeState) =
decodeJson json = do H.a { className: "glyphicon glyphicon-cog"
obj <- decodeJson json , id: "rename-leaf"
id_ <- obj .? "id" , onClick: mkEffectFn1 $ \_ -> setNodeState $ setPopOver (not popOver) s
name <- obj .? "name" } []
nodeType <- obj .? "type"
pure $ LNode {id : id_, name, nodeType, open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : false}
fldr :: Boolean -> String
instance decodeJsonFTree :: DecodeJson (NTree LNode) where fldr open = if open then "fas fa-folder-open" else "fas fa-folder"
decodeJson json = do
obj <- decodeJson json
node <- obj .? "node" loadNode :: ID -> Aff FTree
nodes <- obj .? "children"
node' <- decodeJson node
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
loadNode :: Int -> Aff FTree
loadNode = get <<< toUrl Back Tree <<< Just loadNode = get <<< toUrl Back Tree <<< Just
----- TREE CRUD Operations ----- TREE CRUD Operations
...@@ -437,18 +598,51 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where ...@@ -437,18 +598,51 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
= "r_name" := name = "r_name" := name
~> jsonEmptyObject ~> jsonEmptyObject
renameNode :: Int -> RenameValue -> Aff (Array Int) newtype CreateValue = CreateValue
{
name :: String
, nodeType :: NodeType
}
instance encodeJsonCreateValue :: EncodeJson CreateValue where
encodeJson (CreateValue {name, nodeType})
= "pn_name" := name
~> "pn_typename" := nodeType
~> jsonEmptyObject
createNode :: ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new"
createNode parentId = post $ toUrl Back Node (Just parentId)
renameNode :: ID -> RenameValue -> Aff (Array ID)
renameNode renameNodeId = put $ toUrl Back Node (Just renameNodeId) <> "/rename" renameNode renameNodeId = put $ toUrl Back Node (Just renameNodeId) <> "/rename"
deleteNode :: Int -> Aff Int deleteNode :: ID -> Aff ID
deleteNode = delete <<< toUrl Back Node <<< Just deleteNode = delete <<< toUrl Back Node <<< Just
newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
}
derive instance newtypeSearchQuery :: Newtype FileUploadQuery _
instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
toQuery (FileUploadQuery {fileType}) =
QP.print id id $ QP.QueryPairs $
pair "fileType" fileType
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 :: ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile id fileType (UploadFileContents fileContents) = postWwwUrlencoded url fileContents
where
q = FileUploadQuery { fileType: fileType }
url = toUrl Back Node (Just id) <> "/upload" <> Q.print (toQuery q)
-- UNUSED -- UNUSED
-- deleteNodes :: TODO -> Aff Int -- deleteNodes :: TODO -> Aff ID
-- deleteNodes = deleteWithBody (toUrl Back Nodes Nothing) -- deleteNodes = deleteWithBody (toUrl Back Nodes Nothing)
-- UNUSED -- UNUSED
-- createNode :: TODO -> Aff Int -- createNode :: TODO -> Aff ID
-- createNode = post (toUrl Back Node Nothing) -- createNode = post (toUrl Back Node Nothing)
fnTransform :: LNode -> FTree fnTransform :: LNode -> FTree
......
...@@ -10,7 +10,7 @@ toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1" ...@@ -10,7 +10,7 @@ toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1"
module Gargantext.Config where module Gargantext.Config where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson) import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
...@@ -227,9 +227,9 @@ instance toUrlPath :: ToUrl Path where ...@@ -227,9 +227,9 @@ instance toUrlPath :: ToUrl Path where
data NodeType = NodeUser data NodeType = NodeUser
| Annuaire | Annuaire
| NodeContact | NodeContact
| Corpus | Corpus
| Url_Document | Url_Document
| CorpusV3 | CorpusV3
| Dashboard | Dashboard
| Error | Error
...@@ -259,6 +259,57 @@ instance showNodeType :: Show NodeType where ...@@ -259,6 +259,57 @@ instance showNodeType :: Show NodeType where
show Tree = "NodeTree" show Tree = "NodeTree"
show NodeList = "NodeList" show NodeList = "NodeList"
readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = Graph
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser
readNodeType "NodeContact" = NodeContact
readNodeType "Tree" = Tree
readNodeType "NodeList" = NodeList
readNodeType _ = Error
{-
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
compare n1 n2 = compare (show n1) (show n2)
instance eqNodeType :: Eq NodeType where
eq n1 n2 = eq (show n1) (show n2)
-}
------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ readNodeType obj
instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType
nodeTypeUrl :: NodeType -> Url
nodeTypeUrl Annuaire = "annuaire"
nodeTypeUrl Corpus = "corpus"
nodeTypeUrl CorpusV3 = "corpus"
nodeTypeUrl Dashboard = "dashboard"
nodeTypeUrl Url_Document = "document"
nodeTypeUrl Error = "ErrorNodeType"
nodeTypeUrl Folder = "folder"
nodeTypeUrl Graph = "graph"
nodeTypeUrl Individu = "individu"
nodeTypeUrl Node = "node"
nodeTypeUrl Nodes = "nodes"
nodeTypeUrl NodeUser = "user"
nodeTypeUrl NodeContact = "contact"
nodeTypeUrl Tree = "tree"
nodeTypeUrl NodeList = "list"
------------------------------------------------------------
type ListId = Int type ListId = Int
data Path data Path
...@@ -366,50 +417,3 @@ derive instance genericTabType :: Generic TabType _ ...@@ -366,50 +417,3 @@ derive instance genericTabType :: Generic TabType _
instance showTabType :: Show TabType where instance showTabType :: Show TabType where
show = genericShow show = genericShow
------------------------------------------------------------
nodeTypeUrl :: NodeType -> Url
nodeTypeUrl Annuaire = "annuaire"
nodeTypeUrl Corpus = "corpus"
nodeTypeUrl CorpusV3 = "corpus"
nodeTypeUrl Dashboard = "dashboard"
nodeTypeUrl Url_Document = "document"
nodeTypeUrl Error = "ErrorNodeType"
nodeTypeUrl Folder = "folder"
nodeTypeUrl Graph = "graph"
nodeTypeUrl Individu = "individu"
nodeTypeUrl Node = "node"
nodeTypeUrl Nodes = "nodes"
nodeTypeUrl NodeUser = "user"
nodeTypeUrl NodeContact = "contact"
nodeTypeUrl Tree = "tree"
nodeTypeUrl NodeList = "list"
readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = Graph
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser
readNodeType "NodeContact" = NodeContact
readNodeType "Tree" = Tree
readNodeType "NodeList" = NodeList
readNodeType _ = Error
{-
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
compare n1 n2 = compare (show n1) (show n2)
instance eqNodeType :: Eq NodeType where
eq n1 n2 = eq (show n1) (show n2)
-}
------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ readNodeType obj
module Gargantext.Config.REST where module Gargantext.Config.REST where
import Gargantext.Prelude
import Affjax (defaultRequest, printResponseFormatError, request) import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..)) import Affjax.RequestBody (RequestBody(..), string)
import Affjax.RequestHeader (RequestHeader(..)) import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson) import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON) import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON)
import Effect.Aff (Aff, throwError) import Effect.Aff (Aff, throwError)
import Effect.Exception (error) import Effect.Exception (error)
import Gargantext.Prelude
send :: forall a b. EncodeJson a => DecodeJson b => send :: forall a b. EncodeJson a => DecodeJson b =>
Method -> String -> Maybe a -> Aff b Method -> String -> Maybe a -> Aff b
send m url reqbody = do send m url reqbody = do
...@@ -58,3 +58,26 @@ deleteWithBody url = send DELETE url <<< Just ...@@ -58,3 +58,26 @@ deleteWithBody url = send DELETE url <<< Just
post :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b post :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b
post url = send POST url <<< Just post url = send POST url <<< Just
postWwwUrlencoded :: forall b. DecodeJson b => String -> String -> Aff b
postWwwUrlencoded url body = do
affResp <- request $ defaultRequest
{ url = url
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = [ ContentType applicationFormURLEncoded
, Accept applicationJSON
]
, content = Just $ string body
}
case affResp.body of
Left err -> do
_ <- logs $ printResponseFormatError err
throwError $ error $ printResponseFormatError err
Right json -> do
--_ <- logs $ show json.status
--_ <- logs $ show json.headers
--_ <- logs $ show json.body
case decodeJson json of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Right b -> pure b
module Gargantext.Pages.Corpus.Graph where module Gargantext.Pages.Corpus.Graph where
import Effect.Unsafe import Effect.Unsafe (unsafePerformEffect)
import Gargantext.Prelude hiding (max,min) import Gargantext.Prelude hiding (max,min)
import Affjax (defaultRequest, request)
import Affjax.ResponseFormat (ResponseFormat(..), printResponseFormatError)
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (.??), (:=), (~>))
import Data.Argonaut (decodeJson)
import Data.Array (fold, length, mapWithIndex, (!!), null) import Data.Array (fold, length, mapWithIndex, (!!), null)
import Data.Either (Either(..)) import Data.Int (toNumber)
import Data.HTTP.Method (Method(..))
import Data.Int (fromString, toNumber)
import Data.Int as Int import Data.Int as Int
import Data.Lens (Lens, Lens', over, (%~), (+~), (.~), (^.), review) import Data.Lens (Lens', over, (%~), (.~), (^.))
import Data.Lens.Record (prop) import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing) import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Number as Num import Data.Number as Num
import Data.String (joinWith)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.Traversable (for_) import Data.Traversable (for_)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, attempt) import Effect.Aff (Aff)
import Effect.Aff.Class (liftAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log)
import Effect.Uncurried (runEffectFn1, runEffectFn2)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, setSigmaRef, getSigmaRef, cameras, CameraProps, getCameraProps, goTo, pauseForceAtlas2, sStyle, sigmaOnMouseMove, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings) import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, setSigmaRef, getSigmaRef, cameras, CameraProps, getCameraProps, goTo, pauseForceAtlas2, sStyle, sigmaOnMouseMove, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), MetaData(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData) import Gargantext.Components.GraphExplorer.Types (Cluster(..), MetaData(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Components.Login.Types (AuthData(..), TreeId) import Gargantext.Components.Login.Types (AuthData(..), TreeId)
import Gargantext.Components.RandomText (words) import Gargantext.Components.RandomText (words)
import Gargantext.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Config as Config import Gargantext.Config as Config
import Gargantext.Config.REST (get, post) import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.Graph.Tabs as GT import Gargantext.Pages.Corpus.Graph.Tabs as GT
import Gargantext.Prelude (flip)
import Gargantext.Types (class Optional) import Gargantext.Types (class Optional)
import Gargantext.Utils (getter, toggleSet) import Gargantext.Utils (toggleSet)
import Math (cos, sin)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, br', h2, button, div, form', input, li, li', menu, option, p, select, span, text, ul, ul') import React.DOM (button, div, input, li, li', menu, p, span, text, ul')
import React.DOM.Props (_id, _type, checked, className, defaultValue, href, max, min, name, onChange, onClick, placeholder, style, title, value, onMouseMove) import React.DOM.Props (_id, _type, className, defaultValue, max, min, onChange, onClick, style, onMouseMove)
import React.SyntheticEvent (SyntheticUIEvent, target) import React.SyntheticEvent (SyntheticUIEvent, target)
import Thermite (PerformAction, Render, Spec, _render, cmapProps, createClass, defaultPerformAction, defaultRender, modifyState, modifyState_, noState, simpleSpec, withState) import Thermite (PerformAction, Render, Spec, _render, cmapProps, defaultPerformAction, defaultRender, modifyState, modifyState_, noState, simpleSpec, withState)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Web.HTML (window) import Web.HTML (window)
import Web.HTML.Window (localStorage) import Web.HTML.Window (localStorage)
......
...@@ -2,18 +2,22 @@ module Gargantext.Utils.Reactix ...@@ -2,18 +2,22 @@ module Gargantext.Utils.Reactix
where where
import Prelude import Prelude
import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe )
import Data.Traversable ( traverse_ )
import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import FFI.Simple ( (...), defineProperty ) import Effect.Uncurried (mkEffectFn1)
import React ( ReactElement ) import FFI.Simple ((...), defineProperty)
import React (ReactElement)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML (ElemFactory)
import Reactix.React (createElement)
import Reactix.SyntheticEvent as RE import Reactix.SyntheticEvent as RE
import Unsafe.Coerce ( unsafeCoerce ) import Unsafe.Coerce (unsafeCoerce)
newtype Point = Point { x :: Number, y :: Number } newtype Point = Point { x :: Number, y :: Number }
-- | Turns a ReactElement into a Reactix Element -- | Turns a ReactElement into a Reactix Element
...@@ -40,3 +44,9 @@ useLayoutEffect1' :: forall a. a -> (Unit -> Effect Unit) -> R.Hooks Unit ...@@ -40,3 +44,9 @@ useLayoutEffect1' :: forall a. a -> (Unit -> Effect Unit) -> R.Hooks Unit
useLayoutEffect1' a f = R.useLayoutEffect1 a $ \_ -> useLayoutEffect1' a f = R.useLayoutEffect1 a $ \_ ->
do f unit do f unit
pure $ \_ -> pure unit pure $ \_ -> pure unit
select :: ElemFactory
select = createElement "select"
effToggler (value /\ setValue) = mkEffectFn1 $ \_ -> setValue $ not value
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