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 @@
"repo": "https://github.com/reactormonk/purescript-simple-timestamp.git",
"version": "v1.3.0"
},
"simplecrypto": {
"dependencies": [
"prelude",
"maybe",
"node-buffer"
],
"repo": "https://github.com/alpacaaa/purescript-simplecrypto",
"version": "v1.0.1"
},
"sized-vectors": {
"dependencies": [
"arrays",
......
......@@ -838,6 +838,15 @@
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" = {
name = "smolder";
version = "v12.0.0";
......
{
"name": "Gargantext",
"version": "0.0.1.6.6",
"version": "0.0.1.7.1",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......@@ -13,10 +13,12 @@
"clean": "rm -Rf output node_modules",
"clean-js": "rm -Rf node_modules",
"clean-ps": "rm -Rf output",
"test": "pulp test",
"test": "pulp test --no-check-main",
"server": "serve dist"
},
"dependencies": {
"aes-js": "^3.1.1",
"base-x": "^3.0.2",
"create-react-class": "^15.6.3",
"echarts": "^4.1.0",
"echarts-for-react": "^2.0.14",
......@@ -25,6 +27,7 @@
"react": "^16.10",
"react-awesome-popover": "^6.1.1",
"react-dom": "^16.10",
"secp256k1": "^3.3.0",
"sigma": "git://github.com/poorscript/sigma.js#garg"
},
"devDependencies": {
......
......@@ -140,6 +140,11 @@ let additions =
[ "prelude" ]
"https://github.com/hdgarrood/purescript-versions.git"
"v5.0.1"
, simplecrypto =
mkPackage
[ "prelude", "maybe", "node-buffer"]
"https://github.com/alpacaaa/purescript-simplecrypto"
"v1.0.1"
}
in upstream ⫽ overrides ⫽ additions
......@@ -3,8 +3,8 @@
"set": "local",
"source": ".psc-package/local/.set/packages.json",
"depends": [
"affjax",
"aff-promise",
"affjax",
"argonaut",
"console",
"css",
......@@ -12,8 +12,8 @@
"dom-filereader",
"dom-simple",
"effect",
"foreign-object",
"foreign-generic",
"foreign-object",
"generics-rep",
"globals",
"integers",
......@@ -32,6 +32,7 @@
"record-extra",
"routing",
"sequences",
"simplecrypto",
"smolder",
"spec-discovery",
"spec-quickcheck",
......
module Gargantext.Components.App where
import Prelude
import Data.Array (fromFoldable)
import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe')
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.GraphExplorer (explorerLayout)
import Gargantext.Components.Lang (LandingLang(..))
import Gargantext.Components.Login (login)
import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, userLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.License (license)
import Gargantext.Router (router)
import Gargantext.Routes (AppRoute(..))
import Gargantext.Sessions (Sessions, useSessions)
import Gargantext.Sessions as Sessions
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?)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
......@@ -251,59 +245,21 @@ liNav (LiNav { title : title'
]
---------------------------------------------------------------------------
-- | TODO put Version in the Tree/Root node
type VersionProps =
type FooterProps =
(
session :: Sessions.Session
)
version :: Record VersionProps -> 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 :: Record FooterProps -> R.Element
footer props = R.createElement footerCpt props []
footerCpt :: R.Component VersionProps
footerCpt :: R.Component FooterProps
footerCpt = R.hooksComponent "G.C.A.footer" cpt
where
cpt { session } _ = do
pure $ H.div
{ className: "container" }
[ H.hr {}
, H.footer {} [ version { session }
, license
]
, H.footer {} [ license ]
]
......@@ -363,18 +363,18 @@ loadPage session { corpusId, listId, nodeId, query, tabType } = do
--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)
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 ret = if mock then
--Tuple 0 (take limit $ drop offset sampleData)
Tuple 0 sampleData
else
Tuple res.count docs
pure $ HashedResponse { md5, value: ret }
pure $ HashedResponse { hash, value: ret }
getPageMD5 :: Session -> PageParams -> Aff String
getPageMD5 session { corpusId, listId, nodeId, query, tabType } = do
let p = NodeAPI Node (Just nodeId) $ "table/md5" <> "?tabType=" <> (showTabType' tabType)
getPageHash :: Session -> PageParams -> Aff String
getPageHash session { corpusId, listId, nodeId, query, tabType } = do
let p = NodeAPI Node (Just nodeId) $ "table/hash" <> "?tabType=" <> (showTabType' tabType)
(get session p) :: Aff String
......@@ -404,9 +404,9 @@ pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponent "G.C.DocsTable.pageLayout" cpt where
cpt props@{frontends, session, nodeId, listId, corpusId, tabType, query, params} _ =
-- useLoader path (loadPage session) paint
--useLoaderWithCache path keyFunc (getPageMD5 session) (loadPage session) paint
-- useLoaderWithCache path keyFunc (getPageHash session) (loadPage session) paint
useLoaderWithCacheAPI {
cacheEndpoint: getPageMD5 session
cacheEndpoint: getPageHash session
, handleResponse
, mkRequest
, path
......@@ -424,7 +424,7 @@ pageLayoutCpt = R.hooksComponent "G.C.DocsTable.pageLayout" cpt where
mkRequest p@{ listId, nodeId, tabType } =
GUC.makeGetRequest session $ NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) <> "&list=" <> (show listId)
handleResponse :: HashedResponse (TableResult Response) -> Tuple Int (Array DocumentsView)
handleResponse (HashedResponse { md5, value: res }) = ret
handleResponse (HashedResponse { hash, value: res }) = ret
where
docs = res2corpus <$> res.docs
ret = if mock then
......
......@@ -63,7 +63,7 @@ forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
plus :: R2.Setter Boolean -> R.Element
plus showLogin =
H.button { on: {click}
, className: "btn btn-primary"
, className: "btn btn-default"
}
[ H.div { "type": ""
, className: "fa fa-universal-access fa-lg"
......
......@@ -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.Action (Action(..))
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.Merge (mergeNodeReq)
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.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.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
......@@ -33,7 +33,7 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>))
import Gargantext.Routes (AppRoute)
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.Routes as GR
......@@ -192,7 +192,11 @@ toHtml p@{ asyncTasks
} ]
<> childNodes ( Record.merge commonProps
{ 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
}
)
......@@ -232,13 +236,17 @@ type PerformActionProps =
performAction :: Action
-> Record PerformActionProps
-> Aff Unit
performAction DeleteNode p@{ openNodes: (_ /\ setOpenNodes)
performAction (DeleteNode nt) p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _)
, tree: (NTree (LNode {id, parent_id}) _)
} =
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))
performAction RefreshTree p
......@@ -274,12 +282,22 @@ performAction (RenameNode name) p@{ reload: (_ /\ setReload)
performAction RefreshTree p
-------
performAction (ShareNode username) p@{ reload: (_ /\ setReload)
performAction (ShareTeam username) p@{ reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _)
} =
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)
......
......@@ -22,6 +22,7 @@ import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, unit, void, ($), (<>), (==))
import Gargantext.Routes as Routes
import Gargantext.Version as GV
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (Name, ID)
import Gargantext.Types as GT
......@@ -88,6 +89,9 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
}
) tasks
)
, if nodeType == GT.NodeUser
then GV.versionView {session}
else H.div {} []
]
where
SettingsBox {show: showBox} = settingsBox nodeType
......@@ -96,6 +100,7 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
name' {name, nodeType} = if nodeType == GT.NodeUser
then show session
else name
chevronIcon nodeType folderOpen'@(open /\ _) =
H.a { className: "chevron-icon"
, onClick: R2.effToggler folderOpen'
......@@ -230,6 +235,8 @@ mAppRouteId (Just (Routes.Texts _ id)) = Just id
mAppRouteId (Just (Routes.Lists _ id)) = Just id
mAppRouteId (Just (Routes.Annuaire _ 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.ContactPage _ id _ )) = Just id
mAppRouteId (Just (Routes.CorpusDocument _ id _ _)) = Just id
......
......@@ -20,41 +20,45 @@ type Props =
data Action = AddNode String GT.NodeType
| DeleteNode
| DeleteNode GT.NodeType
| RenameNode String
| UpdateNode UpdateNodeParams
| ShareNode String
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| DownloadNode
| RefreshTree
| MoveNode {params :: Maybe SubTreeOut}
| MergeNode {params :: Maybe SubTreeOut}
| LinkNode {params :: Maybe SubTreeOut}
| ShareTeam String
| SharePublic {params :: Maybe SubTreeOut}
| MoveNode {params :: Maybe SubTreeOut}
| MergeNode {params :: Maybe SubTreeOut}
| LinkNode {params :: Maybe SubTreeOut}
| NoAction
subTreeOut :: Action -> Maybe SubTreeOut
subTreeOut (MoveNode {params}) = params
subTreeOut (MergeNode {params}) = params
subTreeOut (LinkNode {params}) = params
subTreeOut (MoveNode {params}) = params
subTreeOut (MergeNode {params}) = params
subTreeOut (LinkNode {params}) = params
subTreeOut (SharePublic {params}) = params
subTreeOut _ = Nothing
setTreeOut :: Action -> Maybe SubTreeOut -> Action
setTreeOut (MoveNode {params:_}) p = MoveNode {params: p}
setTreeOut (MergeNode {params:_}) p = MergeNode {params: p}
setTreeOut (LinkNode {params:_}) p = LinkNode {params: p}
setTreeOut (SharePublic {params:_}) p = SharePublic {params: p}
setTreeOut a _ = a
instance showShow :: Show Action where
show (AddNode _ _ )= "AddNode"
show DeleteNode = "DeleteNode"
show (DeleteNode _ )= "DeleteNode"
show (RenameNode _ )= "RenameNode"
show (UpdateNode _ )= "UpdateNode"
show (ShareNode _ )= "ShareNode"
show (ShareTeam _ )= "ShareTeam"
show (SharePublic _ )= "SharePublic"
show (DoSearch _ )= "SearchQuery"
show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree"
......@@ -67,10 +71,11 @@ instance showShow :: Show Action where
-----------------------------------------------------------------------
icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon DeleteNode = glyphiconNodeAction Delete
icon (DeleteNode _) = glyphiconNodeAction Delete
icon (RenameNode _) = glyphiconNodeAction Config
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 (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
......@@ -85,16 +90,17 @@ icon NoAction = "hand-o-right"
text :: Action -> String
text (AddNode _ _ )= "Add !"
text DeleteNode = "Delete !"
text (DeleteNode _ )= "Delete !"
text (RenameNode _ )= "Rename !"
text (UpdateNode _ )= "Update !"
text (ShareNode _ )= "Share !"
text (ShareTeam _ )= "Share with team !"
text (SharePublic _ )= "Publish !"
text (DoSearch _ )= "Launch search !"
text (UploadFile _ _ _ _)= "Upload File !"
text RefreshTree = "Refresh Tree !"
text DownloadNode = "Download !"
text (MoveNode _ ) = "Move !"
text (MergeNode _ ) = "Merge !"
text (LinkNode _ ) = "Link !"
text (MoveNode _ ) = "Move !"
text (MergeNode _ ) = "Merge !"
text (LinkNode _ ) = "Link !"
text NoAction = "No Action"
-----------------------------------------------------------------------
module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array (head)
import Data.Array (head, length)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
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.Sessions (Session, post)
import Gargantext.Types as GT
......@@ -61,17 +61,26 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
el = R.hooksComponent "AddNodeView" cpt
cpt {id, name} _ = do
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
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
then formEdit "Node Name" setNodeName
else H.div {} []
]
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt) dispatch)
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt') dispatch)
-- END Create Node
......
......@@ -5,7 +5,7 @@ import Data.Maybe (Maybe(..))
import Gargantext.Prelude
import Effect.Aff (Aff)
import Gargantext.Types as GT
import Gargantext.Sessions (Session, delete)
import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Types (NodeType(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
......@@ -14,8 +14,20 @@ import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Reactix.DOM.HTML as H
-- TODO Delete with asyncTaskWithType
deleteNode :: Session -> GT.ID -> Aff GT.ID
deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
deleteNode :: Session -> NodeType -> GT.ID -> Aff GT.ID
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
actionDelete :: NodeType -> (Action -> Aff Unit) -> R.Hooks R.Element
......@@ -29,7 +41,7 @@ actionDelete NodeUser _ = do
]
(H.div {} [])
actionDelete _ dispatch = do
actionDelete nt dispatch = do
pure $ panel [ H.div {style: {margin: "10px"}}
(map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?"
......@@ -37,7 +49,7 @@ actionDelete _ dispatch = do
]
)
]
(submitButton DeleteNode dispatch)
(submitButton (DeleteNode nt) dispatch)
......
......@@ -5,31 +5,87 @@ import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Prelude (($))
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 (ID)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
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)
share session nodeId =
shareReq :: Session -> ID -> ShareNodeParams -> Aff ID
shareReq session nodeId =
post session $ GR.NodeAPI GT.Node (Just nodeId) "share"
shareAction :: String -> Action
shareAction username = ShareNode username
shareAction username = Action.ShareTeam username
------------------------------------------------------------------------
textInputBox :: Record Tools.TextInputBoxProps -> R.Element
textInputBox = Tools.textInputBox
------------------------------------------------------------------------
newtype ShareValue = ShareValue
{ text :: String }
data ShareNodeParams = ShareTeamParams { username :: 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
textInputBox = Tools.textInputBox
shareNode :: Record SubTreeParamsIn -> R.Element
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
[]
]
where
{- -- This shows the Help of this button
undo = setNodePopup
$ const (node { action = Nothing })
-}
doToDo = setNodePopup $ const $ node { action = Just todo }
-- | Open the help indications if selected already
doToDo = setNodePopup $ const $ node { action = todo' }
where
todo' = case action == Just todo of
true -> Nothing
false -> Just todo
iconAStyle :: GT.NodeType -> NodeAction -> {
color :: String
......@@ -295,8 +295,13 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
, id
, text: "username"
, 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} _ =
actionSearch session (Just id) dispatch nodePopup
......
......@@ -20,6 +20,7 @@ data NodeAction = Documentation NodeType
| Download | Upload | Refresh | Config
| Delete
| Share
| Publish { subTreeParams :: SubTreeParams }
| Add (Array NodeType)
| Merge { subTreeParams :: SubTreeParams }
| Move { subTreeParams :: SubTreeParams }
......@@ -41,6 +42,7 @@ instance eqNodeAction :: Eq NodeAction where
eq (Add x) (Add y) = x == y
eq (Merge x) (Merge y) = x == y
eq Config Config = true
eq (Publish x) (Publish y) = x == y
eq _ _ = false
instance showNodeAction :: Show NodeAction where
......@@ -57,7 +59,7 @@ instance showNodeAction :: Show NodeAction where
show (Link x) = "Link to " <> show x
show (Add xs) = foldl (\a b -> a <> show b) "Add " xs
show (Merge t) = "Merge with subtree" <> show t
show (Publish x) = "Publish" <> show x
glyphiconNodeAction :: NodeAction -> String
glyphiconNodeAction (Documentation _) = "question-circle"
......@@ -72,9 +74,9 @@ glyphiconNodeAction Refresh = "refresh"
glyphiconNodeAction Config = "wrench"
glyphiconNodeAction Share = "user-plus"
glyphiconNodeAction (Move _) = "share-square-o"
glyphiconNodeAction (Publish _) = fldr FolderPublic true
glyphiconNodeAction _ = ""
------------------------------------------------------------------------
data SettingsBox =
SettingsBox { show :: Boolean
......@@ -133,11 +135,9 @@ settingsBox FolderShared =
settingsBox FolderPublic =
SettingsBox { show : true
, edit : false
, edit : true
, doc : Documentation FolderPublic
, buttons : [ Add [ Corpus
, Folder
]
, buttons : [ Add [ FolderPublic ]
-- , Delete
]
}
......@@ -190,15 +190,43 @@ settingsBox Texts =
settingsBox Graph =
SettingsBox { show : true
, edit : false
, edit : true
, doc : Documentation Graph
, buttons : [ Refresh
, Config
, 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
]
}
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 { show : true
, edit : false
......@@ -227,6 +255,7 @@ settingsBox Dashboard =
, edit : false
, doc : Documentation Dashboard
, buttons : [ Refresh
, Publish publishParams
, Delete
]
}
......@@ -249,6 +278,7 @@ settingsBox NodeFrameWrite =
, buttons : [ Add [ NodeFrameWrite
, NodeFrameCalc
]
, Move moveFrameParameters
, Delete
]
}
......@@ -261,6 +291,7 @@ settingsBox NodeFrameCalc =
, buttons : [ Add [ NodeFrameCalc
, NodeFrameWrite
]
, Move moveFrameParameters
, Delete
]
}
......@@ -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
{ showtypes: [ FolderPrivate
, FolderShared
......@@ -303,3 +358,13 @@ linkParams = { subTreeParams : SubTreeParams
}
}
publishParams = { subTreeParams : SubTreeParams
{ showtypes: [ FolderPublic
]
, valitypes: [ FolderPublic
]
}
}
......@@ -13,7 +13,6 @@ hasStatus _ Refresh = Dev
hasStatus _ Config = Dev
hasStatus _ (Link _) = Dev
hasStatus _ (Merge _) = Dev
hasStatus _ (Move _) = Test
hasStatus _ (Documentation _) = Dev
hasStatus Annuaire Upload = Dev
hasStatus Texts Upload = Dev
......
......@@ -167,17 +167,22 @@ formChoice nodeTypes defaultNodeType setNodeType =
-- | Button Form
-- FIXME: currently needs a click from the user (by default, we could avoid such click)
formButton :: forall a b c
. a
. Show a
=> a
-> ((b -> a) -> Effect c)
-> R.Element
formButton nodeType setNodeType =
H.button { className : "btn btn-primary center"
, type : "button"
, title: "Form Button"
, style : { width: "50%" }
, onClick : mkEffectFn1
$ \_ -> setNodeType ( const nodeType )
} [H.text $ "Go !"]
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"
, title: "Form Button"
, style : { width: "100%" }
, onClick : mkEffectFn1
$ \_ -> setNodeType ( const nodeType )
} [H.text $ "Confirmation"]
------------------------------------------------------------------------
------------------------------------------------------------------------
......@@ -263,7 +268,3 @@ nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt
------------------------------------------------------------------------
module Gargantext.Components.Forest.Tree.Node.Tools.FTree where
import Data.Maybe (Maybe(..))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Newtype (class Newtype)
import Gargantext.Types as GT
......@@ -21,6 +22,7 @@ instance ntreeFunctor :: Functor NTree where
newtype LNode = LNode { id :: ID
, name :: Name
, nodeType :: GT.NodeType
, parent_id :: Maybe ID
}
derive instance newtypeLNode :: Newtype LNode _
......@@ -34,6 +36,7 @@ instance decodeJsonLNode :: DecodeJson LNode where
pure $ LNode { id : id_
, name
, nodeType
, parent_id : Nothing
}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
......@@ -43,5 +46,10 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
nodes <- obj .: "children"
node' <- decodeJson node
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
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
......
......@@ -89,8 +89,8 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
cpt props@{frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin, treeReload } _ = do
dataRef <- R.useRef graph
graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion)
controls <- Controls.useGraphControls graph
graphVersionRef <- R.useRef (fst graphVersion)
controls <- Controls.useGraphControls graph
multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled
R.useEffect' $ do
......@@ -105,12 +105,12 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
R.setRef dataRef graph
R.setRef graphVersionRef (fst graphVersion)
-- Reinitialize bunch of state as well.
snd controls.removedNodeIds $ const SigmaxT.emptyNodeIds
snd controls.removedNodeIds $ const SigmaxT.emptyNodeIds
snd controls.selectedNodeIds $ const SigmaxT.emptyNodeIds
snd controls.showEdges $ const SigmaxT.EShow
snd controls.showEdges $ const SigmaxT.EShow
snd controls.forceAtlasState $ const SigmaxT.InitialRunning
snd controls.graphStage $ const Graph.Init
snd controls.showSidePanel $ const GET.InitialClosed
snd controls.graphStage $ const Graph.Init
snd controls.showSidePanel $ const GET.InitialClosed
pure $
RH.div
......@@ -141,10 +141,10 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, graph
, graphId
, graphVersion
, removedNodeIds: controls.removedNodeIds
, removedNodeIds : controls.removedNodeIds
, session
, selectedNodeIds: controls.selectedNodeIds
, showSidePanel: fst controls.showSidePanel
, showSidePanel : controls.showSidePanel
, treeReload
}
]
......@@ -171,7 +171,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
mSidebar :: Maybe GET.MetaData
-> Record MSidebarProps
-> R.Element
mSidebar Nothing _ = RH.div {} []
mSidebar Nothing _ = RH.div {} []
mSidebar (Just metaData) props =
Sidebar.sidebar (Record.merge props { metaData })
......@@ -186,15 +186,15 @@ type TreeProps =
)
type MSidebarProps =
( frontends :: Frontends
, graph :: SigmaxT.SGraph
, graphId :: GraphId
, graphVersion :: R.State Int
, removedNodeIds :: R.State SigmaxT.NodeIds
, showSidePanel :: GET.SidePanelState
( frontends :: Frontends
, graph :: SigmaxT.SGraph
, graphId :: GraphId
, graphVersion :: R.State Int
, removedNodeIds :: R.State SigmaxT.NodeIds
, showSidePanel :: R.State GET.SidePanelState
, selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session
, treeReload :: R.State Int
, session :: Session
, treeReload :: R.State Int
)
type GraphProps = (
......
......@@ -94,7 +94,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
-- Automatic opening of sidebar when a node is selected (but only first time).
R.useEffect' $ do
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
pure unit
......
......@@ -23,6 +23,11 @@ legendCpt = R.hooksComponent "Legend" cpt
entry :: Legend -> R.Element
entry (Legend {id_, label}) =
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
]
......@@ -144,12 +144,12 @@ sidebarToggleButton (state /\ setState) = R.createElement el {} []
]
onMessage = "Hide 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.Closed = off
text _on off GET.Closed = off
onClick = \_ -> do
setState $ \s -> case s of
GET.InitialClosed -> GET.Opened
GET.Closed -> GET.Opened
GET.Opened -> GET.Closed
GET.InitialClosed -> GET.Opened GET.SideTabLegend
GET.Closed -> GET.Opened GET.SideTabLegend
(GET.Opened _) -> GET.Closed
module Gargantext.Components.GraphExplorer.Types where
import Prelude
import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Array ((!!), length)
import Data.Maybe (Maybe(..), fromJust)
......@@ -58,14 +58,12 @@ derive instance newtypeGraphData :: Newtype GraphData _
newtype MetaData = MetaData
{
title :: String
, legend :: Array Legend
{ title :: String
, legend :: Array Legend
, corpusId :: Array Int
, list :: {
listId :: ListId
, version :: Version
}
, list :: { listId :: ListId
, version :: Version
}
}
getLegend :: GraphData -> Maybe (Array Legend)
......@@ -191,6 +189,20 @@ intColor :: Int -> String
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
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)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
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.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
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.Routes as R
import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel, toggleSet)
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.List (sortWith) as L
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' =
CoreState
......
......@@ -26,20 +26,19 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..), AffTableResult)
import Gargantext.Utils.Crypto as GUC
import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Reactix as R2
type Props = (
nodeId :: Int
type Props =
( nodeId :: Int
, session :: Session
)
type Reload = R.State Int
type KeyProps =
(
key :: String
| Props
( key :: String
| Props
)
corpusLayout :: Record KeyProps -> R.Element
......@@ -54,8 +53,8 @@ corpusLayoutCpt = R.hooksComponent "G.C.N.C.corpusLayout" cpt
useLoader {nodeId, reload: fst reload, session} loadCorpusWithReload $
\corpus -> corpusLayoutView {corpus, nodeId, reload, session}
type ViewProps = (
corpus :: NodePoly Hyperdata
type ViewProps =
( corpus :: NodePoly Hyperdata
, reload :: Reload
| Props
)
......@@ -184,7 +183,7 @@ fieldsCodeEditorCpt = R.hooksComponent "G.C.N.C.fieldsCodeEditorCpt" cpt
recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t
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 =
(
......@@ -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.Markdown c = onc $ Markdown $ md { text = c }
type LoadProps = (
nodeId :: Int
type LoadProps =
( nodeId :: Int
, session :: Session
)
......
......@@ -9,7 +9,8 @@ import Reactix as R
import Gargantext.Prelude
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.Utils.CacheAPI as GUC
......@@ -33,7 +34,7 @@ metricsLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsLoadView" cpt
loaded { path, reload, session } l
type MetricsWithCacheLoadViewProps res ret = (
getMetricsMD5 :: Session -> ReloadPath -> Aff MD5
getMetricsHash :: Session -> ReloadPath -> Aff Hash
, handleResponse :: HashedResponse res -> ret
, loaded :: Record MetricsProps -> ret -> R.Element
, mkRequest :: ReloadPath -> GUC.Request
......@@ -48,13 +49,13 @@ metricsWithCacheLoadViewCpt :: forall res ret. DecodeJson res =>
R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = R.hooksComponent "G.C.N.C.C.metricsWithCacheLoadView" cpt
where
cpt { getMetricsMD5, handleResponse, loaded, mkRequest, path, reload, session } _ = do
-- useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsMD5 session) (getMetrics session) $ \l ->
cpt { getMetricsHash, handleResponse, loaded, mkRequest, path, reload, session } _ = do
-- useLoaderWithCache (fst reload /\ path) (metricsKeyFunc keyFunc) (getMetricsHash session) (getMetrics session) $ \l ->
-- loaded session path reload l
-- metricsKeyFunc keyFunc st@(_ /\ { corpusId, listId, tabType }) =
-- "metrics-" <> (show tabType) <> "-" <> (show corpusId) <> "-" <> (show listId) <> "--" <> (keyFunc st)
useLoaderWithCacheAPI { cacheEndpoint: (getMetricsMD5 session)
useLoaderWithCacheAPI { cacheEndpoint: (getMetricsHash session)
, handleResponse
, mkRequest
, path: (fst reload /\ path)
......
......@@ -6,24 +6,22 @@ import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
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.Font (itemStyle, mkTooltip, templateFormatter)
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.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType(..))
import Gargantext.Utils.CacheAPI as GUC
import Reactix as R
import Reactix.DOM.HTML as H
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
......@@ -62,9 +60,9 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
, series : [seriesBarD1 {name: "Number of publication / year"} $
map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] }
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: Histo, listId: mListId, tabType } (Just corpusId)
getMetricsHash :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartHash { chartType: Histo, listId: mListId, tabType } (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
......@@ -88,7 +86,7 @@ histoCpt = R.hooksComponent "G.C.N.C.C.H.histo" cpt
cpt { path, session } _ = do
reload <- R.useState' 0
pure $ metricsWithCacheLoadView {
getMetricsMD5
getMetricsHash
, handleResponse
, loaded
, mkRequest: mkRequest session
......
......@@ -98,9 +98,9 @@ scatterOptions metrics' = Options
}
--}
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsMD5 { listId, tabType } (Just corpusId)
getMetricsHash :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsHash session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsHash { listId, tabType } (Just corpusId)
chartUrl :: Record Path -> SessionRoute
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
cpt {path, session} _ = do
reload <- R.useState' 0
pure $ metricsWithCacheLoadView {
getMetricsMD5
getMetricsHash
, handleResponse
, loaded
, mkRequest: mkRequest session
......
......@@ -9,24 +9,22 @@ import Data.String (take, joinWith, Pattern(..), split, length)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
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.Font (itemStyle, mkTooltip, templateFormatter)
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.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType)
import Gargantext.Utils.CacheAPI as GUC
import Reactix as R
import Reactix.DOM.HTML as H
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
......@@ -81,9 +79,9 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
}
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartPie, listId: mListId, tabType } (Just corpusId)
getMetricsHash :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartHash { chartType: ChartPie, listId: mListId, tabType } (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
......@@ -107,7 +105,7 @@ pieCpt = R.hooksComponent "G.C.N.C.C.P.pie" cpt
cpt { path, session } _ = do
reload <- R.useState' 0
pure $ metricsWithCacheLoadView {
getMetricsMD5
getMetricsHash
, handleResponse
, loaded: loadedPie
, mkRequest: mkRequest session
......@@ -135,7 +133,7 @@ barCpt = R.hooksComponent "LoadedMetricsBar" cpt
reload <- R.useState' 0
--pure $ metricsLoadView {getMetrics, loaded: loadedBar, path, reload, session}
pure $ metricsWithCacheLoadView {
getMetricsMD5
getMetricsHash
, handleResponse
, loaded: loadedPie
, mkRequest: mkRequest session
......
......@@ -53,9 +53,9 @@ scatterOptions nodes = Options
}
getMetricsMD5 :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsMD5 session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartMD5 { chartType: ChartTree, listId: mListId, tabType } (Just corpusId)
getMetricsHash :: Session -> Tuple Reload (Record Path) -> Aff String
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartHash { chartType: ChartTree, listId: mListId, tabType } (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
......@@ -79,7 +79,7 @@ treeCpt = R.hooksComponent "G.C.N.C.C.T.tree" cpt
cpt {path, session} _ = do
reload <- R.useState' 0
pure $ metricsWithCacheLoadView {
getMetricsMD5
getMetricsHash
, handleResponse
, loaded
, mkRequest: mkRequest session
......
......@@ -11,8 +11,8 @@ import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
type Props = (
frontends :: Frontends
type Props =
( frontends :: Frontends
, query :: TextQuery
, session :: Session
, sides :: Array GraphSideCorpus
......@@ -35,7 +35,7 @@ tab :: Frontends -> Session -> TextQuery -> GraphSideCorpus -> Tuple String R.El
tab frontends session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) =
Tuple corpusLabel (docView dvProps)
where
dvProps = {frontends, session, nodeId, listId, query, chart, totalRecords: 0, container}
chart = mempty
dvProps = {frontends, session, nodeId, listId, query, chart, totalRecords: 0, container}
chart = mempty
container = T.graphContainer {title: corpusLabel}
......@@ -79,16 +79,9 @@ data FrameType = Calc | Write
type Base = String
type FrameId = String
hframe :: FrameType -> String
hframe ft = "https://" <> hframe' ft <> ".frame.gargantext.org/test"
where
hframe' Calc = "calc"
hframe' Write = "write"
hframeUrl :: Base -> FrameId -> String
hframeUrl base frame_id = base <> "/" <> frame_id <> "?both"
frameLayoutView :: Record ViewProps -> R.Element
frameLayoutView props = R.createElement frameLayoutViewCpt props []
......@@ -96,11 +89,10 @@ frameLayoutViewCpt :: R.Component ViewProps
frameLayoutViewCpt = R.hooksComponent "G.C.N.C.frameLayoutView" cpt
where
cpt {frame: (NodePoly {hyperdata: Hyperdata {base, frame_id}}), nodeId, reload, session} _ = do
pure $ H.div { className : "istex-search" }
pure $ H.div { className : "frame" }
[ H.iframe { src: hframeUrl base frame_id
, width: "100%"
, height: "100%"
-- , ref: "https://write.frame.gargantext.org/test"
} []
]
......
module Gargantext.Components.Nodes.Home where
import Prelude
import Data.Newtype (class Newtype)
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.DOM.HTML as H
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 = ()
......@@ -48,15 +48,16 @@ homeLayout lang = R.createElement homeLayoutCpt {landingData} []
where landingData = langLandingData lang
homeLayoutCpt :: R.Component ( landingData :: LandingData )
homeLayoutCpt = R.staticComponent "LayoutLanding" cpt
homeLayoutCpt = R.hooksComponent "LayoutLanding" cpt
where
cpt {landingData} _ =
H.span {}
[ H.div { className: "container1" } [ jumboTitle landingData false ]
, H.div { className: "container1" } [] -- TODO put research form
, H.div { className: "container1" } [ blocksRandomText' landingData ]
, license
]
cpt {landingData} _ = do
pure $ H.span {}
[ H.div { className: "container1" } [ jumboTitle landingData false ]
, H.div { className: "container1" } [] -- TODO put research form
, H.div { className: "container1" } [ blocksRandomText' landingData ]
, H.div { className: "container1" } [ renderPublic ]
, license
]
------------------------------------------------------------------------
......@@ -89,6 +90,8 @@ docButton (Button b) =
, 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 hd) b =
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
-------------------------------------------------------------------
words :: String -> Array String
words sentence = filter ((/=) "") $ split (Pattern " ") sentence
words sentence = filter ((/=) "")
$ split (Pattern " ") sentence
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
}
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
start = take 2 array
middle = dropEnd 2 $ drop 2 array
......@@ -93,7 +96,7 @@ randomArray array = unsafePartial $ do
case maybeDuring of
Nothing ->
crash "[ERROR] It should never happen."
crash "[G.C.N.H.R.RandomText ERROR] It should never happen."
Just during ->
pure $ RandomWheel { before : remove n array
, during : during
......
......@@ -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.Tab as Tab
import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoaderWithCache)
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
......
module Gargantext.Config where
import Data.String as S
import Web.HTML.Location (Location(..))
import Effect (Effect)
import Data.NonEmpty (NonEmpty, (:|), head)
import Gargantext.Ends
import Gargantext.Types (ApiVersion(..))
import Gargantext.Utils (location)
import Gargantext.Prelude (bind, pure, ($))
defaultBackends :: NonEmpty Array Backend
defaultBackends = local :| [prod, partner, demo, dev]
where
prod = backend V10 "/api/" "https://v4.gargantext.org" "iscpif.cnrs"
partner = backend V10 "/api/" "https://imtv4.gargantext.org" "institut-mines-telecom.imt"
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"
defaultBackends = backend_local :| [ backend_prod
, backend_partner
, backend_demo
, backend_dev
]
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 = relative :| [prod, dev, demo, haskell, caddy]
where
relative = frontend "/#/" "" "Relative"
prod = frontend "/#/" "https://v4.gargantext.org" "v4.gargantext.org"
dev = frontend "/#/" "https://dev.gargantext.org" "gargantext.org (dev)"
relative = frontend "/#/" "" "Relative"
prod = frontend "/#/" "https://v4.gargantext.org" "v4.gargantext.org"
dev = frontend "/#/" "https://dev.gargantext.org" "gargantext.org (dev)"
demo = frontend "/#/" "https://demo.gargantext.org" "gargantext.org (demo)"
haskell = frontend "/#/" "http://localhost:8008" "localhost.gargantext"
python = frontend "/#/" "http://localhost:8000" "localhost.python"
caddy = frontend "/#/" "http://localhost:2015" "localhost.caddy"
haskell = frontend "/#/" "http://localhost:8008" "localhost.gargantext"
python = frontend "/#/" "http://localhost:8000" "localhost.python"
caddy = frontend "/#/" "http://localhost:2015" "localhost.caddy"
defaultStatics :: NonEmpty Array Frontend
defaultStatics = relative :| []
......@@ -38,3 +73,7 @@ defaultStatic = head defaultStatics
defaultFrontends :: Frontends
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)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Gargantext.Routes as R
import Gargantext.Types (ApiVersion, ChartType(..), Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType')
import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==))
import Gargantext.Types (ApiVersion, ChartType(..), Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType', TermList(MapTerm))
import Gargantext.Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==), (/=))
-- | A means of generating a url to visit, a destination
class ToUrl conf p where
......@@ -24,7 +24,8 @@ newtype Backend = Backend
{ name :: String
, baseUrl :: String
, prePath :: String
, version :: ApiVersion }
, version :: ApiVersion
}
backend :: ApiVersion -> String -> String -> String -> Backend
backend version prePath baseUrl name = Backend { name, version, prePath, baseUrl }
......@@ -117,13 +118,13 @@ sessionPath :: R.SessionRoute -> String
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.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.RecomputeListChart ChartBar nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartPie nt nId lId) = "node/" <> (show nId) <> "/pie?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartTree nt nId lId) = "node/" <> (show nId) <> "/tree?list=" <> (show lId) <> "&ngramsType=" <> (show nt) <> "&listType=MapTerm"
sessionPath (R.RecomputeListChart Histo nt nId lId) = "node/" <> (show nId) <> "/chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart Scatter nt nId lId) = "node/" <> (show nId) <> "/metrics?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart _ nt nId lId) = "node/" <> (show nId) <> "/recompute-chart?list=" <> (show lId) <> "&ngramsType=" <> (show nt)
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?" <> (defaultList 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?" <> (defaultList lId) <> "&ngramsType=" <> (show nt) <> "&listType=" <> show MapTerm
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?" <> (defaultList 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.GetNgrams opts i) =
base opts.tabType
......@@ -132,7 +133,7 @@ sessionPath (R.GetNgrams opts i) =
<> limitUrl opts.limit
<> offset opts.offset
<> 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 termSizeFilter opts.termSizeFilter
<> search opts.searchQuery
......@@ -191,9 +192,9 @@ sessionPath (R.CorpusMetrics { listId, limit, tabType} i) =
<> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
<> maybe "" limitUrl limit
sessionPath (R.CorpusMetricsMD5 { listId, tabType} i) =
sessionPath (R.CorpusMetricsHash { listId, tabType} i) =
sessionPath $ R.NodeAPI Corpus i
$ "metrics/md5"
$ "metrics/hash"
<> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
-- TODO fix this url path
......@@ -201,30 +202,35 @@ sessionPath (R.Chart {chartType, limit, listId, tabType} i) =
sessionPath $ R.NodeAPI Corpus i
$ show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=MapTerm" -- <> show listId
<> listPath
<> "&listType=" <> show MapTerm -- listId
<> defaultListAddMaybe listId
where
listPath = case listId of
Just li -> "&list=" <> show li
Nothing -> ""
limitPath = case limit of
Just li -> "&limit=" <> show li
Nothing -> ""
-- <> maybe "" limitUrl limit
sessionPath (R.ChartMD5 { chartType, listId, tabType } i) =
sessionPath (R.ChartHash { chartType, listId, tabType } i) =
sessionPath $ R.NodeAPI Corpus i
$ show chartType
<> "/md5?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId
<> listPath
where
listPath = case listId of
Just li -> "&list=" <> show li
Nothing -> ""
<> "/hash?ngramsType=" <> showTabType' tabType
<> "&listType=" <> show MapTerm -- listId
<> defaultListAddMaybe listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
------- 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 l = "&limit=" <> show l
......
module Gargantext.Hooks.Loader where
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Core (stringify)
import Data.Argonaut.Parser (jsonParser)
......@@ -7,28 +8,26 @@ import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
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.Ends (class ToUrl, toUrl)
import Gargantext.Prelude
import Gargantext.Utils.Crypto (Hash)
import Gargantext.Utils as GU
import Gargantext.Utils.CacheAPI as GUC
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 =>
path
-> (path -> Aff st)
-> (st -> R.Element)
-> R.Hooks R.Element
useLoader :: forall path st. Eq path
=> path
-> (path -> Aff st)
-> (st -> R.Element)
-> R.Hooks R.Element
useLoader path loader render = do
state <- R.useState' Nothing
useLoaderEffect path state loader
......@@ -53,24 +52,21 @@ useLoaderEffect path state@(state' /\ setState) loader = do
liftEffect $ setState $ const $ Just l
type MD5 = String
newtype HashedResponse a = HashedResponse {
md5 :: MD5
, value :: a
}
newtype HashedResponse a =
HashedResponse { hash :: Hash
, value :: a
}
instance decodeHashedResponse :: DecodeJson a => DecodeJson (HashedResponse a) where
decodeJson json = do
obj <- decodeJson json
md5 <- obj .: "md5"
obj <- decodeJson json
hash <- obj .: "hash"
value <- obj .: "value"
pure $ HashedResponse { md5, value }
pure $ HashedResponse { hash, value }
instance encodeHashedResponse :: EncodeJson a => EncodeJson (HashedResponse a) where
encodeJson (HashedResponse { md5, value }) = do
"md5" := encodeJson md5
encodeJson (HashedResponse { hash, value }) = do
"hash" := encodeJson hash
~> "value" := encodeJson value
~> jsonEmptyObject
......@@ -81,9 +77,9 @@ useLoaderWithCache :: forall path st. Eq path => DecodeJson st => EncodeJson st
-> (path -> Aff (HashedResponse st))
-> (st -> R.Element)
-> R.Hooks R.Element
useLoaderWithCache path keyFunc md5Endpoint loader render = do
useLoaderWithCache path keyFunc hashEndpoint loader render = do
state <- R.useState' Nothing
useCachedLoaderEffect { cacheEndpoint: md5Endpoint
useCachedLoaderEffect { cacheEndpoint: hashEndpoint
, keyFunc
, loadRealData: loadRealData state
, path
......@@ -93,11 +89,11 @@ useLoaderWithCache path keyFunc md5Endpoint loader render = do
loadRealData :: R.State (Maybe st) -> String -> String -> WSS.Storage -> Aff Unit
loadRealData (_ /\ setState) key keyCache localStorage = do
--R2.affEffect "G.H.Loader.useCachedLoaderEffect" $ do
HashedResponse { md5, value: l } <- loader path
HashedResponse { hash, value: l } <- loader path
liftEffect $ do
let value = stringify $ encodeJson l
WSS.setItem key value localStorage
WSS.setItem keyCache md5 localStorage
WSS.setItem keyCache hash localStorage
setState $ const $ Just l
pure unit
......@@ -158,8 +154,8 @@ useCachedLoaderEffect { cacheEndpoint, keyFunc, loadRealData, path, state: state
decode j = GU.mapLeft (\err -> "Error decoding serialised sessions:" <> show err) (decodeJson j)
type LoaderWithCacheAPIProps path res ret = (
cacheEndpoint :: path -> Aff MD5
type LoaderWithCacheAPIProps path res ret =
( cacheEndpoint :: path -> Aff Hash
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
......@@ -179,15 +175,16 @@ useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer
, state }
pure $ maybe (loadingSpinner {}) renderer (fst state)
type LoaderWithCacheAPIEffectProps path res ret = (
cacheEndpoint :: path -> Aff MD5
type LoaderWithCacheAPIEffectProps path res ret =
( cacheEndpoint :: path -> Aff Hash
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
, 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)
-> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint
......@@ -209,14 +206,14 @@ useCachedAPILoaderEffect { cacheEndpoint
launchAff_ $ do
cache <- GUC.openCache $ GUC.CacheName cacheName
-- TODO Parallelize?
hr@(HashedResponse { md5, value }) <- GUC.cachedJson cache req
hr@(HashedResponse { hash, value }) <- GUC.cachedJson cache req
cacheReal <- cacheEndpoint path
val <- if md5 == cacheReal then
val <- if hash == cacheReal then
pure hr
else do
_ <- GUC.delete cache req
hr@(HashedResponse { md5, value }) <- GUC.cachedJson cache req
if md5 == cacheReal then
hr@(HashedResponse { hash, value }) <- GUC.cachedJson cache req
if hash == cacheReal then
pure hr
else
throwError $ error $ "Fetched clean cache but hashes don't match"
......
module Gargantext.License where
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
license :: R.Element
license = H.p {}
[ H.text "Gargantext "
, H.span {className: "glyphicon glyphicon-registration-mark"} []
, H.a { href: "http://www.cnrs.fr"
, H.span { className: "glyphicon glyphicon-registration-mark"} []
, H.text " is made by "
, H.a { href: "https://iscpif.fr"
, target: "blank"
, title: "Project hosted by CNRS."
}
[ H.text ", Copyrights "
, H.span { className: "glyphicon glyphicon-copyright-mark" } []
, H.text " CNRS 2017-Present"
]
} [ H.text "CNRS/ISCPIF" ]
, H.a { href: "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE"
, target: "blank"
, 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 "."
]
......@@ -48,9 +48,9 @@ data SessionRoute
| ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id)
| CorpusMetricsMD5 { listId :: ListId, tabType :: TabType } (Maybe Id)
| CorpusMetricsHash { listId :: ListId, tabType :: TabType } (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
show Home = "Home"
......
......@@ -63,7 +63,7 @@ derive instance eqTermList :: Eq TermList
derive instance ordTermList :: Ord TermList
instance encodeJsonTermList :: EncodeJson TermList where
encodeJson MapTerm = encodeJson "MapTerm"
encodeJson MapTerm = encodeJson "MapTerm"
encodeJson StopTerm = encodeJson "StopTerm"
encodeJson CandidateTerm = encodeJson "CandidateTerm"
......@@ -71,7 +71,7 @@ instance decodeJsonTermList :: DecodeJson TermList where
decodeJson json = do
s <- decodeJson json
case s of
"MapTerm" -> pure MapTerm
"MapTerm" -> pure MapTerm
"StopTerm" -> pure StopTerm
"CandidateTerm" -> pure CandidateTerm
_ -> Left "Unexpected list name"
......@@ -84,7 +84,7 @@ listTypeId StopTerm = 2
listTypeId CandidateTerm = 3
instance showTermList :: Show TermList where
show MapTerm = "MapTerm"
show MapTerm = "MapTerm"
show StopTerm = "StopTerm"
show CandidateTerm = "CandidateTerm"
......@@ -154,6 +154,8 @@ data NodeType = NodeUser
-- TODO Optional Nodes
| NodeFrameWrite
| NodeFrameCalc
| NodePublic NodeType
derive instance eqNodeType :: Eq NodeType
......@@ -182,6 +184,7 @@ instance showNodeType :: Show NodeType where
show Texts = "NodeTexts"
show NodeFrameWrite = "NodeFrameWrite"
show NodeFrameCalc = "NodeFrameCalc"
show (NodePublic nt) = "NodePublic" <> show nt
instance readNodeType :: Read NodeType where
......@@ -207,6 +210,7 @@ instance readNodeType :: Read NodeType where
read "Annuaire" = Just Annuaire
read "NodeFrameWrite" = Just NodeFrameWrite
read "NodeFrameCalc" = Just NodeFrameCalc
-- TODO NodePublic read ?
read _ = Nothing
......@@ -245,16 +249,26 @@ fldr Annuaire false = "fa fa-address-card"
fldr NodeContact true = "fa fa-address-card-o"
fldr NodeContact false = "fa fa-address-card"
fldr NodeFrameWrite true = "fa fa-file-word-o"
fldr NodeFrameWrite false = "fa fa-file-word-o"
fldr NodeFrameWrite true = "fa fa-file-text-o"
fldr NodeFrameWrite false = "fa fa-file-text"
fldr NodeFrameCalc true = "fa fa-file-excel-o"
fldr NodeFrameCalc false = "fa fa-file-excel-o"
fldr NodeFrameCalc true = "fa fa-calculator"
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 _ 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"
nodeTypePath Team = "team"
nodeTypePath NodeFrameWrite = "write"
nodeTypePath NodeFrameCalc = "calc"
nodeTypePath (NodePublic nt) = nodeTypePath nt
------------------------------------------------------------
......
module Gargantext.Utils where
import Prelude
import DOM.Simple.Window (window)
import Data.Either (Either(..))
import Data.Lens (Lens', lens)
import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Set as Set
import Data.Set (Set)
import Data.Set as Set
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)
csrfMiddlewareToken :: String
......@@ -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 f (Left l) = Left (f l)
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
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" $ []
row :: Array R.Element -> R.Element
row children = H.div { className: "row" } children
col12 :: Array R.Element -> R.Element
col12 children = H.div { className: "col-md-12" } children
col :: Int -> Array R.Element -> R.Element
col n children = H.div { className : "col-md" <> show n } children
innerText :: DOM.Element -> String
innerText e = e .. "innerText"
......
module Gargantext.Version where
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.Ends (toUrl)
import Gargantext.Sessions (Session(..))
import Gargantext.Sessions as Sessions
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
type Version = String
foreign import version :: Version
getBackendVersion :: Session -> Aff 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)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils as GU
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 Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
......@@ -63,10 +63,6 @@ spec =
GU.zeroPad 3 1000 `shouldEqual` "1000"
it "log10 10" do
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
let result1 = Argonaut.decodeJson =<< Argonaut.jsonParser """{"Boat":{"hi":1}}"""
......@@ -113,3 +109,28 @@ spec =
let result2' = Argonaut.decodeJson result2
Argonaut.stringify result2 `shouldEqual` "\"Member2\""
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:
resolved "https://registry.yarnpkg.com/acorn/-/acorn-7.1.0.tgz#949d36f2c292535da602283586c2477c57eb2d6c"
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:
version "6.5.3"
resolved "https://registry.yarnpkg.com/ajv/-/ajv-6.5.3.tgz#71a569d189ecf4f4f321224fecb166f071dd90f9"
......@@ -254,6 +259,13 @@ balanced-match@^1.0.0:
resolved "https://registry.yarnpkg.com/balanced-match/-/balanced-match-1.0.0.tgz#89b4d199ab2bee49de164ea02b89ce462d71b767"
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:
version "1.3.1"
resolved "https://registry.yarnpkg.com/base64-js/-/base64-js-1.3.1.tgz#58ece8cb75dd07e71ed08c736abc5fac4dbf8df1"
......@@ -271,6 +283,20 @@ binary-extensions@^2.0.0:
resolved "https://registry.yarnpkg.com/binary-extensions/-/binary-extensions-2.0.0.tgz#23c0df14f6a88077f5f986c0d167ec03c3d5537c"
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:
version "3.7.2"
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:
resolved "https://registry.yarnpkg.com/bn.js/-/bn.js-4.11.8.tgz#2cde09eb5ee341f484746bb0309b3253b1b1442f"
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:
version "1.3.0"
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:
dependencies:
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"
resolved "https://registry.yarnpkg.com/browserify-aes/-/browserify-aes-1.2.0.tgz#326734642f403dabc3003209853bb70ad428ef48"
integrity sha512-+7CHXqGuspUn/Sl5aO7Ea0xWGAtETPXNSAjHo48JfLdPWcMng33Xe4znFvQweqc/uzk5zSOI3H52CYnjCfb5hA==
......@@ -777,7 +808,7 @@ create-ecdh@^4.0.0:
bn.js "^4.1.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"
resolved "https://registry.yarnpkg.com/create-hash/-/create-hash-1.2.0.tgz#889078af11a63756bcfb59bd221996be3a9ef196"
integrity sha512-z00bCGNHDG8mHAkP7CtT1qVu+bFQUPjYq/4Iv3C3kWjTFV10zIjfSoeqXo9Asws8gwSHDGj/hl2u4OGIjapeCg==
......@@ -1004,6 +1035,15 @@ download-purescript@^0.8.3:
is-plain-obj "^1.1.0"
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:
version "0.1.4"
resolved "https://registry.yarnpkg.com/duplexer2/-/duplexer2-0.1.4.tgz#8b12dab878c0d69e3e7891051662a32fc6bddcc1"
......@@ -1057,6 +1097,19 @@ elliptic@^6.0.0:
minimalistic-assert "^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:
version "7.0.3"
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:
pump "^3.0.0"
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:
version "4.2.1"
resolved "https://registry.yarnpkg.com/filesize/-/filesize-4.2.1.tgz#ab1cb2069db5d415911c1a13e144c0e743bc89bc"
......@@ -2018,6 +2076,11 @@ mute-stream@~0.0.4:
resolved "https://registry.yarnpkg.com/mute-stream/-/mute-stream-0.0.8.tgz#1630c42b2251ff81e2a283de96a5497ea92e5e0d"
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:
version "1.0.1"
resolved "https://registry.yarnpkg.com/neat-stack/-/neat-stack-1.0.1.tgz#6dc506acdcdb9f536def80c4fe3ba39324481be6"
......@@ -2805,6 +2868,20 @@ scheduler@^0.18.0:
loose-envify "^1.1.0"
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:
version "5.7.1"
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