Commit 4ec844e6 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-list-charts

parents a361da8a 74fd189f
...@@ -204,6 +204,7 @@ a:focus, a:hover { ...@@ -204,6 +204,7 @@ a:focus, a:hover {
.copy-from-corpus .tree .node { .copy-from-corpus .tree .node {
padding-left: 10px; padding-left: 10px;
margin-top: 5px;
} }
.copy-from-corpus .tree .node .name.clickable { .copy-from-corpus .tree .node .name.clickable {
color: #337ab7; color: #337ab7;
......
...@@ -192,6 +192,7 @@ a:focus, a:hover ...@@ -192,6 +192,7 @@ a:focus, a:hover
.tree .tree
.node .node
padding-left: 10px padding-left: 10px
margin-top: 5px
.name .name
&.clickable &.clickable
color: #337ab7 color: #337ab7
......
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.1.6.2", "version": "0.0.1.6.4",
"scripts": { "scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall", "rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall", "rebuild-set": "spago psc-package-insdhall",
......
...@@ -38,7 +38,7 @@ annotationMenuCpt :: R.Component Props ...@@ -38,7 +38,7 @@ annotationMenuCpt :: R.Component Props
annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt
where where
cpt props _ = pure $ R.fragment $ children props cpt props _ = pure $ R.fragment $ children props
children props = A.mapMaybe (addToList props) [ GraphTerm, CandidateTerm, StopTerm ] children props = A.mapMaybe (addToList props) [ MapTerm, CandidateTerm, StopTerm ]
-- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem -- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
addToList :: Record Props -> TermList -> Maybe R.Element addToList :: Record Props -> TermList -> Maybe R.Element
......
...@@ -3,11 +3,11 @@ module Gargantext.Components.Annotation.Utils where ...@@ -3,11 +3,11 @@ module Gargantext.Components.Annotation.Utils where
import Gargantext.Types ( TermList(..) ) import Gargantext.Types ( TermList(..) )
termClass :: TermList -> String termClass :: TermList -> String
termClass GraphTerm = "graph-term" termClass MapTerm = "graph-term"
termClass StopTerm = "stop-term" termClass StopTerm = "stop-term"
termClass CandidateTerm = "candidate-term" termClass CandidateTerm = "candidate-term"
termBootstrapClass :: TermList -> String termBootstrapClass :: TermList -> String
termBootstrapClass GraphTerm = "success" termBootstrapClass MapTerm = "success"
termBootstrapClass StopTerm = "danger" termBootstrapClass StopTerm = "danger"
termBootstrapClass CandidateTerm = "warning" termBootstrapClass CandidateTerm = "warning"
...@@ -20,6 +20,7 @@ import Gargantext.Components.Login (login) ...@@ -20,6 +20,7 @@ import Gargantext.Components.Login (login)
import Gargantext.Components.Nodes.Annuaire (annuaireLayout) import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout) import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout) import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout) import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout) import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.Home (homeLayout) import Gargantext.Components.Nodes.Home (homeLayout)
...@@ -77,6 +78,8 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -77,6 +78,8 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
FolderPublic sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session } FolderPublic sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session }
FolderShared sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session } FolderShared sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session }
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session } Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { key: show nodeId, nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { key: show nodeId, nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session } Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends } Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session } Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
...@@ -84,8 +87,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -84,8 +87,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { frontends, nodeId, session } Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { frontends, nodeId, session }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session } UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session }
ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, frontends, nodeId, session } ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, frontends, nodeId, session }
CorpusDocument sid corpusId listId nodeId -> CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
Document sid listId nodeId -> Document sid listId nodeId ->
withSession sid $ withSession sid $
\session -> forested $ documentLayout { nodeId, listId, session, corpusId: Nothing } \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Nothing }
...@@ -102,8 +104,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -102,8 +104,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
, treeReload } , treeReload }
type ForestLayoutProps = type ForestLayoutProps =
( ( child :: R.Element
child :: R.Element
, frontends :: Frontends , frontends :: Frontends
, reload :: R.State Int , reload :: R.State Int
, route :: AppRoute , route :: AppRoute
......
...@@ -10,6 +10,7 @@ import Effect.Aff (Aff) ...@@ -10,6 +10,7 @@ import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (nodeMainSpan) import Gargantext.Components.Forest.Tree.Node (nodeMainSpan)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode) import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode) import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode)
...@@ -104,8 +105,6 @@ getNodeTree :: Session -> GT.ID -> Aff FTree ...@@ -104,8 +105,6 @@ getNodeTree :: Session -> GT.ID -> Aff FTree
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) "" getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
-------------- --------------
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree , tree :: FTree
, tasks :: Record Tasks , tasks :: Record Tasks
...@@ -306,16 +305,25 @@ performAction (UploadFile nodeType fileType mName contents) { session ...@@ -306,16 +305,25 @@ performAction (UploadFile nodeType fileType mName contents) { session
performAction DownloadNode _ = do performAction DownloadNode _ = do
liftEffect $ log "[performAction] DownloadNode" liftEffect $ log "[performAction] DownloadNode"
------- -------
performAction (MoveNode n1 n2) p@{session} = do performAction (MoveNode {params}) p@{session} =
void $ moveNodeReq session n1 n2 case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ moveNodeReq session in' out
performAction RefreshTree p performAction RefreshTree p
performAction (MergeNode n1 n2) p@{session} = do performAction (MergeNode {params}) p@{session} =
void $ mergeNodeReq session n1 n2 case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ mergeNodeReq session in' out
performAction RefreshTree p performAction RefreshTree p
performAction (LinkNode n1 n2) p@{session} = do performAction (LinkNode {params}) p@{session} =
void $ linkNodeReq session n1 n2 case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ linkNodeReq session in' out
performAction RefreshTree p performAction RefreshTree p
------- -------
......
...@@ -14,6 +14,7 @@ import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps) ...@@ -14,6 +14,7 @@ import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..)) import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks) import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks)
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList) import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
import Gargantext.Components.GraphExplorer.API as GraphAPI import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN)) import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild) import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
...@@ -166,28 +167,6 @@ fldr nt open = if open ...@@ -166,28 +167,6 @@ fldr nt open = if open
-} -}
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name :: Name
)
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement nodeTextCpt p []
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt
where
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
-- START nodeActions -- START nodeActions
type NodeActionsProps = type NodeActionsProps =
......
module Gargantext.Components.Forest.Tree.Node.Action where module Gargantext.Components.Forest.Tree.Node.Action where
import Data.Maybe (Maybe) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Prelude (class Show, Unit) import Gargantext.Prelude (class Show, Unit)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction, SubTreeParams(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut, SubTreeParams(..))
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents)
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams) import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
{-
type UpdateNodeProps = type Props =
( id :: GT.ID ( dispatch :: Action -> Aff Unit
, dispatch :: Action -> Aff Unit , id :: Int
, name :: GT.Name , nodeType :: GT.NodeType
, nodeType :: NodeType , session :: Session
, params :: UpdateNodeParams
) )
-}
data Action = AddNode String GT.NodeType data Action = AddNode String GT.NodeType
| DeleteNode | DeleteNode
...@@ -28,11 +28,27 @@ data Action = AddNode String GT.NodeType ...@@ -28,11 +28,27 @@ data Action = AddNode String GT.NodeType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents | UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| DownloadNode | DownloadNode
| RefreshTree | RefreshTree
| MoveNode GT.NodeID GT.NodeID
| MergeNode GT.NodeID GT.NodeID | MoveNode {params :: Maybe SubTreeOut}
| LinkNode GT.NodeID GT.NodeID | MergeNode {params :: Maybe SubTreeOut}
| LinkNode {params :: Maybe SubTreeOut}
| NoAction | NoAction
subTreeOut :: Action -> Maybe SubTreeOut
subTreeOut (MoveNode {params}) = params
subTreeOut (MergeNode {params}) = params
subTreeOut (LinkNode {params}) = params
subTreeOut _ = Nothing
setTreeOut :: Action -> Maybe SubTreeOut -> Action
setTreeOut (MoveNode {params:_}) p = MoveNode {params: p}
setTreeOut (MergeNode {params:_}) p = MergeNode {params: p}
setTreeOut (LinkNode {params:_}) p = LinkNode {params: p}
setTreeOut a _ = a
instance showShow :: Show Action where instance showShow :: Show Action where
show (AddNode _ _ )= "AddNode" show (AddNode _ _ )= "AddNode"
show DeleteNode = "DeleteNode" show DeleteNode = "DeleteNode"
...@@ -43,17 +59,11 @@ instance showShow :: Show Action where ...@@ -43,17 +59,11 @@ instance showShow :: Show Action where
show (UploadFile _ _ _ _)= "UploadFile" show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree" show RefreshTree = "RefreshTree"
show DownloadNode = "Download" show DownloadNode = "Download"
show (MoveNode _ _) = "MoveNode" show (MoveNode _ ) = "MoveNode"
show (MergeNode _ _) = "MergeNode" show (MergeNode _ ) = "MergeNode"
show (LinkNode _ _) = "LinkNode" show (LinkNode _ ) = "LinkNode"
show NoAction = "NoAction" show NoAction = "NoAction"
type Props =
( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
)
----------------------------------------------------------------------- -----------------------------------------------------------------------
icon :: Action -> String icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add []) icon (AddNode _ _) = glyphiconNodeAction (Add [])
...@@ -65,9 +75,9 @@ icon (DoSearch _) = glyphiconNodeAction SearchBox ...@@ -65,9 +75,9 @@ icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh icon RefreshTree = glyphiconNodeAction Refresh
icon DownloadNode = glyphiconNodeAction Download icon DownloadNode = glyphiconNodeAction Download
icon (MoveNode _ _) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ _) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ _) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon NoAction = "hand-o-right" icon NoAction = "hand-o-right"
...@@ -83,8 +93,8 @@ text (DoSearch _ )= "Launch search !" ...@@ -83,8 +93,8 @@ text (DoSearch _ )= "Launch search !"
text (UploadFile _ _ _ _)= "Upload File !" text (UploadFile _ _ _ _)= "Upload File !"
text RefreshTree = "Refresh Tree !" text RefreshTree = "Refresh Tree !"
text DownloadNode = "Download !" text DownloadNode = "Download !"
text (MoveNode _ _ ) = "Move !" text (MoveNode _ ) = "Move !"
text (MergeNode _ _ ) = "Merge !" text (MergeNode _ ) = "Merge !"
text (LinkNode _ _ ) = "Link !" text (LinkNode _ ) = "Link !"
text NoAction = "No Action" text NoAction = "No Action"
----------------------------------------------------------------------- -----------------------------------------------------------------------
...@@ -6,7 +6,7 @@ import Data.Tuple.Nested ((/\)) ...@@ -6,7 +6,7 @@ import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (SubTreeParamsIn, subTreeView, SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, put_)
...@@ -20,19 +20,21 @@ linkNodeReq session fromId toId = ...@@ -20,19 +20,21 @@ linkNodeReq session fromId toId =
linkNode :: Record SubTreeParamsIn -> R.Hooks R.Element linkNode :: Record SubTreeParamsIn -> R.Hooks R.Element
linkNode p@{dispatch, subTreeParams, id, nodeType, session} = do linkNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut)
<- R.useState' Nothing action@(valAction /\ setAction) :: R.State Action <- R.useState' (LinkNode {params:Nothing})
let button = case subTreeOutParams of
let button = case valAction of
LinkNode {params} -> case params of
Just val -> submitButton (LinkNode {params: Just val}) dispatch
Nothing -> H.div {} [] Nothing -> H.div {} []
Just sbto -> submitButton (LinkNode inId outId) dispatch _ -> H.div {} []
where
(SubTreeOut { in:inId, out:outId}) = sbto pure $ panel [ subTreeView { action
pure $ panel [ subTreeView { subTreeOut
, dispatch , dispatch
, subTreeParams
, id , id
, nodeType , nodeType
, session , session
, subTreeParams
} }
] button ] button
...@@ -5,15 +5,15 @@ import Data.Maybe (Maybe(..)) ...@@ -5,15 +5,15 @@ import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel, checkbox, checkboxes)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (SubTreeParamsIn, subTreeView, SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT import Gargantext.Types as GT
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Data.Set as Set
mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID) mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID)
mergeNodeReq session fromId toId = mergeNodeReq session fromId toId =
...@@ -21,19 +21,32 @@ mergeNodeReq session fromId toId = ...@@ -21,19 +21,32 @@ mergeNodeReq session fromId toId =
mergeNode :: Record SubTreeParamsIn -> R.Hooks R.Element mergeNode :: Record SubTreeParamsIn -> R.Hooks R.Element
mergeNode p@{dispatch, subTreeParams, id, nodeType, session} = do mergeNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut) action@(valAction /\ setAction) :: R.State Action <- R.useState' (MergeNode {params:Nothing})
<- R.useState' Nothing
let button = case subTreeOutParams of merge <- R.useState' false
options <- R.useState' (Set.singleton GT.MapTerm)
let button = case valAction of
MergeNode {params} -> case params of
Just val -> submitButton (MergeNode {params: Just val}) dispatch
Nothing -> H.div {} [] Nothing -> H.div {} []
Just sbto -> submitButton (MergeNode inId outId) dispatch _ -> H.div {} []
where
(SubTreeOut { in:inId, out:outId}) = sbto pure $ panel [ subTreeView { action
pure $ panel [ subTreeView { subTreeOut
, dispatch , dispatch
, subTreeParams
, id , id
, nodeType , nodeType
, session , session
, subTreeParams
} }
, H.div { className:"panel panel-primary"}
[ H.text "Merge which list?"
, checkboxes [GT.MapTerm, GT.CandidateTerm, GT.StopTerm] options
]
, H.div { className:"panel panel-primary"}
[ H.text "Title"
, H.div {className: "checkbox"}
[checkbox merge, H.text "Merge data?"]
]
] button ] button
...@@ -4,9 +4,9 @@ module Gargantext.Components.Forest.Tree.Node.Action.Move ...@@ -4,9 +4,9 @@ module Gargantext.Components.Forest.Tree.Node.Action.Move
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (SubTreeParamsIn, subTreeView, SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, put_)
...@@ -20,19 +20,20 @@ moveNodeReq session fromId toId = ...@@ -20,19 +20,20 @@ moveNodeReq session fromId toId =
moveNode :: Record SubTreeParamsIn -> R.Hooks R.Element moveNode :: Record SubTreeParamsIn -> R.Hooks R.Element
moveNode p@{dispatch, subTreeParams, id, nodeType, session} = do moveNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut) action@(valAction /\ setAction) :: R.State Action <- R.useState' (MoveNode {params: Nothing})
<- R.useState' Nothing
let button = case subTreeOutParams of let button = case valAction of
MoveNode {params} -> case params of
Just val -> submitButton (MoveNode {params: Just val}) dispatch
Nothing -> H.div {} [] Nothing -> H.div {} []
Just sbto -> submitButton (MoveNode inId outId) dispatch _ -> H.div {} []
where
(SubTreeOut { in:inId, out:outId}) = sbto pure $ panel [ subTreeView { action
pure $ panel [ subTreeView { subTreeOut
, dispatch , dispatch
, subTreeParams
, id , id
, nodeType , nodeType
, session , session
, subTreeParams
} }
] button ] button
...@@ -4,6 +4,7 @@ import Data.Generic.Rep (class Generic) ...@@ -4,6 +4,7 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Gargantext.Prelude (class Eq, class Show, show, (&&), (<>), (==)) import Gargantext.Prelude (class Eq, class Show, show, (&&), (<>), (==))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..))
import Data.Array (foldl) import Data.Array (foldl)
import Gargantext.Types import Gargantext.Types
...@@ -24,19 +25,8 @@ data NodeAction = Documentation NodeType ...@@ -24,19 +25,8 @@ data NodeAction = Documentation NodeType
| Move { subTreeParams :: SubTreeParams } | Move { subTreeParams :: SubTreeParams }
| Link { subTreeParams :: SubTreeParams } | Link { subTreeParams :: SubTreeParams }
| Clone | Clone
------------------------------------------------------------------------
-- TODO move elsewhere
data SubTreeParams = SubTreeParams { showtypes :: Array NodeType
, valitypes :: Array NodeType
}
derive instance eqSubTreeParams :: Eq SubTreeParams
derive instance genericSubTreeParams :: Generic SubTreeParams _
instance showSubTreeParams :: Show SubTreeParams where
show = genericShow
------------------------------------------------------------------------ ------------------------------------------------------------------------
instance eqNodeAction :: Eq NodeAction where instance eqNodeAction :: Eq NodeAction where
eq (Documentation x) (Documentation y) = true && (x == y) eq (Documentation x) (Documentation y) = true && (x == y)
eq SearchBox SearchBox = true eq SearchBox SearchBox = true
...@@ -99,7 +89,9 @@ settingsBox NodeUser = ...@@ -99,7 +89,9 @@ settingsBox NodeUser =
SettingsBox { show : true SettingsBox { show : true
, edit : false , edit : false
, doc : Documentation NodeUser , doc : Documentation NodeUser
, buttons : [ Delete ] , buttons : [ Delete
-- , Add [FolderPublic]
]
} }
settingsBox FolderPrivate = settingsBox FolderPrivate =
...@@ -109,6 +101,8 @@ settingsBox FolderPrivate = ...@@ -109,6 +101,8 @@ settingsBox FolderPrivate =
, buttons : [ Add [ Corpus , buttons : [ Add [ Corpus
, Folder , Folder
, Annuaire , Annuaire
, NodeFrameWrite
, NodeFrameCalc
] ]
] ]
} }
...@@ -120,9 +114,12 @@ settingsBox Team = ...@@ -120,9 +114,12 @@ settingsBox Team =
, buttons : [ Add [ Corpus , buttons : [ Add [ Corpus
, Folder , Folder
, Annuaire , Annuaire
, NodeFrameWrite
, NodeFrameCalc
] ]
, Share , Share
, Delete] , Delete
]
} }
settingsBox FolderShared = settingsBox FolderShared =
...@@ -141,6 +138,7 @@ settingsBox FolderPublic = ...@@ -141,6 +138,7 @@ settingsBox FolderPublic =
, buttons : [ Add [ Corpus , buttons : [ Add [ Corpus
, Folder , Folder
] ]
-- , Delete
] ]
} }
...@@ -151,6 +149,8 @@ settingsBox Folder = ...@@ -151,6 +149,8 @@ settingsBox Folder =
, buttons : [ Add [ Corpus , buttons : [ Add [ Corpus
, Folder , Folder
, Annuaire , Annuaire
, NodeFrameWrite
, NodeFrameCalc
] ]
, Move moveParameters , Move moveParameters
, Delete , Delete
...@@ -164,6 +164,8 @@ settingsBox Corpus = ...@@ -164,6 +164,8 @@ settingsBox Corpus =
, buttons : [ Add [ NodeList , buttons : [ Add [ NodeList
, Graph , Graph
, Dashboard , Dashboard
, NodeFrameWrite
, NodeFrameCalc
] ]
, SearchBox , SearchBox
, Upload , Upload
...@@ -239,6 +241,29 @@ settingsBox Annuaire = ...@@ -239,6 +241,29 @@ settingsBox Annuaire =
] ]
} }
settingsBox NodeFrameWrite =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameWrite
, buttons : [ Add [ NodeFrameWrite
, NodeFrameCalc
]
]
}
settingsBox NodeFrameCalc =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameCalc
, buttons : [ Add [ NodeFrameCalc
, NodeFrameWrite
]
]
}
settingsBox _ = settingsBox _ =
SettingsBox { show : false SettingsBox { show : false
, edit : false , edit : false
......
...@@ -9,9 +9,13 @@ data Status = Stable | Test | Dev ...@@ -9,9 +9,13 @@ data Status = Stable | Test | Dev
hasStatus :: NodeType -> NodeAction -> Status hasStatus :: NodeType -> NodeAction -> Status
hasStatus _ SearchBox = Dev hasStatus _ SearchBox = Dev
hasStatus _ Refresh = Dev
hasStatus _ Config = Dev hasStatus _ Config = Dev
hasStatus _ (Link _) = Test hasStatus _ (Link _) = Dev
hasStatus _ (Merge _) = Dev
hasStatus _ (Move _) = Test hasStatus _ (Move _) = Test
hasStatus _ (Documentation _) = Test hasStatus _ (Documentation _) = Dev
hasStatus Annuaire Upload = Dev
hasStatus Texts Upload = Dev
hasStatus _ _ = Stable hasStatus _ _ = Stable
...@@ -2,14 +2,18 @@ module Gargantext.Components.Forest.Tree.Node.Tools ...@@ -2,14 +2,18 @@ module Gargantext.Components.Forest.Tree.Node.Tools
where where
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Set as Set
import Data.String as S import Data.String as S
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Gargantext.Types (Name)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import Gargantext.Components.Forest.Tree.Node.Action import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, ($), (<<<), (<>), read, map, class Read, class Show) import Gargantext.Prelude (Unit, bind, const, discard, pure, show, ($), (<<<), (<>), read, map, class Read, class Show, not, class Ord)
import Gargantext.Types (ID) import Gargantext.Types (ID)
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -28,10 +32,9 @@ panel bodies submit = ...@@ -28,10 +32,9 @@ panel bodies submit =
[ H.div { className: "row" [ H.div { className: "row"
, style: {"margin":"10px"} , style: {"margin":"10px"}
} }
[ H.div { className: "col-md-10" } [ H.div { className: "col-md-12" } bs
-- TODO add type for text or form here -- TODO add type for text or form here
[ H.form {className: "form-horizontal"} bs -- [ H.form {className: "form-horizontal"} bs ]
]
] ]
] ]
footer sb = footer sb =
...@@ -201,6 +204,65 @@ submitButtonHref action href = ...@@ -201,6 +204,65 @@ submitButtonHref action href =
} }
[ H.text $ " " <> text action] [ H.text $ " " <> text action]
------------------------------------------------------------------------
-- | CheckBox tools
-- checkboxes: Array of poolean values (basic: without pending option)
-- checkbox : One boolean value only
checkbox :: R.State Boolean -> R.Element
checkbox ( val /\ set ) =
H.input { id: "checkbox-id"
, type: "checkbox"
, value: val
, className : "checkbox"
, on: { click: \_ -> set $ const $ not val}
}
data CheckBoxes = Multiple | Uniq
checkboxes :: forall a
. Ord a
=> Show a
=> Array a
-> R.State (Set a)
-> R.Element
checkboxes xs (val /\ set) =
H.fieldset {} $ map (\a -> H.div {} [ H.input { type: "checkbox"
, checked: Set.member a val
, on: { click: \_ -> set
$ const
$ toggleSet a val
}
}
, H.div {} [H.text $ show a]
]
) xs
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name :: Name
)
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement nodeTextCpt p []
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt
where
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
------------------------------------------------------------------------
......
module Gargantext.Components.Forest.Tree.Node.Tools.SubTree where module Gargantext.Components.Forest.Tree.Node.Tools.SubTree where
import DOM.Simple.Console (log2)
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Props, Action, subTreeOut, setTreeOut)
import Gargantext.Components.Forest.Tree.Node.Settings (SubTreeParams(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..)) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (discard, map, pure, show, unit, ($), (&&), (/=), (<>), class Eq, const) import Gargantext.Prelude (map, pure, show, ($), (&&), (/=), (<>), const, (==){-, discard, bind, void-})
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), get) import Gargantext.Sessions (Session(..), get)
import Gargantext.Types as GT import Gargantext.Types as GT
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
type SubTreeParamsIn = type SubTreeParamsIn =
( subTreeParams :: SubTreeParams ( subTreeParams :: SubTreeParams
| Props | Props
) )
------------------------------------------------------------------------
data SubTreeOut = SubTreeOut { in :: GT.ID
, out :: GT.ID
}
------------------------------------------------------------------------ ------------------------------------------------------------------------
type SubTreeParamsProps = type SubTreeParamsProps =
( subTreeOut :: R.State (Maybe SubTreeOut) ( action :: R.State Action
| SubTreeParamsIn | SubTreeParamsIn
) )
...@@ -46,10 +39,13 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt ...@@ -46,10 +39,13 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt
, nodeType , nodeType
, session , session
, subTreeParams , subTreeParams
, subTreeOut , action
} _ = } _ =
do do
let SubTreeParams {showtypes} = subTreeParams let
SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action
-- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
useLoader session (loadSubTree showtypes) $ useLoader session (loadSubTree showtypes) $
\tree -> \tree ->
...@@ -59,7 +55,7 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt ...@@ -59,7 +55,7 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt
, session , session
, tree , tree
, subTreeParams , subTreeParams
, subTreeOut , action
} }
loadSubTree :: Array GT.NodeType -> Session -> Aff FTree loadSubTree :: Array GT.NodeType -> Session -> Aff FTree
...@@ -85,10 +81,12 @@ subTreeViewLoadedCpt :: R.Component CorpusTreeProps ...@@ -85,10 +81,12 @@ subTreeViewLoadedCpt :: R.Component CorpusTreeProps
subTreeViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeViewLoadedCpt" cpt subTreeViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeViewLoadedCpt" cpt
where where
cpt p@{dispatch, id, nodeType, session, tree} _ = do cpt p@{dispatch, id, nodeType, session, tree} _ = do
pure $ H.div { className: "copy-from-corpus" } pure $ H.div {className:"panel panel-primary"}
[H.div { className: "copy-from-corpus" }
[ H.div { className: "tree" } [ H.div { className: "tree" }
[subTreeTreeView p] [subTreeTreeView p]
] ]
]
subTreeTreeView :: Record CorpusTreeProps -> R.Element subTreeTreeView :: Record CorpusTreeProps -> R.Element
subTreeTreeView props = R.createElement subTreeTreeViewCpt props [] subTreeTreeView props = R.createElement subTreeTreeViewCpt props []
...@@ -97,37 +95,48 @@ subTreeTreeViewCpt :: R.Component CorpusTreeProps ...@@ -97,37 +95,48 @@ subTreeTreeViewCpt :: R.Component CorpusTreeProps
subTreeTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeTreeViewCpt" cpt subTreeTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeTreeViewCpt" cpt
where where
cpt p@{ id cpt p@{ id
, tree: NTree (LNode { id: sourceId , tree: NTree (LNode { id: targetId
, name , name
, nodeType , nodeType
} }
) ary ) ary
, subTreeParams , subTreeParams
, dispatch , dispatch
, subTreeOut , action
} _ = do } _ = do
pure $ {- H.div {} [ H.h5 { className: GT.fldr nodeType true} [] pure $ H.div {} [ H.div { className: "node " <> GT.fldr nodeType true}
, -} H.div { className: "node" }
( [ H.span { className: "name " <> clickable ( [ H.span { className: "name " <> clickable
, on: { click: onClick } , on: { click: onClick }
} [ H.text name ] } [ nodeText { isSelected: isSelected targetId valAction
, name: " " <> name
}
]
] <> children ] <> children
) )
-- ] ]
where where
SubTreeParams { valitypes } = subTreeParams SubTreeParams { valitypes } = subTreeParams
children = map (\c -> subTreeTreeView (p { tree = c })) ary sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id') ary
validNodeType = (A.elem nodeType valitypes) && (id /= sourceId) children = map (\ctree -> subTreeTreeView (p { tree = ctree })) sortedAry
validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
clickable = if validNodeType then "clickable" else "" clickable = if validNodeType then "clickable" else ""
sbto@( subTreeOutParams /\ setSubTreeOut) = subTreeOut
( valAction /\ setAction) = action
isSelected n action' = case (subTreeOut action') of
Nothing -> false
(Just (SubTreeOut {out})) -> n == out
onClick _ = mkEffectFn1 $ \_ -> case validNodeType of onClick _ = mkEffectFn1 $ \_ -> case validNodeType of
false -> setSubTreeOut (const Nothing) false -> setAction (const $ setTreeOut valAction Nothing)
true -> setSubTreeOut (const $ Just $ SubTreeOut { in: id, out:sourceId}) true -> setAction (const $ setTreeOut valAction (Just $ SubTreeOut { in: id, out:targetId}))
-------------------------------------------------------------------------------------------- --------------------------------------------------------------------------------------------
module Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types where
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Prelude (class Eq, class Show)
import Gargantext.Types as GT
import Reactix as R
data SubTreeOut = SubTreeOut { in :: GT.ID
, out :: GT.ID
}
------------------------------------------------------------------------
data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
, valitypes :: Array GT.NodeType
}
derive instance eqSubTreeParams :: Eq SubTreeParams
derive instance genericSubTreeParams :: Generic SubTreeParams _
instance showSubTreeParams :: Show SubTreeParams where
show = genericShow
------------------------------------------------------------------------
...@@ -187,7 +187,7 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches ...@@ -187,7 +187,7 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches
np :: NTC.NgramsPatches np :: NTC.NgramsPatches
np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list } np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
patch_list :: NTC.Replace TermList patch_list :: NTC.Replace TermList
patch_list = NTC.Replace { new: termList, old: GraphTerm } patch_list = NTC.Replace { new: termList, old: MapTerm }
query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element
......
...@@ -19,6 +19,7 @@ import Reactix as R ...@@ -19,6 +19,7 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Components.Forest.Tree.Node.Tools (checkbox)
import Gargantext.Components.Forms (clearfix, cardBlock, cardGroup, center, formGroup) import Gargantext.Components.Forms (clearfix, cardBlock, cardGroup, center, formGroup)
import Gargantext.Components.Login.Types (AuthRequest(..)) import Gargantext.Components.Login.Types (AuthRequest(..))
import Gargantext.Ends (Backend(..)) import Gargantext.Ends (Backend(..))
...@@ -178,7 +179,7 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where ...@@ -178,7 +179,7 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where
, center , center
[ H.label {} [ H.label {}
[ H.div {className: "checkbox"} [ H.div {className: "checkbox"}
[ termsCheckbox setBox [ checkbox setBox
, H.text "I hereby accept " , H.text "I hereby accept "
, H.a { target: "_blank" , H.a { target: "_blank"
, href: "http://gitlab.iscpif.fr/humanities/tofu/tree/master" , href: "http://gitlab.iscpif.fr/humanities/tofu/tree/master"
...@@ -213,15 +214,6 @@ csrfTokenInput _ = ...@@ -213,15 +214,6 @@ csrfTokenInput _ =
, value: csrfMiddlewareToken , value: csrfMiddlewareToken
} -- TODO hard-coded CSRF token } -- TODO hard-coded CSRF token
termsCheckbox :: R.State Boolean -> R.Element
termsCheckbox setCheckBox =
H.input { id: "terms-accept"
, type: "checkbox"
, value: fst setCheckBox
, className: "checkbox"
, on: { click: \_ -> (snd setCheckBox) $ const $ not (fst setCheckBox)}
}
termsLink :: {} -> R.Element termsLink :: {} -> R.Element
termsLink _ = termsLink _ =
H.a { target: "_blank", href: termsUrl } [ H.text "the terms of use" ] H.a { target: "_blank", href: termsUrl } [ H.text "the terms of use" ]
......
...@@ -256,7 +256,7 @@ tableContainerCpt { dispatch ...@@ -256,7 +256,7 @@ tableContainerCpt { dispatch
selectButtons true = selectButtons true =
H.div {} [ H.div {} [
H.button { className: "btn btn-primary" H.button { className: "btn btn-primary"
, on: { click: const $ setSelection GraphTerm } , on: { click: const $ setSelection MapTerm }
} [ H.text "Map" ] } [ H.text "Map" ]
, H.button { className: "btn btn-primary" , H.button { className: "btn btn-primary"
, on: { click: const $ setSelection StopTerm } , on: { click: const $ setSelection StopTerm }
......
...@@ -183,7 +183,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt ...@@ -183,7 +183,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
, ngramsTable } _ = , ngramsTable } _ =
pure $ Tbl.makeRow [ pure $ Tbl.makeRow [
selected selected
, checkbox T.GraphTerm , checkbox T.MapTerm
, checkbox T.StopTerm , checkbox T.StopTerm
, if ngramsParent == Nothing , if ngramsParent == Nothing
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
...@@ -232,7 +232,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt ...@@ -232,7 +232,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
termStyle :: T.TermList -> Number -> DOM.Props termStyle :: T.TermList -> Number -> DOM.Props
termStyle T.GraphTerm opacity = DOM.style { color: "green", opacity } termStyle T.MapTerm opacity = DOM.style { color: "green", opacity }
termStyle T.StopTerm opacity = DOM.style { color: "red", opacity termStyle T.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" } , textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity } termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity }
...@@ -250,6 +250,6 @@ tablePatchHasNgrams ngramsTablePatch ngrams = ...@@ -250,6 +250,6 @@ tablePatchHasNgrams ngramsTablePatch ngrams =
nextTermList :: T.TermList -> T.TermList nextTermList :: T.TermList -> T.TermList
nextTermList T.GraphTerm = T.StopTerm nextTermList T.MapTerm = T.StopTerm
nextTermList T.StopTerm = T.CandidateTerm nextTermList T.StopTerm = T.CandidateTerm
nextTermList T.CandidateTerm = T.GraphTerm nextTermList T.CandidateTerm = T.MapTerm
...@@ -133,7 +133,7 @@ initialPageParams session nodeId listIds tabType = ...@@ -133,7 +133,7 @@ initialPageParams session nodeId listIds tabType =
, params , params
, tabType , tabType
, termSizeFilter: Nothing , termSizeFilter: Nothing
, termListFilter: Just GraphTerm , termListFilter: Just MapTerm
, searchQuery: "" , searchQuery: ""
, scoreType: Occurrences , scoreType: Occurrences
, session , session
......
...@@ -88,7 +88,7 @@ scatterOptions metrics' = Options ...@@ -88,7 +88,7 @@ scatterOptions metrics' = Options
color = color =
case k of case k of
StopTerm -> red StopTerm -> red
GraphTerm -> green MapTerm -> green
CandidateTerm -> grey CandidateTerm -> grey
toSerie color' (Metric {label,x,y}) = toSerie color' (Metric {label,x,y}) =
dataSerie { name: label, itemStyle: itemStyle {color: color'} dataSerie { name: label, itemStyle: itemStyle {color: color'}
......
...@@ -60,7 +60,7 @@ type Loaded = HistoMetrics ...@@ -60,7 +60,7 @@ type Loaded = HistoMetrics
chartOptionsBar :: HistoMetrics -> Options chartOptionsBar :: HistoMetrics -> Options
chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Bar" { mainTitle : "Bar"
, subTitle : "Count of GraphTerm" , subTitle : "Count of MapTerm"
, xAxis : xAxis' $ map (\t -> joinWith " " $ map (take 3) $ A.take 3 $ filter (\s -> length s > 3) $ split (Pattern " ") t) dates' , xAxis : xAxis' $ map (\t -> joinWith " " $ map (take 3) $ A.take 3 $ filter (\s -> length s > 3) $ split (Pattern " ") t) dates'
, yAxis : yAxis' { position: "left", show: true, min:0} , yAxis : yAxis' { position: "left", show: true, min:0}
, series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", itemStyle: itemStyle {color:blue}, value: n }) count'] , series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", itemStyle: itemStyle {color:blue}, value: n }) count']
...@@ -71,7 +71,7 @@ chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -71,7 +71,7 @@ chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options
chartOptionsPie :: HistoMetrics -> Options chartOptionsPie :: HistoMetrics -> Options
chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Pie" { mainTitle : "Pie"
, subTitle : "Distribution by GraphTerm" , subTitle : "Distribution by MapTerm"
, xAxis : xAxis' [] , xAxis : xAxis' []
, yAxis : yAxis' { position: "", show: false, min:0} , yAxis : yAxis' { position: "", show: false, min:0}
, series : [seriesPieD1 {name: "Data"} $ map (\(Tuple n v) -> dataSerie {name: n, value:v}) $ zip dates' count'] , series : [seriesPieD1 {name: "Data"} $ map (\(Tuple n v) -> dataSerie {name: n, value:v}) $ zip dates' count']
......
...@@ -53,8 +53,7 @@ dashboardLayoutCpt = R.hooksComponent "G.C.N.C.D.dashboardLayout" cpt ...@@ -53,8 +53,7 @@ dashboardLayoutCpt = R.hooksComponent "G.C.N.C.D.dashboardLayout" cpt
liftEffect $ setReload $ (+) 1 liftEffect $ setReload $ (+) 1
type LoadedProps = type LoadedProps =
( ( charts :: Array P.PredefinedChart
charts :: Array P.PredefinedChart
, corpusId :: NodeID , corpusId :: NodeID
, defaultListId :: Int , defaultListId :: Int
, key :: String , key :: String
...@@ -91,8 +90,7 @@ dashboardLayoutLoadedCpt = R.hooksComponent "G.C.N.C.D.dashboardLayoutLoaded" cp ...@@ -91,8 +90,7 @@ dashboardLayoutLoadedCpt = R.hooksComponent "G.C.N.C.D.dashboardLayoutLoaded" cp
onRemove _ = onChange $ fromMaybe charts $ A.deleteAt idx charts onRemove _ = onChange $ fromMaybe charts $ A.deleteAt idx charts
type PredefinedChartProps = type PredefinedChartProps =
( ( chart :: P.PredefinedChart
chart :: P.PredefinedChart
, corpusId :: NodeID , corpusId :: NodeID
, defaultListId :: Int , defaultListId :: Int
, onChange :: P.PredefinedChart -> Effect Unit , onChange :: P.PredefinedChart -> Effect Unit
......
...@@ -13,8 +13,7 @@ type Preferences = Maybe String ...@@ -13,8 +13,7 @@ type Preferences = Maybe String
newtype Hyperdata = newtype Hyperdata =
Hyperdata Hyperdata
{ { charts :: Array P.PredefinedChart
charts :: Array P.PredefinedChart
, preferences :: Preferences , preferences :: Preferences
} }
instance decodeHyperdata :: DecodeJson Hyperdata where instance decodeHyperdata :: DecodeJson Hyperdata where
...@@ -52,8 +51,8 @@ saveDashboard {hyperdata, nodeId, session} = do ...@@ -52,8 +51,8 @@ saveDashboard {hyperdata, nodeId, session} = do
id_ <- (put session (NodeAPI Node (Just nodeId) "") hyperdata) :: Aff Int id_ <- (put session (NodeAPI Node (Just nodeId) "") hyperdata) :: Aff Int
pure unit pure unit
type DashboardData = { type DashboardData =
id :: Int { id :: Int
, hyperdata :: Hyperdata , hyperdata :: Hyperdata
, parentId :: Int , parentId :: Int
} }
module Gargantext.Components.Nodes.Frame where
import Data.Maybe (Maybe(..))
import Data.Tuple (fst)
import Effect.Aff (Aff)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
--import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Gargantext.Utils.Argonaut (genericSumEncodeJson)
import Data.Argonaut (decodeJson, (.:))
data Hyperdata =
Hyperdata { base :: String
, frame_id :: String
}
derive instance eqHyperdata :: Eq Hyperdata
derive instance genericHyperdata :: Generic Hyperdata _
instance showHyperdata :: Show Hyperdata where
show = genericShow
instance decodeJsonHyperdata :: Argonaut.DecodeJson Hyperdata where
-- TODO
-- decodeJson = genericSumDecodeJson
decodeJson json = do
obj <- decodeJson json
base <- obj .: "base"
frame_id <- obj .: "frame_id"
pure $ Hyperdata {base, frame_id}
instance encodeJsonHyperdata :: Argonaut.EncodeJson Hyperdata where
encodeJson = genericSumEncodeJson
type Props =
( nodeId :: Int
, session :: Session
)
type Reload = R.State Int
type KeyProps =
( key :: String
| Props
)
frameLayout :: Record KeyProps -> R.Element
frameLayout props = R.createElement frameLayoutCpt props []
frameLayoutCpt :: R.Component KeyProps
frameLayoutCpt = R.hooksComponent "G.C.N.C.writeLayout" cpt
where
cpt {nodeId, session} _ = do
reload <- R.useState' 0
useLoader {nodeId, reload: fst reload, session} loadframeWithReload $
\frame -> frameLayoutView {frame, nodeId, reload, session}
type ViewProps =
( frame :: NodePoly Hyperdata
, reload :: Reload
| Props
)
data FrameType = Calc | Write
type Base = String
type FrameId = String
hframe :: FrameType -> String
hframe ft = "https://" <> hframe' ft <> ".frame.gargantext.org/test"
where
hframe' Calc = "calc"
hframe' Write = "write"
hframeUrl :: Base -> FrameId -> String
hframeUrl base frame_id = base <> "/" <> frame_id <> "?both"
frameLayoutView :: Record ViewProps -> R.Element
frameLayoutView props = R.createElement frameLayoutViewCpt props []
frameLayoutViewCpt :: R.Component ViewProps
frameLayoutViewCpt = R.hooksComponent "G.C.N.C.frameLayoutView" cpt
where
cpt {frame: (NodePoly {hyperdata: Hyperdata {base, frame_id}}), nodeId, reload, session} _ = do
pure $ H.div { className : "istex-search" }
[ H.iframe { src: hframeUrl base frame_id
, width: "100%"
, height: "100%"
-- , ref: "https://write.frame.gargantext.org/test"
} []
]
type LoadProps =
( nodeId :: Int
, session :: Session
)
loadframe' :: Record LoadProps -> Aff (NodePoly Hyperdata)
loadframe' {nodeId, session} = get session $ NodeAPI Node (Just nodeId) ""
-- Just to make reloading effective
loadframeWithReload :: {reload :: Int | LoadProps} -> Aff (NodePoly Hyperdata)
loadframeWithReload {nodeId, session} = loadframe' {nodeId, session}
...@@ -120,7 +120,7 @@ sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe ...@@ -120,7 +120,7 @@ sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe
sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartBar nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart ChartBar nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartPie nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart ChartPie nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartTree nt nId lId) = "node/" <> (show nId) <> "/tree?list=" <> (show lId) <> "&ngramsType=" <> (show nt) <> "&listType=GraphTerm" sessionPath (R.RecomputeListChart ChartTree nt nId lId) = "node/" <> (show nId) <> "/tree?list=" <> (show lId) <> "&ngramsType=" <> (show nt) <> "&listType=MapTerm"
sessionPath (R.RecomputeListChart Histo nt nId lId) = "node/" <> (show nId) <> "/chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart Histo nt nId lId) = "node/" <> (show nId) <> "/chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart Scatter nt nId lId) = "node/" <> (show nId) <> "/metrics?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart Scatter nt nId lId) = "node/" <> (show nId) <> "/metrics?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart _ nt nId lId) = "node/" <> (show nId) <> "/recompute-chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart _ nt nId lId) = "node/" <> (show nId) <> "/recompute-chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
...@@ -195,7 +195,7 @@ sessionPath (R.Chart {chartType, listId, limit, tabType} i) = ...@@ -195,7 +195,7 @@ sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
sessionPath $ R.NodeAPI Corpus i sessionPath $ R.NodeAPI Corpus i
$ show chartType $ show chartType
<> "?ngramsType=" <> showTabType' tabType <> "?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId <> "&listType=MapTerm" -- <> show listId
<> "&listId=" <> show listId <> "&listId=" <> show listId
where where
limitPath = case limit of limitPath = case limit of
......
...@@ -29,6 +29,9 @@ router = oneOf ...@@ -29,6 +29,9 @@ router = oneOf
<*> (lit "contact" *> int) <*> (lit "contact" *> int)
, Annuaire <$> (route "annuaire" *> sid) <*> int , Annuaire <$> (route "annuaire" *> sid) <*> int
, UserPage <$> (route "user" *> sid) <*> int , UserPage <$> (route "user" *> sid) <*> int
, RouteFrameWrite <$> (route "write" *> sid) <*> int
, RouteFrameCalc <$> (route "calc" *> sid) <*> int
, Home <$ lit "" , Home <$ lit ""
] ]
where where
......
...@@ -23,6 +23,9 @@ data AppRoute ...@@ -23,6 +23,9 @@ data AppRoute
| Annuaire SessionId Int | Annuaire SessionId Int
| UserPage SessionId Int | UserPage SessionId Int
| ContactPage SessionId Int Int | ContactPage SessionId Int Int
| RouteFrameWrite SessionId Int
| RouteFrameCalc SessionId Int
derive instance eqAppRoute :: Eq AppRoute derive instance eqAppRoute :: Eq AppRoute
...@@ -66,6 +69,9 @@ instance showAppRoute :: Show AppRoute where ...@@ -66,6 +69,9 @@ instance showAppRoute :: Show AppRoute where
show (Annuaire s i) = "Annuaire" <> show i <> " (" <> show s <> ")" show (Annuaire s i) = "Annuaire" <> show i <> " (" <> show s <> ")"
show (UserPage s i) = "User" <> show i <> " (" <> show s <> ")" show (UserPage s i) = "User" <> show i <> " (" <> show s <> ")"
show (ContactPage s a i) = "Contact" <> show a <> "::" <> show i <> " (" <> show s <> ")" show (ContactPage s a i) = "Contact" <> show a <> "::" <> show i <> " (" <> show s <> ")"
show (RouteFrameWrite s i) = "write" <> show i <> " (" <> show s <> ")"
show (RouteFrameCalc s i) = "calc" <> show i <> " (" <> show s <> ")"
appPath :: AppRoute -> String appPath :: AppRoute -> String
appPath Home = "" appPath Home = ""
...@@ -85,3 +91,6 @@ appPath (Lists s i) = "lists/" <> show s <> "/" <> show i ...@@ -85,3 +91,6 @@ appPath (Lists s i) = "lists/" <> show s <> "/" <> show i
appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i
appPath (UserPage s i) = "user/" <> show s <> "/" <> show i appPath (UserPage s i) = "user/" <> show s <> "/" <> show i
appPath (ContactPage s a i) = "annuaire/" <> show s <> "/" <> show a <> "/contact/" <> show i appPath (ContactPage s a i) = "annuaire/" <> show s <> "/" <> show a <> "/contact/" <> show i
appPath (RouteFrameWrite s i) = "write/" <> show s <> "/" <> show i
appPath (RouteFrameCalc s i) = "calc/" <> show s <> "/" <> show i
...@@ -10,7 +10,7 @@ import Data.Generic.Rep.Show (genericShow) ...@@ -10,7 +10,7 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Prelude (class Read, read) import Gargantext.Prelude (class Read, read, class Show, show)
import Prelude import Prelude
import Prim.Row (class Union) import Prim.Row (class Union)
import URI.Query (Query) import URI.Query (Query)
...@@ -56,14 +56,14 @@ termSizes = [ { desc: "All types", mval: Nothing } ...@@ -56,14 +56,14 @@ termSizes = [ { desc: "All types", mval: Nothing }
, { desc: "Multi-word terms", mval: Just MultiTerm } , { desc: "Multi-word terms", mval: Just MultiTerm }
] ]
data TermList = GraphTerm | StopTerm | CandidateTerm data TermList = MapTerm | StopTerm | CandidateTerm
-- TODO use generic JSON instance -- TODO use generic JSON instance
derive instance eqTermList :: Eq TermList derive instance eqTermList :: Eq TermList
derive instance ordTermList :: Ord TermList derive instance ordTermList :: Ord TermList
instance encodeJsonTermList :: EncodeJson TermList where instance encodeJsonTermList :: EncodeJson TermList where
encodeJson GraphTerm = encodeJson "GraphTerm" encodeJson MapTerm = encodeJson "MapTerm"
encodeJson StopTerm = encodeJson "StopTerm" encodeJson StopTerm = encodeJson "StopTerm"
encodeJson CandidateTerm = encodeJson "CandidateTerm" encodeJson CandidateTerm = encodeJson "CandidateTerm"
...@@ -71,7 +71,7 @@ instance decodeJsonTermList :: DecodeJson TermList where ...@@ -71,7 +71,7 @@ instance decodeJsonTermList :: DecodeJson TermList where
decodeJson json = do decodeJson json = do
s <- decodeJson json s <- decodeJson json
case s of case s of
"GraphTerm" -> pure GraphTerm "MapTerm" -> pure MapTerm
"StopTerm" -> pure StopTerm "StopTerm" -> pure StopTerm
"CandidateTerm" -> pure CandidateTerm "CandidateTerm" -> pure CandidateTerm
_ -> Left "Unexpected list name" _ -> Left "Unexpected list name"
...@@ -79,31 +79,31 @@ instance decodeJsonTermList :: DecodeJson TermList where ...@@ -79,31 +79,31 @@ instance decodeJsonTermList :: DecodeJson TermList where
type ListTypeId = Int type ListTypeId = Int
listTypeId :: TermList -> ListTypeId listTypeId :: TermList -> ListTypeId
listTypeId GraphTerm = 1 listTypeId MapTerm = 1
listTypeId StopTerm = 2 listTypeId StopTerm = 2
listTypeId CandidateTerm = 3 listTypeId CandidateTerm = 3
instance showTermList :: Show TermList where instance showTermList :: Show TermList where
show GraphTerm = "GraphTerm" show MapTerm = "MapTerm"
show StopTerm = "StopTerm" show StopTerm = "StopTerm"
show CandidateTerm = "CandidateTerm" show CandidateTerm = "CandidateTerm"
-- TODO: Can we replace the show instance above with this? -- TODO: Can we replace the show instance above with this?
termListName :: TermList -> String termListName :: TermList -> String
termListName GraphTerm = "Map List" termListName MapTerm = "Map List"
termListName StopTerm = "Stop List" termListName StopTerm = "Stop List"
termListName CandidateTerm = "Candidate List" termListName CandidateTerm = "Candidate List"
instance readTermList :: Read TermList where instance readTermList :: Read TermList where
read :: String -> Maybe TermList read :: String -> Maybe TermList
read "GraphTerm" = Just GraphTerm read "MapTerm" = Just MapTerm
read "StopTerm" = Just StopTerm read "StopTerm" = Just StopTerm
read "CandidateTerm" = Just CandidateTerm read "CandidateTerm" = Just CandidateTerm
read _ = Nothing read _ = Nothing
termLists :: Array { desc :: String, mval :: Maybe TermList } termLists :: Array { desc :: String, mval :: Maybe TermList }
termLists = [ { desc: "All terms", mval: Nothing } termLists = [ { desc: "All terms", mval: Nothing }
, { desc: "Map terms", mval: Just GraphTerm } , { desc: "Map terms", mval: Just MapTerm }
, { desc: "Stop terms", mval: Just StopTerm } , { desc: "Stop terms", mval: Just StopTerm }
, { desc: "Candidate terms", mval: Just CandidateTerm } , { desc: "Candidate terms", mval: Just CandidateTerm }
] ]
...@@ -151,6 +151,9 @@ data NodeType = NodeUser ...@@ -151,6 +151,9 @@ data NodeType = NodeUser
| Tree | Tree
| NodeList | NodeList
| Texts | Texts
-- TODO Optional Nodes
| NodeFrameWrite
| NodeFrameCalc
derive instance eqNodeType :: Eq NodeType derive instance eqNodeType :: Eq NodeType
...@@ -177,6 +180,9 @@ instance showNodeType :: Show NodeType where ...@@ -177,6 +180,9 @@ instance showNodeType :: Show NodeType where
show Team = "NodeTeam" show Team = "NodeTeam"
show NodeList = "NodeList" show NodeList = "NodeList"
show Texts = "NodeTexts" show Texts = "NodeTexts"
show NodeFrameWrite = "NodeFrameWrite"
show NodeFrameCalc = "NodeFrameCalc"
instance readNodeType :: Read NodeType where instance readNodeType :: Read NodeType where
read "NodeUser" = Just NodeUser read "NodeUser" = Just NodeUser
...@@ -199,6 +205,8 @@ instance readNodeType :: Read NodeType where ...@@ -199,6 +205,8 @@ instance readNodeType :: Read NodeType where
read "NodeList" = Just NodeList read "NodeList" = Just NodeList
read "NodeTexts" = Just Texts read "NodeTexts" = Just Texts
read "Annuaire" = Just Annuaire read "Annuaire" = Just Annuaire
read "NodeFrameWrite" = Just NodeFrameWrite
read "NodeFrameCalc" = Just NodeFrameCalc
read _ = Nothing read _ = Nothing
...@@ -237,6 +245,12 @@ fldr Annuaire false = "fa fa-address-card" ...@@ -237,6 +245,12 @@ fldr Annuaire false = "fa fa-address-card"
fldr NodeContact true = "fa fa-address-card-o" fldr NodeContact true = "fa fa-address-card-o"
fldr NodeContact false = "fa fa-address-card" fldr NodeContact false = "fa fa-address-card"
fldr NodeFrameWrite true = "fa fa-file-word-o"
fldr NodeFrameWrite false = "fa fa-file-word-o"
fldr NodeFrameCalc true = "fa fa-file-excel-o"
fldr NodeFrameCalc false = "fa fa-file-excel-o"
fldr _ false = "fa fa-folder-o" fldr _ false = "fa fa-folder-o"
fldr _ true = "fa fa-folder-open" fldr _ true = "fa fa-folder-open"
...@@ -280,6 +294,9 @@ nodeTypePath Tree = "tree" ...@@ -280,6 +294,9 @@ nodeTypePath Tree = "tree"
nodeTypePath NodeList = "lists" nodeTypePath NodeList = "lists"
nodeTypePath Texts = "texts" nodeTypePath Texts = "texts"
nodeTypePath Team = "team" nodeTypePath Team = "team"
nodeTypePath NodeFrameWrite = "write"
nodeTypePath NodeFrameCalc = "calc"
------------------------------------------------------------ ------------------------------------------------------------
type ListId = Int type ListId = Int
......
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