Skip to content

P
purescript-gargantext
Commit 62a4eacb authored by James Laver's avatar James Laver
Browse files
Options

Merge branch 'dev' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev

parents e1491127 142d031d
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 993 additions and 695 deletions
package.json
View file @ 62a4eacb
{
"name": "Gargantext",
"version": "0.0.1.4.2",
"version": "0.0.1.5",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......
src/Gargantext/Components/Forest.purs
View file @ 62a4eacb
......@@ -3,21 +3,19 @@ module Gargantext.Components.Forest where
import Gargantext.Prelude
import Data.Array as A
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Components.Forest.Tree.Node.Action (Reload)
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Types (Reload)
import Gargantext.Utils.Reactix as R2
type Props =
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree where
import DOM.Simple.Console (log2)
import Data.Array as A
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe)
import Data.Set as Set
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, deleteNode, loadNode, renameNode)
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.CopyFrom (loadNode)
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
import Gargantext.Components.Forest.Tree.Node.Action.Share (ShareValue(..), share)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan, Tasks, tasksStruct)
import Gargantext.Components.Forest.Tree.Node.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>), identity)
import Gargantext.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>))
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT
import Gargantext.Types (ID, Reload)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
------------------------------------------------------------------------
......@@ -186,9 +188,9 @@ performAction p@{ openNodes: (_ /\ setOpenNodes)
performAction { reload: (_ /\ setReload)
, session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _) } (SearchQuery task) = do
, tree: (NTree (LNode {id}) _) } (DoSearch task) = do
liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] SearchQuery task:" task
liftEffect $ log2 "[performAction] DoSearch task:" task
performAction { reload: (_ /\ setReload)
, session
......@@ -197,17 +199,21 @@ performAction { reload: (_ /\ setReload)
liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] UpdateNode task:" task
performAction p@{ reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (Submit name) = do
void $ renameNode session id $ RenameValue {name}
, tree: (NTree (LNode {id}) _) } (RenameNode name) = do
void $ rename session id $ RenameValue {text:name}
performAction p RefreshTree
performAction p@{ reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (ShareNode username) = do
void $ share session id $ ShareValue {text:username}
performAction p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
, tree: (NTree (LNode {id}) _) } (AddNode name nodeType) = do
task <- addNode session id $ AddNodeValue {name, nodeType}
liftEffect do
setOpenNodes (Set.insert (mkNodeId session id))
......
src/Gargantext/Components/Forest/Tree/Node.purs
View file @ 62a4eacb
......@@ -2,17 +2,13 @@ module Gargantext.Components.Forest.Tree.Node where
import Prelude (class Eq, class Show, show, (&&), (<>), (==))
import Data.Array (foldl)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Gargantext.Types
------------------------------------------------------------------------
------------------------------------------------------------------------
{-
-- | TODO
filterWithRights (show action if user can only)
-- | RIGHT Management
if user has access to node then he can do all his related actions
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
......@@ -38,8 +34,8 @@ instance eqNodeAction :: Eq NodeAction where
eq Clone Clone = true
eq Delete Delete = true
eq Share Share = true
eq (Link x) (Link y) = true && (x == y)
eq (Add x) (Add y) = true && (x == y)
eq (Link x) (Link y) = (x == y)
eq (Add x) (Add y) = (x == y)
eq CopyFromCorpus CopyFromCorpus = true
eq Config Config = true
eq _ _ = false
......@@ -61,16 +57,17 @@ instance showNodeAction :: Show NodeAction where
glyphiconNodeAction :: NodeAction -> String
glyphiconNodeAction (Documentation _) = "question-sign"
glyphiconNodeAction (Documentation _) = "question-circle"
glyphiconNodeAction Delete = "trash"
glyphiconNodeAction (Add _) = "plus"
glyphiconNodeAction SearchBox = "search"
glyphiconNodeAction Upload = "upload"
glyphiconNodeAction (Link _) = "transfer"
glyphiconNodeAction (Link _) = "arrows-h"
glyphiconNodeAction Download = "download"
glyphiconNodeAction CopyFromCorpus = "random"
glyphiconNodeAction Refresh = "refresh"
glyphiconNodeAction Config = "wrench"
glyphiconNodeAction Share = "user-plus"
glyphiconNodeAction _ = ""
......@@ -110,6 +107,7 @@ settingsBox Team = SettingsBox {
, Folder
, Annuaire
]
, Share
, Delete]
}
......@@ -155,7 +153,6 @@ settingsBox Corpus =
]
, Upload
, Download
--, Share
--, Move
--, Clone
, Link Annuaire
......
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Maybe (Maybe)
import Effect.Aff (Aff)
import Prelude hiding (div)
import Gargantext.Components.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Routes as GR
import Gargantext.Prelude
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Components.Forest.Tree.Node (NodeAction(..), glyphiconNodeAction)
type Props =
( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
)
data Action = CreateSubmit String GT.NodeType
data Action = AddNode String GT.NodeType
| DeleteNode
| UpdateNode GT.AsyncTaskWithType
| SearchQuery GT.AsyncTaskWithType
| Submit String
| RenameNode String
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| RefreshTree
| ShareNode String
-----------------------------------------------------
-- UploadFile Action
-- file upload types
instance showShow :: Show Action where
show DeleteNode = "DeleteNode"
show RefreshTree = "RefreshTree"
show (ShareNode _ )= "ShareNode"
show (UpdateNode _ )= "UpdateNode"
show (RenameNode _ )= "RenameNode"
show (DoSearch _ )= "SearchQuery"
show (AddNode _ _ )= "AddNode"
show (UploadFile _ _ _ _)= "UploadFile"
-----------------------------------------------------------------------
icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon DeleteNode = glyphiconNodeAction Delete
icon (UpdateNode _) = glyphiconNodeAction Refresh
icon (RenameNode _) = glyphiconNodeAction Config
icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
icon (ShareNode _) = glyphiconNodeAction Share
-- icon _ = "hand-o-right"
text :: Action -> String
text DeleteNode = "Delete !"
text RefreshTree = "Refresh Tree !"
text (AddNode _ _ )= "Add !"
text (UpdateNode _ )= "Update !"
text (RenameNode _ )= "Rename !"
text (DoSearch _ )= "Launch search !"
text (ShareNode _ )= "Share !"
text (UploadFile _ _ _ _)= "Upload File !"
-----------------------------------------------------------------------
-- TODO move code below elsewhere
data FileType = CSV | CSV_HAL | WOS | PresseRIS
derive instance genericFileType :: Generic FileType _
......@@ -36,111 +73,4 @@ instance eqFileType :: Eq FileType where
instance showFileType :: Show FileType where
show = genericShow
readFileType :: String -> Maybe FileType
readFileType "CSV" = Just CSV
readFileType "CSV_HAL" = Just CSV_HAL
readFileType "PresseRIS" = Just PresseRIS
readFileType "WOS" = Just WOS
readFileType _ = Nothing
data DroppedFile =
DroppedFile { contents :: UploadFileContents
, fileType :: Maybe FileType
, lang :: Maybe Lang
}
type FileHash = String
type Name = String
type ID = Int
type Reload = Int
newtype UploadFileContents = UploadFileContents String
type UploadFile =
{ contents :: UploadFileContents
, name :: String
}
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put session $ NodeAPI GT.Node (Just renameNodeId) "rename"
deleteNode :: Session -> ID -> Aff ID
deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
loadNode :: Session -> ID -> Aff FTree
loadNode session nodeId = get session $ NodeAPI GT.Tree (Just nodeId) ""
{-
updateNode :: Session -> ID -> Aff ID
updateNode session nodeId = post session
-}
-----------------------------------------------------------------------
newtype RenameValue = RenameValue
{ name :: Name }
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue {name})
= "r_name" := name
~> jsonEmptyObject
-----------------------------------------------------------------------
-----------------------------------------------------------------------
data UpdateNodeParams = UpdateNodeParamsList { method :: Int }
| UpdateNodeParamsGraph { method :: String }
| UpdateNodeParamsTexts { method :: Int }
instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
where
encodeJson (UpdateNodeParamsList { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsGraph { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsTexts { method })
= "method" := method
~> jsonEmptyObject
-----------------------------------------------------------------------
data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode
type Tree = { tree :: FTree
, asyncTasks :: Array GT.AsyncTaskWithType
}
instance ntreeFunctor :: Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary)
newtype LNode = LNode { id :: ID
, name :: Name
, nodeType :: GT.NodeType
}
derive instance newtypeLNode :: Newtype LNode _
instance decodeJsonLNode :: DecodeJson LNode where
decodeJson json = do
obj <- decodeJson json
id_ <- obj .: "id"
name <- obj .: "name"
nodeType <- obj .: "type"
pure $ LNode { id : id_
, name
, nodeType
}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
obj <- decodeJson json
node <- obj .: "node"
nodes <- obj .: "children"
node' <- decodeJson node
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array (length, head)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Maybe (Maybe(..), fromMaybe)
-- import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff)
import Effect.Aff (Aff)
import Effect.Uncurried (mkEffectFn1)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), ID, Name)
import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
import Gargantext.Types (NodeType(..), readNodeType)
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session, post)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
import Prelude (Unit, bind, const, discard, map, pure, show, ($), (<>), (>), (<<<))
import Gargantext.Types (NodeType(..), readNodeType)
import Gargantext.Utils.Reactix as R2
import Prelude (Unit, bind, const, map, pure, show, ($), (<>), (>), (<<<))
import Reactix as R
import Reactix.DOM.HTML as H
-- START Create Node
addNode :: Session -> ID -> AddNodeValue -> Aff (Array ID)
----------------------------------------------------------------------
addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Array GT.ID)
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
addNodeAsync :: Session
-> ID
-> GT.ID
-> AddNodeValue
-> Aff GT.AsyncTaskWithType
addNodeAsync session parentId q = do
......@@ -34,8 +33,9 @@ addNodeAsync session parentId q = do
p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
----------------------------------------------------------------------
-- TODO AddNodeParams
newtype AddNodeValue = AddNodeValue
{ name :: Name
{ name :: GT.Name
, nodeType :: GT.NodeType
}
......@@ -46,15 +46,13 @@ instance encodeJsonAddNodeValue :: EncodeJson AddNodeValue where
~> jsonEmptyObject
----------------------------------------------------------------------
type Dispatch = Action -> Aff Unit
data NodePopup = CreatePopup | NodePopup
type CreateNodeProps =
( id :: ID
, dispatch :: Action -> Aff Unit
, name :: Name
, nodeType :: NodeType
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, name :: GT.Name
, nodeType :: NodeType
, nodeTypes :: Array NodeType
)
......@@ -64,11 +62,11 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
where
el = R.hooksComponent "AddNodeView" cpt
cpt {id, name} _ = do
nodeName <- R.useState' "Name"
nodeType' <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
nodeName@(name' /\ _) <- R.useState' "Name"
nodeType'@(nt /\ _) <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
pure $ H.div {}
[ panelBody readNodeType nodeName nodeType'
, panelFooter nodeName nodeType'
, submitButton (AddNode name' nt) dispatch -- panelFooter nodeName nodeType'
]
where
panelBody :: (String -> NodeType)
......@@ -108,7 +106,7 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
-- , showConfig nt
]
else
H.button { className : "btn btn-primary"
H.button { className : "btn btn-primary center"
, type : "button"
, onClick : mkEffectFn1 $ \_ -> setNodeType ( const
$ fromMaybe nt
......@@ -118,19 +116,6 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
]
panelFooter :: R.State String -> R.State NodeType -> R.Element
panelFooter (name' /\ _) (nt /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-primary text-center"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
-- TODO
--setPopupOpen $ const Nothing
launchAff $ dispatch $ CreateSubmit name' nt
} [H.text "Add"]
]
-- END Create Node
showConfig :: NodeType -> R.Element
......
src/Gargantext/Components/Forest/Tree/Node/Action/CopyFrom.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action.CopyFrom where
import DOM.Simple.Console (log2)
import Data.Array as A
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Props)
import Gargantext.Components.Forest.Tree.Node.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (discard, map, pure, show, unit, ($), (&&), (/=), (<>))
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
loadNode :: Session -> GT.ID -> Aff FTree
loadNode session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
copyFromCorpusView :: Record Props -> R.Element
copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props []
copyFromCorpusViewCpt :: R.Component Props
copyFromCorpusViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusView" cpt
where
cpt {dispatch, id, nodeType, session} _ = do
useLoader session loadCorporaTree $
\tree ->
copyFromCorpusViewLoaded {dispatch, id, nodeType, session, tree}
type CorpusTreeProps =
( tree :: FTree
| Props
)
copyFromCorpusViewLoaded :: Record CorpusTreeProps -> R.Element
copyFromCorpusViewLoaded props = R.createElement copyFromCorpusViewLoadedCpt props []
copyFromCorpusViewLoadedCpt :: R.Component CorpusTreeProps
copyFromCorpusViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusViewLoadedCpt" cpt
where
cpt p@{dispatch, id, nodeType, session, tree} _ = do
pure $ H.div { className: "copy-from-corpus" } [
H.div { className: "tree" } [copyFromCorpusTreeView p]
]
copyFromCorpusTreeView :: Record CorpusTreeProps -> R.Element
copyFromCorpusTreeView props = R.createElement copyFromCorpusTreeViewCpt props []
copyFromCorpusTreeViewCpt :: R.Component CorpusTreeProps
copyFromCorpusTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusTreeViewCpt" cpt
where
cpt p@{id, tree: NTree (LNode { id: sourceId, name, nodeType }) ary} _ = 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)
-- ]
where
children = map (\c -> copyFromCorpusTreeView (p { tree = c })) ary
validNodeType = (A.elem nodeType [GT.NodeList]) && (id /= sourceId)
clickable = if validNodeType then "clickable" else ""
onClick _ = case validNodeType of
false -> pure unit
true -> do
log2 "[copyFromCorpusTreeViewCpt] issue copy into" id
log2 "[copyFromCorpusTreeViewCpt] issue copy from" sourceId
loadCorporaTree :: Session -> Aff FTree
loadCorporaTree session = getCorporaTree session treeId
where
Session { treeId } = session
getCorporaTree :: Session -> Int -> Aff FTree
getCorporaTree session treeId = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
where
nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" [ GT.FolderPrivate
, GT.FolderShared
, GT.Team
, GT.FolderPublic
, GT.Folder
, GT.Corpus
, GT.NodeList]
src/Gargantext/Components/Forest/Tree/Node/Action/Delete.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action.Delete
where
import Data.Maybe (Maybe(..))
import Gargantext.Prelude
import Effect.Aff (Aff)
import Gargantext.Types as GT
import Gargantext.Sessions (Session, delete)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Types (NodeType(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Reactix as R
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton)
import Reactix.DOM.HTML as H
-- TODO Delete with asyncTaskWithType
deleteNode :: Session -> GT.ID -> Aff GT.ID
deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
-- | Action : Delete
actionDelete :: NodeType -> (Action -> Aff Unit) -> R.Hooks R.Element
actionDelete NodeUser _ = do
pure $ R.fragment [
H.div {style: {margin: "10px"}}
[H.text $ "Yes, we are RGPD compliant!"
<> " But you can not delete User Node yet."
<> " We are still on development."
<> " Thanks for your comprehensin."
]
]
actionDelete _ dispatch = do
pure $ R.fragment [
H.div {style: {margin: "10px"}}
(map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?"
, "If yes, click again below."
]
)
, submitButton DeleteNode dispatch
]
src/Gargantext/Components/Forest/Tree/Node/Action/Documentation.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action.Documentation where
import Gargantext.Prelude (map, pure, show, ($), (<>))
import Gargantext.Types (NodeType)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
-- | Action: Show Documentation
actionDoc :: NodeType -> R.Hooks R.Element
actionDoc nodeType =
pure $ R.fragment [ H.div { style: {margin: "10px"} }
$ [ infoTitle nodeType ]
<> (map (\info -> H.p {} [H.text info]) $ docOf nodeType)
]
where
infoTitle :: NodeType -> R.Element
infoTitle nt = H.div { style: {margin: "10px"}}
[ H.h3 {} [H.text "Documentation about " ]
, H.h3 {className: GT.fldr nt true} [ H.text $ show nt ]
]
-- | TODO add documentation of all NodeType
docOf :: NodeType -> Array String
docOf GT.NodeUser = [ "This account is personal"
, "See the instances terms of uses."
]
docOf GT.FolderPrivate = ["This folder and its children are private only."]
docOf GT.FolderPublic = ["Soon, you will be able to build public folders to share your work with the world!"]
docOf GT.FolderShared = ["Soon, you will be able to build teams folders to share your work"]
docOf nodeType = ["More information on " <> show nodeType]
src/Gargantext/Components/Forest/Tree/Node/Action/Download.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action.Download where
import Data.Maybe (Maybe(..))
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT)
import Gargantext.Ends (url)
import Gargantext.Prelude (pure, ($))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
-- | Action : Download
actionDownload :: NodeType -> ID -> Session -> R.Hooks R.Element
actionDownload NodeList id session = downloadButton href label info
where
href = url session $ Routes.NodeAPI GT.NodeList (Just id) ""
label = "Download List"
info = "Info about the List as JSON format"
actionDownload GT.Graph id session = downloadButton href label info
where
href = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
label = "Download Graph"
info = "Info about the Graph as GEXF format"
actionDownload GT.Corpus id session = downloadButton href label info
where
href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
label = "Download Corpus"
info = "Download as JSON"
actionDownload GT.Texts id session = downloadButton href label info
where
href = url session $ Routes.NodeAPI GT.Texts (Just id) ""
label = "Download texts"
info = "TODO: fix the backend route. What is the expected result ?"
actionDownload _ _ _ = pure $ fragmentPT $ "Soon, you will be able to dowload your file here "
type Href = String
type Label = String
type Info = String
downloadButton :: Href -> Label -> Info -> R.Hooks R.Element
downloadButton href label info = do
pure $ R.fragment [ H.div { className: "row"}
[ H.div { className: "col-md-2"} []
, H.div { className: "col-md-7 flex-center"}
[ H.p {} [H.text info] ]
]
, H.span { className: "row" }
[ H.div { className: "panel-footer"}
[ H.div { className: "col-md-3"} []
, H.div { className: "col-md-3 flex-center"}
[ H.a { className: "btn btn-primary"
, style : { width: "50%" }
, href
, target: "_blank" }
[ H.text label ]
]
]
]
]
src/Gargantext/Components/Forest/Tree/Node/Action/Rename.purs
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action.Rename where
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1)
import Prelude (Unit, bind, const, discard, pure, ($), (<<<))
import Reactix as R
import Reactix.DOM.HTML as H
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Prelude (($))
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Types (NodeType)
import Gargantext.Utils.Reactix as R2
type Dispatch = Action -> Aff Unit
-- | START Rename Box
type RenameBoxProps =
( id :: ID
, dispatch :: Dispatch
, name :: Name
, nodeType :: NodeType
, renameBoxOpen :: R.State Boolean
)
import Gargantext.Types as GT
import Gargantext.Types (ID)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, put)
renameBox :: Record RenameBoxProps -> R.Element
renameBox p@{ dispatch, renameBoxOpen: (true /\ setRenameBoxOpen) } = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {id, name, nodeType} _ = do
renameNodeName <- R.useState' name
pure $ H.div {className: "from-group row-no-padding"}
[ renameInput renameNodeName
, renameBtn renameNodeName
, cancelBtn
]
where
renameInput (_ /\ setRenameNodeName) =
H.div {className: "col-md-8"}
[ H.input { type: "text"
, placeholder: "Rename Node"
, defaultValue: name
, className: "form-control"
, onInput: mkEffectFn1 $ setRenameNodeName <<< const <<< R2.unsafeEventValue
}
]
renameBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setRenameBoxOpen $ const false
launchAff $ dispatch $ Submit newName
, title: "Rename"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const false
, title: "Cancel"
} []
renameBox p@{ renameBoxOpen: (false /\ _) } = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {name} _ = pure $ H.div {} []
------------------------------------------------------------------------
rename :: Session -> ID -> RenameValue -> Aff (Array ID)
rename session renameNodeId =
put session $ GR.NodeAPI GT.Node (Just renameNodeId) "rename"
-- END Rename Box
renameAction :: String -> Action
renameAction newName = RenameNode newName
------------------------------------------------------------------------
newtype RenameValue = RenameValue
{ text :: String }
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue {text})
= "r_name" := text
~> jsonEmptyObject
------------------------------------------------------------------------
src/Gargantext/Components/Forest/Tree/Node/Action/Search/Frame.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action.Search.Frame where
{-
import Data.Array as A
import Data.Map as Map
import Data.String as S
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), FileType(..), UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView)
import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (copyFromCorpusView)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameAction)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), uploadFileView, fileTypeView, uploadTermListView)
import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (allLangs, Lang(EN))
import Gargantext.Components.NgramsTable.API as NTAPI
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Ends (Frontends, url)
-}
import DOM.Simple as DOM
import DOM.Simple.Event (MessageEvent)
import DOM.Simple.EventListener (Callback, addEventListener, callback)
import DOM.Simple.Window (window)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (Search, isIsTex_Advanced)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..))
import Gargantext.Components.Forest.Tree.Node.Box.Types
import Gargantext.Prelude (discard, identity, pure, unit, ($), (<>), (==))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
--------------------
-- | Iframes
searchIframes :: Record NodePopupProps
-> R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
searchIframes {nodeType} search@(search' /\ _) iframeRef =
if isIsTex_Advanced search'.datafield then
H.div { className: "istex-search panel panel-default" }
[ iframeWith "https://istex.gargantext.org" search iframeRef ]
else
if Just Web == search'.datafield then
H.div { className: "istex-search panel panel-default" }
[ iframeWith "https://searx.gargantext.org" search iframeRef ]
else
H.div {} []
iframeWith :: String
-> R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
iframeWith url (search /\ setSearch) iframeRef =
H.iframe { src: isTexTermUrl search.term
,width: "100%"
,height: "100%"
,ref: iframeRef
,on: {
load: \_ -> do
addEventListener window "message" (changeSearchOnMessage url)
R2.postMessage iframeRef search.term
}
} []
where
changeSearchOnMessage :: String -> Callback MessageEvent
changeSearchOnMessage url' =
callback $ \m -> if R2.getMessageOrigin m == url'
then do
let {url'', term} = R2.getMessageData m
setSearch $ _ {url = url'', term = term}
else
pure unit
isTexTermUrl term = url <> query
where
query = Query.print $ NQP.print identity identity qp
qp = NQP.QueryPairs [
Tuple (NQP.keyFromString "query") (Just (NQP.valueFromString term))
]
src/Gargantext/Components/Search/SearchBar.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchBar.purs
View file @ 62a4eacb
module Gargantext.Components.Search.SearchBar
module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar
( Props, searchBar, searchBarCpt
) where
......@@ -7,11 +7,10 @@ import Data.Nullable (Nullable)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Effect (Effect)
import Gargantext.Components.Lang (Lang)
import Gargantext.Components.Search.SearchField (Search, searchField)
import Gargantext.Components.Search.Types (allDatabases) -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (Search, searchField)
import Gargantext.Prelude (Unit, pure, ($))
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
......
src/Gargantext/Components/Search/SearchField.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchField.purs
View file @ 62a4eacb
module Gargantext.Components.Search.SearchField
module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField
( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex, isIsTex_Advanced) where
import Data.Maybe (Maybe(..), maybe, fromMaybe, isJust)
......@@ -20,7 +20,7 @@ import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, ($), (&&
import Gargantext.Data.Array (catMaybes)
import Gargantext.Components.Lang (Lang)
import Gargantext.Components.Search.Types (DataOriginApi(..), DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, readDatabase, readOrg, datafield2database)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataOriginApi(..), DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, readDatabase, readOrg, datafield2database)
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
......
src/Gargantext/Components/Search/Types.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/Types.purs
View file @ 62a4eacb
module Gargantext.Components.Search.Types where
module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
import Data.Array (concat)
import Data.Argonaut (class EncodeJson, encodeJson, jsonEmptyObject, (:=), (~>))
......@@ -12,14 +12,13 @@ import Effect.Aff (Aff)
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Gargantext.Prelude (class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>))
import Gargantext.Prelude (id, class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>))
import Gargantext.Components.Lang
import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post)
import Gargantext.Types as GT
import Gargantext.Utils (id)
------------------------------------------------------------------------
class Doc a where
......
src/Gargantext/Components/Forest/Tree/Node/Action/Share.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action.Share where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Prelude (($))
import Reactix as R
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Types as GT
import Gargantext.Types (ID)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
------------------------------------------------------------------------
share :: Session -> ID -> ShareValue -> Aff (Array ID)
share session nodeId =
post session $ GR.NodeAPI GT.Node (Just nodeId) "share"
shareAction :: String -> Action
shareAction username = ShareNode username
------------------------------------------------------------------------
newtype ShareValue = ShareValue
{ text :: String }
instance encodeJsonShareValue :: EncodeJson ShareValue where
encodeJson (ShareValue {text})
= "username" := text
~> jsonEmptyObject
------------------------------------------------------------------------
textInputBox :: Record Tools.TextInputBoxProps -> R.Element
textInputBox = Tools.textInputBox
src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Action.Update where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Types (NodeType)
import Gargantext.Types as GT
import Gargantext.Prelude (Unit)
{-
updateNode :: Session -> ID -> UpdateNodeParams -> Aff (Array ID)
updateNode session nodeId params = post session $ GR.NodeAPI GT.Node (Just nodeId) ""
-}
data UpdateNodeParams = UpdateNodeParamsList { method :: Int }
| UpdateNodeParamsGraph { method :: String }
| UpdateNodeParamsTexts { method :: Int }
instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
where
encodeJson (UpdateNodeParamsList { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsGraph { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsTexts { method })
= "method" := method
~> jsonEmptyObject
----------------------------------------------------------------------
type UpdateNodeProps =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, name :: GT.Name
, nodeType :: NodeType
, params :: UpdateNodeParams
)
src/Gargantext/Components/Forest/Tree/Node/Box/Types.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Box.Types where
import DOM.Simple as DOM
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node (NodeAction)
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Prelude (Unit)
import Gargantext.Sessions (Session)
import Gargantext.Types (ID, Name)
import Gargantext.Types as GT
type CommonProps =
( dispatch :: Action -> Aff Unit
, session :: Session
)
type NodePopupProps =
( id :: ID
, name :: Name
, nodeType :: GT.NodeType
, onPopoverClose :: DOM.Element -> Effect Unit
| CommonProps
)
type NodePopupS =
( action :: Maybe NodeAction
, id :: ID
, name :: Name
, nodeType :: GT.NodeType
)
src/Gargantext/Components/Forest/Tree/Node/FTree.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.FTree where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Prelude hiding (div)
import Gargantext.Components.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Routes as GR
import Gargantext.Types as GT
-----------------------------------------------------------------------
type ID = Int
type Name = String
-----------------------------------------------------------------------
type FTree = NTree LNode
data NTree a = NTree a (Array (NTree a))
type Tree = { tree :: FTree
, asyncTasks :: Array GT.AsyncTaskWithType
}
instance ntreeFunctor :: Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary)
newtype LNode = LNode { id :: ID
, name :: Name
, nodeType :: GT.NodeType
}
derive instance newtypeLNode :: Newtype LNode _
instance decodeJsonLNode :: DecodeJson LNode where
decodeJson json = do
obj <- decodeJson json
id_ <- obj .: "id"
name <- obj .: "name"
nodeType <- obj .: "type"
pure $ LNode { id : id_
, name
, nodeType
}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
obj <- decodeJson json
node <- obj .: "node"
nodes <- obj .: "children"
node' <- decodeJson node
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs
View file @ 62a4eacb
......@@ -9,7 +9,6 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Timer (clearInterval, setInterval)
import Gargantext.Components.Forest.Tree.Node.Action (ID)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types as GT
......@@ -26,7 +25,7 @@ type Props =
(
asyncTask :: GT.AsyncTaskWithType
, barType :: BarType
, corpusId :: ID
, corpusId :: GT.ID
, onFinish :: Unit -> Effect Unit
, session :: Session
)
......
src/Gargantext/Components/Forest/Tree/Node/Tools.purs 0 → 100644
View file @ 62a4eacb
module Gargantext.Components.Forest.Tree.Node.Tools where
import Data.String as S
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1)
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Types (ID)
import Gargantext.Utils.Reactix as R2
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, ($), (<<<), (<>))
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
-- | START Rename Box
type TextInputBoxProps =
( id :: ID
, dispatch :: Action -> Aff Unit
, text :: String
, isOpen :: R.State Boolean
, boxName :: String
, boxAction :: String -> Action
)
textInputBox :: Record TextInputBoxProps -> R.Element
textInputBox p@{ boxName, boxAction, dispatch, isOpen: (true /\ setIsOpen) } = R.createElement el p []
where
el = R.hooksComponent (boxName <> "Box") cpt
cpt {id, text} _ = do
renameNodeName <- R.useState' text
pure $ H.div {className: "from-group row-no-padding"}
[ textInput renameNodeName
, submitBtn renameNodeName
, cancelBtn
]
where
textInput (_ /\ setRenameNodeName) =
H.div {className: "col-md-8"}
[ H.input { type: "text"
, placeholder: (boxName <> " Node")
, defaultValue: text
, className: "form-control"
, onInput: mkEffectFn1 $ setRenameNodeName
<<< const
<<< R2.unsafeEventValue
}
]
submitBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setIsOpen $ const false
launchAff $ dispatch ( boxAction newName )
, title: "Submit"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setIsOpen $ const false
, title: "Cancel"
} []
textInputBox p@{ boxName, isOpen: (false /\ _) } = R.createElement el p []
where
el = R.hooksComponent (boxName <> "Box") cpt
cpt {text} _ = pure $ H.div {} []
-- | END Rename Box
submitButton :: Action -> (Action -> Aff Unit) -> R.Element
submitButton action dispatch =
H.div {className: "panel-footer"}
[ H.div {} []
, H.div { className: "center"}
[ H.button { className : "btn btn-primary fa fa-" <> icon action
, type: "button"
, style : { width: "50%" }
, id: S.toLower $ show action
, title: show action
, on: {click: \_ -> launchAff $ dispatch action}
}
[ H.text $ " " <> text action]
]
]
-- | Sugar Text style
fragmentPT :: String -> R.Element
fragmentPT text = H.div {style: {margin: "10px"}} [H.text text]
src/Gargantext/Components/Login.purs
View file @ 62a4eacb
......@@ -63,7 +63,7 @@ modalCpt = R.hooksComponent "G.C.Login.modal" cpt where
[ H.h2 {className: "text-primary center m-a-2"}
[
-- H.i {className: "material-icons md-36"} [ H.text "control_point" ]
H.span {className: "icon-text"} [ H.text "Gargantext" ] ] ]
H.span {className: "icon-text"} [ H.text "GarganText" ] ] ]
closing = H.button { "type": "button", className: "close"
, "data": { dismiss: "modal" } }
......@@ -208,8 +208,10 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where
csrfTokenInput :: {} -> R.Element
csrfTokenInput _ =
H.input { type: "hidden", name: "csrfmiddlewaretoken"
, value: csrfMiddlewareToken }-- TODO hard-coded CSRF token
H.input { type: "hidden"
, name: "csrfmiddlewaretoken"
, value: csrfMiddlewareToken
} -- TODO hard-coded CSRF token
termsCheckbox :: R.State Boolean -> R.Element
termsCheckbox setCheckBox =
......
src/Gargantext/Components/NgramsTable.purs
View file @ 62a4eacb
......@@ -226,19 +226,27 @@ tableContainerCpt { dispatch
editor = H.div {} $ maybe [] f ngramsParent
where
f ngrams = [
H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, NTC.renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
, H.button {className: "btn btn-primary", on: {click: (const $ dispatch AddTermChildren)}} [H.text "Save"]
, H.button {className: "btn btn-secondary", on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}} [H.text "Cancel"]
]
f ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, NTC.renderNgramsTree { ngramsTable
, ngrams
, ngramsStyle: []
, ngramsClick
, ngramsEdit
}
, H.button { className: "btn btn-primary"
, on: {click: (const $ dispatch AddTermChildren)}
} [H.text "Save"]
, H.button { className: "btn btn-secondary"
, on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
} [H.text "Cancel"]
]
where
ngramsTable = ngramsTableCache # at ngrams
<<< _Just
<<< _NgramsElement
<<< _children
%~ applyPatchSet (patchSetFromMap ngramsChildren)
ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild true child
ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
ngramsClick _ = Nothing
ngramsEdit _ = Nothing
......
src/Gargantext/Prelude.purs
View file @ 62a4eacb
module Gargantext.Prelude (module Prelude, logs)
module Gargantext.Prelude (module Prelude, logs, id)
where
import Prelude (class Applicative, class Apply, class Bind, class BooleanAlgebra, class Bounded, class Category, class CommutativeRing, class Discard, class DivisionRing, class Eq, class EuclideanRing, class Field, class Functor, class HeytingAlgebra, class Monad, class Monoid, class Ord, class Ring, class Semigroup, class Semigroupoid, class Semiring, class Show, type (~>), Ordering(..), Unit, Void, absurd, add, ap, append, apply, between, bind, bottom, clamp, compare, comparing, compose, conj, const, degree, discard, disj, eq, flap, flip, gcd, identity, ifM, join, lcm, liftA1, liftM1, map, max, mempty, min, mod, mul, negate, not, notEq, one, otherwise, pure, recip, show, sub, top, unit, unless, unlessM, void, when, whenM, zero, (#), ($), ($>), (&&), (*), (*>), (+), (-), (/), (/=), (<), (<#>), (<$), (<$>), (<*), (<*>), (<<<), (<=), (<=<), (<>), (<@>), (=<<), (==), (>), (>=), (>=>), (>>=), (>>>), (||))
......@@ -6,6 +6,15 @@ import Effect.Console (log)
import Effect.Class (class MonadEffect, liftEffect)
-- | JL: Astonishingly, not in the prelude
-- AD: recent Preludes in Haskell much prefer identity
-- then id can be used as a variable name (in records for instance)
-- since records in Purescript are not the same as in Haskell
-- this behavior is questionable indeed.
id :: forall a. a -> a
id a = a
logs:: forall message effect.
(MonadEffect effect)
=> Show message
......
src/Gargantext/Types.purs
View file @ 62a4eacb
......@@ -15,6 +15,10 @@ import Effect.Aff (Aff)
import Prim.Row (class Union)
import URI.Query (Query)
type ID = Int
type Name = String
type Reload = Int
newtype SessionId = SessionId String
type NodeID = Int
......@@ -436,7 +440,10 @@ instance showTabType :: Show TabType where
type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a)
data Mode = Authors | Sources | Institutes | Terms
data Mode = Authors
| Sources
| Institutes
| Terms
derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where
......@@ -467,6 +474,7 @@ data AsyncTaskType = Form
| GraphT
| Query
| AddNode
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
instance eqAsyncTaskType :: Eq AsyncTaskType where
eq = genericEq
......@@ -492,7 +500,13 @@ asyncTaskTypePath AddNode = "async/nobody/"
type AsyncTaskID = String
data AsyncTaskStatus = Running | Pending | Received | Started | Failed | Finished | Killed
data AsyncTaskStatus = Running
| Pending
| Received
| Started
| Failed
| Finished
| Killed
derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
instance showAsyncTaskStatus :: Show AsyncTaskStatus where
show = genericShow
......@@ -514,10 +528,11 @@ readAsyncTaskStatus "IsRunning" = Running
readAsyncTaskStatus "IsStarted" = Started
readAsyncTaskStatus _ = Running
newtype AsyncTask = AsyncTask {
id :: AsyncTaskID
, status :: AsyncTaskStatus
}
newtype AsyncTask =
AsyncTask { id :: AsyncTaskID
, status :: AsyncTaskStatus
}
derive instance genericAsyncTask :: Generic AsyncTask _
instance eqAsyncTask :: Eq AsyncTask where
eq = genericEq
......@@ -528,8 +543,8 @@ instance encodeJsonAsyncTask :: EncodeJson AsyncTask where
~> jsonEmptyObject
instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
obj <- decodeJson json
id <- obj .: "id"
status <- obj .: "status"
pure $ AsyncTask { id, status }
......@@ -547,9 +562,9 @@ instance encodeJsonAsyncTaskWithType :: EncodeJson AsyncTaskWithType where
~> jsonEmptyObject
instance decodeJsonAsyncTaskWithType :: DecodeJson AsyncTaskWithType where
decodeJson json = do
obj <- decodeJson json
obj <- decodeJson json
task <- obj .: "task"
typ <- obj .: "typ"
typ <- obj .: "typ"
pure $ AsyncTaskWithType { task, typ }
newtype AsyncProgress = AsyncProgress {
......@@ -560,9 +575,9 @@ newtype AsyncProgress = AsyncProgress {
derive instance genericAsyncProgress :: Generic AsyncProgress _
instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
log <- obj .: "log"
obj <- decodeJson json
id <- obj .: "id"
log <- obj .: "log"
status <- obj .: "status"
pure $ AsyncProgress {id, log, status}
......@@ -575,9 +590,9 @@ newtype AsyncTaskLog = AsyncTaskLog {
derive instance genericAsyncTaskLog :: Generic AsyncTaskLog _
instance decodeJsonAsyncTaskLog :: DecodeJson AsyncTaskLog where
decodeJson json = do
obj <- decodeJson json
events <- obj .: "events"
failed <- obj .: "failed"
obj <- decodeJson json
events <- obj .: "events"
failed <- obj .: "failed"
remaining <- obj .: "remaining"
succeeded <- obj .: "succeeded"
pure $ AsyncTaskLog {events, failed, remaining, succeeded}
......
src/Gargantext/Utils.purs
View file @ 62a4eacb
......@@ -7,9 +7,9 @@ import Data.Set as Set
import Data.Set (Set)
import Data.String as S
-- | Astonishingly, not in the prelude
id :: forall a. a -> a
id a = a
-- | TODO (hard coded)
csrfMiddlewareToken :: String
csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
setterv :: forall nt record field.
Newtype nt record
......@@ -45,15 +45,12 @@ invertOrdering LT = GT
invertOrdering GT = LT
invertOrdering EQ = EQ
csrfMiddlewareToken :: String
csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
-- A lens that always returns unit
_unit :: forall s. Lens' s Unit
_unit = lens (\_ -> unit) (\s _ -> s)
glyphicon :: String -> String
glyphicon t = "btn glyphitem glyphicon glyphicon-" <> t
glyphicon t = "btn glyphitem fa fa-" <> t
glyphiconActive :: String -> Boolean -> String
glyphiconActive icon b = glyphicon icon <> if b then " active" else ""
......
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