Skip to content

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

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

parents f061407f 37febcb1
Hide whitespace changes
Inline Side-by-side
Showing with 660 additions and 391 deletions
.psc-package/local/.set/packages.json
View file @ 20baab9e
......@@ -570,6 +570,16 @@
"repo": "https://github.com/purescript/purescript-distributive.git",
"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": {
"dependencies": [
"media-types",
......
dist/styles/Login.css
View file @ 20baab9e
......@@ -82,7 +82,7 @@ li#rename #rename-a{
}
#rename-tooltip {
#node-popup-tooltip {
position : absolute;
left : 96px;
top:-64px;
......@@ -90,6 +90,28 @@ li#rename #rename-a{
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 {
display:none;
......@@ -106,6 +128,7 @@ li a#rename-leaf {
display:none;
position:absolute;
text-decoration:none;
margin-left: 20px;
}
li:hover a#rename-leaf {
......@@ -139,7 +162,7 @@ text-align: center;
transform: scale(1.4);
}
#rename-tooltip:hover {
#node-popup-tooltip:hover {
border:none;
}
......@@ -155,7 +178,7 @@ text-align: center;
left: -9px;
}
#rename-tooltip a:hover
#node-popup-tooltip a:hover
{
text-decoration:none;
}
......@@ -184,3 +207,12 @@ text-align: center;
#graph-tree .tree {
margin-top: 27px;
}
.nopadding {
padding: 0 !important;
margin: 0 !important;
}
.row-no-padding > [class*="col-"] {
padding-left: 0 !important;
padding-right: 0 !important;
}
packages.dhall
View file @ 20baab9e
......@@ -173,6 +173,15 @@ let additions =
]
"https://github.com/irresponsible/purescript-dom-simple"
"v0.2.4"
, dom-filereader =
mkPackage
[ "aff"
, "arraybuffer-types"
, "web-file"
, "web-html"
]
"https://github.com/nwolverson/purescript-dom-filereader"
"v5.0.0"
, reactix =
mkPackage
[ "console"
......
psc-package.json
View file @ 20baab9e
......@@ -3,30 +3,31 @@
"set": "local",
"source": ".psc-package",
"depends": [
"numbers",
"spec-quickcheck",
"spec-discovery",
"uint",
"js-timers",
"psci-support",
"css",
"generics-rep",
"maybe",
"routing",
"foreign-object",
"affjax",
"argonaut",
"console",
"css",
"dom-filereader",
"dom-simple",
"effect",
"web-html",
"thermite",
"foreign-object",
"generics-rep",
"integers",
"random",
"affjax",
"console",
"strings",
"string-parsers",
"js-timers",
"maybe",
"numbers",
"prelude",
"dom-simple",
"psci-support",
"random",
"reactix",
"uri"
"routing",
"spec-discovery",
"spec-quickcheck",
"string-parsers",
"strings",
"thermite",
"uint",
"uri",
"web-html"
]
}
src/Gargantext/Components/ContextMenu/ContextMenu.purs
View file @ 20baab9e
......@@ -24,7 +24,7 @@ import Reactix as R
import Reactix.DOM.HTML as HTML
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)
......@@ -71,14 +71,14 @@ contextMenuEffect setMenu rootRef _ =
documentClickHandler :: forall t. (Maybe t -> Effect Unit) -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler hide menu =
R'.named "hideMenuOnClickOutside" $ callback $ \e ->
R2.named "hideMenuOnClickOutside" $ callback $ \e ->
if Element.contains menu (DE.target e)
then pure unit
else hide Nothing
documentScrollHandler :: forall t. (Maybe t -> Effect Unit) -> Callback DE.MouseEvent
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 mouse {width: menuWidth, height: menuHeight} = {left, top}
......
src/Gargantext/Components/Search/SearchField.purs
View file @ 20baab9e
......@@ -93,4 +93,3 @@ submitButton (database /\ _) (term /\ _) (_ /\ setSearch) =
case term of
"" -> setSearch Nothing
_ -> setSearch $ Just { database, term }
src/Gargantext/Components/Tree.purs
View file @ 20baab9e
module Gargantext.Components.Tree where
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 DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter)
import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff, runAff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Prelude (identity)
import Effect.Exception (error)
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 as React
import React.DOM (a, button, div, h5, i, input, li, span, text, ul, b, u)
import React.DOM.Props (_id, _type, className, href, title, onClick, onInput, placeholder, style, defaultValue, _data)
import React.DOM.Props as DOM
import Thermite (PerformAction, Render, Spec, createClass, defaultPerformAction, defaultRender, modifyState_, simpleSpec, modifyState)
import Gargantext.Config (toUrl, End(..), NodeType(..))
import Gargantext.Config.REST (get, put, post, delete, deleteWithBody)
import Gargantext.Components.Loader as Loader
import React.DOM (a, div, i)
import React.DOM.Props (className, style)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (PerformAction, Render, Spec, createClass, defaultPerformAction, simpleSpec, modifyState_)
import URI.Extra.QueryPairs as QP
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 Open = Boolean
......@@ -49,64 +59,92 @@ filterNTree :: forall a. (a -> Boolean) -> NTree a -> NTree a
filterNTree p (NTree x 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
data Action = ShowPopOver ID
| ToggleFolder ID
| RenameNode String ID
| Submit ID String
setName v (NTree (LNode s@{name}) ary) = NTree (LNode $ s {name = v}) ary
setPopOver v (NTree (LNode s@{popOver}) ary) = NTree (LNode $ s {popOver = v}) ary
setCreateOpen v (NTree (LNode s@{createOpen}) ary) = NTree (LNode $ s {createOpen = v}) ary
-- 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
| Create ID
| CreateSubmit ID String NodeType
| SetNodeValue String ID
| ToggleCreateNode ID
| ShowRenameBox ID
| CancelRename ID
| CurrentNode ID
| UploadFile ID FileType UploadFileContents
type State = { state :: FTree
, currentNode :: Maybe Int
type State = { state :: FTree
, 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 f {state, currentNode} = {state: f state, currentNode: currentNode}
-- TODO: make it a local function
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
void $ lift $ deleteNode nid
modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
performAction (Submit rid name) _ _ = do
void $ lift $ renameNode rid $ RenameValue {name}
modifyState_ $ mapFTree $ map $ popOverNode rid
<<< onNode rid (\(LNode node) -> LNode (node { name = name }))
performAction (RenameNode r nid) _ _ =
modifyState_ $ mapFTree $ rename nid r
performAction (Create nid) _ _ =
modifyState_ $ mapFTree $ showCreateNode nid
performAction (CreateSubmit nid name nodeType) _ _ = do
void $ lift $ createNode nid $ CreateValue {name, nodeType}
--modifyState_ $ mapFTree $ map $ hidePopOverNode nid
performAction (SetNodeValue v nid) _ _ =
modifyState_ $ mapFTree $ setNodeValue nid v
......@@ -114,88 +152,33 @@ performAction (SetNodeValue v nid) _ _ =
performAction (CurrentNode 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 true = not
toggleIf false = const false
onNode :: Int -> (LNode -> LNode) -> LNode -> LNode
onNode :: ID -> (LNode -> LNode) -> LNode -> LNode
onNode id f l@(LNode node)
| node.id == id = f l
| otherwise = l
popOverNode :: Int -> LNode -> LNode
popOverNode sid (LNode node) =
LNode $ node { popOver = toggleIf (sid == node.id) node.popOver
, showRenameBox = false }
showPopOverNode :: Int -> LNode -> LNode
showPopOverNode sid (LNode node) =
LNode $ node {showRenameBox = toggleIf (sid == node.id) node.showRenameBox}
--toggleFileTypeBox :: ID -> UploadFileContents -> LNode -> LNode
--toggleFileTypeBox sid contents (LNode node@{id, droppedFile: Nothing}) | sid == id = LNode $ node {droppedFile = droppedFile}
-- where
-- droppedFile = Just $ DroppedFile {contents: contents, fileType: Nothing}
--toggleFileTypeBox sid _ (LNode node) = LNode $ node {droppedFile = Nothing}
-- TODO: DRY, NTree.map
showCreateNode :: Int -> NTree LNode -> NTree LNode
showCreateNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open , popOver, renameNodeValue, createNode : createNode', nodeValue, showRenameBox}) $ map (showCreateNode sid) 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
setNodeValue :: ID -> String -> NTree LNode -> NTree LNode
setNodeValue sid v (NTree (LNode node@{id}) ary) =
NTree (LNode $ node {nodeValue = nvalue}) $ map (setNodeValue sid v) ary
where
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
render :: Render State LoadedTreeViewProps Action
render dispatch _ {state, currentNode} _ =
[ 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
, 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
div [ _id "beforeClick", className "col-md-12"]
[ div [className "row"]
[ div [className "col-md-6"] [text name]
, a [ style {color:"black"},className "glyphitem glyphicon glyphicon-pencil col-md-2", _id "rename1", title "Rename", onClick $ (\_-> d $ (ShowRenameBox id))] [ ]
]
]
]
,div [className "panel-body", style {display:"flex", justifyContent : "center", backgroundColor: "white", border: "none"}]
[ div [className "col-md-4"] [a [ style {color:"black", paddingTop: "6px", paddingBottom: "6px"},className "glyphitem glyphicon glyphicon-download-alt", _id "rename1", title "Download [WIP]"] [ ]]
, div [className "col-md-4"] [a [ style {color:"black", paddingTop: "6px", paddingBottom: "6px"},className "glyphitem glyphicon glyphicon-duplicate", _id "rename1", title "Duplicate [WIP]"] [ ]]
, 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))] [ ]]
, H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "duplicate")
, id: "duplicate"
, title: "Duplicate [WIP]"}
[]
]
, H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "trash")
, id: "rename2"
, 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 -> Int -> ReactElement
createNodeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) nid =
div [className ""]
[ div [className "panel panel-default"]
[
div [className "panel-heading"]
[
h5 [] [text "Create Node"]
]
,div [className "panel-body"]
[
input [ _type "text"
, placeholder "Create Node"
, defaultValue $ getCreateNodeValue s
, className "col-md-12 form-control"
, onInput \e -> d (SetNodeValue (unsafeEventValue e) nid)
]
--createNodeView :: (Action -> Effect Unit) -> FTree -> R.Element
createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNodeState) = R.createElement el {} []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = do
nodeName <- R.useState $ \_ -> pure ""
nodeType <- R.useState $ \_ -> pure Corpus
pure $ H.div tooltipProps $
[ H.div {className: "panel panel-default"}
[ panelHeading
, panelBody nodeName nodeType
, panelFooter nodeName nodeType
]
]
where
tooltipProps = ({ className: ""
, 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"
, _type "button"
, onClick \_ -> d $ (Create nid )
] [text "Create"]
]
panelBody (_ /\ setNodeName) (nt /\ setNodeType) =
H.div {className: "panel-body"}
[ H.div {className: "row"}
[ 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
popOverValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, showRenameBox }) ary) = popOver
--fileTypeView :: (Action -> Effect Unit) -> FTree -> R.Element
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 (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 d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode,nodeValue, showRenameBox }) []) n =
ul []
[
li [] $
[ a [className "glyphicon glyphicon-cog", _id "rename-leaf",onClick $ (\_-> d $ (ShowPopOver id))] []
, a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}
, onClick $ (\e -> d $ CurrentNode id)
toHtml :: (Action -> Effect Unit) -> FTree -> Maybe ID -> R.Element
toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
cpt props _ = do
nodeState <- R.useState $ \_ -> pure s
folderOpen <- R.useState $ \_ -> pure true
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 <> " ") ]
, if (popOver == true) then (renameTreeView d s id) else (renameTreeViewDummy d s)
, if (createNode == true) then (createNodeView d s id) else (renameTreeViewDummy d s)
]
]
--- need to add renameTreeview value to this function
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue,createNode, nodeValue, showRenameBox}) ary) n=
ul []
[ li [] $
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}
, onClick $ (\e -> d $ CurrentNode id)
]
--[ text name ]
[ if n == (Just id) then u [] [b [] [text $ "| " <> name <> " |"]] else text name ]
, a [className "glyphicon glyphicon-cog", _id "rename",onClick $ (\_-> d $ (ShowPopOver id))]
[
]
, if (popOver == true) then (renameTreeView d s id) else (renameTreeViewDummy d s)
, if (createNode == true) then (createNodeView d s id) else (renameTreeViewDummy d s)
] <>
if open then
map (\s -> toHtml d s n) ary
else []
)
]
fldr :: Boolean -> DOM.Props
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"
newtype LNode = LNode {id :: Int, name :: String, nodeType :: NodeType, open :: Boolean, popOver :: Boolean, renameNodeValue :: String, nodeValue :: String, createNode :: Boolean, showRenameBox :: 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, open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : 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'
loadNode :: Int -> Aff FTree
where
folderIcon folderOpen@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen}
[ H.i {className: fldr open} [] ]
dropProps (_ /\ setDroppedFile) = {
onDrop: dropHandler
, onDragOver: onDragOverHandler
}
where
dropHandler = mkEffectFn1 $ \e -> unsafePartial $ do
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
liftEffect $ log2 "drop:" ff
-- prevent redirection when file is dropped
E.preventDefault e
E.stopPropagation e
let blob = toBlob $ ff
void $ runAff (\_ -> pure unit) do
contents <- readAsText blob
liftEffect $ setDroppedFile $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
onDragOverHandler = mkEffectFn1 $ \e -> do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
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
nodeText (NTree (LNode {id, name}) _) n = if n == (Just id) then
H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
else
H.text (name <> " ")
popOverIcon (s@(NTree (LNode {popOver}) _) /\ setNodeState) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, onClick: mkEffectFn1 $ \_ -> setNodeState $ setPopOver (not popOver) s
} []
fldr :: Boolean -> String
fldr open = if open then "fas fa-folder-open" else "fas fa-folder"
loadNode :: ID -> Aff FTree
loadNode = get <<< toUrl Back Tree <<< Just
----- TREE CRUD Operations
......@@ -437,18 +598,51 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
= "r_name" := name
~> 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"
deleteNode :: Int -> Aff Int
deleteNode :: ID -> Aff ID
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
-- deleteNodes :: TODO -> Aff Int
-- deleteNodes :: TODO -> Aff ID
-- deleteNodes = deleteWithBody (toUrl Back Nodes Nothing)
-- UNUSED
-- createNode :: TODO -> Aff Int
-- createNode :: TODO -> Aff ID
-- createNode = post (toUrl Back Node Nothing)
fnTransform :: LNode -> FTree
......
src/Gargantext/Config.purs
View file @ 20baab9e
......@@ -10,7 +10,7 @@ toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1"
module Gargantext.Config where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
......@@ -227,9 +227,9 @@ instance toUrlPath :: ToUrl Path where
data NodeType = NodeUser
| Annuaire
| NodeContact
| NodeContact
| Corpus
| Url_Document
| Url_Document
| CorpusV3
| Dashboard
| Error
......@@ -259,6 +259,57 @@ instance showNodeType :: Show NodeType where
show Tree = "NodeTree"
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
data Path
......@@ -366,50 +417,3 @@ derive instance genericTabType :: Generic TabType _
instance showTabType :: Show TabType where
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
src/Gargantext/Config/REST.purs
View file @ 20baab9e
module Gargantext.Config.REST where
import Gargantext.Prelude
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestBody (RequestBody(..), string)
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON)
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON)
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Gargantext.Prelude
send :: forall a b. EncodeJson a => DecodeJson b =>
Method -> String -> Maybe a -> Aff b
send m url reqbody = do
......@@ -58,3 +58,26 @@ deleteWithBody url = send DELETE url <<< Just
post :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b
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
src/Gargantext/Pages/Corpus/Graph.purs
View file @ 20baab9e
module Gargantext.Pages.Corpus.Graph where
import Effect.Unsafe
import Effect.Unsafe (unsafePerformEffect)
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 Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (.??), (:=), (~>))
import Data.Argonaut (decodeJson)
import Data.Array (fold, length, mapWithIndex, (!!), null)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Int (fromString, toNumber)
import Data.Int (toNumber)
import Data.Int as Int
import Data.Lens (Lens, Lens', over, (%~), (+~), (.~), (^.), review)
import Data.Lens (Lens', over, (%~), (.~), (^.))
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Data.Number as Num
import Data.String (joinWith)
import Data.Set (Set)
import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Traversable (for_)
import Effect (Effect)
import Effect.Aff (Aff, attempt)
import Effect.Aff.Class (liftAff)
import Effect.Aff (Aff)
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.Types (Cluster(..), MetaData(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Components.Login.Types (AuthData(..), TreeId)
import Gargantext.Components.RandomText (words)
import Gargantext.Components.Tree as Tree
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.Prelude (flip)
import Gargantext.Types (class Optional)
import Gargantext.Utils (getter, toggleSet)
import Math (cos, sin)
import Gargantext.Utils (toggleSet)
import Partial.Unsafe (unsafePartial)
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.Props (_id, _type, checked, className, defaultValue, href, max, min, name, onChange, onClick, placeholder, style, title, value, onMouseMove)
import React.DOM (button, div, input, li, li', menu, p, span, text, ul')
import React.DOM.Props (_id, _type, className, defaultValue, max, min, onChange, onClick, style, onMouseMove)
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 Web.HTML (window)
import Web.HTML.Window (localStorage)
......
src/Gargantext/Utils/Reactix.purs
View file @ 20baab9e
......@@ -2,18 +2,22 @@ module Gargantext.Utils.Reactix
where
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 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 FFI.Simple ( (...), defineProperty )
import React ( ReactElement )
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((...), defineProperty)
import React (ReactElement)
import Reactix as R
import Reactix.DOM.HTML (ElemFactory)
import Reactix.React (createElement)
import Reactix.SyntheticEvent as RE
import Unsafe.Coerce ( unsafeCoerce )
import Unsafe.Coerce (unsafeCoerce)
newtype Point = Point { x :: Number, y :: Number }
-- | Turns a ReactElement into a Reactix Element
......@@ -40,3 +44,9 @@ useLayoutEffect1' :: forall a. a -> (Unit -> Effect Unit) -> R.Hooks Unit
useLayoutEffect1' a f = R.useLayoutEffect1 a $ \_ ->
do f 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