Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
d3533356
Commit
d3533356
authored
5 years ago
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[REFACT] FOREST compiles but warnings and needs more refact (WIP).
parent
4e38bda1
Changes
10
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
747 additions
and
626 deletions
+747
-626
Forest.purs
src/Gargantext/Components/Forest.purs
+1
-2
Action.purs
src/Gargantext/Components/Forest/Action.purs
+120
-0
Add.purs
src/Gargantext/Components/Forest/Action/Add.purs
+126
-0
Rename.purs
src/Gargantext/Components/Forest/Action/Rename.purs
+59
-0
Upload.purs
src/Gargantext/Components/Forest/Action/Upload.purs
+112
-0
NodeActions.purs
src/Gargantext/Components/Forest/NodeActions.purs
+2
-2
Tree.purs
src/Gargantext/Components/Forest/Tree.purs
+46
-617
HTML.purs
src/Gargantext/Components/Forest/Tree/HTML.purs
+276
-0
GraphExplorer.purs
src/Gargantext/Components/GraphExplorer.purs
+1
-1
Types.purs
src/Gargantext/Types.purs
+4
-4
No files found.
src/Gargantext/Components/Forest.purs
View file @
d3533356
module Gargantext.Components.Forest where
module Gargantext.Components.Forest where
import Prelude (const,
otherwise, ($), (<>
), (<$>))
import Prelude (const,
($
), (<$>))
import Data.Array as A
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Gargantext.Ends (Frontends)
import Gargantext.Ends (Frontends)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Action.purs
0 → 100644
View file @
d3533356
module Gargantext.Components.Forest.Action where
import Prelude hiding (div)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Effect.Aff (Aff, launchAff, runAff)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Routes (AppRoute, SessionRoute(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Gargantext.Sessions (Session, sessionId, get, put, post, postWwwUrlencoded, delete)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Generic.Rep.Eq (genericEq)
-- file upload types
data Action = Submit String
| DeleteNode
| CreateSubmit String NodeType
| UploadFile FileType UploadFileContents
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
data DroppedFile = DroppedFile {
contents :: UploadFileContents
, fileType :: Maybe FileType
}
type FileHash = String
type Name = String
type ID = Int
type Reload = Int
data NodePopup = CreatePopup | NodePopup
newtype UploadFileContents = UploadFileContents String
createNode :: Session -> ID -> CreateValue -> Aff ID
createNode session parentId = post session $ NodeAPI Node (Just parentId) ""
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put session $ NodeAPI Node (Just renameNodeId) "rename"
deleteNode :: Session -> ID -> Aff ID
deleteNode session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
loadNode :: Session -> ID -> Aff FTree
loadNode session nodeId = get session $ NodeAPI Tree (Just nodeId) ""
newtype RenameValue = RenameValue
{
name :: Name
}
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue {name})
= "r_name" := name
~> jsonEmptyObject
newtype CreateValue = CreateValue
{
name :: Name
, nodeType :: NodeType
}
instance encodeJsonCreateValue :: EncodeJson CreateValue where
encodeJson (CreateValue {name, nodeType})
= "pn_name" := name
~> "pn_typename" := nodeType
~> jsonEmptyObject
data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode
type Tree = { tree :: FTree }
instance ntreeFunctor :: Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary)
newtype LNode = LNode { id :: ID
, name :: Name
, nodeType :: NodeType
}
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}
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'
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Action/Add.purs
0 → 100644
View file @
d3533356
module Gargantext.Components.Forest.Action.Add where
import Prelude hiding (div)
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter, null)
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.Aff (Aff, launchAff, runAff)
import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Routes (AppRoute, SessionRoute(..))
import Gargantext.Sessions (Session, sessionId, get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Utils (id, glyphicon)
import Gargantext.Utils.Reactix as R2
import Gargantext.Components.Forest.NodeActions
import Gargantext.Components.Forest.Action
-- START Create Node
type CreateNodeProps =
( id :: ID
, name :: Name
, nodeType :: NodeType)
createNodeView :: (Action -> Aff Unit)
-> Record CreateNodeProps
-> R.State (Maybe NodePopup)
-> R.Element
createNodeView d p (Just CreatePopup /\ setPopupOpen) = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt {id, name} _ = do
nodeName <- R.useState' ""
nodeType <- R.useState' NodeUser
pure $ H.div tooltipProps $
[ H.div {className: "panel panel-default"}
[ panelHeading
, panelBody nodeName nodeType
, panelFooter nodeName nodeType
]
]
where
tooltipProps = { className: ""
, id: "add-node-tooltip"
, title: "Add new node"
, data: {toggle: "tooltip", placement: "right"}
}
panelHeading =
H.div {className: "panel-heading"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
[ H.h5 {} [H.text "Add"] ]
, H.div {className: "col-md-2"}
[ H.a { className: "btn glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
, title: "Close"} []
]
]
]
panelBody :: R.State String -> R.State NodeType -> R.Element
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: name
, className: "form-control"
, onInput: mkEffectFn1 $ \e -> setNodeName $ const $ e .. "target" .. "value"
}
]
, H.div {className: "form-group"}
[ R2.select { className: "form-control"
, onChange: mkEffectFn1 $ \e -> setNodeType $ const $ readNodeType $ e .. "target" .. "value"
}
(map renderOption [FolderPublic, FolderShared, FolderPrivate])
]
]
]
]
]
renderOption (opt :: NodeType) = H.option {} [ H.text $ show opt ]
panelFooter :: R.State String -> R.State NodeType -> R.Element
panelFooter (name' /\ _) (nt /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setPopupOpen $ const Nothing
launchAff $ d $ CreateSubmit name' nt
} [H.text "Add"]
]
createNodeView _ _ _ = R.createElement el {} []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} []
-- END Create Node
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Action/Rename.purs
0 → 100644
View file @
d3533356
module Gargantext.Components.Forest.Action.Rename where
import Prelude hiding (div)
import Data.Tuple.Nested ((/\))
import Reactix.DOM.HTML as H
import Reactix as R
import Effect.Aff (Aff, launchAff, runAff)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Gargantext.Components.Forest.Action
-- START Rename Box
type RenameBoxProps =
( id :: ID
, name :: Name)
renameBox :: (Action -> Aff Unit) -> Record RenameBoxProps -> R.State Boolean -> R.Element
renameBox d p (true /\ setRenameBoxOpen) = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {id, name} _ = do
renameNodeName <- R.useState' 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 $ const $ e .. "target" .. "value"
}
]
renameBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setRenameBoxOpen $ const false
launchAff $ d $ Submit newName
, title: "Rename"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const false
, title: "Cancel"
} []
renameBox _ p (false /\ _) = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {name} _ = pure $ H.div {} [ H.text name ]
-- END Rename Box
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Action/Upload.purs
0 → 100644
View file @
d3533356
module Gargantext.Components.Forest.Action.Upload where
import Data.Newtype (class Newtype)
import Effect.Aff (Aff, launchAff, runAff)
import Gargantext.Sessions (Session, sessionId, get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Routes (AppRoute, SessionRoute(..))
import Prelude hiding (div)
import Data.Maybe (Maybe(..), fromJust)
import URI.Extra.QueryPairs as QP
import Gargantext.Components.Forest.Action
import Reactix as R
import Data.Tuple (Tuple)
import URI.Query as Q
import Reactix.DOM.HTML as H
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Gargantext.Utils (id, glyphicon)
import Gargantext.Utils.Reactix as R2
import Data.Tuple.Nested ((/\))
-- START File Type View
type FileTypeProps =
( id :: ID
, nodeType :: NodeType)
fileTypeView :: (Action -> Aff Unit)
-> Record FileTypeProps
-> R.State (Maybe DroppedFile)
-> R.State Boolean
-> R.Element
fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_ /\ setIsDragOver) = R.createElement el p []
where
el = R.hooksComponent "FileTypeView" cpt
cpt {id} _ = 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", 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 glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile $ const Nothing
setIsDragOver $ const false
, 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 $ const $ 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 $ const Nothing
launchAff $ d $ UploadFile 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 {} []
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 :: Session -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile session id fileType (UploadFileContents fileContents) =
postWwwUrlencoded session p fileContents
where
q = FileUploadQuery { fileType: fileType }
p = NodeAPI Node (Just id) $ "upload" <> Q.print (toQuery q)
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/NodeActions.purs
View file @
d3533356
...
@@ -57,14 +57,14 @@ filterWithRights (show action if user can only)
...
@@ -57,14 +57,14 @@ filterWithRights (show action if user can only)
nodeActions :: NodeType -> Array NodeAction
nodeActions :: NodeType -> Array NodeAction
nodeActions NodeUser = [ Add [ FolderPrivate
nodeActions NodeUser = [ Add [ FolderPrivate
, Folder
Team
, Folder
Shared
, FolderPublic
, FolderPublic
]
]
, Delete
, Delete
]
]
nodeActions FolderPrivate = [ Add [Folder, Corpus]]
nodeActions FolderPrivate = [ Add [Folder, Corpus]]
nodeActions Folder
Team
= [ Add [Folder, Corpus]]
nodeActions Folder
Shared
= [ Add [Folder, Corpus]]
nodeActions FolderPublic = [ Add [Folder, Corpus]]
nodeActions FolderPublic = [ Add [Folder, Corpus]]
nodeActions Folder = [ Add [Corpus], Rename, Delete]
nodeActions Folder = [ Add [Corpus], Rename, Delete]
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Tree.purs
View file @
d3533356
module Gargantext.Components.Forest.Tree where
module Gargantext.Components.Forest.Tree where
import Prelude hiding (div)
import DOM.Simple.Console (log2)
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter, null)
import Data.Array (filter, null)
...
@@ -16,33 +14,22 @@ import Effect.Aff (Aff, launchAff, runAff)
...
@@ -16,33 +14,22 @@ import Effect.Aff (Aff, launchAff, runAff)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import FFI.Simple ((..))
import Partial.Unsafe (unsafePartial)
import Gargantext.Components.Forest.Action
import React.SyntheticEvent as E
import Gargantext.Components.Forest.Action.Add
import Gargantext.Components.Forest.Action.Rename
import Gargantext.Components.Forest.Action.Upload
import Gargantext.Components.Forest.NodeActions
import Gargantext.Components.Forest.Tree.HTML
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session)
import Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>))
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Routes (AppRoute, SessionRoute(..))
import Gargantext.Sessions (Session, sessionId, get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Utils (id, glyphicon)
import Gargantext.Utils.Reactix as R2
import Gargantext.Components.Forest.NodeActions
type Name = String
type Open = Boolean
type Open = Boolean
type URL = String
type URL = String
type ID = Int
type Reload = Int
data NodePopup = CreatePopup | NodePopup
type Props = ( root :: ID
type Props = ( root :: ID
, mCurrentRoute :: Maybe AppRoute
, mCurrentRoute :: Maybe AppRoute
...
@@ -56,106 +43,13 @@ type TreeViewProps = ( tree :: FTree
...
@@ -56,106 +43,13 @@ type TreeViewProps = ( tree :: FTree
, session :: Session
, session :: Session
)
)
data NTree a = NTree a (Array (NTree a))
instance ntreeFunctor :: Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary)
-- Keep only the nodes matching the predicate.
-- Keep only the nodes matching the predicate.
-- The root of the tree is always kept.
-- The root of the tree is always kept.
filterNTree :: forall a. (a -> Boolean) -> NTree a -> NTree a
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 :: Name
, nodeType :: NodeType
}
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}
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
-- 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 String
| DeleteNode
| CreateSubmit String NodeType
| UploadFile FileType UploadFileContents
type Tree = { tree :: FTree }
mapFTree :: (FTree -> FTree) -> Tree -> Tree
mapFTree f s@{tree} = s {tree = f tree}
performAction :: Session -> R.State Int -> R.State Tree -> Action -> Aff Unit
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode session id
liftEffect $ setReload (_ + 1)
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode session id $ RenameValue {name}
liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode session id $ CreateValue {name, nodeType}
liftEffect $ setReload (_ + 1)
performAction session _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- uploadFile session id fileType contents
liftEffect $ log2 "uploaded:" hashes
------------------------------------------------------------------------
------------------------------------------------------------------------
mCorpusId :: Maybe AppRoute -> Maybe Int
mCorpusId (Just (Routes.Corpus _ id)) = Just id
mCorpusId (Just (Routes.CorpusDocument _ id _ _)) = Just id
mCorpusId _ = Nothing
treeView :: Record Props -> R.Element
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
treeView props = R.createElement treeViewCpt props []
...
@@ -185,12 +79,24 @@ loadedTreeView reload p = R.createElement el p []
...
@@ -185,12 +79,24 @@ loadedTreeView reload p = R.createElement el p []
pure $ H.div {className: "tree"}
pure $ H.div {className: "tree"}
[ toHtml reload treeState session frontends mCurrentRoute ]
[ toHtml reload treeState session frontends mCurrentRoute ]
-- | START toHtml
toHtml :: R.State Reload -> R.State Tree -> Session -> Frontends -> Maybe AppRoute -> R.Element
-- | To HTML
toHtml :: R.State Reload
-> R.State Tree
-> Session
-> Frontends
-> Maybe AppRoute
-> R.Element
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) session frontends mCurrentRoute = R.createElement el {} []
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) session frontends mCurrentRoute = R.createElement el {} []
where
where
el = R.hooksComponent "NodeView" cpt
el = R.hooksComponent "NodeView" cpt
pAction = performAction session reload treeState
pAction = performAction session reload treeState
cpt props _ = do
cpt props _ = do
folderOpen <- R.useState' true
folderOpen <- R.useState' true
...
@@ -203,88 +109,7 @@ toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _)
...
@@ -203,88 +109,7 @@ toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _)
)
)
]
]
type NodeMainSpanProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
, mCurrentRoute :: Maybe AppRoute
)
nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps
-> R.State Boolean
-> Session
-> Frontends
-> R.Element
nodeMainSpan d p folderOpen session frontends = R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentRoute} _ = do
-- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
pure $ H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen
, H.a { href: (url frontends (NodePath (sessionId session) nodeType (Just id)))
, style: {marginLeft: "22px"}
}
[ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name:name'} ]
, popOverIcon popupOpen
, nodePopupView d {id, name, nodeType} popupOpen
, createNodeView d {id, name, nodeType} popupOpen
, fileTypeView d {id , nodeType} droppedFile isDragOver
]
where
name' = if nodeType == NodeUser then show session else name
folderIcon folderOpen'@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen'}
[ H.i {className: fldr open} [] ]
popOverIcon (popOver /\ setPopOver) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, on: { click: \_ -> setPopOver $ toggle }
} []
where
toggle Nothing = Just NodePopup
toggle _ = Nothing
dropProps droppedFile isDragOver =
{ className: dropClass droppedFile isDragOver
, on: { drop: dropHandler droppedFile
, dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver } }
where
dropClass (Just _ /\ _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped"
dropClass (Nothing /\ _) _ = ""
dropHandler (_ /\ setDroppedFile) 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 $ const $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
onDragOverHandler (_ /\ setIsDragOver) e = do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver $ const true
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
fldr :: Boolean -> String
fldr open = if open
then "glyphicon glyphicon-folder-open"
else "glyphicon glyphicon-folder-close"
childNodes :: Session -> Frontends
childNodes :: Session -> Frontends
-> R.State Reload -> R.State Boolean
-> R.State Reload -> R.State Boolean
...
@@ -302,431 +127,35 @@ childNodes session frontends reload (true /\ _) mCurrentRoute ary =
...
@@ -302,431 +127,35 @@ childNodes session frontends reload (true /\ _) mCurrentRoute ary =
treeState <- R.useState' {tree}
treeState <- R.useState' {tree}
pure $ toHtml reload treeState session frontends mCurrentRoute
pure $ toHtml reload treeState session frontends mCurrentRoute
-- END toHtml
-- | START Popup View
type NodePopupProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
)
iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"}
nodePopupView :: (Action -> Aff Unit)
-> Record NodePopupProps
-> R.State (Maybe NodePopup)
-> R.Element
nodePopupView d p (Just NodePopup /\ setPopupOpen) = R.createElement el p []
where
el = R.hooksComponent "NodePopupView" cpt
cpt {id, name, nodeType} _ = do
renameBoxOpen <- R.useState' 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", placement: "right"}
}
rowClass true = "col-md-10"
rowClass false = "col-md-8"
Buttons {edit:edits,click:clicks,pop:pops} = buttons nodeType
panelHeading renameBoxOpen@(open /\ _) =
H.div {className: "panel-heading"}
[ H.div {className: "row" }
[ H.div {className: "col-md-1"} []
, buttonClick d (Documentation nodeType)
, H.div {className: rowClass open} [ renameBox d {id, name} renameBoxOpen ]
, if not (null edits) then editIcon renameBoxOpen else H.div {} []
, H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
, title: "Close"} []
]
]
]
where
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 $ const true
}
[]
]
editIcon (true /\ _) = H.div {} []
panelBody =
H.div {className: "panel-body"
, style: { display:"flex"
, justifyContent : "center"
, backgroundColor: "white"
, border: "none"}}
((map (\a -> buttonPop a setPopupOpen) pops)
<>
(map (buttonClick d) clicks))
nodePopupView _ p _ = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt _ _ = pure $ H.div {} []
-- buttonAction :: NodeAction -> R.Element
buttonClick _ (Documentation x ) = H.div {className: "col-md-1"}
[ H.a { style: iconAStyle
, className: (glyphicon "question-sign")
, id: "doc"
, title: "Documentation"
}
-- , onClick: mkEffectFn1 $ \_ -> launchAff $ d $ DeleteNode}
[]
]
buttonClick d Delete = H.div {className: "col-md-4"}
[ H.a { style: iconAStyle
, className: (glyphicon "trash")
, id: "rename2"
, title: "Delete"
, onClick: mkEffectFn1 $ \_ -> launchAff $ d $ DeleteNode}
[]
]
buttonClick _ Upload = H.div {className: "col-md-4"}
[ H.a { style: iconAStyle
, className: (glyphicon "upload")
, id: "upload"
, title: "Upload [WIP]"}
[]
]
buttonClick _ Download = H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "download")
, id: "download"
, title: "Download [WIP]"}
[]
]
buttonClick _ _ = H.div {} []
buttonPop (Add _) f = H.div {className: "col-md-4"}
[ H.a { style: iconAStyle
, className: (glyphicon "plus")
, id: "create"
, title: "Create"
, onClick: mkEffectFn1 $ \_ -> f $ const $ Just CreatePopup
}
[]
]
buttonPop _ _ = H.div {} []
-- END Popup View
-- START Rename Box
type RenameBoxProps =
( id :: ID
, name :: Name)
renameBox :: (Action -> Aff Unit) -> Record RenameBoxProps -> R.State Boolean -> R.Element
renameBox d p (true /\ setRenameBoxOpen) = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {id, name} _ = do
renameNodeName <- R.useState' 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 $ const $ e .. "target" .. "value"
}
]
renameBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setRenameBoxOpen $ const false
launchAff $ d $ Submit newName
, title: "Rename"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const false
, title: "Cancel"
} []
renameBox _ p (false /\ _) = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {name} _ = pure $ H.div {} [ H.text name ]
-- END Rename Box
-- START Create Node
type CreateNodeProps =
( id :: ID
, name :: Name
, nodeType :: NodeType)
createNodeView :: (Action -> Aff Unit) -> Record CreateNodeProps -> R.State (Maybe NodePopup) -> R.Element
createNodeView d p (Just CreatePopup /\ setPopupOpen) = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt {id, name} _ = do
nodeName <- R.useState' ""
nodeType <- R.useState' NodeUser
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", 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 $ \_ -> setPopupOpen $ const Nothing
, title: "Close"} []
]
]
]
panelBody :: R.State String -> R.State NodeType -> R.Element
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: name
, className: "form-control"
, onInput: mkEffectFn1 $ \e -> setNodeName $ const $ e .. "target" .. "value"
}
]
, H.div {className: "form-group"}
[ R2.select { className: "form-control"
, onChange: mkEffectFn1 $ \e -> setNodeType $ const $ readNodeType $ e .. "target" .. "value"
}
(map renderOption [Corpus, Folder])
]
]
]
]
]
renderOption (opt :: NodeType) = H.option {} [ H.text $ show opt ]
panelFooter :: R.State String -> R.State NodeType -> R.Element
panelFooter (name' /\ _) (nt /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setPopupOpen $ const Nothing
launchAff $ d $ CreateSubmit name' nt
} [H.text "Create"]
]
createNodeView _ _ _ = R.createElement el {} []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} []
-- END Create Node
performAction :: Session -> R.State Int -> R.State Tree -> Action -> Aff Unit
-- START File Type View
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode session id
liftEffect $ setReload (_ + 1)
type FileTypeProps =
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
( id :: ID
void $ renameNode session id $ RenameValue {name}
, nodeType :: NodeType)
liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
fileTypeView :: (Action -> Aff Unit) -> Record FileTypeProps -> R.State (Maybe DroppedFile) -> R.State Boolean -> R.Element
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_ /\ setIsDragOver) = R.createElement el p []
void $ createNode session id $ CreateValue {name, nodeType}
where
liftEffect $ setReload (_ + 1)
el = R.hooksComponent "FileTypeView" cpt
cpt {id} _ = 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", 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 $ \_ -> do
setDroppedFile $ const Nothing
setIsDragOver $ const false
, 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 $ const $ 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 $ const Nothing
launchAff $ d $ UploadFile 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 {} []
-- END File Type View
performAction session _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- uploadFile session id fileType contents
liftEffect $ log2 "uploaded:" hashes
--
START node text
--
TO be deleted
type NodeTextProps =
{-
( isSelected :: Boolean
mapFTree :: (FTree -> FTree) -> Tree -> Tree
, name :: Name )
mapFTree f s@{tree} = s {tree = f tree}
-}
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement el p []
where
el = R.hooksComponent "NodeText" cpt
cpt {isSelected: true, name} _ = do
pure $ H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
cpt {isSelected: false, name} _ = do
pure $ H.text (name <> " ")
-- END node text
loadNode :: Session -> ID -> Aff FTree
loadNode session nodeId = get session $ NodeAPI Tree (Just nodeId) ""
----- TREE CRUD Operations
newtype RenameValue = RenameValue
{
name :: Name
}
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue {name})
= "r_name" := name
~> jsonEmptyObject
newtype CreateValue = CreateValue
{
name :: Name
, nodeType :: NodeType
}
instance encodeJsonCreateValue :: EncodeJson CreateValue where
encodeJson (CreateValue {name, nodeType})
= "pn_name" := name
~> "pn_typename" := nodeType
~> jsonEmptyObject
createNode :: Session -> ID -> CreateValue -> Aff ID
createNode session parentId = post session $ NodeAPI Node (Just parentId) ""
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put session $ NodeAPI Node (Just renameNodeId) "rename"
deleteNode :: Session -> ID -> Aff ID
deleteNode session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
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 :: Session -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile session id fileType (UploadFileContents fileContents) =
postWwwUrlencoded session p fileContents
where
q = FileUploadQuery { fileType: fileType }
p = NodeAPI Node (Just id) $ "upload" <> Q.print (toQuery q)
{-
fnTransform :: LNode -> FTree
fnTransform :: LNode -> FTree
fnTransform n = NTree n []
fnTransform n = NTree n []
-}
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Tree/HTML.purs
0 → 100644
View file @
d3533356
module Gargantext.Components.Forest.Tree.HTML where
import DOM.Simple.Console (log2)
import Data.Array (filter, null)
import Data.Maybe (Maybe(..), fromJust)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff, runAff)
import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Gargantext.Components.Forest.Action
import Gargantext.Components.Forest.Action.Rename
import Gargantext.Components.Forest.Action.Add
import Gargantext.Components.Forest.Action.Upload
import Gargantext.Components.Forest.NodeActions
import Gargantext.Ends (Frontends, url)
import Gargantext.Routes (AppRoute, SessionRoute(..))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Utils (id, glyphicon)
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial)
import Prelude hiding (div)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText)
-- Main Node
type NodeMainSpanProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
, mCurrentRoute :: Maybe AppRoute
)
nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps
-> R.State Boolean
-> Session
-> Frontends
-> R.Element
nodeMainSpan d p folderOpen session frontends = R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentRoute} _ = do
-- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
pure $ H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen
, H.a { href: (url frontends (NodePath (sessionId session) nodeType (Just id)))
, style: {marginLeft: "22px"}
}
[ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name:name'} ]
, popOverIcon popupOpen
, nodePopupView d {id, name, nodeType} popupOpen
, createNodeView d {id, name, nodeType} popupOpen
, fileTypeView d {id , nodeType} droppedFile isDragOver
]
where
name' = if nodeType == NodeUser then show session else name
folderIcon folderOpen'@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen'}
[ H.i {className: fldr open} [] ]
popOverIcon (popOver /\ setPopOver) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, on: { click: \_ -> setPopOver $ toggle }
} []
where
toggle Nothing = Just NodePopup
toggle _ = Nothing
dropProps droppedFile isDragOver =
{ className: dropClass droppedFile isDragOver
, on: { drop: dropHandler droppedFile
, dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver } }
where
dropClass (Just _ /\ _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped"
dropClass (Nothing /\ _) _ = ""
dropHandler (_ /\ setDroppedFile) 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 $ const $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
onDragOverHandler (_ /\ setIsDragOver) e = do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver $ const true
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
fldr :: Boolean -> String
fldr open = if open
then "glyphicon glyphicon-folder-open"
else "glyphicon glyphicon-folder-close"
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name :: Name )
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement el p []
where
el = R.hooksComponent "NodeText" cpt
cpt {isSelected: true, name} _ = do
pure $ H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
cpt {isSelected: false, name} _ = do
pure $ H.text (name <> " ")
-- END node text
mCorpusId :: Maybe AppRoute -> Maybe Int
mCorpusId (Just (Routes.Corpus _ id)) = Just id
mCorpusId (Just (Routes.CorpusDocument _ id _ _)) = Just id
mCorpusId _ = Nothing
-- | START Popup View
type NodePopupProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
)
iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"}
nodePopupView :: (Action -> Aff Unit)
-> Record NodePopupProps
-> R.State (Maybe NodePopup)
-> R.Element
nodePopupView d p (Just NodePopup /\ setPopupOpen) = R.createElement el p []
where
el = R.hooksComponent "NodePopupView" cpt
cpt {id, name, nodeType} _ = do
renameBoxOpen <- R.useState' 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", placement: "right"}
}
rowClass true = "col-md-10"
rowClass false = "col-md-8"
Buttons {edit:edits,click:clicks,pop:pops} = buttons nodeType
panelHeading renameBoxOpen@(open /\ _) =
H.div {className: "panel-heading"}
[ H.div {className: "row" }
[ H.div {className: "col-md-1"} []
, buttonClick d (Documentation nodeType)
, H.div {className: rowClass open} [ renameBox d {id, name} renameBoxOpen ]
, if not (null edits) then editIcon renameBoxOpen else H.div {} []
, H.div {className: "col-md-2"}
[ H.a {className: "btn glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
, title: "Close"} []
]
]
]
where
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 $ const true
}
[]
]
editIcon (true /\ _) = H.div {} []
panelBody =
H.div {className: "panel-body"
, style: { display:"flex"
, justifyContent : "center"
, backgroundColor: "white"
, border: "none"}}
((map (\a -> buttonPop a setPopupOpen) pops)
<>
(map (buttonClick d) clicks))
nodePopupView _ p _ = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt _ _ = pure $ H.div {} []
-- buttonAction :: NodeAction -> R.Element
buttonClick _ (Documentation x ) = H.div {className: "col-md-1"}
[ H.a { style: iconAStyle
, className: (glyphicon "question-sign")
, id: "doc"
, title: "Documentation"
}
-- , onClick: mkEffectFn1 $ \_ -> launchAff $ d $ DeleteNode}
[]
]
buttonClick d Delete = H.div {className: "col-md-4"}
[ H.a { style: iconAStyle
, className: (glyphicon "trash")
, id: "rename2"
, title: "Delete"
, onClick: mkEffectFn1 $ \_ -> launchAff $ d $ DeleteNode}
[]
]
buttonClick _ Upload = H.div {className: "col-md-4"}
[ H.a { style: iconAStyle
, className: (glyphicon "upload")
, id: "upload"
, title: "Upload [WIP]"}
[]
]
buttonClick _ Download = H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "download")
, id: "download"
, title: "Download [WIP]"}
[]
]
buttonClick _ _ = H.div {} []
buttonPop (Add _) f = H.div {className: "col-md-4"}
[ H.a { style: iconAStyle
, className: (glyphicon "plus")
, id: "create"
, title: "Create"
, onClick: mkEffectFn1 $ \_ -> f $ const $ Just CreatePopup
}
[]
]
buttonPop _ _ = H.div {} []
-- END Popup View
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/GraphExplorer.purs
View file @
d3533356
...
@@ -24,7 +24,7 @@ import Gargantext.Components.Graph as Graph
...
@@ -24,7 +24,7 @@ import Gargantext.Components.Graph as Graph
import Gargantext.Components.Forest (forest)
import Gargantext.Components.Forest (forest)
import Gargantext.Ends (Frontends)
import Gargantext.Ends (Frontends)
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
import Gargantext.Sessions (Session, Sessions
(..)
, get)
import Gargantext.Sessions (Session, Sessions, get)
import Gargantext.Types (NodeType(Graph))
import Gargantext.Types (NodeType(Graph))
type GraphId = Int
type GraphId = Int
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Types.purs
View file @
d3533356
...
@@ -123,7 +123,7 @@ instance encodeJsonTabPostQuery :: EncodeJson TabPostQuery where
...
@@ -123,7 +123,7 @@ instance encodeJsonTabPostQuery :: EncodeJson TabPostQuery where
~> jsonEmptyObject
~> jsonEmptyObject
data NodeType = NodeUser
data NodeType = NodeUser
| Folder | FolderPrivate | Folder
Team
| FolderPublic
| Folder | FolderPrivate | Folder
Shared
| FolderPublic
| Annuaire
| Annuaire
| NodeContact
| NodeContact
| Corpus
| Corpus
...
@@ -146,7 +146,7 @@ instance showNodeType :: Show NodeType where
...
@@ -146,7 +146,7 @@ instance showNodeType :: Show NodeType where
show Folder = "NodeFolder"
show Folder = "NodeFolder"
show FolderPrivate = "NodeFolderPrivate"
show FolderPrivate = "NodeFolderPrivate"
show Folder
Team = "NodeFolderTeam
"
show Folder
Shared = "NodeFolderShared
"
show FolderPublic = "NodeFolderPublic"
show FolderPublic = "NodeFolderPublic"
show Annuaire = "Annuaire"
show Annuaire = "Annuaire"
...
@@ -169,7 +169,7 @@ readNodeType "NodeUser" = NodeUser
...
@@ -169,7 +169,7 @@ readNodeType "NodeUser" = NodeUser
readNodeType "NodeFolder" = Folder
readNodeType "NodeFolder" = Folder
readNodeType "NodeFolderPrivate" = FolderPrivate
readNodeType "NodeFolderPrivate" = FolderPrivate
readNodeType "NodeFolder
Team" = FolderTeam
readNodeType "NodeFolder
Shared" = FolderShared
readNodeType "NodeFolderPublic" = FolderPublic
readNodeType "NodeFolderPublic" = FolderPublic
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeAnnuaire" = Annuaire
...
@@ -206,7 +206,7 @@ instance encodeJsonNodeType :: EncodeJson NodeType where
...
@@ -206,7 +206,7 @@ instance encodeJsonNodeType :: EncodeJson NodeType where
nodeTypePath :: NodeType -> String
nodeTypePath :: NodeType -> String
nodeTypePath Folder = "folder"
nodeTypePath Folder = "folder"
nodeTypePath FolderPrivate = "folderPrivate"
nodeTypePath FolderPrivate = "folderPrivate"
nodeTypePath Folder
Team = "folderTeam
"
nodeTypePath Folder
Shared = "folderShared
"
nodeTypePath FolderPublic = "folderPublic"
nodeTypePath FolderPublic = "folderPublic"
nodeTypePath Annuaire = "annuaire"
nodeTypePath Annuaire = "annuaire"
nodeTypePath Corpus = "corpus"
nodeTypePath Corpus = "corpus"
...
...
This diff is collapsed.
Click to expand it.
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment