Commit 5c5b4641 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-doc-table-optimization

parents 756153d5 2ee876fb
...@@ -2675,6 +2675,15 @@ ...@@ -2675,6 +2675,15 @@
"repo": "https://github.com/reactormonk/purescript-simple-timestamp.git", "repo": "https://github.com/reactormonk/purescript-simple-timestamp.git",
"version": "v1.3.0" "version": "v1.3.0"
}, },
"simplecrypto": {
"dependencies": [
"prelude",
"maybe",
"node-buffer"
],
"repo": "https://github.com/alpacaaa/purescript-simplecrypto",
"version": "v1.0.1"
},
"sized-vectors": { "sized-vectors": {
"dependencies": [ "dependencies": [
"arrays", "arrays",
......
...@@ -838,6 +838,15 @@ ...@@ -838,6 +838,15 @@
sha256 = "10fkkmmb7qh4p5gmgb6xpxh9g8hy06ddy8cyfrs3py8a5b8h46hw"; sha256 = "10fkkmmb7qh4p5gmgb6xpxh9g8hy06ddy8cyfrs3py8a5b8h46hw";
}; };
}; };
"simplecrypto" = {
name = "simplecrypto";
version = "v1.0.1";
src = pkgs.fetchgit {
url = "https://github.com/alpacaaa/purescript-simplecrypto";
rev = "v1.0.1";
sha256 = "0rzjzwn4s7pb8f9hm9wkl1gza9y2y9qn1116s6x5lizv81q48cyw";
};
};
"smolder" = { "smolder" = {
name = "smolder"; name = "smolder";
version = "v12.0.0"; version = "v12.0.0";
......
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.1.6.6", "version": "0.0.1.7.1",
"scripts": { "scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall", "rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall", "rebuild-set": "spago psc-package-insdhall",
...@@ -13,10 +13,12 @@ ...@@ -13,10 +13,12 @@
"clean": "rm -Rf output node_modules", "clean": "rm -Rf output node_modules",
"clean-js": "rm -Rf node_modules", "clean-js": "rm -Rf node_modules",
"clean-ps": "rm -Rf output", "clean-ps": "rm -Rf output",
"test": "pulp test", "test": "pulp test --no-check-main",
"server": "serve dist" "server": "serve dist"
}, },
"dependencies": { "dependencies": {
"aes-js": "^3.1.1",
"base-x": "^3.0.2",
"create-react-class": "^15.6.3", "create-react-class": "^15.6.3",
"echarts": "^4.1.0", "echarts": "^4.1.0",
"echarts-for-react": "^2.0.14", "echarts-for-react": "^2.0.14",
...@@ -25,6 +27,7 @@ ...@@ -25,6 +27,7 @@
"react": "^16.10", "react": "^16.10",
"react-awesome-popover": "^6.1.1", "react-awesome-popover": "^6.1.1",
"react-dom": "^16.10", "react-dom": "^16.10",
"secp256k1": "^3.3.0",
"sigma": "git://github.com/poorscript/sigma.js#garg" "sigma": "git://github.com/poorscript/sigma.js#garg"
}, },
"devDependencies": { "devDependencies": {
......
...@@ -140,6 +140,11 @@ let additions = ...@@ -140,6 +140,11 @@ let additions =
[ "prelude" ] [ "prelude" ]
"https://github.com/hdgarrood/purescript-versions.git" "https://github.com/hdgarrood/purescript-versions.git"
"v5.0.1" "v5.0.1"
, simplecrypto =
mkPackage
[ "prelude", "maybe", "node-buffer"]
"https://github.com/alpacaaa/purescript-simplecrypto"
"v1.0.1"
} }
in upstream ⫽ overrides ⫽ additions in upstream ⫽ overrides ⫽ additions
...@@ -3,8 +3,8 @@ ...@@ -3,8 +3,8 @@
"set": "local", "set": "local",
"source": ".psc-package/local/.set/packages.json", "source": ".psc-package/local/.set/packages.json",
"depends": [ "depends": [
"affjax",
"aff-promise", "aff-promise",
"affjax",
"argonaut", "argonaut",
"console", "console",
"css", "css",
...@@ -12,8 +12,8 @@ ...@@ -12,8 +12,8 @@
"dom-filereader", "dom-filereader",
"dom-simple", "dom-simple",
"effect", "effect",
"foreign-object",
"foreign-generic", "foreign-generic",
"foreign-object",
"generics-rep", "generics-rep",
"globals", "globals",
"integers", "integers",
...@@ -32,6 +32,7 @@ ...@@ -32,6 +32,7 @@
"record-extra", "record-extra",
"routing", "routing",
"sequences", "sequences",
"simplecrypto",
"smolder", "smolder",
"spec-discovery", "spec-discovery",
"spec-quickcheck", "spec-quickcheck",
......
module Gargantext.Components.App where module Gargantext.Components.App where
import Prelude
import Data.Array (fromFoldable) import Data.Array (fromFoldable)
import Data.Foldable (intercalate) import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe') import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.License (license)
import Gargantext.Components.Lang (LandingLang(..))
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout) import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Lang (LandingLang(..))
import Gargantext.Components.Login (login) import Gargantext.Components.Login (login)
import Gargantext.Components.Nodes.Annuaire (annuaireLayout) import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout) import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout) import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout) import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout) import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout) import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout) import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout) import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Config (defaultFrontends, defaultBackends) import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Router (useHashRouter) import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.License (license)
import Gargantext.Router (router) import Gargantext.Router (router)
import Gargantext.Routes (AppRoute(..)) import Gargantext.Routes (AppRoute(..))
import Gargantext.Sessions (Sessions, useSessions) import Gargantext.Sessions (Sessions, useSessions)
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Version as GV import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
-- TODO (what does this mean?) -- TODO (what does this mean?)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc -- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
...@@ -251,59 +245,21 @@ liNav (LiNav { title : title' ...@@ -251,59 +245,21 @@ liNav (LiNav { title : title'
] ]
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
-- | TODO put Version in the Tree/Root node type FooterProps =
type VersionProps =
( (
session :: Sessions.Session session :: Sessions.Session
) )
version :: Record VersionProps -> R.Element footer :: Record FooterProps -> R.Element
version props = R.createElement versionCpt props []
versionCpt :: R.Component VersionProps
versionCpt = R.hooksComponent "G.C.A.version" cpt
where
cpt { session } _ = do
(ver /\ setVer) <- R.useState' "No Backend Version"
R.useEffect' $ do
launchAff_ $ do
v <- GV.getBackendVersion session
liftEffect $ setVer $ const v
pure $ H.div { className: "row" }
[ H.div { className: versionCheck GV.version ver}
[ H.h4 {} [H.text $ versionMessage GV.version ver]
, H.div { className: "container" } [showVersions GV.version ver]
]
]
where
versionCheck v1 v2 = case v1 == v2 of
false -> "col alert alert-danger"
true -> "col alert alert-success"
versionMessage v1 v2 = case v1 == v2 of
false -> "Versions do not match"
true -> "Versions are up to date"
showVersions frontendVer backendVer =
H.div { className: "row" }
[ H.h5 {} [ H.text $ "Frontend version: " <> frontendVer ]
, H.h5 {} [ H.text $ "Backend version: " <> backendVer ]
]
footer :: Record VersionProps -> R.Element
footer props = R.createElement footerCpt props [] footer props = R.createElement footerCpt props []
footerCpt :: R.Component VersionProps footerCpt :: R.Component FooterProps
footerCpt = R.hooksComponent "G.C.A.footer" cpt footerCpt = R.hooksComponent "G.C.A.footer" cpt
where where
cpt { session } _ = do cpt { session } _ = do
pure $ H.div pure $ H.div
{ className: "container" } { className: "container" }
[ H.hr {} [ H.hr {}
, H.footer {} [ version { session } , H.footer {} [ license ]
, license
]
] ]
...@@ -363,18 +363,18 @@ loadPage session { corpusId, listId, nodeId, query, tabType } = do ...@@ -363,18 +363,18 @@ loadPage session { corpusId, listId, nodeId, query, tabType } = do
--liftEffect $ log3 "loading documents page: loadPage with Offset and limit" offset limit --liftEffect $ log3 "loading documents page: loadPage with Offset and limit" offset limit
-- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId) -- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
let p = NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) let p = NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType)
HashedResponse { md5, value: res } <- (get session p) :: Aff (HashedResponse (TableResult Response)) HashedResponse { hash, value: res } <- (get session p) :: Aff (HashedResponse (TableResult Response))
let docs = res2corpus <$> res.docs let docs = res2corpus <$> res.docs
let ret = if mock then let ret = if mock then
--Tuple 0 (take limit $ drop offset sampleData) --Tuple 0 (take limit $ drop offset sampleData)
Tuple 0 sampleData Tuple 0 sampleData
else else
Tuple res.count docs Tuple res.count docs
pure $ HashedResponse { md5, value: ret } pure $ HashedResponse { hash, value: ret }
getPageMD5 :: Session -> PageParams -> Aff String getPageHash :: Session -> PageParams -> Aff String
getPageMD5 session { corpusId, listId, nodeId, query, tabType } = do getPageHash session { corpusId, listId, nodeId, query, tabType } = do
let p = NodeAPI Node (Just nodeId) $ "table/md5" <> "?tabType=" <> (showTabType' tabType) let p = NodeAPI Node (Just nodeId) $ "table/hash" <> "?tabType=" <> (showTabType' tabType)
(get session p) :: Aff String (get session p) :: Aff String
...@@ -404,9 +404,9 @@ pageLayoutCpt :: R.Component PageLayoutProps ...@@ -404,9 +404,9 @@ pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponent "G.C.DocsTable.pageLayout" cpt where pageLayoutCpt = R.hooksComponent "G.C.DocsTable.pageLayout" cpt where
cpt props@{frontends, session, nodeId, listId, corpusId, tabType, query, params} _ = cpt props@{frontends, session, nodeId, listId, corpusId, tabType, query, params} _ =
-- useLoader path (loadPage session) paint -- useLoader path (loadPage session) paint
--useLoaderWithCache path keyFunc (getPageMD5 session) (loadPage session) paint -- useLoaderWithCache path keyFunc (getPageHash session) (loadPage session) paint
useLoaderWithCacheAPI { useLoaderWithCacheAPI {
cacheEndpoint: getPageMD5 session cacheEndpoint: getPageHash session
, handleResponse , handleResponse
, mkRequest , mkRequest
, path , path
...@@ -424,7 +424,7 @@ pageLayoutCpt = R.hooksComponent "G.C.DocsTable.pageLayout" cpt where ...@@ -424,7 +424,7 @@ pageLayoutCpt = R.hooksComponent "G.C.DocsTable.pageLayout" cpt where
mkRequest p@{ listId, nodeId, tabType } = mkRequest p@{ listId, nodeId, tabType } =
GUC.makeGetRequest session $ NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) <> "&list=" <> (show listId) GUC.makeGetRequest session $ NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) <> "&list=" <> (show listId)
handleResponse :: HashedResponse (TableResult Response) -> Tuple Int (Array DocumentsView) handleResponse :: HashedResponse (TableResult Response) -> Tuple Int (Array DocumentsView)
handleResponse (HashedResponse { md5, value: res }) = ret handleResponse (HashedResponse { hash, value: res }) = ret
where where
docs = res2corpus <$> res.docs docs = res2corpus <$> res.docs
ret = if mock then ret = if mock then
......
...@@ -63,7 +63,7 @@ forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where ...@@ -63,7 +63,7 @@ forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
plus :: R2.Setter Boolean -> R.Element plus :: R2.Setter Boolean -> R.Element
plus showLogin = plus showLogin =
H.button { on: {click} H.button { on: {click}
, className: "btn btn-primary" , className: "btn btn-default"
} }
[ H.div { "type": "" [ H.div { "type": ""
, className: "fa fa-universal-access fa-lg" , className: "fa fa-universal-access fa-lg"
......
...@@ -18,12 +18,12 @@ import Gargantext.Components.Forest.Tree.Node (nodeMainSpan) ...@@ -18,12 +18,12 @@ import Gargantext.Components.Forest.Tree.Node (nodeMainSpan)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode) import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode) import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNodeReq) import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq) import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq) import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename) 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.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest) import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..)) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
...@@ -33,7 +33,7 @@ import Gargantext.Hooks.Loader (useLoader) ...@@ -33,7 +33,7 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>)) import Gargantext.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>))
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get) import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
import Gargantext.Types (ID, Reload) import Gargantext.Types (ID, Reload, isPublic, publicize)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Routes as GR import Gargantext.Routes as GR
...@@ -192,7 +192,11 @@ toHtml p@{ asyncTasks ...@@ -192,7 +192,11 @@ toHtml p@{ asyncTasks
} ] } ]
<> childNodes ( Record.merge commonProps <> childNodes ( Record.merge commonProps
{ asyncTasks { asyncTasks
, children: ary , children: if isPublic nodeType
then map (\t -> map (\(LNode n@{ nodeType:nt } )
-> (LNode (n { nodeType= publicize nt }))
) t) ary
else ary
, folderOpen , folderOpen
} }
) )
...@@ -232,13 +236,17 @@ type PerformActionProps = ...@@ -232,13 +236,17 @@ type PerformActionProps =
performAction :: Action performAction :: Action
-> Record PerformActionProps -> Record PerformActionProps
-> Aff Unit -> Aff Unit
performAction DeleteNode p@{ openNodes: (_ /\ setOpenNodes) performAction (DeleteNode nt) p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload) , reload: (_ /\ setReload)
, session , session
, tree: (NTree (LNode {id}) _) , tree: (NTree (LNode {id, parent_id}) _)
} = } =
do do
void $ deleteNode session id case nt of
GT.NodePublic GT.FolderPublic -> void $ deleteNode session nt id
GT.NodePublic _ -> void $ unpublishNode session parent_id id
_ -> void $ deleteNode session nt id
liftEffect $ setOpenNodes (Set.delete (mkNodeId session id)) liftEffect $ setOpenNodes (Set.delete (mkNodeId session id))
performAction RefreshTree p performAction RefreshTree p
...@@ -274,12 +282,22 @@ performAction (RenameNode name) p@{ reload: (_ /\ setReload) ...@@ -274,12 +282,22 @@ performAction (RenameNode name) p@{ reload: (_ /\ setReload)
performAction RefreshTree p performAction RefreshTree p
------- -------
performAction (ShareNode username) p@{ reload: (_ /\ setReload) performAction (ShareTeam username) p@{ reload: (_ /\ setReload)
, session , session
, tree: (NTree (LNode {id}) _) , tree: (NTree (LNode {id}) _)
} = } =
do do
void $ share session id $ ShareValue {text:username} void $ Share.shareReq session id $ Share.ShareTeamParams {username}
performAction (SharePublic {params}) p@{ session
, openNodes: (_ /\ setOpenNodes)
} =
case params of
Nothing -> performAction NoAction p
Just (SubTreeOut {in:inId,out}) -> do
void $ Share.shareReq session inId $ Share.SharePublicParams {node_id:out}
liftEffect $ setOpenNodes (Set.insert (mkNodeId session out))
performAction RefreshTree p
------- -------
performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes) performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
......
...@@ -22,6 +22,7 @@ import Gargantext.Ends (Frontends, url) ...@@ -22,6 +22,7 @@ import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, unit, void, ($), (<>), (==)) import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, unit, void, ($), (<>), (==))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Version as GV
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (Name, ID) import Gargantext.Types (Name, ID)
import Gargantext.Types as GT import Gargantext.Types as GT
...@@ -88,6 +89,9 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el ...@@ -88,6 +89,9 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
} }
) tasks ) tasks
) )
, if nodeType == GT.NodeUser
then GV.versionView {session}
else H.div {} []
] ]
where where
SettingsBox {show: showBox} = settingsBox nodeType SettingsBox {show: showBox} = settingsBox nodeType
...@@ -96,6 +100,7 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el ...@@ -96,6 +100,7 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
name' {name, nodeType} = if nodeType == GT.NodeUser name' {name, nodeType} = if nodeType == GT.NodeUser
then show session then show session
else name else name
chevronIcon nodeType folderOpen'@(open /\ _) = chevronIcon nodeType folderOpen'@(open /\ _) =
H.a { className: "chevron-icon" H.a { className: "chevron-icon"
, onClick: R2.effToggler folderOpen' , onClick: R2.effToggler folderOpen'
...@@ -230,6 +235,8 @@ mAppRouteId (Just (Routes.Texts _ id)) = Just id ...@@ -230,6 +235,8 @@ mAppRouteId (Just (Routes.Texts _ id)) = Just id
mAppRouteId (Just (Routes.Lists _ id)) = Just id mAppRouteId (Just (Routes.Lists _ id)) = Just id
mAppRouteId (Just (Routes.Annuaire _ id)) = Just id mAppRouteId (Just (Routes.Annuaire _ id)) = Just id
mAppRouteId (Just (Routes.UserPage _ id)) = Just id mAppRouteId (Just (Routes.UserPage _ id)) = Just id
mAppRouteId (Just (Routes.RouteFrameWrite _ id)) = Just id
mAppRouteId (Just (Routes.RouteFrameCalc _ id)) = Just id
mAppRouteId (Just (Routes.Document _ id _ )) = Just id mAppRouteId (Just (Routes.Document _ id _ )) = Just id
mAppRouteId (Just (Routes.ContactPage _ id _ )) = Just id mAppRouteId (Just (Routes.ContactPage _ id _ )) = Just id
mAppRouteId (Just (Routes.CorpusDocument _ id _ _)) = Just id mAppRouteId (Just (Routes.CorpusDocument _ id _ _)) = Just id
......
...@@ -20,15 +20,16 @@ type Props = ...@@ -20,15 +20,16 @@ type Props =
data Action = AddNode String GT.NodeType data Action = AddNode String GT.NodeType
| DeleteNode | DeleteNode GT.NodeType
| RenameNode String | RenameNode String
| UpdateNode UpdateNodeParams | UpdateNode UpdateNodeParams
| ShareNode String
| DoSearch GT.AsyncTaskWithType | DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents | UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| DownloadNode | DownloadNode
| RefreshTree | RefreshTree
| ShareTeam String
| SharePublic {params :: Maybe SubTreeOut}
| MoveNode {params :: Maybe SubTreeOut} | MoveNode {params :: Maybe SubTreeOut}
| MergeNode {params :: Maybe SubTreeOut} | MergeNode {params :: Maybe SubTreeOut}
| LinkNode {params :: Maybe SubTreeOut} | LinkNode {params :: Maybe SubTreeOut}
...@@ -40,21 +41,24 @@ subTreeOut :: Action -> Maybe SubTreeOut ...@@ -40,21 +41,24 @@ subTreeOut :: Action -> Maybe SubTreeOut
subTreeOut (MoveNode {params}) = params subTreeOut (MoveNode {params}) = params
subTreeOut (MergeNode {params}) = params subTreeOut (MergeNode {params}) = params
subTreeOut (LinkNode {params}) = params subTreeOut (LinkNode {params}) = params
subTreeOut (SharePublic {params}) = params
subTreeOut _ = Nothing subTreeOut _ = Nothing
setTreeOut :: Action -> Maybe SubTreeOut -> Action setTreeOut :: Action -> Maybe SubTreeOut -> Action
setTreeOut (MoveNode {params:_}) p = MoveNode {params: p} setTreeOut (MoveNode {params:_}) p = MoveNode {params: p}
setTreeOut (MergeNode {params:_}) p = MergeNode {params: p} setTreeOut (MergeNode {params:_}) p = MergeNode {params: p}
setTreeOut (LinkNode {params:_}) p = LinkNode {params: p} setTreeOut (LinkNode {params:_}) p = LinkNode {params: p}
setTreeOut (SharePublic {params:_}) p = SharePublic {params: p}
setTreeOut a _ = a setTreeOut a _ = a
instance showShow :: Show Action where instance showShow :: Show Action where
show (AddNode _ _ )= "AddNode" show (AddNode _ _ )= "AddNode"
show DeleteNode = "DeleteNode" show (DeleteNode _ )= "DeleteNode"
show (RenameNode _ )= "RenameNode" show (RenameNode _ )= "RenameNode"
show (UpdateNode _ )= "UpdateNode" show (UpdateNode _ )= "UpdateNode"
show (ShareNode _ )= "ShareNode" show (ShareTeam _ )= "ShareTeam"
show (SharePublic _ )= "SharePublic"
show (DoSearch _ )= "SearchQuery" show (DoSearch _ )= "SearchQuery"
show (UploadFile _ _ _ _)= "UploadFile" show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree" show RefreshTree = "RefreshTree"
...@@ -67,10 +71,11 @@ instance showShow :: Show Action where ...@@ -67,10 +71,11 @@ instance showShow :: Show Action where
----------------------------------------------------------------------- -----------------------------------------------------------------------
icon :: Action -> String icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add []) icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon DeleteNode = glyphiconNodeAction Delete icon (DeleteNode _) = glyphiconNodeAction Delete
icon (RenameNode _) = glyphiconNodeAction Config icon (RenameNode _) = glyphiconNodeAction Config
icon (UpdateNode _) = glyphiconNodeAction Refresh icon (UpdateNode _) = glyphiconNodeAction Refresh
icon (ShareNode _) = glyphiconNodeAction Share icon (ShareTeam _) = glyphiconNodeAction Share
icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (DoSearch _) = glyphiconNodeAction SearchBox icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh icon RefreshTree = glyphiconNodeAction Refresh
...@@ -85,10 +90,11 @@ icon NoAction = "hand-o-right" ...@@ -85,10 +90,11 @@ icon NoAction = "hand-o-right"
text :: Action -> String text :: Action -> String
text (AddNode _ _ )= "Add !" text (AddNode _ _ )= "Add !"
text DeleteNode = "Delete !" text (DeleteNode _ )= "Delete !"
text (RenameNode _ )= "Rename !" text (RenameNode _ )= "Rename !"
text (UpdateNode _ )= "Update !" text (UpdateNode _ )= "Update !"
text (ShareNode _ )= "Share !" text (ShareTeam _ )= "Share with team !"
text (SharePublic _ )= "Publish !"
text (DoSearch _ )= "Launch search !" text (DoSearch _ )= "Launch search !"
text (UploadFile _ _ _ _)= "Upload File !" text (UploadFile _ _ _ _)= "Upload File !"
text RefreshTree = "Refresh Tree !" text RefreshTree = "Refresh Tree !"
......
module Gargantext.Components.Forest.Tree.Node.Action.Add where module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>)) import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array (head) import Data.Array (head, length)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox) import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, formEdit, formChoiceSafe, panel) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, formEdit, formChoiceSafe, panel)
import Gargantext.Prelude (Unit, bind, pure, show, ($), (<>)) import Gargantext.Prelude (Unit, bind, pure, show, ($), (<>), (>))
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT import Gargantext.Types as GT
...@@ -61,17 +61,26 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p [] ...@@ -61,17 +61,26 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
el = R.hooksComponent "AddNodeView" cpt el = R.hooksComponent "AddNodeView" cpt
cpt {id, name} _ = do cpt {id, name} _ = do
nodeName@(name' /\ setNodeName) <- R.useState' "Name" nodeName@(name' /\ setNodeName) <- R.useState' "Name"
nodeType'@(nt /\ setNodeType) <- R.useState' $ fromMaybe NodeUser $ head nodeTypes nodeType'@(nt /\ setNodeType) <- R.useState' $ fromMaybe Folder $ head nodeTypes
let let
SettingsBox {edit} = settingsBox nt SettingsBox {edit} = settingsBox nt
maybeChoose = [ formChoiceSafe nodeTypes Error setNodeType ] (maybeChoose /\ nt') = if length nodeTypes > 1
then ([ formChoiceSafe nodeTypes Error setNodeType ] /\ nt)
else ([H.div {} [H.text $ "Creating a node of type "
<> show defaultNt
<> " with name:"
]
] /\ defaultNt
)
where
defaultNt = (fromMaybe Error $ head nodeTypes)
maybeEdit = [ if edit maybeEdit = [ if edit
then formEdit "Node Name" setNodeName then formEdit "Node Name" setNodeName
else H.div {} [] else H.div {} []
] ]
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt) dispatch) pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt') dispatch)
-- END Create Node -- END Create Node
......
...@@ -5,7 +5,7 @@ import Data.Maybe (Maybe(..)) ...@@ -5,7 +5,7 @@ import Data.Maybe (Maybe(..))
import Gargantext.Prelude import Gargantext.Prelude
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Sessions (Session, delete) import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
...@@ -14,8 +14,20 @@ import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) ...@@ -14,8 +14,20 @@ import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
-- TODO Delete with asyncTaskWithType -- TODO Delete with asyncTaskWithType
deleteNode :: Session -> GT.ID -> Aff GT.ID deleteNode :: Session -> NodeType -> GT.ID -> Aff GT.ID
deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) "" deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
{-
case nt of
NodePublic FolderPublic -> delete session $ NodeAPI GT.Node (Just nodeId) ""
NodePublic _ -> put_ session $ NodeAPI GT.Node (Just nodeId) "unpublish"
_ -> delete session $ NodeAPI GT.Node (Just nodeId) ""
-}
type ParentID = GT.ID
unpublishNode :: Session -> Maybe ParentID -> GT.ID -> Aff GT.ID
unpublishNode s p n = put_ s $ NodeAPI GT.Node p ("unpublish/" <> show n)
-- | Action : Delete -- | Action : Delete
actionDelete :: NodeType -> (Action -> Aff Unit) -> R.Hooks R.Element actionDelete :: NodeType -> (Action -> Aff Unit) -> R.Hooks R.Element
...@@ -29,7 +41,7 @@ actionDelete NodeUser _ = do ...@@ -29,7 +41,7 @@ actionDelete NodeUser _ = do
] ]
(H.div {} []) (H.div {} [])
actionDelete _ dispatch = do actionDelete nt dispatch = do
pure $ panel [ H.div {style: {margin: "10px"}} pure $ panel [ H.div {style: {margin: "10px"}}
(map (\t -> H.p {} [H.text t]) (map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?" [ "Are your sure you want to delete it ?"
...@@ -37,7 +49,7 @@ actionDelete _ dispatch = do ...@@ -37,7 +49,7 @@ actionDelete _ dispatch = do
] ]
) )
] ]
(submitButton DeleteNode dispatch) (submitButton (DeleteNode nt) dispatch)
......
...@@ -5,31 +5,87 @@ import Data.Maybe (Maybe(..)) ...@@ -5,31 +5,87 @@ import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Prelude (($)) import Prelude (($))
import Reactix as R import Reactix as R
import Gargantext.Components.Forest.Tree.Node.Action import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Types (ID) import Gargantext.Types (ID)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Components.Forest.Tree.Node.Tools as Tools import Gargantext.Components.Forest.Tree.Node.Tools as Tools
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.Action as Action
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
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.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Read, class Show)
------------------------------------------------------------------------ ------------------------------------------------------------------------
share :: Session -> ID -> ShareValue -> Aff (Array ID) shareReq :: Session -> ID -> ShareNodeParams -> Aff ID
share session nodeId = shareReq session nodeId =
post session $ GR.NodeAPI GT.Node (Just nodeId) "share" post session $ GR.NodeAPI GT.Node (Just nodeId) "share"
shareAction :: String -> Action shareAction :: String -> Action
shareAction username = ShareNode username shareAction username = Action.ShareTeam username
------------------------------------------------------------------------
textInputBox :: Record Tools.TextInputBoxProps -> R.Element
textInputBox = Tools.textInputBox
------------------------------------------------------------------------ ------------------------------------------------------------------------
newtype ShareValue = ShareValue data ShareNodeParams = ShareTeamParams { username :: String }
{ text :: String } | SharePublicParams { node_id :: Int }
derive instance eqShareNodeParams :: Eq ShareNodeParams
derive instance genericShareNodeParams :: Generic ShareNodeParams _
instance showShareNodeParams :: Show ShareNodeParams where
show = genericShow
instance decodeJsonShareNodeParams :: Argonaut.DecodeJson ShareNodeParams where
decodeJson = genericSumDecodeJson
instance encodeJsonShareNodeParams :: Argonaut.EncodeJson ShareNodeParams where
encodeJson = genericSumEncodeJson
instance encodeJsonShareValue :: EncodeJson ShareValue where
encodeJson (ShareValue {text})
= "username" := text
~> jsonEmptyObject
------------------------------------------------------------------------ ------------------------------------------------------------------------
textInputBox :: Record Tools.TextInputBoxProps -> R.Element shareNode :: Record SubTreeParamsIn -> R.Element
textInputBox = Tools.textInputBox shareNode p = R.createElement shareNodeCpt p []
shareNodeCpt :: R.Component SubTreeParamsIn
shareNodeCpt = R.hooksComponent "G.C.F.T.N.A.M.shareNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session} _ = do
action@(valAction /\ setAction) :: R.State Action <- R.useState' (Action.SharePublic {params: Nothing})
let button = case valAction of
Action.SharePublic {params} -> case params of
Just val -> submitButton (Action.SharePublic {params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
pure $ panel [ subTreeView { action
, dispatch
, id
, nodeType
, session
, subTreeParams
}
] button
...@@ -215,12 +215,12 @@ buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt ...@@ -215,12 +215,12 @@ buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt
[] []
] ]
where where
{- -- This shows the Help of this button -- | Open the help indications if selected already
undo = setNodePopup doToDo = setNodePopup $ const $ node { action = todo' }
$ const (node { action = Nothing }) where
-} todo' = case action == Just todo of
true -> Nothing
doToDo = setNodePopup $ const $ node { action = Just todo } false -> Just todo
iconAStyle :: GT.NodeType -> NodeAction -> { iconAStyle :: GT.NodeType -> NodeAction -> {
color :: String color :: String
...@@ -297,6 +297,11 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt ...@@ -297,6 +297,11 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
, isOpen , isOpen
} }
] ]
cpt {action : Publish {subTreeParams}, dispatch, id, nodeType, session } _ = do
pure $ Share.shareNode {dispatch, id, nodeType, session, subTreeParams}
cpt props@{action: SearchBox, id, session, dispatch, nodePopup} _ = cpt props@{action: SearchBox, id, session, dispatch, nodePopup} _ =
actionSearch session (Just id) dispatch nodePopup actionSearch session (Just id) dispatch nodePopup
......
...@@ -20,6 +20,7 @@ data NodeAction = Documentation NodeType ...@@ -20,6 +20,7 @@ data NodeAction = Documentation NodeType
| Download | Upload | Refresh | Config | Download | Upload | Refresh | Config
| Delete | Delete
| Share | Share
| Publish { subTreeParams :: SubTreeParams }
| Add (Array NodeType) | Add (Array NodeType)
| Merge { subTreeParams :: SubTreeParams } | Merge { subTreeParams :: SubTreeParams }
| Move { subTreeParams :: SubTreeParams } | Move { subTreeParams :: SubTreeParams }
...@@ -41,6 +42,7 @@ instance eqNodeAction :: Eq NodeAction where ...@@ -41,6 +42,7 @@ instance eqNodeAction :: Eq NodeAction where
eq (Add x) (Add y) = x == y eq (Add x) (Add y) = x == y
eq (Merge x) (Merge y) = x == y eq (Merge x) (Merge y) = x == y
eq Config Config = true eq Config Config = true
eq (Publish x) (Publish y) = x == y
eq _ _ = false eq _ _ = false
instance showNodeAction :: Show NodeAction where instance showNodeAction :: Show NodeAction where
...@@ -57,7 +59,7 @@ instance showNodeAction :: Show NodeAction where ...@@ -57,7 +59,7 @@ instance showNodeAction :: Show NodeAction where
show (Link x) = "Link to " <> show x show (Link x) = "Link to " <> show x
show (Add xs) = foldl (\a b -> a <> show b) "Add " xs show (Add xs) = foldl (\a b -> a <> show b) "Add " xs
show (Merge t) = "Merge with subtree" <> show t show (Merge t) = "Merge with subtree" <> show t
show (Publish x) = "Publish" <> show x
glyphiconNodeAction :: NodeAction -> String glyphiconNodeAction :: NodeAction -> String
glyphiconNodeAction (Documentation _) = "question-circle" glyphiconNodeAction (Documentation _) = "question-circle"
...@@ -72,9 +74,9 @@ glyphiconNodeAction Refresh = "refresh" ...@@ -72,9 +74,9 @@ glyphiconNodeAction Refresh = "refresh"
glyphiconNodeAction Config = "wrench" glyphiconNodeAction Config = "wrench"
glyphiconNodeAction Share = "user-plus" glyphiconNodeAction Share = "user-plus"
glyphiconNodeAction (Move _) = "share-square-o" glyphiconNodeAction (Move _) = "share-square-o"
glyphiconNodeAction (Publish _) = fldr FolderPublic true
glyphiconNodeAction _ = "" glyphiconNodeAction _ = ""
------------------------------------------------------------------------ ------------------------------------------------------------------------
data SettingsBox = data SettingsBox =
SettingsBox { show :: Boolean SettingsBox { show :: Boolean
...@@ -133,11 +135,9 @@ settingsBox FolderShared = ...@@ -133,11 +135,9 @@ settingsBox FolderShared =
settingsBox FolderPublic = settingsBox FolderPublic =
SettingsBox { show : true SettingsBox { show : true
, edit : false , edit : true
, doc : Documentation FolderPublic , doc : Documentation FolderPublic
, buttons : [ Add [ Corpus , buttons : [ Add [ FolderPublic ]
, Folder
]
-- , Delete -- , Delete
] ]
} }
...@@ -190,15 +190,43 @@ settingsBox Texts = ...@@ -190,15 +190,43 @@ settingsBox Texts =
settingsBox Graph = settingsBox Graph =
SettingsBox { show : true SettingsBox { show : true
, edit : false , edit : true
, doc : Documentation Graph , doc : Documentation Graph
, buttons : [ Refresh , buttons : [ Refresh
, Config , Config
, Download -- TODO as GEXF or JSON , Download -- TODO as GEXF or JSON
, Publish publishParams
, Delete
]
}
settingsBox (NodePublic Graph) =
SettingsBox { show : true
, edit : true
, doc : Documentation Graph
, buttons : [ Download -- TODO as GEXF or JSON
, Delete , Delete
] ]
} }
settingsBox (NodePublic Dashboard) =
SettingsBox { show : true
, edit : true
, doc : Documentation Dashboard
, buttons : [ Delete
]
}
settingsBox (NodePublic FolderPublic) =
SettingsBox { show : true
, edit : true
, doc : Documentation FolderPublic
, buttons : [ Add [FolderPublic]
, Delete
]
}
settingsBox NodeList = settingsBox NodeList =
SettingsBox { show : true SettingsBox { show : true
, edit : false , edit : false
...@@ -227,6 +255,7 @@ settingsBox Dashboard = ...@@ -227,6 +255,7 @@ settingsBox Dashboard =
, edit : false , edit : false
, doc : Documentation Dashboard , doc : Documentation Dashboard
, buttons : [ Refresh , buttons : [ Refresh
, Publish publishParams
, Delete , Delete
] ]
} }
...@@ -249,6 +278,7 @@ settingsBox NodeFrameWrite = ...@@ -249,6 +278,7 @@ settingsBox NodeFrameWrite =
, buttons : [ Add [ NodeFrameWrite , buttons : [ Add [ NodeFrameWrite
, NodeFrameCalc , NodeFrameCalc
] ]
, Move moveFrameParameters
, Delete , Delete
] ]
} }
...@@ -261,6 +291,7 @@ settingsBox NodeFrameCalc = ...@@ -261,6 +291,7 @@ settingsBox NodeFrameCalc =
, buttons : [ Add [ NodeFrameCalc , buttons : [ Add [ NodeFrameCalc
, NodeFrameWrite , NodeFrameWrite
] ]
, Move moveFrameParameters
, Delete , Delete
] ]
} }
...@@ -290,6 +321,30 @@ moveParameters = { subTreeParams : SubTreeParams ...@@ -290,6 +321,30 @@ moveParameters = { subTreeParams : SubTreeParams
} }
} }
moveFrameParameters = { subTreeParams : SubTreeParams
{ showtypes: [ FolderPrivate
, FolderShared
, Team
, FolderPublic
, Folder
, Corpus
, NodeFrameWrite
, NodeFrameCalc
]
, valitypes: [ FolderPrivate
, Team
-- , FolderPublic
, Folder
, Corpus
, NodeFrameWrite
, NodeFrameCalc
]
}
}
linkParams = { subTreeParams : SubTreeParams linkParams = { subTreeParams : SubTreeParams
{ showtypes: [ FolderPrivate { showtypes: [ FolderPrivate
, FolderShared , FolderShared
...@@ -303,3 +358,13 @@ linkParams = { subTreeParams : SubTreeParams ...@@ -303,3 +358,13 @@ linkParams = { subTreeParams : SubTreeParams
} }
} }
publishParams = { subTreeParams : SubTreeParams
{ showtypes: [ FolderPublic
]
, valitypes: [ FolderPublic
]
}
}
...@@ -13,7 +13,6 @@ hasStatus _ Refresh = Dev ...@@ -13,7 +13,6 @@ hasStatus _ Refresh = Dev
hasStatus _ Config = Dev hasStatus _ Config = Dev
hasStatus _ (Link _) = Dev hasStatus _ (Link _) = Dev
hasStatus _ (Merge _) = Dev hasStatus _ (Merge _) = Dev
hasStatus _ (Move _) = Test
hasStatus _ (Documentation _) = Dev hasStatus _ (Documentation _) = Dev
hasStatus Annuaire Upload = Dev hasStatus Annuaire Upload = Dev
hasStatus Texts Upload = Dev hasStatus Texts Upload = Dev
......
...@@ -167,17 +167,22 @@ formChoice nodeTypes defaultNodeType setNodeType = ...@@ -167,17 +167,22 @@ formChoice nodeTypes defaultNodeType setNodeType =
-- | Button Form -- | Button Form
-- FIXME: currently needs a click from the user (by default, we could avoid such click) -- FIXME: currently needs a click from the user (by default, we could avoid such click)
formButton :: forall a b c formButton :: forall a b c
. a . Show a
=> a
-> ((b -> a) -> Effect c) -> ((b -> a) -> Effect c)
-> R.Element -> R.Element
formButton nodeType setNodeType = formButton nodeType setNodeType =
H.button { className : "btn btn-primary center" H.div {} [ H.text $ "Confirm the selection of: " <> show nodeType
, bouton
]
where
bouton = H.button { className : "cold-md-5 btn btn-primary center"
, type : "button" , type : "button"
, title: "Form Button" , title: "Form Button"
, style : { width: "50%" } , style : { width: "100%" }
, onClick : mkEffectFn1 , onClick : mkEffectFn1
$ \_ -> setNodeType ( const nodeType ) $ \_ -> setNodeType ( const nodeType )
} [H.text $ "Go !"] } [H.text $ "Confirmation"]
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -263,7 +268,3 @@ nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt ...@@ -263,7 +268,3 @@ nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt
------------------------------------------------------------------------ ------------------------------------------------------------------------
module Gargantext.Components.Forest.Tree.Node.Tools.FTree where module Gargantext.Components.Forest.Tree.Node.Tools.FTree where
import Data.Maybe (Maybe(..))
import Data.Argonaut (class DecodeJson, decodeJson, (.:)) import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Gargantext.Types as GT import Gargantext.Types as GT
...@@ -21,6 +22,7 @@ instance ntreeFunctor :: Functor NTree where ...@@ -21,6 +22,7 @@ instance ntreeFunctor :: Functor NTree where
newtype LNode = LNode { id :: ID newtype LNode = LNode { id :: ID
, name :: Name , name :: Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, parent_id :: Maybe ID
} }
derive instance newtypeLNode :: Newtype LNode _ derive instance newtypeLNode :: Newtype LNode _
...@@ -34,6 +36,7 @@ instance decodeJsonLNode :: DecodeJson LNode where ...@@ -34,6 +36,7 @@ instance decodeJsonLNode :: DecodeJson LNode where
pure $ LNode { id : id_ pure $ LNode { id : id_
, name , name
, nodeType , nodeType
, parent_id : Nothing
} }
instance decodeJsonFTree :: DecodeJson (NTree LNode) where instance decodeJsonFTree :: DecodeJson (NTree LNode) where
...@@ -43,5 +46,10 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where ...@@ -43,5 +46,10 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
nodes <- obj .: "children" nodes <- obj .: "children"
node' <- decodeJson node node' <- decodeJson node
nodes' <- decodeJson nodes nodes' <- decodeJson nodes
pure $ NTree node' nodes' let (LNode {id}) = node'
pure $ NTree node' (map (addParent id) nodes')
addParent :: ID -> NTree LNode -> NTree LNode
addParent id (NTree (LNode p@{id:id'}) ary)=
NTree (LNode (p {parent_id=Just id}))
(map (addParent id') ary)
...@@ -119,7 +119,8 @@ subTreeTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeTreeViewCpt" cpt ...@@ -119,7 +119,8 @@ subTreeTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.subTreeTreeViewCpt" cpt
SubTreeParams { valitypes } = subTreeParams SubTreeParams { valitypes } = subTreeParams
sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id') ary sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id')
$ A.filter (\(NTree (LNode {id:id'}) _) -> id'/= id) ary
children = map (\ctree -> subTreeTreeView (p { tree = ctree })) sortedAry children = map (\ctree -> subTreeTreeView (p { tree = ctree })) sortedAry
......
...@@ -141,10 +141,10 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -141,10 +141,10 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, graph , graph
, graphId , graphId
, graphVersion , graphVersion
, removedNodeIds: controls.removedNodeIds , removedNodeIds : controls.removedNodeIds
, session , session
, selectedNodeIds: controls.selectedNodeIds , selectedNodeIds: controls.selectedNodeIds
, showSidePanel: fst controls.showSidePanel , showSidePanel : controls.showSidePanel
, treeReload , treeReload
} }
] ]
...@@ -191,7 +191,7 @@ type MSidebarProps = ...@@ -191,7 +191,7 @@ type MSidebarProps =
, graphId :: GraphId , graphId :: GraphId
, graphVersion :: R.State Int , graphVersion :: R.State Int
, removedNodeIds :: R.State SigmaxT.NodeIds , removedNodeIds :: R.State SigmaxT.NodeIds
, showSidePanel :: GET.SidePanelState , showSidePanel :: R.State GET.SidePanelState
, selectedNodeIds :: R.State SigmaxT.NodeIds , selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session , session :: Session
, treeReload :: R.State Int , treeReload :: R.State Int
......
...@@ -94,7 +94,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt ...@@ -94,7 +94,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
-- Automatic opening of sidebar when a node is selected (but only first time). -- Automatic opening of sidebar when a node is selected (but only first time).
R.useEffect' $ do R.useEffect' $ do
if fst props.showSidePanel == GET.InitialClosed && (not Set.isEmpty $ fst props.selectedNodeIds) then if fst props.showSidePanel == GET.InitialClosed && (not Set.isEmpty $ fst props.selectedNodeIds) then
snd props.showSidePanel $ \_ -> GET.Opened snd props.showSidePanel $ \_ -> GET.Opened GET.SideTabSelection
else else
pure unit pure unit
......
...@@ -23,6 +23,11 @@ legendCpt = R.hooksComponent "Legend" cpt ...@@ -23,6 +23,11 @@ legendCpt = R.hooksComponent "Legend" cpt
entry :: Legend -> R.Element entry :: Legend -> R.Element
entry (Legend {id_, label}) = entry (Legend {id_, label}) =
RH.p {} RH.p {}
[ RH.span { style: { width: 10, height: 10, backgroundColor: intColor id_, display: "inline-block" } } [] [ RH.span { style: { width : 10
, height: 10
, backgroundColor: intColor id_
, display: "inline-block"
}
} []
, RH.text $ " " <> label , RH.text $ " " <> label
] ]
...@@ -15,6 +15,8 @@ import Effect (Effect) ...@@ -15,6 +15,8 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Types (SidePanelState(..), SideTab(..))
import Gargantext.Components.GraphExplorer.Legend as Legend
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
import Gargantext.Components.RandomText (words) import Gargantext.Components.RandomText (words)
...@@ -28,6 +30,7 @@ import Partial.Unsafe (unsafePartial) ...@@ -28,6 +30,7 @@ import Partial.Unsafe (unsafePartial)
import Gargantext.Prelude import Gargantext.Prelude
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
import Reactix.DOM.HTML as H
type Props = type Props =
( frontends :: Frontends ( frontends :: Frontends
...@@ -38,7 +41,7 @@ type Props = ...@@ -38,7 +41,7 @@ type Props =
, removedNodeIds :: R.State SigmaxT.NodeIds , removedNodeIds :: R.State SigmaxT.NodeIds
, selectedNodeIds :: R.State SigmaxT.NodeIds , selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session , session :: Session
, showSidePanel :: GET.SidePanelState , showSidePanel :: R.State GET.SidePanelState
, treeReload :: R.State Int , treeReload :: R.State Int
) )
...@@ -48,37 +51,63 @@ sidebar props = R.createElement sidebarCpt props [] ...@@ -48,37 +51,63 @@ sidebar props = R.createElement sidebarCpt props []
sidebarCpt :: R.Component Props sidebarCpt :: R.Component Props
sidebarCpt = R.hooksComponent "Sidebar" cpt sidebarCpt = R.hooksComponent "Sidebar" cpt
where where
cpt {showSidePanel: GET.Closed} _children = do cpt {showSidePanel: (GET.Closed /\ _)} _children = do
pure $ RH.div {} [] pure $ RH.div {} []
cpt {showSidePanel: GET.InitialClosed} _children = do cpt {showSidePanel: (GET.InitialClosed /\ _)} _children = do
pure $ RH.div {} [] pure $ RH.div {} []
cpt props _children = do cpt props@{metaData, showSidePanel} _children = do
let nodesMap = SigmaxT.nodesGraphMap props.graph pure $ RH.div { id: "sp-container" }
[ sideTabNav showSidePanel [SideTabLegend, SideTabSelection, SideTabPairing]
pure $ , sideTab (fst showSidePanel) props
RH.div { id: "sp-container" } ]
[ RH.div {}
[ R2.row sideTabNav :: R.State SidePanelState -> Array SideTab -> R.Element
[ R2.col12 sideTabNav (sidePanel /\ setSidePanel) sideTabs =
R.fragment [ H.div { className: "text-primary center"} [H.text "SideTab"]
, H.div {className: "nav nav-tabs"} (liItem <$> sideTabs)
-- , H.div {className: "center"} [ H.text "Doc sideTabs"]
]
where
liItem :: SideTab -> R.Element
liItem tab =
H.div { className : "nav-item nav-link"
<> if (Opened tab) == sidePanel
then " active"
else ""
, on: { click: \_ -> setSidePanel $ const (Opened tab)
}
} [ H.text $ show tab ]
sideTab :: SidePanelState -> Record Props -> R.Element
sideTab (Opened SideTabLegend) props@{metaData} =
let (GET.MetaData {legend}) = metaData
in Legend.legend { items: Seq.fromFoldable legend}
sideTab (Opened SideTabSelection) props =
RH.div {} [ R2.row [ R2.col 12
[ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist"} [ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist"}
[ RH.div { className: "tab-content" } [ RH.div { className: "tab-content" }
[ RH.div { className: "", role: "tabpanel" } [ RH.div { className: "", role: "tabpanel" }
(Seq.toUnfoldable $ (Seq.map (badge props.selectedNodeIds) (badges props.graph props.selectedNodeIds))) ( Seq.toUnfoldable
$ ( Seq.map (badge props.selectedNodeIds)
(badges props.graph props.selectedNodeIds)
)
)
] ]
, RH.div { className: "tab-content" } , RH.div { className: "tab-content flex-space-between" }
[ [ removeButton "Move as candidate" CandidateTerm props nodesMap
removeButton "Remove candidate" CandidateTerm props nodesMap , removeButton "Move as stop" StopTerm props nodesMap
, removeButton "Remove stop" StopTerm props nodesMap ]
]
, RH.div { className: "col-md-12", id: "query" }
[ query props.frontends
props.metaData
props.session
nodesMap
props.selectedNodeIds
] ]
, RH.li { className: "nav-item" }
[ RH.a { id: "home-tab"
, className: "nav-link active"
, data: {toggle: "tab"}
, href: "#home"
, role: "tab"
, aria: {controls: "home", selected: "true"}
}
[ RH.text "Neighbours" ]
] ]
] ]
, RH.div { className: "tab-content", id: "myTabContent" } , RH.div { className: "tab-content", id: "myTabContent" }
...@@ -86,22 +115,10 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -86,22 +115,10 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
(Seq.toUnfoldable $ (Seq.map (badge props.selectedNodeIds) (neighbourBadges props.graph props.selectedNodeIds))) (Seq.toUnfoldable $ (Seq.map (badge props.selectedNodeIds) (neighbourBadges props.graph props.selectedNodeIds)))
] ]
] ]
{-, RH.div { className: "col-md-12", id: "horizontal-checkbox" } where
[ RH.ul {}
[ checkbox "Pubs" nodesMap = SigmaxT.nodesGraphMap props.graph
, checkbox "Projects"
, checkbox "Patents"
, checkbox "Others"
]
]
-}
, RH.div { className: "col-md-12", id: "query" }
[
query props.frontends props.metaData props.session nodesMap props.selectedNodeIds
]
]
]
]
checkbox text = checkbox text =
RH.li {} RH.li {}
[ RH.span {} [ RH.text text ] [ RH.span {} [ RH.text text ]
...@@ -110,26 +127,34 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -110,26 +127,34 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, checked: true , checked: true
, title: "Mark as completed" } ] , title: "Mark as completed" } ]
removeButton text rType props nodesMap = removeButton text rType props' nodesMap' =
if Set.isEmpty $ fst props.selectedNodeIds then if Set.isEmpty $ fst props'.selectedNodeIds then
RH.div {} [] RH.div {} []
else else
RH.button { className: "btn btn-danger" RH.button { className: "btn btn-info"
, on: { click: onClickRemove rType props nodesMap }} , on: { click: onClickRemove rType props' nodesMap' }
}
[ RH.text text ] [ RH.text text ]
onClickRemove rType props nodesMap e = do onClickRemove rType props' nodesMap' e = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap) $ Set.toUnfoldable $ fst props.selectedNodeIds let nodes = mapMaybe (\id -> Map.lookup id nodesMap')
deleteNodes { graphId: props.graphId $ Set.toUnfoldable $ fst props'.selectedNodeIds
, metaData: props.metaData deleteNodes { graphId: props'.graphId
, metaData: props'.metaData
, nodes , nodes
, session: props.session , session: props'.session
, termList: rType , termList: rType
, treeReload: props.treeReload } , treeReload: props'.treeReload }
snd props.removedNodeIds $ const $ fst props.selectedNodeIds snd props'.removedNodeIds $ const $ fst props'.selectedNodeIds
snd props.selectedNodeIds $ const SigmaxT.emptyNodeIds snd props'.selectedNodeIds $ const SigmaxT.emptyNodeIds
sideTab _ _ = H.div {} []
-------------------------------------------
badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge (_ /\ setNodeIds) {id, label} = badge (_ /\ setNodeIds) {id, label} =
RH.a { className: "badge badge-light" RH.a { className: "badge badge-light"
...@@ -147,9 +172,9 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected ...@@ -147,9 +172,9 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected
where where
selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
type DeleteNodes = type DeleteNodes =
( ( graphId :: Int
graphId :: Int
, metaData :: GET.MetaData , metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node) , nodes :: Array (Record SigmaxT.Node)
, session :: Session , session :: Session
...@@ -172,37 +197,63 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches ...@@ -172,37 +197,63 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches
where where
nodeId :: Int nodeId :: Int
nodeId = unsafePartial $ fromJust $ fromString node.id nodeId = unsafePartial $ fromJust $ fromString node.id
versioned :: NTC.VersionedNgramsPatches versioned :: NTC.VersionedNgramsPatches
versioned = NTC.Versioned {version: metaData.list.version, data: np} versioned = NTC.Versioned {version: metaData.list.version, data: np}
coreParams :: NTC.CoreParams () coreParams :: NTC.CoreParams ()
coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType} coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
tabNgramType :: CTabNgramType tabNgramType :: CTabNgramType
tabNgramType = modeTabType node.gargType tabNgramType = modeTabType node.gargType
tabType :: TabType tabType :: TabType
tabType = TabCorpus (TabNgramType tabNgramType) tabType = TabCorpus (TabNgramType tabNgramType)
term :: NTC.NgramsTerm term :: NTC.NgramsTerm
term = NTC.normNgram tabNgramType node.label term = NTC.normNgram tabNgramType node.label
pt :: NTC.NgramsTablePatch pt :: NTC.NgramsTablePatch
pt = NTC.fromNgramsPatches np pt = NTC.fromNgramsPatches np
np :: NTC.NgramsPatches np :: NTC.NgramsPatches
np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list } np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
patch_list :: NTC.Replace TermList patch_list :: NTC.Replace TermList
patch_list = NTC.Replace { new: termList, old: MapTerm } patch_list = NTC.Replace { new: termList, old: MapTerm }
query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} [] query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) = query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
query' (head metaData.corpusId) query' (head metaData.corpusId)
where where
query' Nothing = RH.div {} [] query' Nothing = RH.div {} []
query' (Just corpusId) = query' (Just corpusId) = CGT.tabs { frontends
CGT.tabs {frontends, session, query: q <$> Set.toUnfoldable selectedNodeIds, sides: [side corpusId]} , session
q id = case Map.lookup id nodesMap of , query: toQuery <$> Set.toUnfoldable selectedNodeIds
, sides: [side corpusId]
}
toQuery id = case Map.lookup id nodesMap of
Nothing -> [] Nothing -> []
Just n -> words n.label Just n -> words n.label
side corpusId = GET.GraphSideCorpus {
corpusId side corpusId = GET.GraphSideCorpus { corpusId
, listId: metaData.list.listId , listId : metaData.list.listId
, corpusLabel: metaData.title , corpusLabel: metaData.title
} }
------------------------------------------------------------------------
{-, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
[ RH.ul {}
[ checkbox "Pubs"
, checkbox "Projects"
, checkbox "Patents"
, checkbox "Others"
]
]
-}
...@@ -144,12 +144,12 @@ sidebarToggleButton (state /\ setState) = R.createElement el {} [] ...@@ -144,12 +144,12 @@ sidebarToggleButton (state /\ setState) = R.createElement el {} []
] ]
onMessage = "Hide Sidebar" onMessage = "Hide Sidebar"
offMessage = "Show Sidebar" offMessage = "Show Sidebar"
text on _off GET.Opened = on text on _off (GET.Opened _) = on
text _on off GET.InitialClosed = off text _on off GET.InitialClosed = off
text _on off GET.Closed = off text _on off GET.Closed = off
onClick = \_ -> do onClick = \_ -> do
setState $ \s -> case s of setState $ \s -> case s of
GET.InitialClosed -> GET.Opened GET.InitialClosed -> GET.Opened GET.SideTabLegend
GET.Closed -> GET.Opened GET.Closed -> GET.Opened GET.SideTabLegend
GET.Opened -> GET.Closed (GET.Opened _) -> GET.Closed
module Gargantext.Components.GraphExplorer.Types where module Gargantext.Components.GraphExplorer.Types where
import Prelude import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:)) import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Array ((!!), length) import Data.Array ((!!), length)
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
...@@ -58,12 +58,10 @@ derive instance newtypeGraphData :: Newtype GraphData _ ...@@ -58,12 +58,10 @@ derive instance newtypeGraphData :: Newtype GraphData _
newtype MetaData = MetaData newtype MetaData = MetaData
{ { title :: String
title :: String
, legend :: Array Legend , legend :: Array Legend
, corpusId :: Array Int , corpusId :: Array Int
, list :: { , list :: { listId :: ListId
listId :: ListId
, version :: Version , version :: Version
} }
} }
...@@ -191,6 +189,20 @@ intColor :: Int -> String ...@@ -191,6 +189,20 @@ intColor :: Int -> String
intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaultPalette) intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaultPalette)
data SidePanelState = InitialClosed | Opened | Closed data SidePanelState = InitialClosed | Opened SideTab | Closed
derive instance eqSidePanelState :: Eq SidePanelState derive instance eqSidePanelState :: Eq SidePanelState
data SideTab = SideTabLegend | SideTabSelection | SideTabPairing
derive instance eqSideTab :: Eq SideTab
instance showSideTab :: Show SideTab where
show SideTabLegend = "Legend"
show SideTabSelection = "Navigation"
show SideTabPairing = "Pairing"
...@@ -24,23 +24,22 @@ import Data.Tuple (Tuple(..), fst, snd) ...@@ -24,23 +24,22 @@ import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.NgramsTable.Components as NTC import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI) import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read) import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read)
import Gargantext.Routes as R import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes) import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel, toggleSet) import Gargantext.Utils (queryMatchesLabel, toggleSet)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.List (sortWith) as L import Gargantext.Utils.List (sortWith) as L
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix (Component, Element, State, createElement, fragment, hooksComponent, useState') as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
type State' = type State' =
CoreState CoreState
......
...@@ -26,19 +26,18 @@ import Gargantext.Hooks.Loader (useLoader) ...@@ -26,19 +26,18 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI, Children)) import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session, get, put) import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..), AffTableResult) import Gargantext.Types (NodeType(..), AffTableResult)
import Gargantext.Utils.Crypto as GUC import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type Props = ( type Props =
nodeId :: Int ( nodeId :: Int
, session :: Session , session :: Session
) )
type Reload = R.State Int type Reload = R.State Int
type KeyProps = type KeyProps =
( ( key :: String
key :: String
| Props | Props
) )
...@@ -54,8 +53,8 @@ corpusLayoutCpt = R.hooksComponent "G.C.N.C.corpusLayout" cpt ...@@ -54,8 +53,8 @@ corpusLayoutCpt = R.hooksComponent "G.C.N.C.corpusLayout" cpt
useLoader {nodeId, reload: fst reload, session} loadCorpusWithReload $ useLoader {nodeId, reload: fst reload, session} loadCorpusWithReload $
\corpus -> corpusLayoutView {corpus, nodeId, reload, session} \corpus -> corpusLayoutView {corpus, nodeId, reload, session}
type ViewProps = ( type ViewProps =
corpus :: NodePoly Hyperdata ( corpus :: NodePoly Hyperdata
, reload :: Reload , reload :: Reload
| Props | Props
) )
...@@ -184,7 +183,7 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt ...@@ -184,7 +183,7 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t
hash :: FTFieldWithIndex -> Hash hash :: FTFieldWithIndex -> Hash
hash (Tuple idx f) = GUC.md5 $ "--idx--" <> (show idx) <> "--field--" <> (show f) hash (Tuple idx f) = Crypto.hash $ "--idx--" <> (show idx) <> "--field--" <> (show f)
type FieldCodeEditorProps = type FieldCodeEditorProps =
( (
...@@ -345,8 +344,8 @@ changeCode onc (Markdown md) CE.Haskell c = onc $ Haskell $ defaultHaskell' { ha ...@@ -345,8 +344,8 @@ changeCode onc (Markdown md) CE.Haskell c = onc $ Haskell $ defaultHaskell' { ha
changeCode onc (Markdown md) CE.JSON c = onc $ Markdown $ defaultMarkdown' { text = c } changeCode onc (Markdown md) CE.JSON c = onc $ Markdown $ defaultMarkdown' { text = c }
changeCode onc (Markdown md) CE.Markdown c = onc $ Markdown $ md { text = c } changeCode onc (Markdown md) CE.Markdown c = onc $ Markdown $ md { text = c }
type LoadProps = ( type LoadProps =
nodeId :: Int ( nodeId :: Int
, session :: Session , session :: Session
) )
......
...@@ -9,7 +9,8 @@ import Reactix as R ...@@ -9,7 +9,8 @@ import Reactix as R
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types (Reload, Path, Props, MetricsProps, ReloadPath) import Gargantext.Components.Nodes.Corpus.Chart.Types (Reload, Path, Props, MetricsProps, ReloadPath)
import Gargantext.Hooks.Loader (MD5, HashedResponse, useLoader, useLoaderWithCache, useLoaderWithCacheAPI) import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCache, useLoaderWithCacheAPI)
import Gargantext.Utils.Crypto (Hash)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
...@@ -33,7 +34,7 @@ metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt ...@@ -33,7 +34,7 @@ metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt
loaded { path, reload, session } l loaded { path, reload, session } l
type MetricsWithCacheLoadViewProps res ret = ( type MetricsWithCacheLoadViewProps res ret = (
getMetricsMD5 :: Session -> ReloadPath -> Aff MD5 getMetricsHash :: Session -> ReloadPath -> Aff Hash
, handleResponse :: HashedResponse res -> ret , handleResponse :: HashedResponse res -> ret
, loaded :: Record MetricsProps -> ret -> R.Element , loaded :: Record MetricsProps -> ret -> R.Element
, mkRequest :: ReloadPath -> GUC.Request , mkRequest :: ReloadPath -> GUC.Request
...@@ -48,13 +49,13 @@ metricsWithCacheLoadViewCpt :: forall res ret. DecodeJson res => ...@@ -48,13 +49,13 @@ metricsWithCacheLoadViewCpt :: forall res ret. DecodeJson res =>
R.Component (MetricsWithCacheLoadViewProps res ret) R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt
where where
cpt { getMetricsMD5, handleResponse, loaded, mkRequest, path, reload, session } _ = do cpt { getMetricsHash, handleResponse, loaded, mkRequest, path, reload, session } _ = do
-- useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsMD5 session) (getMetrics session) $ \l -> -- useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsHash session) (getMetrics session) $ \l ->
-- loaded session path reload l -- loaded session path reload l
-- metricsKeyFunc keyFunc st@(_ /\ { corpusId, listId, tabType }) = -- metricsKeyFunc keyFunc st@(_ /\ { corpusId, listId, tabType }) =
-- "metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) <> "--" <> (keyFunc st) -- "metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) <> "--" <> (keyFunc st)
useLoaderWithCacheAPI { cacheEndpoint: (getMetricsMD5 session) useLoaderWithCacheAPI { cacheEndpoint: (getMetricsHash session)
, handleResponse , handleResponse
, mkRequest , mkRequest
, path: (fst reload /\ path) , path: (fst reload /\ path)
......
...@@ -6,24 +6,22 @@ import Data.Maybe (Maybe(..)) ...@@ -6,24 +6,22 @@ import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (seriesBarD1)
import Gargantext.Components.Charts.Options.Color (grey) import Gargantext.Components.Charts.Options.Color (grey)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie) import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Series (seriesBarD1)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..)) import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType(..)) import Gargantext.Types (ChartType(..), TabType(..))
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Reactix as R
import Reactix.DOM.HTML as H
newtype ChartMetrics = ChartMetrics { newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics "data" :: HistoMetrics
...@@ -62,9 +60,9 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -62,9 +60,9 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
, series : [seriesBarD1 {name: "Number of publication / year"} $ , series : [seriesBarD1 {name: "Number of publication / year"} $
map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] } map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] }
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String getMetricsHash :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: Histo, listId: mListId, tabType } (Just corpusId) get session $ ChartHash { chartType: Histo, listId: mListId, tabType } (Just corpusId)
where where
mListId = if listId == 0 then Nothing else (Just listId) mListId = if listId == 0 then Nothing else (Just listId)
...@@ -88,7 +86,7 @@ histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt ...@@ -88,7 +86,7 @@ histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt
cpt { path, session } _ = do cpt { path, session } _ = do
reload <- R.useState' 0 reload <- R.useState' 0
pure $ metricsWithCacheLoadView { pure $ metricsWithCacheLoadView {
getMetricsMD5 getMetricsHash
, handleResponse , handleResponse
, loaded , loaded
, mkRequest: mkRequest session , mkRequest: mkRequest session
......
...@@ -98,9 +98,9 @@ scatterOptions metrics' = Options ...@@ -98,9 +98,9 @@ scatterOptions metrics' = Options
} }
--} --}
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String getMetricsHash :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, listId, tabType }) = getMetricsHash session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsMD5 { listId, tabType } (Just corpusId) get session $ CorpusMetricsHash { listId, tabType } (Just corpusId)
chartUrl :: Record Path -> SessionRoute chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = CorpusMetrics { limit, listId, tabType } (Just corpusId) chartUrl { corpusId, limit, listId, tabType } = CorpusMetrics { limit, listId, tabType } (Just corpusId)
...@@ -120,7 +120,7 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt ...@@ -120,7 +120,7 @@ metricsCpt = R.hooksComponent "G.C.N.C.C.M.metrics" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
pure $ metricsWithCacheLoadView { pure $ metricsWithCacheLoadView {
getMetricsMD5 getMetricsHash
, handleResponse , handleResponse
, loaded , loaded
, mkRequest: mkRequest session , mkRequest: mkRequest session
......
...@@ -9,24 +9,22 @@ import Data.String (take, joinWith, Pattern(..), split, length) ...@@ -9,24 +9,22 @@ import Data.String (take, joinWith, Pattern(..), split, length)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Components.Charts.Options.Color (blue) import Gargantext.Components.Charts.Options.Color (blue)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie) import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView) import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..)) import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Reactix as R
import Reactix.DOM.HTML as H
newtype ChartMetrics = ChartMetrics { newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics "data" :: HistoMetrics
...@@ -81,9 +79,9 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -81,9 +79,9 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" } , tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
} }
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String getMetricsHash :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartPie, listId: mListId, tabType } (Just corpusId) get session $ ChartHash { chartType: ChartPie, listId: mListId, tabType } (Just corpusId)
where where
mListId = if listId == 0 then Nothing else (Just listId) mListId = if listId == 0 then Nothing else (Just listId)
...@@ -107,7 +105,7 @@ pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt ...@@ -107,7 +105,7 @@ pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt
cpt { path, session } _ = do cpt { path, session } _ = do
reload <- R.useState' 0 reload <- R.useState' 0
pure $ metricsWithCacheLoadView { pure $ metricsWithCacheLoadView {
getMetricsMD5 getMetricsHash
, handleResponse , handleResponse
, loaded: loadedPie , loaded: loadedPie
, mkRequest: mkRequest session , mkRequest: mkRequest session
...@@ -135,7 +133,7 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt ...@@ -135,7 +133,7 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt
reload <- R.useState' 0 reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session} --pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session}
pure $ metricsWithCacheLoadView { pure $ metricsWithCacheLoadView {
getMetricsMD5 getMetricsHash
, handleResponse , handleResponse
, loaded: loadedPie , loaded: loadedPie
, mkRequest: mkRequest session , mkRequest: mkRequest session
......
...@@ -53,9 +53,9 @@ scatterOptions nodes = Options ...@@ -53,9 +53,9 @@ scatterOptions nodes = Options
} }
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String getMetricsHash :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartTree, listId: mListId, tabType } (Just corpusId) get session $ ChartHash { chartType: ChartTree, listId: mListId, tabType } (Just corpusId)
where where
mListId = if listId == 0 then Nothing else (Just listId) mListId = if listId == 0 then Nothing else (Just listId)
...@@ -79,7 +79,7 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt ...@@ -79,7 +79,7 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt
cpt {path, session} _ = do cpt {path, session} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
pure $ metricsWithCacheLoadView { pure $ metricsWithCacheLoadView {
getMetricsMD5 getMetricsHash
, handleResponse , handleResponse
, loaded , loaded
, mkRequest: mkRequest session , mkRequest: mkRequest session
......
...@@ -11,8 +11,8 @@ import Gargantext.Components.Tab as Tab ...@@ -11,8 +11,8 @@ import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
type Props = ( type Props =
frontends :: Frontends ( frontends :: Frontends
, query :: TextQuery , query :: TextQuery
, session :: Session , session :: Session
, sides :: Array GraphSideCorpus , sides :: Array GraphSideCorpus
......
...@@ -79,16 +79,9 @@ data FrameType = Calc | Write ...@@ -79,16 +79,9 @@ data FrameType = Calc | Write
type Base = String type Base = String
type FrameId = 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 -> FrameId -> String
hframeUrl base frame_id = base <> "/" <> frame_id <> "?both" hframeUrl base frame_id = base <> "/" <> frame_id <> "?both"
frameLayoutView :: Record ViewProps -> R.Element frameLayoutView :: Record ViewProps -> R.Element
frameLayoutView props = R.createElement frameLayoutViewCpt props [] frameLayoutView props = R.createElement frameLayoutViewCpt props []
...@@ -96,11 +89,10 @@ frameLayoutViewCpt :: R.Component ViewProps ...@@ -96,11 +89,10 @@ frameLayoutViewCpt :: R.Component ViewProps
frameLayoutViewCpt = R.hooksComponent "G.C.N.C.frameLayoutView" cpt frameLayoutViewCpt = R.hooksComponent "G.C.N.C.frameLayoutView" cpt
where where
cpt {frame: (NodePoly {hyperdata: Hyperdata {base, frame_id}}), nodeId, reload, session} _ = do cpt {frame: (NodePoly {hyperdata: Hyperdata {base, frame_id}}), nodeId, reload, session} _ = do
pure $ H.div { className : "istex-search" } pure $ H.div { className : "frame" }
[ H.iframe { src: hframeUrl base frame_id [ H.iframe { src: hframeUrl base frame_id
, width: "100%" , width: "100%"
, height: "100%" , height: "100%"
-- , ref: "https://write.frame.gargantext.org/test"
} [] } []
] ]
......
module Gargantext.Components.Nodes.Home where module Gargantext.Components.Nodes.Home where
import Prelude
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Effect (Effect) import Effect (Effect)
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Lang (LandingLang(..))
import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Nodes.Home.Public (renderPublic)
import Gargantext.License (license)
import Gargantext.Prelude (Unit, map, pure, unit, void, ($), (<>))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Routing.Hash (setHash) import Routing.Hash (setHash)
import Gargantext.License (license)
import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing
(BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Lang (LandingLang(..))
type Props = () type Props = ()
...@@ -48,13 +48,14 @@ homeLayout lang = R.createElement homeLayoutCpt {landingData} [] ...@@ -48,13 +48,14 @@ homeLayout lang = R.createElement homeLayoutCpt {landingData} []
where landingData = langLandingData lang where landingData = langLandingData lang
homeLayoutCpt :: R.Component ( landingData :: LandingData ) homeLayoutCpt :: R.Component ( landingData :: LandingData )
homeLayoutCpt = R.staticComponent "LayoutLanding" cpt homeLayoutCpt = R.hooksComponent "LayoutLanding" cpt
where where
cpt {landingData} _ = cpt {landingData} _ = do
H.span {} pure $ H.span {}
[ H.div { className: "container1" } [ jumboTitle landingData false ] [ H.div { className: "container1" } [ jumboTitle landingData false ]
, H.div { className: "container1" } [] -- TODO put research form , H.div { className: "container1" } [] -- TODO put research form
, H.div { className: "container1" } [ blocksRandomText' landingData ] , H.div { className: "container1" } [ blocksRandomText' landingData ]
, H.div { className: "container1" } [ renderPublic ]
, license , license
] ]
...@@ -89,6 +90,8 @@ docButton (Button b) = ...@@ -89,6 +90,8 @@ docButton (Button b) =
, H.text b.text , H.text b.text
] ]
-- | TODO
-- <img src='logo.png' onmouseover="this.src='gargantextuel.png';" onmouseout="this.src='logo.png';" />
jumboTitle :: LandingData -> Boolean -> R.Element jumboTitle :: LandingData -> Boolean -> R.Element
jumboTitle (LandingData hd) b = jumboTitle (LandingData hd) b =
H.div {className: jumbo} H.div {className: jumbo}
......
module Gargantext.Components.Nodes.Home.Public where
import Data.Array.NonEmpty (toArray)
import Data.Array as Array
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.NonEmpty (head)
import Data.String (take)
import Data.Tuple (fst)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Config (publicBackend)
import Gargantext.Config.REST (get)
import Gargantext.Ends (backendUrl, Backend(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Reactix as R
import Reactix.DOM.HTML as H
import Data.Traversable (traverse)
type PublicProps = (publicDatas :: (Array PublicData)
-- , session :: Session
)
data PublicData = PublicData
{ title :: String
, abstract :: String
, img :: String
, url :: String
, date :: String
, database :: String
, author :: String
} | NoData { nodata :: String }
derive instance eqPublicData :: Eq PublicData
derive instance genericPublicData :: Generic PublicData _
instance showPublicData :: Show PublicData where
show = genericShow
instance decodeJsonPublicData :: Argonaut.DecodeJson PublicData where
decodeJson = genericSumDecodeJson
instance encodeJsonPublicData :: Argonaut.EncodeJson PublicData where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
type LoadData = ()
type LoadProps = (reload :: Int)
-- | WIP still finding the right way to chose the default public backend
loadPublicData :: Record LoadProps -> Aff (Array PublicData)
loadPublicData _l = do
-- This solution is error prone (url needs to be cleaned)
--backend <- liftEffect publicBackend
-- This solution for development only, with local backend
-- let backend = head defaultBackends
let backend = publicBackend
get Nothing (backendUrl backend "public")
{- | Another solution: get all data
let
ok = ["local.cnrs", "devel.inshs.cnrs"]
backends = Array.filter (\(Backend {name}) -> Array.elem name ok) (toArray defaultBackends)
Array.concat <$> traverse (\backend -> get Nothing (backendUrl backend "public")) backends
-}
renderPublic :: R.Element
renderPublic = R.createElement renderPublicCpt {} []
renderPublicCpt :: R.Component LoadData
renderPublicCpt = R.hooksComponent "G.C.N.Home.Public.renderPublic" cpt
where
cpt {} _ = do
reload <- R.useState' 0
useLoader { reload: fst reload } loadPublicData (\pd -> publicLayout {publicDatas: pd})
------------------------------------------------------------------------
publicLayout :: Record PublicProps -> R.Element
publicLayout props = R.createElement publicLayoutCpt props []
publicLayoutCpt :: R.Component PublicProps
publicLayoutCpt = R.hooksComponent "[G.C.N.H.Public.publicLayout" cpt
where
cpt {publicDatas} _ = do
pure $ H.span {}
[ H.div { className: "text-center" }
[ H.div { className:"container1" }
[ H.h2 {} [H.text "Public Maps"]
, H.p { className: "lead text-muted"}
[ H.text "Discover maps made with "
, H.div {className: "fa fa-heart"} []
]
, H.p { className:"flex-space-around" }
[ H.a { className: "btn btn-primary my-2"
, href :"https://gargantext.org"
} [H.text "Join"]
]
]
]
-- | TODO browse maps
-- | TODO random maps
, album publicDatas
]
album :: Array PublicData -> R.Element
album pds = H.div {className: "album py-5 bg-light"}
[ H.div { className: "container" }
[ H.div { className : "row" }
(map (\tab -> H.div {className : "col-md-6 content"}
[tableau tab]
) pds
)
]
]
tableau :: PublicData -> R.Element
tableau (PublicData {title, abstract, img, url, date, database, author}) =
H.div {className: "card mb-6 box-shadow"}
[ H.a { target: "_blank", href: url } [ H.div { className:"center"}
[H.img { src: img
, width: "50%"
}
]
]
, H.div { className : "card-body"}
[ H.h3 {} [H.text title]
, H.p { className: "card-text"} [H.text $ (take 252 abstract) <> "..."]
, H.div { className: "center justify-content-between align-items-center"}
[ H.div { className: "btn-group" }
[ H.button { className : "btn btn-default flex-between"
, href : url
, role : "button"
} [ H.text "View the map" ]
{- TODO
, H.button { className : "btn btn-default flex-start"
, href : url
, role : "button"
} [ H.text "More like this" ]
-}
]
, H.div { className : "small text-muted flex-end" } [ H.text $ "Made by " <> author
<> " on " <> date
<> " with " <> database
]
]
]
]
tableau (NoData {nodata}) = H.div {className : "center"} [H.h2 {} [H.text "Create a corpus and publicize it"]]
...@@ -50,10 +50,12 @@ randomChars word = case (length (toCharArray word)) >= 5 of ...@@ -50,10 +50,12 @@ randomChars word = case (length (toCharArray word)) >= 5 of
------------------------------------------------------------------- -------------------------------------------------------------------
words :: String -> Array String words :: String -> Array String
words sentence = filter ((/=) "") $ split (Pattern " ") sentence words sentence = filter ((/=) "")
$ split (Pattern " ") sentence
sentences :: String -> Array String sentences :: String -> Array String
sentences paragraph = filter ((/=) "") $ split (Pattern ".") paragraph sentences paragraph = filter ((/=) "")
$ split (Pattern ".") paragraph
------------------------------------------------------------------- -------------------------------------------------------------------
...@@ -63,7 +65,8 @@ data RandomWheel a = RandomWheel { before :: Array a ...@@ -63,7 +65,8 @@ data RandomWheel a = RandomWheel { before :: Array a
} }
randomPart :: forall b. Array b -> Effect (Array b) randomPart :: forall b. Array b -> Effect (Array b)
randomPart array = randomArrayPoly middle >>= \(middle') -> pure ( start <> middle' <> end) randomPart array = randomArrayPoly middle
>>= \(middle') -> pure ( start <> middle' <> end)
where where
start = take 2 array start = take 2 array
middle = dropEnd 2 $ drop 2 array middle = dropEnd 2 $ drop 2 array
...@@ -93,7 +96,7 @@ randomArray array = unsafePartial $ do ...@@ -93,7 +96,7 @@ randomArray array = unsafePartial $ do
case maybeDuring of case maybeDuring of
Nothing -> Nothing ->
crash "[ERROR] It should never happen." crash "[G.C.N.H.R.RandomText ERROR] It should never happen."
Just during -> Just during ->
pure $ RandomWheel { before : remove n array pure $ RandomWheel { before : remove n array
, during : during , during : during
......
...@@ -16,7 +16,6 @@ import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo) ...@@ -16,7 +16,6 @@ import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..), getCorpusInfo, CorpusInfo(..)) import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..), getCorpusInfo, CorpusInfo(..))
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoaderWithCache)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..)) import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
......
module Gargantext.Config where module Gargantext.Config where
import Data.String as S
import Web.HTML.Location (Location(..))
import Effect (Effect)
import Data.NonEmpty (NonEmpty, (:|), head) import Data.NonEmpty (NonEmpty, (:|), head)
import Gargantext.Ends import Gargantext.Ends
import Gargantext.Types (ApiVersion(..)) import Gargantext.Types (ApiVersion(..))
import Gargantext.Utils (location)
import Gargantext.Prelude (bind, pure, ($))
defaultBackends :: NonEmpty Array Backend defaultBackends :: NonEmpty Array Backend
defaultBackends = local :| [prod, partner, demo, dev] defaultBackends = backend_local :| [ backend_prod
where , backend_partner
prod = backend V10 "/api/" "https://v4.gargantext.org" "iscpif.cnrs" , backend_demo
partner = backend V10 "/api/" "https://imtv4.gargantext.org" "institut-mines-telecom.imt" , backend_dev
demo = backend V10 "/api/" "https://demo.gargantext.org" "demo.inshs.cnrs" ]
dev = backend V10 "/api/" "https://dev.gargantext.org" "devel.inshs.cnrs"
local = backend V10 "/api/" "http://localhost:8008" "local.cnrs" backend_prod :: Backend
backend_prod = backend V10 "/api/" "https://v4.gargantext.org" "iscpif.cnrs"
backend_partner :: Backend
backend_partner = backend V10 "/api/" "https://imtv4.gargantext.org" "institut-mines-telecom.imt"
backend_demo :: Backend
backend_demo = backend V10 "/api/" "https://demo.gargantext.org" "demo.inshs.cnrs"
backend_dev :: Backend
backend_dev = backend V10 "/api/" "https://dev.gargantext.org" "devel.inshs.cnrs"
backend_local :: Backend
backend_local = backend V10 "/api/" "http://localhost:8008" "local.cnrs"
-- | public Backend
-- When user is not logged, use the location of the window
publicBackend :: Backend
publicBackend = backend_local
publicBackend' :: Effect Backend
publicBackend' = do
url <- location
pure $ Backend { name : "Public Backend"
, baseUrl : url
, prePath : "api/"
, version : V10
}
defaultApps :: NonEmpty Array Frontend defaultApps :: NonEmpty Array Frontend
defaultApps = relative :| [prod, dev, demo, haskell, caddy] defaultApps = relative :| [prod, dev, demo, haskell, caddy]
...@@ -38,3 +73,7 @@ defaultStatic = head defaultStatics ...@@ -38,3 +73,7 @@ defaultStatic = head defaultStatics
defaultFrontends :: Frontends defaultFrontends :: Frontends
defaultFrontends = Frontends { app: defaultApp, static: defaultStatic } defaultFrontends = Frontends { app: defaultApp, static: defaultStatic }
changePort :: String -> String
changePort = S.replace (S.Pattern "http://localhost:8000/") (S.Replacement "http://localhost:8008/")
...@@ -9,8 +9,8 @@ import Data.Generic.Rep (class Generic) ...@@ -9,8 +9,8 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Gargantext.Routes as R import Gargantext.Routes as R
import Gargantext.Types (ApiVersion, ChartType(..), Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType') import Gargantext.Types (ApiVersion, ChartType(..), Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType', TermList(MapTerm))
import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==)) import Gargantext.Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==), (/=))
-- | A means of generating a url to visit, a destination -- | A means of generating a url to visit, a destination
class ToUrl conf p where class ToUrl conf p where
...@@ -24,7 +24,8 @@ newtype Backend = Backend ...@@ -24,7 +24,8 @@ newtype Backend = Backend
{ name :: String { name :: String
, baseUrl :: String , baseUrl :: String
, prePath :: String , prePath :: String
, version :: ApiVersion } , version :: ApiVersion
}
backend :: ApiVersion -> String -> String -> String -> Backend backend :: ApiVersion -> String -> String -> String -> Backend
backend version prePath baseUrl name = Backend { name, version, prePath, baseUrl } backend version prePath baseUrl name = Backend { name, version, prePath, baseUrl }
...@@ -117,13 +118,13 @@ sessionPath :: R.SessionRoute -> String ...@@ -117,13 +118,13 @@ sessionPath :: R.SessionRoute -> String
sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i (showTabType' t)) sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i (showTabType' t))
sessionPath (R.Children n o l s i) = sessionPath (R.NodeAPI Node i ("children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s)) sessionPath (R.Children n o l s i) = sessionPath (R.NodeAPI Node i ("children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s))
sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe 0 pId) <> p sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe 0 pId) <> p
sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartBar nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart ChartBar nt nId lId) = "node/" <> (show nId) <> "/pie?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartPie nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart ChartPie nt nId lId) = "node/" <> (show nId) <> "/pie?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartTree nt nId lId) = "node/" <> (show nId) <> "/tree?list=" <> (show lId) <> "&ngramsType=" <> (show nt) <> "&listType=MapTerm" sessionPath (R.RecomputeListChart ChartTree nt nId lId) = "node/" <> (show nId) <> "/tree?" <> (defaultList lId) <> "&ngramsType=" <> (show nt) <> "&listType=" <> show MapTerm
sessionPath (R.RecomputeListChart Histo nt nId lId) = "node/" <> (show nId) <> "/chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart Histo nt nId lId) = "node/" <> (show nId) <> "/chart?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart Scatter nt nId lId) = "node/" <> (show nId) <> "/metrics?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart Scatter nt nId lId) = "node/" <> (show nId) <> "/metrics?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart _ nt nId lId) = "node/" <> (show nId) <> "/recompute-chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt) sessionPath (R.RecomputeListChart _ nt nId lId) = "node/" <> (show nId) <> "/recompute-chart?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.GraphAPI gId p) = "graph/" <> (show gId) <> "/" <> p sessionPath (R.GraphAPI gId p) = "graph/" <> (show gId) <> "/" <> p
sessionPath (R.GetNgrams opts i) = sessionPath (R.GetNgrams opts i) =
base opts.tabType base opts.tabType
...@@ -132,7 +133,7 @@ sessionPath (R.GetNgrams opts i) = ...@@ -132,7 +133,7 @@ sessionPath (R.GetNgrams opts i) =
<> limitUrl opts.limit <> limitUrl opts.limit
<> offset opts.offset <> offset opts.offset
<> orderByUrl opts.orderBy <> orderByUrl opts.orderBy
<> foldMap (\x -> "&list=" <> show x) opts.listIds <> foldMap (\x -> if x /= 0 then "&list=" <> show x else "") opts.listIds
<> foldMap (\x -> "&listType=" <> show x) opts.termListFilter <> foldMap (\x -> "&listType=" <> show x) opts.termListFilter
<> foldMap termSizeFilter opts.termSizeFilter <> foldMap termSizeFilter opts.termSizeFilter
<> search opts.searchQuery <> search opts.searchQuery
...@@ -191,9 +192,9 @@ sessionPath (R.CorpusMetrics { listId, limit, tabType} i) = ...@@ -191,9 +192,9 @@ sessionPath (R.CorpusMetrics { listId, limit, tabType} i) =
<> "?ngrams=" <> show listId <> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType <> "&ngramsType=" <> showTabType' tabType
<> maybe "" limitUrl limit <> maybe "" limitUrl limit
sessionPath (R.CorpusMetricsMD5 { listId, tabType} i) = sessionPath (R.CorpusMetricsHash { listId, tabType} i) =
sessionPath $ R.NodeAPI Corpus i sessionPath $ R.NodeAPI Corpus i
$ "metrics/md5" $ "metrics/hash"
<> "?ngrams=" <> show listId <> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType <> "&ngramsType=" <> showTabType' tabType
-- TODO fix this url path -- TODO fix this url path
...@@ -201,30 +202,35 @@ sessionPath (R.Chart {chartType, limit, listId, tabType} i) = ...@@ -201,30 +202,35 @@ sessionPath (R.Chart {chartType, limit, listId, tabType} i) =
sessionPath $ R.NodeAPI Corpus i sessionPath $ R.NodeAPI Corpus i
$ show chartType $ show chartType
<> "?ngramsType=" <> showTabType' tabType <> "?ngramsType=" <> showTabType' tabType
<> "&listType=MapTerm" -- <> show listId <> "&listType=" <> show MapTerm -- listId
<> listPath <> defaultListAddMaybe listId
where where
listPath = case listId of
Just li -> "&list=" <> show li
Nothing -> ""
limitPath = case limit of limitPath = case limit of
Just li -> "&limit=" <> show li Just li -> "&limit=" <> show li
Nothing -> "" Nothing -> ""
-- <> maybe "" limitUrl limit -- <> maybe "" limitUrl limit
sessionPath (R.ChartMD5 { chartType, listId, tabType } i) = sessionPath (R.ChartHash { chartType, listId, tabType } i) =
sessionPath $ R.NodeAPI Corpus i sessionPath $ R.NodeAPI Corpus i
$ show chartType $ show chartType
<> "/md5?ngramsType=" <> showTabType' tabType <> "/hash?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId <> "&listType=" <> show MapTerm -- listId
<> listPath <> defaultListAddMaybe listId
where
listPath = case listId of
Just li -> "&list=" <> show li
Nothing -> ""
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i -- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
------- misc routing stuff ------- misc routing stuff
defaultList :: Int -> String
defaultList n = if n == 0 then "" else ("list=" <> show n)
defaultListAdd :: Int -> String
defaultListAdd n = "&" <> defaultList n
defaultListAddMaybe :: Maybe Int -> String
defaultListAddMaybe Nothing = ""
defaultListAddMaybe (Just l) = "&list=" <> show l
limitUrl :: Limit -> String limitUrl :: Limit -> String
limitUrl l = "&limit=" <> show l limitUrl l = "&limit=" <> show l
......
module Gargantext.Hooks.Loader where module Gargantext.Hooks.Loader where
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Core (stringify) import Data.Argonaut.Core (stringify)
import Data.Argonaut.Parser (jsonParser) import Data.Argonaut.Parser (jsonParser)
...@@ -7,25 +8,23 @@ import Data.Either (Either(..)) ...@@ -7,25 +8,23 @@ import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust, maybe) import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_, throwError) import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Milkis as M
import Reactix as R
import Web.Storage.Storage as WSS
import Gargantext.Prelude
import Gargantext.Components.LoadingSpinner (loadingSpinner) import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Ends (class ToUrl, toUrl) import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Prelude
import Gargantext.Utils.Crypto (Hash)
import Gargantext.Utils as GU import Gargantext.Utils as GU
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Milkis as M
import Reactix as R
import Web.Storage.Storage as WSS
useLoader :: forall path st. Eq path => useLoader :: forall path st. Eq path
path => path
-> (path -> Aff st) -> (path -> Aff st)
-> (st -> R.Element) -> (st -> R.Element)
-> R.Hooks R.Element -> R.Hooks R.Element
...@@ -53,24 +52,21 @@ useLoaderEffect path state@(state' /\ setState) loader = do ...@@ -53,24 +52,21 @@ useLoaderEffect path state@(state' /\ setState) loader = do
liftEffect $ setState $ const $ Just l liftEffect $ setState $ const $ Just l
type MD5 = String newtype HashedResponse a =
HashedResponse { hash :: Hash
newtype HashedResponse a = HashedResponse {
md5 :: MD5
, value :: a , value :: a
} }
instance decodeHashedResponse :: DecodeJson a => DecodeJson (HashedResponse a) where instance decodeHashedResponse :: DecodeJson a => DecodeJson (HashedResponse a) where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
md5 <- obj .: "md5" hash <- obj .: "hash"
value <- obj .: "value" value <- obj .: "value"
pure $ HashedResponse { md5, value } pure $ HashedResponse { hash, value }
instance encodeHashedResponse :: EncodeJson a => EncodeJson (HashedResponse a) where instance encodeHashedResponse :: EncodeJson a => EncodeJson (HashedResponse a) where
encodeJson (HashedResponse { md5, value }) = do encodeJson (HashedResponse { hash, value }) = do
"md5" := encodeJson md5 "hash" := encodeJson hash
~> "value" := encodeJson value ~> "value" := encodeJson value
~> jsonEmptyObject ~> jsonEmptyObject
...@@ -81,9 +77,9 @@ useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st ...@@ -81,9 +77,9 @@ useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st
-> (path -> Aff (HashedResponse st)) -> (path -> Aff (HashedResponse st))
-> (st -> R.Element) -> (st -> R.Element)
-> R.Hooks R.Element -> R.Hooks R.Element
useLoaderWithCache path keyFunc md5Endpoint loader render = do useLoaderWithCache path keyFunc hashEndpoint loader render = do
state <- R.useState' Nothing state <- R.useState' Nothing
useCachedLoaderEffect { cacheEndpoint: md5Endpoint useCachedLoaderEffect { cacheEndpoint: hashEndpoint
, keyFunc , keyFunc
, loadRealData: loadRealData state , loadRealData: loadRealData state
, path , path
...@@ -93,11 +89,11 @@ useLoaderWithCache path keyFunc md5Endpoint loader render = do ...@@ -93,11 +89,11 @@ useLoaderWithCache path keyFunc md5Endpoint loader render = do
loadRealData :: R.State (Maybe st) -> String -> String -> WSS.Storage -> Aff Unit loadRealData :: R.State (Maybe st) -> String -> String -> WSS.Storage -> Aff Unit
loadRealData (_ /\ setState) key keyCache localStorage = do loadRealData (_ /\ setState) key keyCache localStorage = do
--R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do --R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do
HashedResponse { md5, value: l } <- loader path HashedResponse { hash, value: l } <- loader path
liftEffect $ do liftEffect $ do
let value = stringify $ encodeJson l let value = stringify $ encodeJson l
WSS.setItem key value localStorage WSS.setItem key value localStorage
WSS.setItem keyCache md5 localStorage WSS.setItem keyCache hash localStorage
setState $ const $ Just l setState $ const $ Just l
pure unit pure unit
...@@ -158,8 +154,8 @@ useCachedLoaderEffect { cacheEndpoint, keyFunc, loadRealData, path, state: state ...@@ -158,8 +154,8 @@ useCachedLoaderEffect { cacheEndpoint, keyFunc, loadRealData, path, state: state
decode j = GU.mapLeft (\err -> "Error decoding serialised sessions:" <> show err) (decodeJson j) decode j = GU.mapLeft (\err -> "Error decoding serialised sessions:" <> show err) (decodeJson j)
type LoaderWithCacheAPIProps path res ret = ( type LoaderWithCacheAPIProps path res ret =
cacheEndpoint :: path -> Aff MD5 ( cacheEndpoint :: path -> Aff Hash
, handleResponse :: HashedResponse res -> ret , handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
...@@ -179,15 +175,16 @@ useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer ...@@ -179,15 +175,16 @@ useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer
, state } , state }
pure $ maybe (loadingSpinner {}) renderer (fst state) pure $ maybe (loadingSpinner {}) renderer (fst state)
type LoaderWithCacheAPIEffectProps path res ret = ( type LoaderWithCacheAPIEffectProps path res ret =
cacheEndpoint :: path -> Aff MD5 ( cacheEndpoint :: path -> Aff Hash
, handleResponse :: HashedResponse res -> ret , handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
, state :: R.State (Maybe ret) , state :: R.State (Maybe ret)
) )
useCachedAPILoaderEffect :: forall path res ret. Eq path => DecodeJson res => useCachedAPILoaderEffect :: forall path res ret.
Eq path => DecodeJson res =>
Record (LoaderWithCacheAPIEffectProps path res ret) Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit -> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint useCachedAPILoaderEffect { cacheEndpoint
...@@ -209,14 +206,14 @@ useCachedAPILoaderEffect { cacheEndpoint ...@@ -209,14 +206,14 @@ useCachedAPILoaderEffect { cacheEndpoint
launchAff_ $ do launchAff_ $ do
cache <- GUC.openCache $ GUC.CacheName cacheName cache <- GUC.openCache $ GUC.CacheName cacheName
-- TODO Parallelize? -- TODO Parallelize?
hr@(HashedResponse { md5, value }) <- GUC.cachedJson cache req hr@(HashedResponse { hash, value }) <- GUC.cachedJson cache req
cacheReal <- cacheEndpoint path cacheReal <- cacheEndpoint path
val <- if md5 == cacheReal then val <- if hash == cacheReal then
pure hr pure hr
else do else do
_ <- GUC.delete cache req _ <- GUC.delete cache req
hr@(HashedResponse { md5, value }) <- GUC.cachedJson cache req hr@(HashedResponse { hash, value }) <- GUC.cachedJson cache req
if md5 == cacheReal then if hash == cacheReal then
pure hr pure hr
else else
throwError $ error $ "Fetched clean cache but hashes don't match" throwError $ error $ "Fetched clean cache but hashes don't match"
......
module Gargantext.License where module Gargantext.License where
import Prelude
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
license :: R.Element license :: R.Element
license = H.p {} license = H.p {}
[ H.text "Gargantext " [ H.text "Gargantext "
, H.span {className: "glyphicon glyphicon-registration-mark"} [] , H.span { className: "glyphicon glyphicon-registration-mark"} []
, H.a { href: "http://www.cnrs.fr" , H.text " is made by "
, H.a { href: "https://iscpif.fr"
, target: "blank" , target: "blank"
, title: "Project hosted by CNRS." } [ H.text "CNRS/ISCPIF" ]
}
[ H.text ", Copyrights "
, H.span { className: "glyphicon glyphicon-copyright-mark" } []
, H.text " CNRS 2017-Present"
]
, H.a { href: "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE" , H.a { href: "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE"
, target: "blank" , target: "blank"
, title: "Legal instructions of the project." , title: "Legal instructions of the project."
} }
[ H.text ", Licences aGPLV3 and CECILL variant Affero compliant" ] [ H.text ", with licences aGPLV3 and CECILL variant Affero compliant, " ]
, H.span { className: "glyphicon glyphicon-copyright-mark" } []
, H.a { href: "https://cnrs.fr", target:"blank"} [H.text " CNRS 2017-Present "]
, H.text "." , H.text "."
] ]
...@@ -48,9 +48,9 @@ data SessionRoute ...@@ -48,9 +48,9 @@ data SessionRoute
| ListDocument (Maybe ListId) (Maybe Id) | ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id) | Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id) | CorpusMetrics CorpusMetricOpts (Maybe Id)
| CorpusMetricsMD5 { listId :: ListId, tabType :: TabType } (Maybe Id) | CorpusMetricsHash { listId :: ListId, tabType :: TabType } (Maybe Id)
| Chart ChartOpts (Maybe Id) | Chart ChartOpts (Maybe Id)
| ChartMD5 { chartType :: ChartType, listId :: Maybe ListId, tabType :: TabType } (Maybe Id) | ChartHash { chartType :: ChartType, listId :: Maybe ListId, tabType :: TabType } (Maybe Id)
instance showAppRoute :: Show AppRoute where instance showAppRoute :: Show AppRoute where
show Home = "Home" show Home = "Home"
......
...@@ -154,6 +154,8 @@ data NodeType = NodeUser ...@@ -154,6 +154,8 @@ data NodeType = NodeUser
-- TODO Optional Nodes -- TODO Optional Nodes
| NodeFrameWrite | NodeFrameWrite
| NodeFrameCalc | NodeFrameCalc
| NodePublic NodeType
derive instance eqNodeType :: Eq NodeType derive instance eqNodeType :: Eq NodeType
...@@ -182,6 +184,7 @@ instance showNodeType :: Show NodeType where ...@@ -182,6 +184,7 @@ instance showNodeType :: Show NodeType where
show Texts = "NodeTexts" show Texts = "NodeTexts"
show NodeFrameWrite = "NodeFrameWrite" show NodeFrameWrite = "NodeFrameWrite"
show NodeFrameCalc = "NodeFrameCalc" show NodeFrameCalc = "NodeFrameCalc"
show (NodePublic nt) = "NodePublic" <> show nt
instance readNodeType :: Read NodeType where instance readNodeType :: Read NodeType where
...@@ -207,6 +210,7 @@ instance readNodeType :: Read NodeType where ...@@ -207,6 +210,7 @@ instance readNodeType :: Read NodeType where
read "Annuaire" = Just Annuaire read "Annuaire" = Just Annuaire
read "NodeFrameWrite" = Just NodeFrameWrite read "NodeFrameWrite" = Just NodeFrameWrite
read "NodeFrameCalc" = Just NodeFrameCalc read "NodeFrameCalc" = Just NodeFrameCalc
-- TODO NodePublic read ?
read _ = Nothing read _ = Nothing
...@@ -245,16 +249,26 @@ fldr Annuaire false = "fa fa-address-card" ...@@ -245,16 +249,26 @@ fldr Annuaire false = "fa fa-address-card"
fldr NodeContact true = "fa fa-address-card-o" fldr NodeContact true = "fa fa-address-card-o"
fldr NodeContact false = "fa fa-address-card" fldr NodeContact false = "fa fa-address-card"
fldr NodeFrameWrite true = "fa fa-file-word-o" fldr NodeFrameWrite true = "fa fa-file-text-o"
fldr NodeFrameWrite false = "fa fa-file-word-o" fldr NodeFrameWrite false = "fa fa-file-text"
fldr NodeFrameCalc true = "fa fa-file-excel-o" fldr NodeFrameCalc true = "fa fa-calculator"
fldr NodeFrameCalc false = "fa fa-file-excel-o" fldr NodeFrameCalc false = "fa fa-calculator"
fldr (NodePublic nt) b = fldr nt b
fldr _ false = "fa fa-folder-o"
fldr _ true = "fa fa-folder-open" fldr _ true = "fa fa-folder-open"
fldr _ false = "fa fa-folder-o"
publicize :: NodeType -> NodeType
publicize (NodePublic nt) = NodePublic nt
publicize nt = NodePublic nt
isPublic :: NodeType -> Boolean
isPublic (NodePublic _) = true
isPublic FolderPublic = true
isPublic _ = false
{- {-
------------------------------------------------------------ ------------------------------------------------------------
...@@ -296,6 +310,7 @@ nodeTypePath Texts = "texts" ...@@ -296,6 +310,7 @@ nodeTypePath Texts = "texts"
nodeTypePath Team = "team" nodeTypePath Team = "team"
nodeTypePath NodeFrameWrite = "write" nodeTypePath NodeFrameWrite = "write"
nodeTypePath NodeFrameCalc = "calc" nodeTypePath NodeFrameCalc = "calc"
nodeTypePath (NodePublic nt) = nodeTypePath nt
------------------------------------------------------------ ------------------------------------------------------------
......
module Gargantext.Utils where module Gargantext.Utils where
import Prelude import DOM.Simple.Window (window)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Lens (Lens', lens) import Data.Lens (Lens', lens)
import Data.Newtype (class Newtype, unwrap, wrap) import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Set as Set
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set
import Data.String as S import Data.String as S
import Effect (Effect)
import Effect.Class (liftEffect)
import FFI.Simple ((..))
import FFI.Simple.Functions (delay)
import Prelude
-- | TODO (hard coded) -- | TODO (hard coded)
csrfMiddlewareToken :: String csrfMiddlewareToken :: String
...@@ -74,3 +79,10 @@ queryMatchesLabel q l = S.contains (S.Pattern $ normalize q) (normalize l) ...@@ -74,3 +79,10 @@ queryMatchesLabel q l = S.contains (S.Pattern $ normalize q) (normalize l)
mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
mapLeft f (Left l) = Left (f l) mapLeft f (Left l) = Left (f l)
mapLeft _ (Right r) = Right r mapLeft _ (Right r) = Right r
-- | Get current Window Location
location :: Effect String
location = delay unit $ \_ -> pure $ window .. "location"
'use strict';
// http://www.myersdaily.org/joseph/javascript/md5.js
function md5cycle(x, k) {
var a = x[0], b = x[1], c = x[2], d = x[3];
a = ff(a, b, c, d, k[0], 7, -680876936);
d = ff(d, a, b, c, k[1], 12, -389564586);
c = ff(c, d, a, b, k[2], 17, 606105819);
b = ff(b, c, d, a, k[3], 22, -1044525330);
a = ff(a, b, c, d, k[4], 7, -176418897);
d = ff(d, a, b, c, k[5], 12, 1200080426);
c = ff(c, d, a, b, k[6], 17, -1473231341);
b = ff(b, c, d, a, k[7], 22, -45705983);
a = ff(a, b, c, d, k[8], 7, 1770035416);
d = ff(d, a, b, c, k[9], 12, -1958414417);
c = ff(c, d, a, b, k[10], 17, -42063);
b = ff(b, c, d, a, k[11], 22, -1990404162);
a = ff(a, b, c, d, k[12], 7, 1804603682);
d = ff(d, a, b, c, k[13], 12, -40341101);
c = ff(c, d, a, b, k[14], 17, -1502002290);
b = ff(b, c, d, a, k[15], 22, 1236535329);
a = gg(a, b, c, d, k[1], 5, -165796510);
d = gg(d, a, b, c, k[6], 9, -1069501632);
c = gg(c, d, a, b, k[11], 14, 643717713);
b = gg(b, c, d, a, k[0], 20, -373897302);
a = gg(a, b, c, d, k[5], 5, -701558691);
d = gg(d, a, b, c, k[10], 9, 38016083);
c = gg(c, d, a, b, k[15], 14, -660478335);
b = gg(b, c, d, a, k[4], 20, -405537848);
a = gg(a, b, c, d, k[9], 5, 568446438);
d = gg(d, a, b, c, k[14], 9, -1019803690);
c = gg(c, d, a, b, k[3], 14, -187363961);
b = gg(b, c, d, a, k[8], 20, 1163531501);
a = gg(a, b, c, d, k[13], 5, -1444681467);
d = gg(d, a, b, c, k[2], 9, -51403784);
c = gg(c, d, a, b, k[7], 14, 1735328473);
b = gg(b, c, d, a, k[12], 20, -1926607734);
a = hh(a, b, c, d, k[5], 4, -378558);
d = hh(d, a, b, c, k[8], 11, -2022574463);
c = hh(c, d, a, b, k[11], 16, 1839030562);
b = hh(b, c, d, a, k[14], 23, -35309556);
a = hh(a, b, c, d, k[1], 4, -1530992060);
d = hh(d, a, b, c, k[4], 11, 1272893353);
c = hh(c, d, a, b, k[7], 16, -155497632);
b = hh(b, c, d, a, k[10], 23, -1094730640);
a = hh(a, b, c, d, k[13], 4, 681279174);
d = hh(d, a, b, c, k[0], 11, -358537222);
c = hh(c, d, a, b, k[3], 16, -722521979);
b = hh(b, c, d, a, k[6], 23, 76029189);
a = hh(a, b, c, d, k[9], 4, -640364487);
d = hh(d, a, b, c, k[12], 11, -421815835);
c = hh(c, d, a, b, k[15], 16, 530742520);
b = hh(b, c, d, a, k[2], 23, -995338651);
a = ii(a, b, c, d, k[0], 6, -198630844);
d = ii(d, a, b, c, k[7], 10, 1126891415);
c = ii(c, d, a, b, k[14], 15, -1416354905);
b = ii(b, c, d, a, k[5], 21, -57434055);
a = ii(a, b, c, d, k[12], 6, 1700485571);
d = ii(d, a, b, c, k[3], 10, -1894986606);
c = ii(c, d, a, b, k[10], 15, -1051523);
b = ii(b, c, d, a, k[1], 21, -2054922799);
a = ii(a, b, c, d, k[8], 6, 1873313359);
d = ii(d, a, b, c, k[15], 10, -30611744);
c = ii(c, d, a, b, k[6], 15, -1560198380);
b = ii(b, c, d, a, k[13], 21, 1309151649);
a = ii(a, b, c, d, k[4], 6, -145523070);
d = ii(d, a, b, c, k[11], 10, -1120210379);
c = ii(c, d, a, b, k[2], 15, 718787259);
b = ii(b, c, d, a, k[9], 21, -343485551);
x[0] = add32(a, x[0]);
x[1] = add32(b, x[1]);
x[2] = add32(c, x[2]);
x[3] = add32(d, x[3]);
}
function cmn(q, a, b, x, s, t) {
a = add32(add32(a, q), add32(x, t));
return add32((a << s) | (a >>> (32 - s)), b);
}
function ff(a, b, c, d, x, s, t) {
return cmn((b & c) | ((~b) & d), a, b, x, s, t);
}
function gg(a, b, c, d, x, s, t) {
return cmn((b & d) | (c & (~d)), a, b, x, s, t);
}
function hh(a, b, c, d, x, s, t) {
return cmn(b ^ c ^ d, a, b, x, s, t);
}
function ii(a, b, c, d, x, s, t) {
return cmn(c ^ (b | (~d)), a, b, x, s, t);
}
function md51(s) {
var txt = '';
var n = s.length,
state = [1732584193, -271733879, -1732584194, 271733878], i;
for (i=64; i<=s.length; i+=64) {
md5cycle(state, md5blk(s.substring(i-64, i)));
}
s = s.substring(i-64);
var tail = [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0];
for (i=0; i<s.length; i++)
tail[i>>2] |= s.charCodeAt(i) << ((i%4) << 3);
tail[i>>2] |= 0x80 << ((i%4) << 3);
if (i > 55) {
md5cycle(state, tail);
for (i=0; i<16; i++) tail[i] = 0;
}
tail[14] = n*8;
md5cycle(state, tail);
return state;
}
/* there needs to be support for Unicode here,
* unless we pretend that we can redefine the MD-5
* algorithm for multi-byte characters (perhaps
* by adding every four 16-bit characters and
* shortening the sum to 32 bits). Otherwise
* I suggest performing MD-5 as if every character
* was two bytes--e.g., 0040 0025 = @%--but then
* how will an ordinary MD-5 sum be matched?
* There is no way to standardize text to something
* like UTF-8 before transformation; speed cost is
* utterly prohibitive. The JavaScript standard
* itself needs to look at this: it should start
* providing access to strings as preformed UTF-8
* 8-bit unsigned value arrays.
*/
function md5blk(s) { /* I figured global was faster. */
var md5blks = [], i; /* Andy King said do it this way. */
for (i=0; i<64; i+=4) {
md5blks[i>>2] = s.charCodeAt(i)
+ (s.charCodeAt(i+1) << 8)
+ (s.charCodeAt(i+2) << 16)
+ (s.charCodeAt(i+3) << 24);
}
return md5blks;
}
var hex_chr = '0123456789abcdef'.split('');
function rhex(n)
{
var s='', j=0;
for(; j<4; j++)
s += hex_chr[(n >> (j * 8 + 4)) & 0x0F]
+ hex_chr[(n >> (j * 8)) & 0x0F];
return s;
}
function hex(x) {
for (var i=0; i<x.length; i++)
x[i] = rhex(x[i]);
return x.join('');
}
function md5(s) {
return hex(md51(s));
}
/* this function is much faster,
so if possible we use it. Some IEs
are the only ones I know of that
need the idiotic second function,
generated by an if clause. */
function add32(a, b) {
return (a + b) & 0xFFFFFFFF;
}
/*
if (md5('hello') != '5d41402abc4b2a76b9719d911017c592') {
function add32(x, y) {
var lsw = (x & 0xFFFF) + (y & 0xFFFF),
msw = (x >> 16) + (y >> 16) + (lsw >> 16);
return (msw << 16) | (lsw & 0xFFFF);
}
}
*/
exports.md5 = md5;
module Gargantext.Utils.Crypto where module Gargantext.Utils.Crypto where
foreign import md5 :: String -> String import Crypto.Simple as Crypto
import Data.Set (Set)
import Data.Set as Set
import Data.Array as Array
import Gargantext.Prelude
-- | TODO use newtype to disambiguate Set String and Set Hash
-- Set String needs Set.map hash
-- Set Hash does not need Set.map hash (just concat)
type Hash = String
hash' :: forall a. Crypto.Hashable a => a -> String
hash' = Crypto.toString <<< Crypto.hash Crypto.SHA256
class IsHashable a where
hash :: a -> Hash
instance isHashableString :: IsHashable String
where
hash = hash'
instance isHashableArray :: (Crypto.Hashable a, IsHashable a) => IsHashable (Array a)
where
hash = hash <<< Set.fromFoldable <<< map hash
instance isHashableSet :: IsHashable (Set String) where
hash = hash <<< concat <<< toArray
where
toArray :: forall a. Set a -> Array a
toArray = Set.toUnfoldable
concat :: Array Hash -> String
concat = Array.foldl (<>) ""
...@@ -252,8 +252,8 @@ blur el = el ... "blur" $ [] ...@@ -252,8 +252,8 @@ blur el = el ... "blur" $ []
row :: Array R.Element -> R.Element row :: Array R.Element -> R.Element
row children = H.div { className: "row" } children row children = H.div { className: "row" } children
col12 :: Array R.Element -> R.Element col :: Int -> Array R.Element -> R.Element
col12 children = H.div { className: "col-md-12" } children col n children = H.div { className : "col-md" <> show n } children
innerText :: DOM.Element -> String innerText :: DOM.Element -> String
innerText e = e .. "innerText" innerText e = e .. "innerText"
......
module Gargantext.Version where module Gargantext.Version where
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Config.REST as REST import Gargantext.Config.REST as REST
import Gargantext.Ends (toUrl) import Gargantext.Ends (toUrl)
import Gargantext.Sessions (Session(..)) import Gargantext.Sessions (Session(..))
import Gargantext.Sessions as Sessions
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
type Version = String type Version = String
foreign import version :: Version foreign import version :: Version
getBackendVersion :: Session -> Aff Version getBackendVersion :: Session -> Aff Version
getBackendVersion (Session { backend }) = REST.get Nothing (toUrl backend "version") getBackendVersion (Session { backend }) = REST.get Nothing (toUrl backend "version")
type VersionProps =
(
session :: Sessions.Session
)
versionView :: Record VersionProps -> R.Element
versionView props = R.createElement versionCpt props []
versionCpt :: R.Component VersionProps
versionCpt = R.hooksComponent "G.C.A.version" cpt
where
cpt { session } _ = do
(versionBack /\ setVer) <- R.useState' "No Backend Version"
R.useEffect' $ do
launchAff_ $ do
v <- getBackendVersion session
liftEffect $ setVer $ const v
pure $ case version == versionBack of
true -> H.a { className: "fa fa-check-circle-o"
, "text-decoration": "none"
, title: "Versions match: frontend ("
<> version
<> "), backend ("
<> versionBack
<> ")"
} []
false -> H.a { className: "fa fa-exclamation-triangle"
, "text-decoration": "none"
, title: "Versions mismatch: frontend ("
<> version
<> "), backend ("
<> versionBack
<> ")"
} []
...@@ -8,7 +8,7 @@ import Data.Generic.Rep (class Generic) ...@@ -8,7 +8,7 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils as GU import Gargantext.Utils as GU
import Gargantext.Utils.Argonaut (genericEnumDecodeJson, genericEnumEncodeJson, genericSumDecodeJson, genericSumEncodeJson) import Gargantext.Utils.Argonaut (genericEnumDecodeJson, genericEnumEncodeJson, genericSumDecodeJson, genericSumEncodeJson)
import Gargantext.Utils.Crypto as GUC import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Math as GUM import Gargantext.Utils.Math as GUM
import Test.Spec (Spec, describe, it) import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual) import Test.Spec.Assertions (shouldEqual)
...@@ -63,10 +63,6 @@ spec = ...@@ -63,10 +63,6 @@ spec =
GU.zeroPad 3 1000 `shouldEqual` "1000" GU.zeroPad 3 1000 `shouldEqual` "1000"
it "log10 10" do it "log10 10" do
GUM.log10 10.0 `shouldEqual` 1.0 GUM.log10 10.0 `shouldEqual` 1.0
it "md5 works" do
let text = "The quick brown fox jumps over the lazy dog"
let textMd5 = "9e107d9d372bb6826bd81d3542a419d6"
GUC.md5 text `shouldEqual` textMd5
it "genericSumDecodeJson works" do it "genericSumDecodeJson works" do
let result1 = Argonaut.decodeJson =<< Argonaut.jsonParser """{"Boat":{"hi":1}}""" let result1 = Argonaut.decodeJson =<< Argonaut.jsonParser """{"Boat":{"hi":1}}"""
...@@ -113,3 +109,28 @@ spec = ...@@ -113,3 +109,28 @@ spec =
let result2' = Argonaut.decodeJson result2 let result2' = Argonaut.decodeJson result2
Argonaut.stringify result2 `shouldEqual` "\"Member2\"" Argonaut.stringify result2 `shouldEqual` "\"Member2\""
result2' `shouldEqual` Right input2 result2' `shouldEqual` Right input2
------------------------------------------------------------------------
-- | Crypto Hash tests
it "Hash String with backend works" do
let text = "To hash with backend"
let hashed = "8a69a94d164279af2b7d1443ce08da6184b3d7e815406076e148159c284b53c3"
-- ^ hash from backend with text above
Crypto.hash text `shouldEqual` hashed
it "Hash List with backend works" do
let list = ["a","b"]
let hashed = "ab19ec537f09499b26f0f62eed7aefad46ab9f498e06a7328ce8e8ef90da6d86"
-- ^ hash from backend with text above
Crypto.hash list `shouldEqual` hashed
------------------------------------------------------------------------
-- | TODO property based tests
it "Hash works with any order of list" do
let hash1 = Crypto.hash ["a","b"]
let hash2 = Crypto.hash ["b","a"]
hash1 `shouldEqual` hash2
...@@ -103,6 +103,11 @@ acorn@^7.0.0: ...@@ -103,6 +103,11 @@ acorn@^7.0.0:
resolved "https://registry.yarnpkg.com/acorn/-/acorn-7.1.0.tgz#949d36f2c292535da602283586c2477c57eb2d6c" resolved "https://registry.yarnpkg.com/acorn/-/acorn-7.1.0.tgz#949d36f2c292535da602283586c2477c57eb2d6c"
integrity sha512-kL5CuoXA/dgxlBbVrflsflzQ3PAas7RYZB52NOm/6839iVYJgKMJ3cQJD+t2i5+qFa8h3MDpEOJiS64E8JLnSQ== integrity sha512-kL5CuoXA/dgxlBbVrflsflzQ3PAas7RYZB52NOm/6839iVYJgKMJ3cQJD+t2i5+qFa8h3MDpEOJiS64E8JLnSQ==
aes-js@^3.1.1:
version "3.1.2"
resolved "https://registry.yarnpkg.com/aes-js/-/aes-js-3.1.2.tgz#db9aabde85d5caabbfc0d4f2a4446960f627146a"
integrity sha512-e5pEa2kBnBOgR4Y/p20pskXI74UEz7de8ZGVo58asOtvSVG5YAbJeELPZxOmt+Bnz3rX753YKhfIn4X4l1PPRQ==
ajv@6.5.3: ajv@6.5.3:
version "6.5.3" version "6.5.3"
resolved "https://registry.yarnpkg.com/ajv/-/ajv-6.5.3.tgz#71a569d189ecf4f4f321224fecb166f071dd90f9" resolved "https://registry.yarnpkg.com/ajv/-/ajv-6.5.3.tgz#71a569d189ecf4f4f321224fecb166f071dd90f9"
...@@ -254,6 +259,13 @@ balanced-match@^1.0.0: ...@@ -254,6 +259,13 @@ balanced-match@^1.0.0:
resolved "https://registry.yarnpkg.com/balanced-match/-/balanced-match-1.0.0.tgz#89b4d199ab2bee49de164ea02b89ce462d71b767" resolved "https://registry.yarnpkg.com/balanced-match/-/balanced-match-1.0.0.tgz#89b4d199ab2bee49de164ea02b89ce462d71b767"
integrity sha1-ibTRmasr7kneFk6gK4nORi1xt2c= integrity sha1-ibTRmasr7kneFk6gK4nORi1xt2c=
base-x@^3.0.2:
version "3.0.8"
resolved "https://registry.yarnpkg.com/base-x/-/base-x-3.0.8.tgz#1e1106c2537f0162e8b52474a557ebb09000018d"
integrity sha512-Rl/1AWP4J/zRrk54hhlxH4drNxPJXYUaKffODVI53/dAsV4t9fBxyxYKAVPU1XBHxYwOWP9h9H0hM2MVw4YfJA==
dependencies:
safe-buffer "^5.0.1"
base64-js@^1.0.2: base64-js@^1.0.2:
version "1.3.1" version "1.3.1"
resolved "https://registry.yarnpkg.com/base64-js/-/base64-js-1.3.1.tgz#58ece8cb75dd07e71ed08c736abc5fac4dbf8df1" resolved "https://registry.yarnpkg.com/base64-js/-/base64-js-1.3.1.tgz#58ece8cb75dd07e71ed08c736abc5fac4dbf8df1"
...@@ -271,6 +283,20 @@ binary-extensions@^2.0.0: ...@@ -271,6 +283,20 @@ binary-extensions@^2.0.0:
resolved "https://registry.yarnpkg.com/binary-extensions/-/binary-extensions-2.0.0.tgz#23c0df14f6a88077f5f986c0d167ec03c3d5537c" resolved "https://registry.yarnpkg.com/binary-extensions/-/binary-extensions-2.0.0.tgz#23c0df14f6a88077f5f986c0d167ec03c3d5537c"
integrity sha512-Phlt0plgpIIBOGTT/ehfFnbNlfsDEiqmzE2KRXoX1bLIlir4X/MR+zSyBEkL05ffWgnRSf/DXv+WrUAVr93/ow== integrity sha512-Phlt0plgpIIBOGTT/ehfFnbNlfsDEiqmzE2KRXoX1bLIlir4X/MR+zSyBEkL05ffWgnRSf/DXv+WrUAVr93/ow==
bindings@^1.5.0:
version "1.5.0"
resolved "https://registry.yarnpkg.com/bindings/-/bindings-1.5.0.tgz#10353c9e945334bc0511a6d90b38fbc7c9c504df"
integrity sha512-p2q/t/mhvuOj/UeLlV6566GD/guowlr0hHxClI0W9m7MWYkL1F0hLo+0Aexs9HSPCtR1SXQ0TD3MMKrXZajbiQ==
dependencies:
file-uri-to-path "1.0.0"
bip66@^1.1.5:
version "1.1.5"
resolved "https://registry.yarnpkg.com/bip66/-/bip66-1.1.5.tgz#01fa8748785ca70955d5011217d1b3139969ca22"
integrity sha1-AfqHSHhcpwlV1QESF9GzE5lpyiI=
dependencies:
safe-buffer "^5.0.1"
bluebird@^3.5.5: bluebird@^3.5.5:
version "3.7.2" version "3.7.2"
resolved "https://registry.yarnpkg.com/bluebird/-/bluebird-3.7.2.tgz#9f229c15be272454ffa973ace0dbee79a1b0c36f" resolved "https://registry.yarnpkg.com/bluebird/-/bluebird-3.7.2.tgz#9f229c15be272454ffa973ace0dbee79a1b0c36f"
...@@ -281,6 +307,11 @@ bn.js@^4.0.0, bn.js@^4.1.0, bn.js@^4.1.1, bn.js@^4.4.0: ...@@ -281,6 +307,11 @@ bn.js@^4.0.0, bn.js@^4.1.0, bn.js@^4.1.1, bn.js@^4.4.0:
resolved "https://registry.yarnpkg.com/bn.js/-/bn.js-4.11.8.tgz#2cde09eb5ee341f484746bb0309b3253b1b1442f" resolved "https://registry.yarnpkg.com/bn.js/-/bn.js-4.11.8.tgz#2cde09eb5ee341f484746bb0309b3253b1b1442f"
integrity sha512-ItfYfPLkWHUjckQCk8xC+LwxgK8NYcXywGigJgSwOP8Y2iyWT4f2vsZnoOXTTbo+o5yXmIUJ4gn5538SO5S3gA== integrity sha512-ItfYfPLkWHUjckQCk8xC+LwxgK8NYcXywGigJgSwOP8Y2iyWT4f2vsZnoOXTTbo+o5yXmIUJ4gn5538SO5S3gA==
bn.js@^4.11.8:
version "4.11.9"
resolved "https://registry.yarnpkg.com/bn.js/-/bn.js-4.11.9.tgz#26d556829458f9d1e81fc48952493d0ba3507828"
integrity sha512-E6QoYqCKZfgatHTdHzs1RRKP7ip4vvm+EyRUeE2RF0NblwVvb0p6jSVeNTOFxPn26QXN2o6SMfNxKp6kU8zQaw==
boxen@1.3.0: boxen@1.3.0:
version "1.3.0" version "1.3.0"
resolved "https://registry.yarnpkg.com/boxen/-/boxen-1.3.0.tgz#55c6c39a8ba58d9c61ad22cd877532deb665a20b" resolved "https://registry.yarnpkg.com/boxen/-/boxen-1.3.0.tgz#55c6c39a8ba58d9c61ad22cd877532deb665a20b"
...@@ -333,7 +364,7 @@ browser-resolve@^1.11.0, browser-resolve@^1.7.0: ...@@ -333,7 +364,7 @@ browser-resolve@^1.11.0, browser-resolve@^1.7.0:
dependencies: dependencies:
resolve "1.1.7" resolve "1.1.7"
browserify-aes@^1.0.0, browserify-aes@^1.0.4: browserify-aes@^1.0.0, browserify-aes@^1.0.4, browserify-aes@^1.0.6:
version "1.2.0" version "1.2.0"
resolved "https://registry.yarnpkg.com/browserify-aes/-/browserify-aes-1.2.0.tgz#326734642f403dabc3003209853bb70ad428ef48" resolved "https://registry.yarnpkg.com/browserify-aes/-/browserify-aes-1.2.0.tgz#326734642f403dabc3003209853bb70ad428ef48"
integrity sha512-+7CHXqGuspUn/Sl5aO7Ea0xWGAtETPXNSAjHo48JfLdPWcMng33Xe4znFvQweqc/uzk5zSOI3H52CYnjCfb5hA== integrity sha512-+7CHXqGuspUn/Sl5aO7Ea0xWGAtETPXNSAjHo48JfLdPWcMng33Xe4znFvQweqc/uzk5zSOI3H52CYnjCfb5hA==
...@@ -777,7 +808,7 @@ create-ecdh@^4.0.0: ...@@ -777,7 +808,7 @@ create-ecdh@^4.0.0:
bn.js "^4.1.0" bn.js "^4.1.0"
elliptic "^6.0.0" elliptic "^6.0.0"
create-hash@^1.1.0, create-hash@^1.1.2: create-hash@^1.1.0, create-hash@^1.1.2, create-hash@^1.2.0:
version "1.2.0" version "1.2.0"
resolved "https://registry.yarnpkg.com/create-hash/-/create-hash-1.2.0.tgz#889078af11a63756bcfb59bd221996be3a9ef196" resolved "https://registry.yarnpkg.com/create-hash/-/create-hash-1.2.0.tgz#889078af11a63756bcfb59bd221996be3a9ef196"
integrity sha512-z00bCGNHDG8mHAkP7CtT1qVu+bFQUPjYq/4Iv3C3kWjTFV10zIjfSoeqXo9Asws8gwSHDGj/hl2u4OGIjapeCg== integrity sha512-z00bCGNHDG8mHAkP7CtT1qVu+bFQUPjYq/4Iv3C3kWjTFV10zIjfSoeqXo9Asws8gwSHDGj/hl2u4OGIjapeCg==
...@@ -1004,6 +1035,15 @@ download-purescript@^0.8.3: ...@@ -1004,6 +1035,15 @@ download-purescript@^0.8.3:
is-plain-obj "^1.1.0" is-plain-obj "^1.1.0"
zen-observable "^0.8.13" zen-observable "^0.8.13"
drbg.js@^1.0.1:
version "1.0.1"
resolved "https://registry.yarnpkg.com/drbg.js/-/drbg.js-1.0.1.tgz#3e36b6c42b37043823cdbc332d58f31e2445480b"
integrity sha1-Pja2xCs3BDgjzbwzLVjzHiRFSAs=
dependencies:
browserify-aes "^1.0.6"
create-hash "^1.1.2"
create-hmac "^1.1.4"
duplexer2@^0.1.2, duplexer2@~0.1.0, duplexer2@~0.1.2: duplexer2@^0.1.2, duplexer2@~0.1.0, duplexer2@~0.1.2:
version "0.1.4" version "0.1.4"
resolved "https://registry.yarnpkg.com/duplexer2/-/duplexer2-0.1.4.tgz#8b12dab878c0d69e3e7891051662a32fc6bddcc1" resolved "https://registry.yarnpkg.com/duplexer2/-/duplexer2-0.1.4.tgz#8b12dab878c0d69e3e7891051662a32fc6bddcc1"
...@@ -1057,6 +1097,19 @@ elliptic@^6.0.0: ...@@ -1057,6 +1097,19 @@ elliptic@^6.0.0:
minimalistic-assert "^1.0.0" minimalistic-assert "^1.0.0"
minimalistic-crypto-utils "^1.0.0" minimalistic-crypto-utils "^1.0.0"
elliptic@^6.5.2:
version "6.5.3"
resolved "https://registry.yarnpkg.com/elliptic/-/elliptic-6.5.3.tgz#cb59eb2efdaf73a0bd78ccd7015a62ad6e0f93d6"
integrity sha512-IMqzv5wNQf+E6aHeIqATs0tOLeOTwj1QKbRcS3jBbYkl5oLAserA8yJTT7/VyHUYG91PRmPyeQDObKLPpeS4dw==
dependencies:
bn.js "^4.4.0"
brorand "^1.0.1"
hash.js "^1.0.0"
hmac-drbg "^1.0.0"
inherits "^2.0.1"
minimalistic-assert "^1.0.0"
minimalistic-crypto-utils "^1.0.0"
emoji-regex@^7.0.1: emoji-regex@^7.0.1:
version "7.0.3" version "7.0.3"
resolved "https://registry.yarnpkg.com/emoji-regex/-/emoji-regex-7.0.3.tgz#933a04052860c85e83c122479c4748a8e4c72156" resolved "https://registry.yarnpkg.com/emoji-regex/-/emoji-regex-7.0.3.tgz#933a04052860c85e83c122479c4748a8e4c72156"
...@@ -1246,6 +1299,11 @@ file-to-npm-cache@^0.1.0: ...@@ -1246,6 +1299,11 @@ file-to-npm-cache@^0.1.0:
pump "^3.0.0" pump "^3.0.0"
tar "^4.4.6" tar "^4.4.6"
file-uri-to-path@1.0.0:
version "1.0.0"
resolved "https://registry.yarnpkg.com/file-uri-to-path/-/file-uri-to-path-1.0.0.tgz#553a7b8446ff6f684359c445f1e37a05dacc33dd"
integrity sha512-0Zt+s3L7Vf1biwWZ29aARiVYLx7iMGnEUl9x33fbB/j3jR81u/O2LbqK+Bm1CDSNDKVtJ/YjwY7TUd5SkeLQLw==
filesize@^4.1.2: filesize@^4.1.2:
version "4.2.1" version "4.2.1"
resolved "https://registry.yarnpkg.com/filesize/-/filesize-4.2.1.tgz#ab1cb2069db5d415911c1a13e144c0e743bc89bc" resolved "https://registry.yarnpkg.com/filesize/-/filesize-4.2.1.tgz#ab1cb2069db5d415911c1a13e144c0e743bc89bc"
...@@ -2018,6 +2076,11 @@ mute-stream@~0.0.4: ...@@ -2018,6 +2076,11 @@ mute-stream@~0.0.4:
resolved "https://registry.yarnpkg.com/mute-stream/-/mute-stream-0.0.8.tgz#1630c42b2251ff81e2a283de96a5497ea92e5e0d" resolved "https://registry.yarnpkg.com/mute-stream/-/mute-stream-0.0.8.tgz#1630c42b2251ff81e2a283de96a5497ea92e5e0d"
integrity sha512-nnbWWOkoWyUsTjKrhgD0dcz22mdkSnpYqbEjIm2nhwhuxlSkpywJmBo8h0ZqJdkp73mb90SssHkN4rsRaBAfAA== integrity sha512-nnbWWOkoWyUsTjKrhgD0dcz22mdkSnpYqbEjIm2nhwhuxlSkpywJmBo8h0ZqJdkp73mb90SssHkN4rsRaBAfAA==
nan@^2.14.0:
version "2.14.1"
resolved "https://registry.yarnpkg.com/nan/-/nan-2.14.1.tgz#d7be34dfa3105b91494c3147089315eff8874b01"
integrity sha512-isWHgVjnFjh2x2yuJ/tj3JbwoHu3UC2dX5G/88Cm24yB6YopVgxvBObDY7n5xW6ExmFhJpSEQqFPvq9zaXc8Jw==
neat-stack@^1.0.1: neat-stack@^1.0.1:
version "1.0.1" version "1.0.1"
resolved "https://registry.yarnpkg.com/neat-stack/-/neat-stack-1.0.1.tgz#6dc506acdcdb9f536def80c4fe3ba39324481be6" resolved "https://registry.yarnpkg.com/neat-stack/-/neat-stack-1.0.1.tgz#6dc506acdcdb9f536def80c4fe3ba39324481be6"
...@@ -2805,6 +2868,20 @@ scheduler@^0.18.0: ...@@ -2805,6 +2868,20 @@ scheduler@^0.18.0:
loose-envify "^1.1.0" loose-envify "^1.1.0"
object-assign "^4.1.1" object-assign "^4.1.1"
secp256k1@^3.3.0:
version "3.8.0"
resolved "https://registry.yarnpkg.com/secp256k1/-/secp256k1-3.8.0.tgz#28f59f4b01dbee9575f56a47034b7d2e3b3b352d"
integrity sha512-k5ke5avRZbtl9Tqx/SA7CbY3NF6Ro+Sj9cZxezFzuBlLDmyqPiL8hJJ+EmzD8Ig4LUDByHJ3/iPOVoRixs/hmw==
dependencies:
bindings "^1.5.0"
bip66 "^1.1.5"
bn.js "^4.11.8"
create-hash "^1.2.0"
drbg.js "^1.0.1"
elliptic "^6.5.2"
nan "^2.14.0"
safe-buffer "^5.1.2"
semver@^5.5.0: semver@^5.5.0:
version "5.7.1" version "5.7.1"
resolved "https://registry.yarnpkg.com/semver/-/semver-5.7.1.tgz#a954f931aeba508d307bbf069eff0c01c96116f7" resolved "https://registry.yarnpkg.com/semver/-/semver-5.7.1.tgz#a954f931aeba508d307bbf069eff0c01c96116f7"
......
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