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 {
.copy-from-corpus .tree .node {
padding-left: 10px;
margin-top: 5px;
}
.copy-from-corpus .tree .node .name.clickable {
color: #337ab7;
......
......@@ -192,6 +192,7 @@ a:focus, a:hover
.tree
.node
padding-left: 10px
margin-top: 5px
.name
&.clickable
color: #337ab7
......
{
"name": "Gargantext",
"version": "0.0.1.6.2",
"version": "0.0.1.6.4",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......
......@@ -38,7 +38,7 @@ annotationMenuCpt :: R.Component Props
annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt
where
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
addToList :: Record Props -> TermList -> Maybe R.Element
......
......@@ -3,11 +3,11 @@ module Gargantext.Components.Annotation.Utils where
import Gargantext.Types ( TermList(..) )
termClass :: TermList -> String
termClass GraphTerm = "graph-term"
termClass MapTerm = "graph-term"
termClass StopTerm = "stop-term"
termClass CandidateTerm = "candidate-term"
termBootstrapClass :: TermList -> String
termBootstrapClass GraphTerm = "success"
termBootstrapClass MapTerm = "success"
termBootstrapClass StopTerm = "danger"
termBootstrapClass CandidateTerm = "warning"
......@@ -20,6 +20,7 @@ import Gargantext.Components.Login (login)
import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
......@@ -72,20 +73,21 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
Home -> forested $ homeLayout LL_EN
Login -> login { sessions, backends, visible: showLogin }
--Folder sid _ -> withSession sid $ \_ -> forested (folder {})
Folder sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session }
Folder sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { key: show nodeId, nodeId, session }
FolderPrivate 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 }
Team 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 }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { 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 }
CorpusDocument sid corpusId listId nodeId ->
withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
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 }
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 }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { 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 }
CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
Document sid listId nodeId ->
withSession sid $
\session -> forested $ documentLayout { nodeId, listId, session, corpusId: Nothing }
......@@ -102,12 +104,11 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
, treeReload }
type ForestLayoutProps =
(
child :: R.Element
( child :: R.Element
, frontends :: Frontends
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R2.Setter Boolean
)
......
......@@ -348,7 +348,7 @@ pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt
]
, delete: true }
where
markClick _ = markCategory session nodeId category [id]
markClick _ = markCategory session nodeId category [id]
toggleClick _ = togglePendingDeletion deletions id
maybeStricken delete
| delete = H.div { style: { textDecoration: "line-through" } }
......
......@@ -10,6 +10,7 @@ import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
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.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode)
......@@ -104,8 +105,6 @@ getNodeTree :: Session -> GT.ID -> Aff FTree
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
--------------
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree
, tasks :: Record Tasks
......@@ -306,17 +305,26 @@ performAction (UploadFile nodeType fileType mName contents) { session
performAction DownloadNode _ = do
liftEffect $ log "[performAction] DownloadNode"
-------
performAction (MoveNode n1 n2) p@{session} = do
void $ moveNodeReq session n1 n2
performAction RefreshTree p
performAction (MoveNode {params}) p@{session} =
case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ moveNodeReq session in' out
performAction RefreshTree p
performAction (MergeNode n1 n2) p@{session} = do
void $ mergeNodeReq session n1 n2
performAction RefreshTree p
performAction (MergeNode {params}) p@{session} =
case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ mergeNodeReq session in' out
performAction RefreshTree p
performAction (LinkNode n1 n2) p@{session} = do
void $ linkNodeReq session n1 n2
performAction RefreshTree p
performAction (LinkNode {params}) p@{session} =
case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:in',out}) -> do
void $ linkNodeReq session in' out
performAction RefreshTree p
-------
performAction RefreshTree { reload: (_ /\ setReload) } = do
......
......@@ -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.Task (Tasks)
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.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
......@@ -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
type NodeActionsProps =
......
module Gargantext.Components.Forest.Tree.Node.Action where
import Data.Maybe (Maybe)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Prelude (class Show, Unit)
import Gargantext.Sessions (Session)
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.Update.Types (UpdateNodeParams)
{-
type UpdateNodeProps =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, name :: GT.Name
, nodeType :: NodeType
, params :: UpdateNodeParams
type Props =
( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
)
-}
data Action = AddNode String GT.NodeType
| DeleteNode
......@@ -28,11 +28,27 @@ data Action = AddNode String GT.NodeType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| DownloadNode
| RefreshTree
| MoveNode GT.NodeID GT.NodeID
| MergeNode GT.NodeID GT.NodeID
| LinkNode GT.NodeID GT.NodeID
| MoveNode {params :: Maybe SubTreeOut}
| MergeNode {params :: Maybe SubTreeOut}
| LinkNode {params :: Maybe SubTreeOut}
| 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
show (AddNode _ _ )= "AddNode"
show DeleteNode = "DeleteNode"
......@@ -43,17 +59,11 @@ instance showShow :: Show Action where
show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree"
show DownloadNode = "Download"
show (MoveNode _ _) = "MoveNode"
show (MergeNode _ _) = "MergeNode"
show (LinkNode _ _) = "LinkNode"
show (MoveNode _ ) = "MoveNode"
show (MergeNode _ ) = "MergeNode"
show (LinkNode _ ) = "LinkNode"
show NoAction = "NoAction"
type Props =
( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
)
-----------------------------------------------------------------------
icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add [])
......@@ -65,9 +75,9 @@ icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
icon DownloadNode = glyphiconNodeAction Download
icon (MoveNode _ _) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ _) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ _) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon NoAction = "hand-o-right"
......@@ -83,8 +93,8 @@ text (DoSearch _ )= "Launch search !"
text (UploadFile _ _ _ _)= "Upload File !"
text RefreshTree = "Refresh Tree !"
text DownloadNode = "Download !"
text (MoveNode _ _ ) = "Move !"
text (MergeNode _ _ ) = "Merge !"
text (LinkNode _ _ ) = "Link !"
text (MoveNode _ ) = "Move !"
text (MergeNode _ ) = "Merge !"
text (LinkNode _ ) = "Link !"
text NoAction = "No Action"
-----------------------------------------------------------------------
......@@ -6,7 +6,7 @@ import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
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.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
......@@ -20,19 +20,21 @@ linkNodeReq session fromId toId =
linkNode :: Record SubTreeParamsIn -> R.Hooks R.Element
linkNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut)
<- R.useState' Nothing
let button = case subTreeOutParams of
Nothing -> H.div {} []
Just sbto -> submitButton (LinkNode inId outId) dispatch
where
(SubTreeOut { in:inId, out:outId}) = sbto
pure $ panel [ subTreeView { subTreeOut
action@(valAction /\ setAction) :: R.State Action <- R.useState' (LinkNode {params:Nothing})
let button = case valAction of
LinkNode {params} -> case params of
Just val -> submitButton (LinkNode {params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
pure $ panel [ subTreeView { action
, dispatch
, subTreeParams
, id
, nodeType
, session
, subTreeParams
}
] button
......@@ -5,15 +5,15 @@ import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
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 (submitButton, panel, checkbox, checkboxes)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
import Data.Set as Set
mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID)
mergeNodeReq session fromId toId =
......@@ -21,19 +21,32 @@ mergeNodeReq session fromId toId =
mergeNode :: Record SubTreeParamsIn -> R.Hooks R.Element
mergeNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut)
<- R.useState' Nothing
let button = case subTreeOutParams of
Nothing -> H.div {} []
Just sbto -> submitButton (MergeNode inId outId) dispatch
where
(SubTreeOut { in:inId, out:outId}) = sbto
pure $ panel [ subTreeView { subTreeOut
action@(valAction /\ setAction) :: R.State Action <- R.useState' (MergeNode {params:Nothing})
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 {} []
_ -> H.div {} []
pure $ panel [ subTreeView { action
, dispatch
, subTreeParams
, id
, nodeType
, 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
......@@ -4,9 +4,9 @@ module Gargantext.Components.Forest.Tree.Node.Action.Move
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
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.SubTree (SubTreeParamsIn, subTreeView, SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
......@@ -20,19 +20,20 @@ moveNodeReq session fromId toId =
moveNode :: Record SubTreeParamsIn -> R.Hooks R.Element
moveNode p@{dispatch, subTreeParams, id, nodeType, session} = do
subTreeOut@(subTreeOutParams /\ setSubTreeOut) :: R.State (Maybe SubTreeOut)
<- R.useState' Nothing
let button = case subTreeOutParams of
Nothing -> H.div {} []
Just sbto -> submitButton (MoveNode inId outId) dispatch
where
(SubTreeOut { in:inId, out:outId}) = sbto
pure $ panel [ subTreeView { subTreeOut
action@(valAction /\ setAction) :: R.State Action <- R.useState' (MoveNode {params: Nothing})
let button = case valAction of
MoveNode {params} -> case params of
Just val -> submitButton (MoveNode {params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
pure $ panel [ subTreeView { action
, dispatch
, subTreeParams
, id
, nodeType
, session
, subTreeParams
}
] button
......@@ -196,7 +196,7 @@ buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt
pure $ H.div {className: "col-md-1"}
[ H.a { style: (iconAStyle nodeType todo)
, className: glyphiconActive (glyphiconNodeAction todo)
(action == (Just todo) )
(action == (Just todo) )
, id: show todo
, title: show todo
, onClick : mkEffectFn1 $ \_ -> undo *> doToDo
......
......@@ -4,6 +4,7 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Generic.Rep.Eq (genericEq)
import Gargantext.Prelude (class Eq, class Show, show, (&&), (<>), (==))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..))
import Data.Array (foldl)
import Gargantext.Types
......@@ -24,19 +25,8 @@ data NodeAction = Documentation NodeType
| Move { subTreeParams :: SubTreeParams }
| Link { subTreeParams :: SubTreeParams }
| 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
eq (Documentation x) (Documentation y) = true && (x == y)
eq SearchBox SearchBox = true
......@@ -99,7 +89,9 @@ settingsBox NodeUser =
SettingsBox { show : true
, edit : false
, doc : Documentation NodeUser
, buttons : [ Delete ]
, buttons : [ Delete
-- , Add [FolderPublic]
]
}
settingsBox FolderPrivate =
......@@ -109,6 +101,8 @@ settingsBox FolderPrivate =
, buttons : [ Add [ Corpus
, Folder
, Annuaire
, NodeFrameWrite
, NodeFrameCalc
]
]
}
......@@ -120,9 +114,12 @@ settingsBox Team =
, buttons : [ Add [ Corpus
, Folder
, Annuaire
, NodeFrameWrite
, NodeFrameCalc
]
, Share
, Delete]
, Delete
]
}
settingsBox FolderShared =
......@@ -141,7 +138,8 @@ settingsBox FolderPublic =
, buttons : [ Add [ Corpus
, Folder
]
]
-- , Delete
]
}
settingsBox Folder =
......@@ -151,6 +149,8 @@ settingsBox Folder =
, buttons : [ Add [ Corpus
, Folder
, Annuaire
, NodeFrameWrite
, NodeFrameCalc
]
, Move moveParameters
, Delete
......@@ -164,6 +164,8 @@ settingsBox Corpus =
, buttons : [ Add [ NodeList
, Graph
, Dashboard
, NodeFrameWrite
, NodeFrameCalc
]
, SearchBox
, Upload
......@@ -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 { show : false
, edit : false
......
......@@ -9,9 +9,13 @@ data Status = Stable | Test | Dev
hasStatus :: NodeType -> NodeAction -> Status
hasStatus _ SearchBox = Dev
hasStatus _ Refresh = Dev
hasStatus _ Config = Dev
hasStatus _ (Link _) = Test
hasStatus _ (Move _) = Test
hasStatus _ (Documentation _) = Test
hasStatus _ (Link _) = Dev
hasStatus _ (Merge _) = Dev
hasStatus _ (Move _) = Test
hasStatus _ (Documentation _) = Dev
hasStatus Annuaire Upload = Dev
hasStatus Texts Upload = Dev
hasStatus _ _ = Stable
......@@ -2,14 +2,18 @@ module Gargantext.Components.Forest.Tree.Node.Tools
where
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Set as Set
import Data.String as S
import Data.Tuple.Nested ((/\))
import Gargantext.Types (Name)
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1)
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.Utils (toggleSet)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -28,10 +32,9 @@ panel bodies submit =
[ H.div { className: "row"
, style: {"margin":"10px"}
}
[ H.div { className: "col-md-10" }
[ H.div { className: "col-md-12" } bs
-- TODO add type for text or form here
[ H.form {className: "form-horizontal"} bs
]
-- [ H.form {className: "form-horizontal"} bs ]
]
]
footer sb =
......@@ -201,6 +204,65 @@ submitButtonHref action href =
}
[ 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
import DOM.Simple.Console (log2)
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Effect.Uncurried (mkEffectFn1)
import Effect.Aff (Aff, launchAff)
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action(..))
import Gargantext.Components.Forest.Tree.Node.Settings (SubTreeParams(..))
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action, subTreeOut, setTreeOut)
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 (nodeText)
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.Sessions (Session(..), get)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
type SubTreeParamsIn =
( subTreeParams :: SubTreeParams
| Props
)
------------------------------------------------------------------------
data SubTreeOut = SubTreeOut { in :: GT.ID
, out :: GT.ID
}
------------------------------------------------------------------------
type SubTreeParamsProps =
( subTreeOut :: R.State (Maybe SubTreeOut)
( action :: R.State Action
| SubTreeParamsIn
)
......@@ -46,10 +39,13 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt
, nodeType
, session
, subTreeParams
, subTreeOut
, action
} _ =
do
let SubTreeParams {showtypes} = subTreeParams
let
SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action
-- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
useLoader session (loadSubTree showtypes) $
\tree ->
......@@ -59,7 +55,7 @@ subTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeView" cpt
, session
, tree
, subTreeParams
, subTreeOut
, action
}
loadSubTree :: Array GT.NodeType -> Session -> Aff FTree
......@@ -85,9 +81,11 @@ subTreeViewLoadedCpt :: R.Component CorpusTreeProps
subTreeViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeViewLoadedCpt" cpt
where
cpt p@{dispatch, id, nodeType, session, tree} _ = do
pure $ H.div { className: "copy-from-corpus" }
[ H.div { className: "tree" }
[subTreeTreeView p]
pure $ H.div {className:"panel panel-primary"}
[H.div { className: "copy-from-corpus" }
[ H.div { className: "tree" }
[subTreeTreeView p]
]
]
subTreeTreeView :: Record CorpusTreeProps -> R.Element
......@@ -97,37 +95,48 @@ subTreeTreeViewCpt :: R.Component CorpusTreeProps
subTreeTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeTreeViewCpt" cpt
where
cpt p@{ id
, tree: NTree (LNode { id: sourceId
, tree: NTree (LNode { id: targetId
, name
, nodeType
}
) ary
, subTreeParams
, dispatch
, subTreeOut
, action
} _ = do
pure $ {- H.div {} [ H.h5 { className: GT.fldr nodeType true} []
, -} H.div { className: "node" }
( [ H.span { className: "name " <> clickable
, on: { click: onClick }
} [ H.text name ]
] <> children
)
-- ]
pure $ H.div {} [ H.div { className: "node " <> GT.fldr nodeType true}
( [ H.span { className: "name " <> clickable
, on: { click: onClick }
} [ nodeText { isSelected: isSelected targetId valAction
, name: " " <> name
}
]
] <> children
)
]
where
SubTreeParams { valitypes } = subTreeParams
sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id') ary
children = map (\c -> subTreeTreeView (p { tree = c })) ary
children = map (\ctree -> subTreeTreeView (p { tree = ctree })) sortedAry
validNodeType = (A.elem nodeType valitypes) && (id /= sourceId)
validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
clickable = if validNodeType then "clickable" else ""
( valAction /\ setAction) = action
isSelected n action' = case (subTreeOut action') of
Nothing -> false
(Just (SubTreeOut {out})) -> n == out
clickable = if validNodeType then "clickable" else ""
sbto@( subTreeOutParams /\ setSubTreeOut) = subTreeOut
onClick _ = mkEffectFn1 $ \_ -> case validNodeType of
false -> setSubTreeOut (const Nothing)
true -> setSubTreeOut (const $ Just $ SubTreeOut { in: id, out:sourceId})
false -> setAction (const $ setTreeOut valAction Nothing)
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
np :: NTC.NgramsPatches
np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
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
......
......@@ -19,6 +19,7 @@ import Reactix as R
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.Login.Types (AuthRequest(..))
import Gargantext.Ends (Backend(..))
......@@ -178,7 +179,7 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where
, center
[ H.label {}
[ H.div {className: "checkbox"}
[ termsCheckbox setBox
[ checkbox setBox
, H.text "I hereby accept "
, H.a { target: "_blank"
, href: "http://gitlab.iscpif.fr/humanities/tofu/tree/master"
......@@ -213,15 +214,6 @@ csrfTokenInput _ =
, value: csrfMiddlewareToken
} -- 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 _ =
H.a { target: "_blank", href: termsUrl } [ H.text "the terms of use" ]
......
......@@ -256,7 +256,7 @@ tableContainerCpt { dispatch
selectButtons true =
H.div {} [
H.button { className: "btn btn-primary"
, on: { click: const $ setSelection GraphTerm }
, on: { click: const $ setSelection MapTerm }
} [ H.text "Map" ]
, H.button { className: "btn btn-primary"
, on: { click: const $ setSelection StopTerm }
......
......@@ -183,7 +183,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
, ngramsTable } _ =
pure $ Tbl.makeRow [
selected
, checkbox T.GraphTerm
, checkbox T.MapTerm
, checkbox T.StopTerm
, if ngramsParent == Nothing
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
......@@ -232,7 +232,7 @@ renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
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
, textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity }
......@@ -250,6 +250,6 @@ tablePatchHasNgrams ngramsTablePatch ngrams =
nextTermList :: T.TermList -> T.TermList
nextTermList T.GraphTerm = T.StopTerm
nextTermList T.MapTerm = T.StopTerm
nextTermList T.StopTerm = T.CandidateTerm
nextTermList T.CandidateTerm = T.GraphTerm
nextTermList T.CandidateTerm = T.MapTerm
......@@ -133,7 +133,7 @@ initialPageParams session nodeId listIds tabType =
, params
, tabType
, termSizeFilter: Nothing
, termListFilter: Just GraphTerm
, termListFilter: Just MapTerm
, searchQuery: ""
, scoreType: Occurrences
, session
......
......@@ -25,7 +25,7 @@ import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType(..))
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
"data" :: HistoMetrics
}
instance decodeChartMetrics :: DecodeJson ChartMetrics where
......
......@@ -88,7 +88,7 @@ scatterOptions metrics' = Options
color =
case k of
StopTerm -> red
GraphTerm -> green
MapTerm -> green
CandidateTerm -> grey
toSerie color' (Metric {label,x,y}) =
dataSerie { name: label, itemStyle: itemStyle {color: color'}
......
......@@ -27,7 +27,7 @@ import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType)
newtype ChartMetrics = ChartMetrics {
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
}
......@@ -60,7 +60,7 @@ type Loaded = HistoMetrics
chartOptionsBar :: HistoMetrics -> Options
chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options
{ 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'
, 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']
......@@ -71,7 +71,7 @@ chartOptionsBar (HistoMetrics { dates: dates', count: count'}) = Options
chartOptionsPie :: HistoMetrics -> Options
chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Pie"
, subTitle : "Distribution by GraphTerm"
, subTitle : "Distribution by MapTerm"
, xAxis : xAxis' []
, yAxis : yAxis' { position: "", show: false, min:0}
, 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
liftEffect $ setReload $ (+) 1
type LoadedProps =
(
charts :: Array P.PredefinedChart
( charts :: Array P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, key :: String
......@@ -91,8 +90,7 @@ dashboardLayoutLoadedCpt = R.hooksComponent "G.C.N.C.D.dashboardLayoutLoaded" cp
onRemove _ = onChange $ fromMaybe charts $ A.deleteAt idx charts
type PredefinedChartProps =
(
chart :: P.PredefinedChart
( chart :: P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, onChange :: P.PredefinedChart -> Effect Unit
......
......@@ -13,9 +13,8 @@ type Preferences = Maybe String
newtype Hyperdata =
Hyperdata
{
charts :: Array P.PredefinedChart
, preferences :: Preferences
{ charts :: Array P.PredefinedChart
, preferences :: Preferences
}
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
......@@ -52,8 +51,8 @@ saveDashboard {hyperdata, nodeId, session} = do
id_ <- (put session (NodeAPI Node (Just nodeId) "") hyperdata) :: Aff Int
pure unit
type DashboardData = {
id :: Int
type DashboardData =
{ id :: Int
, hyperdata :: Hyperdata
, 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
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 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 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)
......@@ -195,7 +195,7 @@ sessionPath (R.Chart {chartType, listId, limit, tabType} i) =
sessionPath $ R.NodeAPI Corpus i
$ show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId
<> "&listType=MapTerm" -- <> show listId
<> "&listId=" <> show listId
where
limitPath = case limit of
......
......@@ -11,9 +11,9 @@ router :: Match AppRoute
router = oneOf
[ Login <$ route "login"
, Folder <$> (route "folder" *> sid) <*> int
, FolderPrivate <$> (route "folderPrivate" *> sid) <*> int
, FolderPublic <$> (route "folderPublic" *> sid) <*> int
, FolderShared <$> (route "folderShared" *> sid) <*> int
, FolderPrivate <$> (route "folderPrivate" *> sid) <*> int
, FolderPublic <$> (route "folderPublic" *> sid) <*> int
, FolderShared <$> (route "folderShared" *> sid) <*> int
, Team <$> (route "team" *> sid) <*> int
, CorpusDocument <$> (route "corpus" *> sid) <*> int
<*> (lit "list" *> int)
......@@ -29,6 +29,9 @@ router = oneOf
<*> (lit "contact" *> int)
, Annuaire <$> (route "annuaire" *> sid) <*> int
, UserPage <$> (route "user" *> sid) <*> int
, RouteFrameWrite <$> (route "write" *> sid) <*> int
, RouteFrameCalc <$> (route "calc" *> sid) <*> int
, Home <$ lit ""
]
where
......
......@@ -23,6 +23,9 @@ data AppRoute
| Annuaire SessionId Int
| UserPage SessionId Int
| ContactPage SessionId Int Int
| RouteFrameWrite SessionId Int
| RouteFrameCalc SessionId Int
derive instance eqAppRoute :: Eq AppRoute
......@@ -66,6 +69,9 @@ instance showAppRoute :: Show AppRoute where
show (Annuaire s i) = "Annuaire" <> 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 (RouteFrameWrite s i) = "write" <> show i <> " (" <> show s <> ")"
show (RouteFrameCalc s i) = "calc" <> show i <> " (" <> show s <> ")"
appPath :: AppRoute -> String
appPath Home = ""
......@@ -85,3 +91,6 @@ appPath (Lists s i) = "lists/" <> show s <> "/" <> show i
appPath (Annuaire s i) = "annuaire/" <> 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 (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)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Effect.Aff (Aff)
import Gargantext.Prelude (class Read, read)
import Gargantext.Prelude (class Read, read, class Show, show)
import Prelude
import Prim.Row (class Union)
import URI.Query (Query)
......@@ -56,14 +56,14 @@ termSizes = [ { desc: "All types", mval: Nothing }
, { desc: "Multi-word terms", mval: Just MultiTerm }
]
data TermList = GraphTerm | StopTerm | CandidateTerm
data TermList = MapTerm | StopTerm | CandidateTerm
-- TODO use generic JSON instance
derive instance eqTermList :: Eq TermList
derive instance ordTermList :: Ord TermList
instance encodeJsonTermList :: EncodeJson TermList where
encodeJson GraphTerm = encodeJson "GraphTerm"
encodeJson MapTerm = encodeJson "MapTerm"
encodeJson StopTerm = encodeJson "StopTerm"
encodeJson CandidateTerm = encodeJson "CandidateTerm"
......@@ -71,7 +71,7 @@ instance decodeJsonTermList :: DecodeJson TermList where
decodeJson json = do
s <- decodeJson json
case s of
"GraphTerm" -> pure GraphTerm
"MapTerm" -> pure MapTerm
"StopTerm" -> pure StopTerm
"CandidateTerm" -> pure CandidateTerm
_ -> Left "Unexpected list name"
......@@ -79,31 +79,31 @@ instance decodeJsonTermList :: DecodeJson TermList where
type ListTypeId = Int
listTypeId :: TermList -> ListTypeId
listTypeId GraphTerm = 1
listTypeId MapTerm = 1
listTypeId StopTerm = 2
listTypeId CandidateTerm = 3
instance showTermList :: Show TermList where
show GraphTerm = "GraphTerm"
show MapTerm = "MapTerm"
show StopTerm = "StopTerm"
show CandidateTerm = "CandidateTerm"
-- TODO: Can we replace the show instance above with this?
termListName :: TermList -> String
termListName GraphTerm = "Map List"
termListName MapTerm = "Map List"
termListName StopTerm = "Stop List"
termListName CandidateTerm = "Candidate List"
instance readTermList :: Read TermList where
read :: String -> Maybe TermList
read "GraphTerm" = Just GraphTerm
read "MapTerm" = Just MapTerm
read "StopTerm" = Just StopTerm
read "CandidateTerm" = Just CandidateTerm
read _ = Nothing
termLists :: Array { desc :: String, mval :: Maybe TermList }
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: "Candidate terms", mval: Just CandidateTerm }
]
......@@ -151,6 +151,9 @@ data NodeType = NodeUser
| Tree
| NodeList
| Texts
-- TODO Optional Nodes
| NodeFrameWrite
| NodeFrameCalc
derive instance eqNodeType :: Eq NodeType
......@@ -177,6 +180,9 @@ instance showNodeType :: Show NodeType where
show Team = "NodeTeam"
show NodeList = "NodeList"
show Texts = "NodeTexts"
show NodeFrameWrite = "NodeFrameWrite"
show NodeFrameCalc = "NodeFrameCalc"
instance readNodeType :: Read NodeType where
read "NodeUser" = Just NodeUser
......@@ -199,6 +205,8 @@ instance readNodeType :: Read NodeType where
read "NodeList" = Just NodeList
read "NodeTexts" = Just Texts
read "Annuaire" = Just Annuaire
read "NodeFrameWrite" = Just NodeFrameWrite
read "NodeFrameCalc" = Just NodeFrameCalc
read _ = Nothing
......@@ -237,6 +245,12 @@ fldr Annuaire false = "fa fa-address-card"
fldr NodeContact true = "fa fa-address-card-o"
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 _ true = "fa fa-folder-open"
......@@ -280,6 +294,9 @@ nodeTypePath Tree = "tree"
nodeTypePath NodeList = "lists"
nodeTypePath Texts = "texts"
nodeTypePath Team = "team"
nodeTypePath NodeFrameWrite = "write"
nodeTypePath NodeFrameCalc = "calc"
------------------------------------------------------------
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