Commit 857f6c39 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-warnings-cleanup' into dev

parents f182c3f6 1832703a
...@@ -2729,7 +2729,7 @@ ...@@ -2729,7 +2729,7 @@
"node-fs" "node-fs"
], ],
"repo": "https://github.com/purescript-spec/purescript-spec-discovery", "repo": "https://github.com/purescript-spec/purescript-spec-discovery",
"version": "v3.1.0" "version": "v4.0.0"
}, },
"spec-quickcheck": { "spec-quickcheck": {
"dependencies": [ "dependencies": [
......
...@@ -12,7 +12,7 @@ ...@@ -12,7 +12,7 @@
} }
#graph-explorer #sp-container { #graph-explorer #sp-container {
position: absolute; position: absolute;
left: 63%; left: 70%;
top: 150px; top: 150px;
z-index: 1; z-index: 1;
border: 1px white solid; border: 1px white solid;
......
...@@ -12,7 +12,7 @@ ...@@ -12,7 +12,7 @@
#sp-container #sp-container
position: absolute position: absolute
left: 63% left: 70%
top: 150px top: 150px
z-index: 1 z-index: 1
border: 1px white solid border: 1px white solid
......
...@@ -8,7 +8,8 @@ ...@@ -8,7 +8,8 @@
"sass": "sass dist/styles/", "sass": "sass dist/styles/",
"dev": "webpack-dev-server --env dev --mode development", "dev": "webpack-dev-server --env dev --mode development",
"repl": "pulp --psc-package repl", "repl": "pulp --psc-package repl",
"clean": "rm -Rf output" "clean": "rm -Rf output",
"test": "pulp test"
}, },
"dependencies": { "dependencies": {
"@babel/polyfill": "^7.0.0", "@babel/polyfill": "^7.0.0",
......
...@@ -156,7 +156,7 @@ let additions = ...@@ -156,7 +156,7 @@ let additions =
mkPackage mkPackage
[ "prelude", "effect", "arrays", "spec", "node-fs" ] [ "prelude", "effect", "arrays", "spec", "node-fs" ]
"https://github.com/purescript-spec/purescript-spec-discovery" "https://github.com/purescript-spec/purescript-spec-discovery"
"v3.1.0" "v4.0.0"
, spec-quickcheck = , spec-quickcheck =
mkPackage mkPackage
[ "prelude", "aff", "random", "quickcheck", "spec" ] [ "prelude", "aff", "random", "quickcheck", "spec" ]
......
...@@ -76,7 +76,8 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -76,7 +76,8 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
\session -> \session ->
simpleLayout $ simpleLayout $
explorerLayout { graphId, mCurrentRoute, session explorerLayout { graphId, mCurrentRoute, session
, sessions: (fst sessions), treeId: Nothing, frontends} , sessions: (fst sessions), frontends
, showLogin}
forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element
forestLayout frontends sessions route showLogin child = forestLayout frontends sessions route showLogin child =
......
...@@ -5,17 +5,15 @@ module Gargantext.Components.FacetsTable where ...@@ -5,17 +5,15 @@ module Gargantext.Components.FacetsTable where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter, (!!)) import Data.Array (concat, filter)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log)
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -28,7 +26,7 @@ import Gargantext.Routes (SessionRoute(Search, NodeAPI)) ...@@ -28,7 +26,7 @@ import Gargantext.Routes (SessionRoute(Search, NodeAPI))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody) import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..)) import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..))
import Gargantext.Utils (toggleSet) import Gargantext.Utils (toggleSet, zeroPad)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -44,7 +42,8 @@ newtype SearchQuery = SearchQuery { query :: TextQuery } ...@@ -44,7 +42,8 @@ newtype SearchQuery = SearchQuery { query :: TextQuery }
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery {query}) encodeJson (SearchQuery {query})
= "query" := query !! 0 -- TODO anoe -- = "query" := query !! 0 -- TODO anoe
= "query" := concat query
~> jsonEmptyObject ~> jsonEmptyObject
newtype SearchResults = SearchResults { results :: Array Response } newtype SearchResults = SearchResults { results :: Array Response }
...@@ -90,8 +89,15 @@ newtype DocumentsView = ...@@ -90,8 +89,15 @@ newtype DocumentsView =
, pairs :: Array Pair , pairs :: Array Pair
, delete :: Boolean , delete :: Boolean
, category :: Category , category :: Category
, publication_year :: Int
, publication_month :: Int
, publication_day :: Int
} }
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView {publication_year, publication_month, publication_day}) =
(zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month) <> "-" <> (zeroPad 2 publication_day)
derive instance genericDocumentsView :: Generic DocumentsView _ derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where instance showDocumentsView :: Show DocumentsView where
...@@ -112,6 +118,9 @@ newtype Hyperdata = Hyperdata ...@@ -112,6 +118,9 @@ newtype Hyperdata = Hyperdata
{ authors :: String { authors :: String
, title :: String , title :: String
, source :: String , source :: String
, publication_year :: Int
, publication_month :: Int
, publication_day :: Int
} }
--instance decodeHyperdata :: DecodeJson Hyperdata where --instance decodeHyperdata :: DecodeJson Hyperdata where
...@@ -134,7 +143,10 @@ instance decodeHyperdata :: DecodeJson Hyperdata where ...@@ -134,7 +143,10 @@ instance decodeHyperdata :: DecodeJson Hyperdata where
authors <- obj .| "authors" authors <- obj .| "authors"
title <- obj .| "title" title <- obj .| "title"
source <- obj .| "source" source <- obj .| "source"
pure $ Hyperdata { authors, title,source } publication_year <- obj .: "publication_year"
publication_month <- obj .: "publication_month"
publication_day <- obj .: "publication_day"
pure $ Hyperdata { authors, title, source, publication_year, publication_month, publication_day }
{- {-
instance decodeResponse :: DecodeJson Response where instance decodeResponse :: DecodeJson Response where
...@@ -170,6 +182,14 @@ docViewCpt = R.hooksComponent "G.C.FacetsTable.DocView" cpt ...@@ -170,6 +182,14 @@ docViewCpt = R.hooksComponent "G.C.FacetsTable.DocView" cpt
cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
deletions <- R.useState' initialDeletions deletions <- R.useState' initialDeletions
path <- R.useState' $ initialPagePath {nodeId, listId, query, session} path <- R.useState' $ initialPagePath {nodeId, listId, query, session}
R.useEffect' $ do
let ipp = initialPagePath {nodeId, listId, query, session}
if fst path == ipp then
pure unit
else
snd path $ const ipp
pure $ H.div { className: "container1" } pure $ H.div { className: "container1" }
[ H.div { className: "row" } [ H.div { className: "row" }
[ chart [ chart
...@@ -237,15 +257,26 @@ initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, que ...@@ -237,15 +257,26 @@ initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, que
loadPage :: PagePath -> Aff (Array DocumentsView) loadPage :: PagePath -> Aff (Array DocumentsView)
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do
liftEffect $ log "loading documents page: loadPage with Offset and limit"
let p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId) let p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
SearchResults res <- post session p $ SearchQuery {query} SearchResults res <- post session p $ SearchQuery {query}
pure $ res2corpus <$> res.results pure $ res2corpus <$> res.results
where where
res2corpus :: Response -> DocumentsView res2corpus :: Response -> DocumentsView
res2corpus (Response { id, created: date, ngramCount: score, category res2corpus (Response { id, created: date, ngramCount: score, category
, hyperdata: Hyperdata {authors, title, source} }) = , hyperdata: Hyperdata {authors, title, source, publication_year, publication_month, publication_day} }) =
DocumentsView { id, date, title, source, score, authors, category, pairs: [], delete: false } DocumentsView { id
, date
, title
, source
, score
, authors
, category
, pairs: []
, delete: false
, publication_year
, publication_month
, publication_day
}
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
convOrderBy (T.ASC (T.ColumnName "Title")) = TitleAsc convOrderBy (T.ASC (T.ColumnName "Title")) = TitleAsc
...@@ -280,10 +311,10 @@ page :: Record PageProps -> R.Element ...@@ -280,10 +311,10 @@ page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props [] page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps pageCpt :: R.Component PageProps
pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt
where where
cpt {frontends, totalRecords, container, deletions, documents, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do cpt {frontends, totalRecords, container, deletions, documents, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
T.table { rows, container, colNames, totalRecords, params, wrapColElts} pure $ T.table { rows, container, colNames, totalRecords, params, wrapColElts }
where where
setParams f = setPath $ \p@{params: ps} -> p {params = f ps} setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
params = (fst path).params /\ setParams params = (fst path).params /\ setParams
...@@ -302,11 +333,11 @@ pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt ...@@ -302,11 +333,11 @@ pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
comma = H.span {} [ H.text ", " ] comma = H.span {} [ H.text ", " ]
rows = row <$> filter (not <<< isDeleted) documents rows = row <$> filter (not <<< isDeleted) documents
row dv@(DocumentsView {id,score,title,source,date, authors,pairs,delete,category}) = row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
{ row: { row:
[ H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ] [ H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, maybeStricken delete [ H.text date ] , maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ] , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
, maybeStricken delete [ H.text source ] , maybeStricken delete [ H.text source ]
, maybeStricken delete [ H.text authors ] , maybeStricken delete [ H.text authors ]
......
module Gargantext.Components.Forest where module Gargantext.Components.Forest where
import Prelude (const, ($), (<$>)) import Prelude (const, pure, ($), (<$>))
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested((/\))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
...@@ -12,9 +13,9 @@ import Gargantext.Components.Forest.Tree (treeView) ...@@ -12,9 +13,9 @@ import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type Props = type Props =
( sessions :: Sessions ( frontends :: Frontends
, route :: AppRoute , route :: AppRoute
, frontends :: Frontends , sessions :: Sessions
, showLogin :: R2.Setter Boolean , showLogin :: R2.Setter Boolean
) )
...@@ -22,9 +23,10 @@ forest :: Record Props -> R.Element ...@@ -22,9 +23,10 @@ forest :: Record Props -> R.Element
forest props = R.createElement forestCpt props [] forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props forestCpt :: R.Component Props
forestCpt = R.staticComponent "G.C.Forest.forest" cpt where forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
cpt {sessions, route, frontends, showLogin} _ = cpt {frontends, route, sessions, showLogin} _ = R2.useCache (frontends /\ route /\ sessions) (cpt' showLogin)
R.fragment $ A.cons (plus showLogin) trees cpt' showLogin (frontends /\ route /\ sessions) =
pure $ R.fragment $ A.cons (plus showLogin) trees
where where
trees = tree <$> unSessions sessions trees = tree <$> unSessions sessions
tree s@(Session {treeId}) = tree s@(Session {treeId}) =
......
module Gargantext.Components.Forest.Tree.Node where module Gargantext.Components.Forest.Tree.Node where
import Prelude import Prelude (class Eq, class Show, show, (&&), (<>), (==))
import Data.Array (foldl) import Data.Array (foldl)
import Gargantext.Types import Gargantext.Types
import Effect.Uncurried (mkEffectFn1)
-- import Data.Set
import Data.Array (filter)
import Reactix.DOM.HTML as H
import Effect.Aff (Aff, launchAff, runAff)
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -4,31 +4,28 @@ module Gargantext.Components.Graph ...@@ -4,31 +4,28 @@ module Gargantext.Components.Graph
-- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings -- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings
-- ) -- )
where where
import Prelude (bind, discard, pure, ($), unit, map) import Prelude (bind, const, discard, pure, ($), unit)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (notNull, null, Nullable) import Data.Nullable (Nullable)
import Data.Set as Set import Data.Tuple (fst)
import Data.Tuple (fst, snd, Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple (createElement, setAttr)
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import Effect.Timer (setTimeout) import FFI.Simple (delay)
import FFI.Simple (delay, (..))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Sigmax as Sigmax import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Hooks.Sigmax.Sigma as Sigma import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Reactix as R2
type OnProps = () type OnProps = ()
type Graph = SigmaxTypes.Graph SigmaxTypes.Node SigmaxTypes.Edge type Graph = SigmaxTypes.Graph SigmaxTypes.Node SigmaxTypes.Edge
data Stage = Init | Ready | Cleanup
type Props sigma forceatlas2 = type Props sigma forceatlas2 =
( elRef :: R.Ref (Nullable Element) ( elRef :: R.Ref (Nullable Element)
, forceAtlas2Settings :: forceatlas2 , forceAtlas2Settings :: forceatlas2
...@@ -36,6 +33,7 @@ type Props sigma forceatlas2 = ...@@ -36,6 +33,7 @@ type Props sigma forceatlas2 =
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, sigmaSettings :: sigma , sigmaSettings :: sigma
, sigmaRef :: R.Ref Sigmax.Sigma , sigmaRef :: R.Ref Sigmax.Sigma
, stage :: R.State Stage
) )
graph :: forall s fa2. Record (Props s fa2) -> R.Element graph :: forall s fa2. Record (Props s fa2) -> R.Element
...@@ -45,14 +43,18 @@ graphCpt :: forall s fa2. R.Component (Props s fa2) ...@@ -45,14 +43,18 @@ graphCpt :: forall s fa2. R.Component (Props s fa2)
graphCpt = R.hooksComponent "Graph" cpt graphCpt = R.hooksComponent "Graph" cpt
where where
cpt props _ = do cpt props _ = do
let nodesMap = SigmaxTypes.nodesMap props.graph stageHooks props
let selectedNodeIds = props.selectedNodeIds
R.useEffect' $ do -- NOTE: This div is not empty after sigma initializes.
Sigmax.dependOnSigma (R.readRef props.sigmaRef) "[graphCpt] no sigma" $ \sigma -> -- When we change state, we make it empty though.
Sigmax.markSelectedNodes sigma (fst selectedNodeIds) nodesMap --pure $ RH.div { ref: props.elRef, style: {height: "95%"} } []
pure $ case R.readNullableRef props.elRef of
Nothing -> RH.div {} []
Just el -> R.createPortal [] el
stageHooks props@{stage: (Init /\ setStage)} = do
R.useEffectOnce $ do R.useEffectOnce $ do
log "[graphCpt] effect once"
let rSigma = R.readRef props.sigmaRef let rSigma = R.readRef props.sigmaRef
case Sigmax.readSigma rSigma of case Sigmax.readSigma rSigma of
...@@ -76,20 +78,26 @@ graphCpt = R.hooksComponent "Graph" cpt ...@@ -76,20 +78,26 @@ graphCpt = R.hooksComponent "Graph" cpt
Sigma.startForceAtlas2 sig props.forceAtlas2Settings Sigma.startForceAtlas2 sig props.forceAtlas2Settings
-- bind the click event only initially, when ref was empty -- bind the click event only initially, when ref was empty
Sigmax.bindSelectedNodesClick props.sigmaRef selectedNodeIds Sigmax.bindSelectedNodesClick props.sigmaRef props.selectedNodeIds
Just sig -> do Just sig -> do
pure unit pure unit
setStage $ const $ Ready
delay unit $ \_ -> do delay unit $ \_ -> do
log "[GraphCpt] cleanup" log "[graphCpt] cleanup"
pure $ pure unit pure $ pure unit
-- NOTE: This div is not empty after sigma initializes. stageHooks props@{stage: (Ready /\ setStage)} = do
-- When we change state, we make it empty though. let nodesMap = SigmaxTypes.nodesMap props.graph
--pure $ RH.div { ref: props.elRef, style: {height: "95%"} } []
pure $ case R.readNullableRef props.elRef of -- TODO Probably this can be optimized to re-mark selected nodes only when they changed
Nothing -> RH.div {} [] R.useEffect' $ do
Just el -> R.createPortal [] el Sigmax.dependOnSigma (R.readRef props.sigmaRef) "[graphCpt] no sigma" $ \sigma ->
Sigmax.markSelectedNodes sigma (fst props.selectedNodeIds) nodesMap
stageHooks _ = pure unit
type SigmaSettings = type SigmaSettings =
( animationsTime :: Number ( animationsTime :: Number
......
...@@ -11,6 +11,7 @@ import Data.Sequence as Seq ...@@ -11,6 +11,7 @@ import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst, snd, Tuple(..)) import Data.Tuple (fst, snd, Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
...@@ -18,6 +19,7 @@ import Reactix.DOM.HTML as RH ...@@ -18,6 +19,7 @@ import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax (Sigma) import Gargantext.Hooks.Sigmax (Sigma)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Components.GraphExplorer.Controls as Controls import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Sidebar as Sidebar import Gargantext.Components.GraphExplorer.Sidebar as Sidebar
...@@ -29,6 +31,7 @@ import Gargantext.Ends (Frontends) ...@@ -29,6 +31,7 @@ import Gargantext.Ends (Frontends)
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute) import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
import Gargantext.Sessions (Session, Sessions, get) import Gargantext.Sessions (Session, Sessions, get)
import Gargantext.Types (NodeType(Graph)) import Gargantext.Types (NodeType(Graph))
import Gargantext.Utils.Reactix as R2
type GraphId = Int type GraphId = Int
...@@ -38,7 +41,7 @@ type LayoutProps = ...@@ -38,7 +41,7 @@ type LayoutProps =
, mCurrentRoute :: AppRoute , mCurrentRoute :: AppRoute
, session :: Session , session :: Session
, sessions :: Sessions , sessions :: Sessions
, treeId :: Maybe Int , showLogin :: R.State Boolean
) )
type Props = ( type Props = (
...@@ -54,11 +57,12 @@ explorerLayout props = R.createElement explorerLayoutCpt props [] ...@@ -54,11 +57,12 @@ explorerLayout props = R.createElement explorerLayoutCpt props []
explorerLayoutCpt :: R.Component LayoutProps explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt
where where
cpt {graphId, mCurrentRoute, treeId, session, sessions, frontends} _ = do cpt {graphId, mCurrentRoute, session, sessions, frontends, showLogin} _ = do
useLoader graphId (getNodes session) handler useLoader graphId (getNodes session) handler
where where
handler loaded = handler loaded =
explorer {graphId, mCurrentRoute, mMetaData, treeId, session, sessions, graph: Just graph, frontends} explorer { graphId, mCurrentRoute, mMetaData
, session, sessions, graph: Just graph, frontends, showLogin}
where (Tuple mMetaData graph) = convert loaded where (Tuple mMetaData graph) = convert loaded
-------------------------------------------------------------- --------------------------------------------------------------
...@@ -68,13 +72,23 @@ explorer props = R.createElement explorerCpt props [] ...@@ -68,13 +72,23 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props explorerCpt :: R.Component Props
explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where where
cpt {frontends, graph, graphId, mCurrentRoute, mMetaData, session, sessions, treeId} _ = do cpt {frontends, graph, graphId, mCurrentRoute, mMetaData, session, sessions, showLogin} _ = do
dataRef <- R.useRef graph
graphRef <- R.useRef null graphRef <- R.useRef null
controls <- Controls.useGraphControls controls <- Controls.useGraphControls
state <- useExplorerState
showLogin <- snd <$> R.useState' true
selectedNodeIds <- R.useState' $ Set.empty selectedNodeIds <- R.useState' $ Set.empty
R.useEffect' $ do
case Tuple (R.readRef dataRef) graph of
Tuple Nothing Nothing -> pure unit
Tuple (Just g1) (Just g2) | SigmaxTypes.eqGraph g1 g2 -> pure unit
_ -> do
let rSigma = R.readRef controls.sigmaRef
Sigmax.cleanupSigma rSigma "explorerCpt"
R.setRef dataRef graph
snd selectedNodeIds $ const Set.empty
snd controls.graphStage $ const Graph.Init
R.useEffect' $ do R.useEffect' $ do
if fst controls.showSidePanel == GET.InitialClosed && (not Set.isEmpty $ fst selectedNodeIds) then if fst controls.showSidePanel == GET.InitialClosed && (not Set.isEmpty $ fst selectedNodeIds) then
snd controls.showSidePanel $ \_ -> GET.Opened snd controls.showSidePanel $ \_ -> GET.Opened
...@@ -93,9 +107,9 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -93,9 +107,9 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, col [ pullRight [ Toggle.sidebarToggleButton controls.showSidePanel ] ] , col [ pullRight [ Toggle.sidebarToggleButton controls.showSidePanel ] ]
] ]
, row [ Controls.controls controls ] , row [ Controls.controls controls ]
, row [ tree {mCurrentRoute, treeId} controls showLogin , row [ tree (fst controls.showTree) {sessions, mCurrentRoute, frontends} (snd showLogin)
, RH.div { ref: graphRef, id: "graph-view", className: "col-md-12", style: {height: "95%"} } [] -- graph container , RH.div { ref: graphRef, id: "graph-view", className: graphClassName controls, style: {height: "95%"} } [] -- graph container
, mGraph graphRef controls.sigmaRef {graphId, graph, selectedNodeIds} , mGraph graphRef controls.sigmaRef {graphId, graph, graphStage: controls.graphStage, selectedNodeIds}
, mSidebar graph mMetaData {frontends, session, selectedNodeIds, showSidePanel: fst controls.showSidePanel} , mSidebar graph mMetaData {frontends, session, selectedNodeIds, showSidePanel: fst controls.showSidePanel}
] ]
, row [ , row [
...@@ -104,12 +118,12 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -104,12 +118,12 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
] ]
] ]
] ]
where
-- tree {treeId: Nothing} _ _ = RH.div { id: "tree" } [] graphClassName :: Record Controls.Controls -> String
tree _ {showTree: false /\ _} _ = RH.div { id: "tree" } [] graphClassName {showSidePanel: (GET.Opened /\ _), showTree: (true /\ _)} = "col-md-8"
tree {mCurrentRoute: route, treeId: root} _ showLogin = graphClassName {showTree: (true /\ _)} = "col-md-10"
RH.div {className: "col-md-2", style: {paddingTop: "60px"}} graphClassName {showSidePanel: (GET.Opened /\ _)} = "col-md-10"
[forest {sessions, route, frontends, showLogin}] graphClassName _ = "col-md-12"
outer = RH.div { className: "col-md-12" } outer = RH.div { className: "col-md-12" }
inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } } inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } }
...@@ -119,14 +133,24 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -119,14 +133,24 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
pullLeft = RH.div { className: "pull-left" } pullLeft = RH.div { className: "pull-left" }
pullRight = RH.div { className: "pull-right" } pullRight = RH.div { className: "pull-right" }
tree :: Boolean
-> {sessions :: Sessions, mCurrentRoute :: AppRoute, frontends :: Frontends}
-> R2.Setter Boolean
-> R.Element
tree false _ _ = RH.div { id: "tree" } []
tree true {sessions, mCurrentRoute: route, frontends} showLogin =
RH.div {className: "col-md-2", style: {paddingTop: "60px"}}
[forest {sessions, route, frontends, showLogin}]
mGraph :: R.Ref (Nullable Element) mGraph :: R.Ref (Nullable Element)
-> R.Ref Sigma -> R.Ref Sigma
-> { graphId :: GraphId -> { graphId :: GraphId
, graph :: Maybe Graph.Graph , graph :: Maybe Graph.Graph
, graphStage :: R.State Graph.Stage
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds} , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds}
-> R.Element -> R.Element
mGraph _ _ {graph: Nothing} = RH.div {} [] mGraph _ _ {graph: Nothing} = RH.div {} []
mGraph graphRef sigmaRef {graphId, graph: Just graph, selectedNodeIds} = graphView graphRef sigmaRef {graphId, graph, selectedNodeIds} mGraph graphRef sigmaRef r@{graph: Just graph} = graphView graphRef sigmaRef $ r { graph = graph }
mSidebar :: Maybe Graph.Graph mSidebar :: Maybe Graph.Graph
-> Maybe GET.MetaData -> Maybe GET.MetaData
...@@ -146,27 +170,10 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -146,27 +170,10 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, showSidePanel , showSidePanel
} }
useExplorerState :: R.Hooks (Record GET.State)
useExplorerState = do pure {}
{- corpusId <- R.useState' 0
cursorSize <- R.useState' 0.0
filePath <- R.useState' ""
graphData <- R.useState' initialGraphData
legendData <- R.useState' []
multiNodeSelection <- R.useState' false
selectedNodes <- R.useState' Set.empty
showControls <- R.useState' false
showSidePanel <- R.useState' false
showTree <- R.useState' false
sigmaGraphData <- R.useState' (Nothing :: Maybe Graph.Graph)
sigmaSettings <- R.useState' Graph.sigmaSettings
treeId <- R.useState' (Nothing :: Maybe TreeId) -}
--treeId : Nothing
type GraphProps = ( type GraphProps = (
graphId :: GraphId graphId :: GraphId
, graph :: Graph.Graph , graph :: Graph.Graph
, graphStage :: R.State Graph.Stage
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
) )
...@@ -184,6 +191,7 @@ graphView elRef sigmaRef props = R.createElement el props [] ...@@ -184,6 +191,7 @@ graphView elRef sigmaRef props = R.createElement el props []
, selectedNodeIds , selectedNodeIds
, sigmaSettings: Graph.sigmaSettings , sigmaSettings: Graph.sigmaSettings
, sigmaRef: sigmaRef , sigmaRef: sigmaRef
, stage: props.graphStage
} }
convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) Graph.Graph convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) Graph.Graph
......
...@@ -5,8 +5,6 @@ module Gargantext.Components.GraphExplorer.Button ...@@ -5,8 +5,6 @@ module Gargantext.Components.GraphExplorer.Button
) where ) where
import Prelude import Prelude
import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
......
...@@ -11,10 +11,10 @@ module Gargantext.Components.GraphExplorer.Controls ...@@ -11,10 +11,10 @@ module Gargantext.Components.GraphExplorer.Controls
) where ) where
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log, log2) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\), get1) import Data.Tuple.Nested ((/\), get1)
import Effect (Effect) import Effect (Effect)
import Effect.Timer (clearTimeout, setTimeout) import Effect.Timer (setTimeout)
import Prelude import Prelude
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
...@@ -26,12 +26,12 @@ import Gargantext.Components.GraphExplorer.SlideButton (cursorSizeButton, labelS ...@@ -26,12 +26,12 @@ import Gargantext.Components.GraphExplorer.SlideButton (cursorSizeButton, labelS
import Gargantext.Components.GraphExplorer.ToggleButton (edgesToggleButton, pauseForceAtlasButton) import Gargantext.Components.GraphExplorer.ToggleButton (edgesToggleButton, pauseForceAtlasButton)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax as Sigmax import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Range as Range import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type Controls = type Controls =
( cursorSize :: R.State Number ( cursorSize :: R.State Number
, graphStage :: R.State Graph.Stage
, multiNodeSelect :: R.Ref Boolean , multiNodeSelect :: R.Ref Boolean
, showControls :: R.State Boolean , showControls :: R.State Boolean
, showSidePanel :: R.State GET.SidePanelState , showSidePanel :: R.State GET.SidePanelState
...@@ -76,15 +76,18 @@ controlsCpt = R.hooksComponent "GraphControls" cpt ...@@ -76,15 +76,18 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
localControls <- initialLocalControls localControls <- initialLocalControls
-- ref to track automatic FA pausing -- ref to track automatic FA pausing
-- If user pauses FA before auto is triggered, clear the timeoutId -- If user pauses FA before auto is triggered, clear the timeoutId
-- TODO: mFAPauseRef needs to be set higher up the tree
mFAPauseRef <- R.useRef Nothing mFAPauseRef <- R.useRef Nothing
--R.useEffect $ handleForceAtlasPause props.sigmaRef localControls.pauseForceAtlas mFAPauseRef -- when graph is changed, cleanup the mFAPauseRef
R.useEffect' $ do
case fst props.graphStage of
Graph.Init -> R.setRef mFAPauseRef Nothing
_ -> pure unit
R.useEffect' $ Sigmax.handleForceAtlas2Pause props.sigmaRef localControls.pauseForceAtlas (get1 localControls.showEdges) mFAPauseRef R.useEffect' $ Sigmax.handleForceAtlas2Pause props.sigmaRef localControls.pauseForceAtlas (get1 localControls.showEdges) mFAPauseRef
R.useEffectOnce' $ do R.useEffectOnce' $ do
timeoutId <- setTimeout 2000 $ do timeoutId <- setTimeout 2000 $ do
--R.setRef mFAPauseRef Nothing
let (toggled /\ setToggled) = localControls.pauseForceAtlas let (toggled /\ setToggled) = localControls.pauseForceAtlas
if toggled then if toggled then
setToggled $ const false setToggled $ const false
...@@ -122,6 +125,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt ...@@ -122,6 +125,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
useGraphControls :: R.Hooks (Record Controls) useGraphControls :: R.Hooks (Record Controls)
useGraphControls = do useGraphControls = do
cursorSize <- R.useState' 10.0 cursorSize <- R.useState' 10.0
graphStage <- R.useState' Graph.Init
multiNodeSelect <- R.useRef false multiNodeSelect <- R.useRef false
showControls <- R.useState' false showControls <- R.useState' false
showSidePanel <- R.useState' GET.InitialClosed showSidePanel <- R.useState' GET.InitialClosed
...@@ -130,6 +134,7 @@ useGraphControls = do ...@@ -130,6 +134,7 @@ useGraphControls = do
sigmaRef <- R.useRef sigma sigmaRef <- R.useRef sigma
pure { cursorSize pure { cursorSize
, graphStage
, multiNodeSelect , multiNodeSelect
, showControls , showControls
, showSidePanel , showSidePanel
......
...@@ -6,7 +6,6 @@ module Gargantext.Components.GraphExplorer.RangeControl ...@@ -6,7 +6,6 @@ module Gargantext.Components.GraphExplorer.RangeControl
) where ) where
import Prelude import Prelude
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
......
...@@ -7,7 +7,6 @@ module Gargantext.Components.GraphExplorer.SlideButton ...@@ -7,7 +7,6 @@ module Gargantext.Components.GraphExplorer.SlideButton
import Global (readFloat) import Global (readFloat)
import Prelude import Prelude
import Data.Maybe (Maybe(..))
import Data.Tuple (snd) import Data.Tuple (snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
......
...@@ -9,7 +9,6 @@ module Gargantext.Components.GraphExplorer.ToggleButton ...@@ -9,7 +9,6 @@ module Gargantext.Components.GraphExplorer.ToggleButton
import Prelude import Prelude
import Data.Maybe (Maybe(..))
import Data.Tuple (snd) import Data.Tuple (snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
...@@ -18,7 +17,6 @@ import Reactix.DOM.HTML as H ...@@ -18,7 +17,6 @@ import Reactix.DOM.HTML as H
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax as Sigmax import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
type Props = ( type Props = (
state :: R.State Boolean state :: R.State Boolean
......
...@@ -6,7 +6,6 @@ import Data.Array ((!!), length) ...@@ -6,7 +6,6 @@ import Data.Array ((!!), length)
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Reactix as R
newtype Node = Node newtype Node = Node
{ id_ :: String { id_ :: String
......
module Gargantext.Components.Loader where module Gargantext.Components.Loader where
import Prelude import Prelude
import Data.Maybe (Maybe(..), isNothing, maybe, maybe') import Data.Maybe (Maybe(..), maybe')
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
......
...@@ -2,7 +2,7 @@ module Gargantext.Components.Login.Types where ...@@ -2,7 +2,7 @@ module Gargantext.Components.Login.Types where
import Prelude import Prelude
import Data.Argonaut ( class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject import Data.Argonaut ( class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject
, (.:), (.??), (:=), (~>) , (.:), (.:!), (:=), (~>)
) )
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
...@@ -52,8 +52,8 @@ instance decodeAuthInvalid :: DecodeJson AuthInvalid where ...@@ -52,8 +52,8 @@ instance decodeAuthInvalid :: DecodeJson AuthInvalid where
instance decodeAuthResponse :: DecodeJson AuthResponse where instance decodeAuthResponse :: DecodeJson AuthResponse where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
valid <- obj .?? "valid" valid <- obj .:! "valid"
inval <- obj .?? "inval" inval <- obj .:! "inval"
pure $ AuthResponse {valid, inval} pure $ AuthResponse {valid, inval}
instance decodeAuthData :: DecodeJson AuthData where instance decodeAuthData :: DecodeJson AuthData where
......
...@@ -19,7 +19,7 @@ import Data.Lens.Record (prop) ...@@ -19,7 +19,7 @@ import Data.Lens.Record (prop)
import Data.List as List import Data.List as List
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), maybe, fromJust) import Data.Maybe (Maybe(..), maybe)
import Data.Monoid.Additive (Additive(..)) import Data.Monoid.Additive (Additive(..))
import Data.Ord.Down (Down(..)) import Data.Ord.Down (Down(..))
import Data.Set (Set) import Data.Set (Set)
......
...@@ -50,14 +50,14 @@ import Control.Monad.Cont.Trans (lift) ...@@ -50,14 +50,14 @@ import Control.Monad.Cont.Trans (lift)
import Data.Array (head) import Data.Array (head)
import Data.Array as A import Data.Array as A
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson
, jsonEmptyObject, (:=), (~>), (.:), (.??) ) , jsonEmptyObject, (:=), (~>), (.:), (.:!) )
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable (class Foldable, foldMap, foldl, foldr) import Data.Foldable (class Foldable, foldMap, foldl, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex) import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Lens (Iso', Lens', use, view, (%=), (.~), (?=), (^.), (^?)) import Data.Lens (Iso', Lens', use, view, (%=), (.~), (?=), (^?))
import Data.Lens.Common (_Just) import Data.Lens.Common (_Just)
import Data.Lens.At (class At, at) import Data.Lens.At (class At, at)
import Data.Lens.Index (class Index, ix) import Data.Lens.Index (class Index, ix)
...@@ -184,8 +184,8 @@ instance decodeJsonNgramsElement :: DecodeJson NgramsElement where ...@@ -184,8 +184,8 @@ instance decodeJsonNgramsElement :: DecodeJson NgramsElement where
ngrams <- obj .: "ngrams" ngrams <- obj .: "ngrams"
list <- obj .: "list" list <- obj .: "list"
occurrences <- obj .: "occurrences" occurrences <- obj .: "occurrences"
parent <- obj .?? "parent" parent <- obj .:! "parent"
root <- obj .?? "root" root <- obj .:! "root"
children' <- obj .: "children" children' <- obj .: "children"
let children = Set.fromFoldable (children' :: Array NgramsTerm) let children = Set.fromFoldable (children' :: Array NgramsTerm)
pure $ NgramsElement {ngrams, list, occurrences, parent, root, children} pure $ NgramsElement {ngrams, list, occurrences, parent, root, children}
...@@ -354,8 +354,8 @@ instance encodeJsonReplace :: EncodeJson a => EncodeJson (Replace a) where ...@@ -354,8 +354,8 @@ instance encodeJsonReplace :: EncodeJson a => EncodeJson (Replace a) where
instance decodeJsonReplace :: (DecodeJson a, Eq a) => DecodeJson (Replace a) where instance decodeJsonReplace :: (DecodeJson a, Eq a) => DecodeJson (Replace a) where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
mold <- obj .?? "old" mold <- obj .:! "old"
mnew <- obj .?? "new" mnew <- obj .:! "new"
case Tuple mold mnew of case Tuple mold mnew of
Tuple (Just old) (Just new) -> pure $ replace old new Tuple (Just old) (Just new) -> pure $ replace old new
Tuple Nothing Nothing -> pure Keep Tuple Nothing Nothing -> pure Keep
......
...@@ -15,7 +15,7 @@ import Gargantext.Ends (url, Frontends) ...@@ -15,7 +15,7 @@ import Gargantext.Ends (url, Frontends)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get) import Gargantext.Sessions (Session, sessionId, get)
import Gargantext.Types (NodePath(..), NodeType(..)) import Gargantext.Types (NodeType(..))
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
newtype IndividuView = newtype IndividuView =
......
...@@ -4,14 +4,13 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts ...@@ -4,14 +4,13 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
, userLayout ) , userLayout )
where where
import Prelude (bind, pure, ($), (<<<), (<>), (<$>), show, discard) import Prelude (bind, pure, ($), (<<<), (<>), (<$>), show)
import Data.Array (head) import Data.Array (head)
import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Newtype (unwrap) import Data.Newtype (unwrap)
import Data.String (joinWith) import Data.String (joinWith)
import DOM.Simple.Console (log2)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -21,7 +20,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types ...@@ -21,7 +20,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, ContactWho(..), HyperData(..), HyperdataContact(..) ) , ContactWho(..), HyperData(..), HyperdataContact(..) )
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes import Gargantext.Routes as Routes
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
...@@ -144,7 +143,7 @@ userLayoutCpt = R.staticComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" ...@@ -144,7 +143,7 @@ userLayoutCpt = R.staticComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout"
-- | toUrl to get data -- | toUrl to get data
getContact :: Session -> Int -> Aff ContactData getContact :: Session -> Int -> Aff ContactData
getContact session id = do getContact session id = do
contactNode <- get session $ NodeAPI NodeContact (Just id) "" contactNode <- get session $ Routes.NodeAPI NodeContact (Just id) ""
-- TODO: we need a default list for the pairings -- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id --defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of --case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
...@@ -175,7 +174,7 @@ annuaireUserLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.annua ...@@ -175,7 +174,7 @@ annuaireUserLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.annua
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do getAnnuaireContact session annuaireId id = do
contactNode <- get session $ NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id) contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
-- TODO: we need a default list for the pairings -- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id --defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of --case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
......
...@@ -13,7 +13,6 @@ import Gargantext.Components.NgramsTable as NT ...@@ -13,7 +13,6 @@ import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData) import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (TabType(..), TabSubType(..), CTabNgramType(..), PTabNgramType(..)) import Gargantext.Types (TabType(..), TabSubType(..), CTabNgramType(..), PTabNgramType(..))
......
...@@ -2,7 +2,7 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where ...@@ -2,7 +2,7 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.??)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Maybe (Maybe, fromMaybe) import Data.Maybe (Maybe, fromMaybe)
import Data.Map (Map) import Data.Map (Map)
import Gargantext.Utils.DecodeMaybe ((.?|)) import Gargantext.Utils.DecodeMaybe ((.?|))
...@@ -36,11 +36,11 @@ instance decodeContactWho :: DecodeJson ContactWho ...@@ -36,11 +36,11 @@ instance decodeContactWho :: DecodeJson ContactWho
where where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
idWho <- obj .?? "id" idWho <- obj .:! "id"
firstName <- obj .?? "firstName" firstName <- obj .:! "firstName"
lastName <- obj .?? "lastName" lastName <- obj .:! "lastName"
keywords <- obj .?? "keywords" keywords <- obj .:! "keywords"
freetags <- obj .?? "freetags" freetags <- obj .:! "freetags"
let k = fromMaybe [] keywords let k = fromMaybe [] keywords
let f = fromMaybe [] freetags let f = fromMaybe [] freetags
...@@ -69,15 +69,15 @@ instance decodeContactWhere :: DecodeJson ContactWhere ...@@ -69,15 +69,15 @@ instance decodeContactWhere :: DecodeJson ContactWhere
where where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
organization <- obj .?? "organization" organization <- obj .:! "organization"
labTeamDepts <- obj .?? "labTeamDepts" labTeamDepts <- obj .:! "labTeamDepts"
role <- obj .?? "role" role <- obj .:! "role"
office <- obj .?? "office" office <- obj .:! "office"
country <- obj .?? "country" country <- obj .:! "country"
city <- obj .?? "city" city <- obj .:! "city"
touch <- obj .?? "touch" touch <- obj .:! "touch"
entry <- obj .?? "entry" entry <- obj .:! "entry"
exit <- obj .?? "exit" exit <- obj .:! "exit"
let o = fromMaybe [] organization let o = fromMaybe [] organization
let l = fromMaybe [] labTeamDepts let l = fromMaybe [] labTeamDepts
...@@ -96,9 +96,9 @@ instance decodeContactTouch :: DecodeJson ContactTouch ...@@ -96,9 +96,9 @@ instance decodeContactTouch :: DecodeJson ContactTouch
where where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
mail <- obj .?? "mail" mail <- obj .:! "mail"
phone <- obj .?? "phone" phone <- obj .:! "phone"
url <- obj .?? "url" url <- obj .:! "url"
pure $ ContactTouch {mail, phone, url} pure $ ContactTouch {mail, phone, url}
...@@ -118,14 +118,14 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact ...@@ -118,14 +118,14 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
where where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
bdd <- obj .?? "bdd" bdd <- obj .:! "bdd"
who <- obj .?? "who" who <- obj .:! "who"
ou <- obj .?? "where" ou <- obj .:! "where"
title <- obj .?? "title" title <- obj .:! "title"
source <- obj .?? "source" source <- obj .:! "source"
lastValidation <- obj .?? "lastValidation" lastValidation <- obj .:! "lastValidation"
uniqId <- obj .?? "uniqId" uniqId <- obj .:! "uniqId"
uniqIdBdd <- obj .?? "uniqIdBdd" uniqIdBdd <- obj .:! "uniqIdBdd"
let ou' = fromMaybe [] ou let ou' = fromMaybe [] ou
...@@ -152,9 +152,9 @@ instance decodeUser :: DecodeJson Contact where ...@@ -152,9 +152,9 @@ instance decodeUser :: DecodeJson Contact where
obj <- decodeJson json obj <- decodeJson json
id <- obj .: "id" id <- obj .: "id"
typename <- obj .?| "typename" typename <- obj .?| "typename"
userId <- obj .?? "userId" userId <- obj .:! "userId"
parentId <- obj .?| "parentId" parentId <- obj .?| "parentId"
name <- obj .?? "name" name <- obj .:! "name"
date <- obj .?| "date" date <- obj .?| "date"
hyperdata <- obj .: "hyperdata" hyperdata <- obj .: "hyperdata"
pure $ Contact { id, typename, userId pure $ Contact { id, typename, userId
......
...@@ -11,7 +11,6 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1) ...@@ -11,7 +11,6 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1)
import Gargantext.Components.Charts.Options.Color (grey) import Gargantext.Components.Charts.Options.Color (grey)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie) import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
......
...@@ -15,7 +15,6 @@ import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2) ...@@ -15,7 +15,6 @@ import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2)
import Gargantext.Components.Charts.Options.Color (green, grey, red) import Gargantext.Components.Charts.Options.Color (green, grey, red)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie) import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
......
...@@ -15,7 +15,6 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1) ...@@ -15,7 +15,6 @@ import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Components.Charts.Options.Color (blue) import Gargantext.Components.Charts.Options.Color (blue)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie) import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
......
...@@ -10,7 +10,6 @@ import Reactix.DOM.HTML as H ...@@ -10,7 +10,6 @@ import Reactix.DOM.HTML as H
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree) import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
......
module Gargantext.Components.Nodes.Corpus.Document where module Gargantext.Components.Nodes.Corpus.Document where
import Prelude (class Show, bind, identity, mempty, pure, ($)) import Prelude (class Show, bind, identity, mempty, pure, ($), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
...@@ -23,6 +23,7 @@ import Gargantext.Hooks.Loader (useLoader) ...@@ -23,6 +23,7 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList, ScoreType(..)) import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList, ScoreType(..))
import Gargantext.Utils as U
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type DocPath = type DocPath =
...@@ -143,6 +144,12 @@ data Document ...@@ -143,6 +144,12 @@ data Document
--, text :: Maybe String --, text :: Maybe String
} }
publicationDate :: Document -> String
publicationDate (Document doc@{publication_year: Nothing}) = ""
publicationDate (Document doc@{publication_year: Just py, publication_month: Nothing}) = U.zeroPad 2 py
publicationDate (Document doc@{publication_year: Just py, publication_month: Just pm, publication_day: Nothing}) = (U.zeroPad 2 py) <> "-" <> (U.zeroPad 2 pm)
publicationDate (Document doc@{publication_year: Just py, publication_month: Just pm, publication_day: Just pd}) = (U.zeroPad 2 py) <> "-" <> (U.zeroPad 2 pm) <> "-" <> (U.zeroPad 2 pd)
defaultNodeDocument :: NodeDocument defaultNodeDocument :: NodeDocument
defaultNodeDocument = defaultNodeDocument =
NodePoly { id : 0 NodePoly { id : 0
...@@ -322,7 +329,7 @@ docViewSpec = simpleSpec performAction render ...@@ -322,7 +329,7 @@ docViewSpec = simpleSpec performAction render
, li' [ span [] [text' doc.authors] , li' [ span [] [text' doc.authors]
, badge "authors" , badge "authors"
] ]
, li' [ span [] [text' doc.publication_date] , li' [ span [] [text $ publicationDate $ Document doc]
, badge "date" , badge "date"
] ]
] ]
......
...@@ -2,9 +2,8 @@ module Gargantext.Components.Search.SearchBar ...@@ -2,9 +2,8 @@ module Gargantext.Components.Search.SearchBar
( Props, searchBar, searchBarCpt ( Props, searchBar, searchBarCpt
) where ) where
import Prelude (Unit, bind, discard, not, pure, show, ($), (<>), map) import Prelude (Unit, bind, discard, pure, ($))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Array (nub, concat)
import Data.Newtype (over) import Data.Newtype (over)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
......
module Gargantext.Components.Search.Types where module Gargantext.Components.Search.Types where
import Prelude (class Eq, class Show, show, ($), (<>), map, (&&), (==)) import Prelude (class Eq, class Show, show, ($), (<>), map)
import Data.Set (Set) import Data.Set (Set)
import Data.Ord import Data.Ord
import Data.Set as Set import Data.Set as Set
import Data.Array (concat) import Data.Array (concat)
import Data.Argonaut (class EncodeJson, class DecodeJson, jsonEmptyObject, (:=), (~>), encodeJson) import Data.Argonaut (class EncodeJson, class DecodeJson, jsonEmptyObject, (:=), (~>), encodeJson)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Ends (class ToUrl, backendUrl) import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Sessions (Session(..), post)
import Gargantext.Sessions (Session(..), post, put) import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..))
import Gargantext.Utils (id) import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
import URI.Query as Q import URI.Query as Q
......
...@@ -30,7 +30,7 @@ tabsCpt = R.hooksComponent "G.C.Tab.tabs" cpt ...@@ -30,7 +30,7 @@ tabsCpt = R.hooksComponent "G.C.Tab.tabs" cpt
eq = index == selected eq = index == selected
className = "nav-item nav-link" <> (if eq then " active" else "") className = "nav-item nav-link" <> (if eq then " active" else "")
click e = setActiveTab (const index) click e = setActiveTab (const index)
item selected index (_ /\ cpt) = tab { selected, index } [ cpt ] item selected index (_ /\ cpt') = tab { selected, index } [ cpt' ]
-- TODO: document what these are (selection, item indices) -- TODO: document what these are (selection, item indices)
type TabProps = ( selected :: Int, index :: Int ) type TabProps = ( selected :: Int, index :: Int )
......
...@@ -7,8 +7,6 @@ import Data.Generic.Rep.Show (genericShow) ...@@ -7,8 +7,6 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
......
...@@ -4,7 +4,6 @@ module Gargantext.Data.Array ...@@ -4,7 +4,6 @@ module Gargantext.Data.Array
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Array as DA import Data.Array as DA
import Data.Maybe as DM
import Data.Sequence as DS import Data.Sequence as DS
......
...@@ -99,6 +99,8 @@ instance toUrlFrontendAppRoute :: ToUrl Frontend R.AppRoute where ...@@ -99,6 +99,8 @@ instance toUrlFrontendAppRoute :: ToUrl Frontend R.AppRoute where
-- | The currently selected App and Static configurations -- | The currently selected App and Static configurations
newtype Frontends = Frontends { app :: Frontend, static :: Frontend } newtype Frontends = Frontends { app :: Frontend, static :: Frontend }
derive instance eqFrontends :: Eq Frontends
instance toUrlFrontendsRoutes :: ToUrl Frontends R.AppRoute where instance toUrlFrontendsRoutes :: ToUrl Frontends R.AppRoute where
toUrl f r = appUrl f (R.appPath r) toUrl f r = appUrl f (R.appPath r)
......
module Gargantext.Hooks.Loader where module Gargantext.Hooks.Loader where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Maybe (Maybe(..), isNothing, maybe, maybe') import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
...@@ -10,55 +10,26 @@ import Reactix as R ...@@ -10,55 +10,26 @@ import Reactix as R
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Components.LoadingSpinner (loadingSpinner) import Gargantext.Components.LoadingSpinner (loadingSpinner)
useAff :: forall st. useLoader :: forall path st. Eq path =>
Aff st -> R.Hooks (Maybe st) path -> (path -> Aff st)
useAff loader = do -> (st -> R.Element) -> R.Hooks R.Element
(loaded /\ setLoaded) <- R.useState' Nothing useLoader path loader render = do
R.useEffect1 loader $ do
if isNothing loaded then
R2.affEffect "G.H.Loader.useAff" $
loader >>= (liftEffect <<< setLoaded <<< const <<< Just)
else pure R.nothing
pure loaded
useLoader :: forall path st.
path -> (path -> Aff st) -> (st -> R.Element) -> R.Hooks R.Element
useLoader path loader render
= maybe' (\_ -> loadingSpinner {}) render
<$> (useAff =<< R.useMemo2 path loader (\_ -> loader path))
useLoader2 :: forall path st.
R.State path -> (path -> Aff st)
-> (st -> R.Element) -> R.Hooks R.Element
useLoader2 path loader render = do
state <- R.useState' Nothing state <- R.useState' Nothing
useLoaderEffect2 path state loader useLoaderEffect path state loader
pure $ maybe (loadingSpinner {}) render (fst state) pure $ maybe (loadingSpinner {}) render (fst state)
useLoaderEffect :: forall state.
Aff state -> R.State (Maybe state) -> R.Hooks Unit
useLoaderEffect loader (state /\ setState) = do
R.useEffect2 state loader $ do
if isNothing state then
R2.affEffect "G.H.Loader.useLoader" $ loader >>= (liftEffect <<< setState <<< const <<< Just)
else pure R.nothing
useLoaderEffect' :: forall state.
Aff state -> R.Hooks (R.State (Maybe state))
useLoaderEffect' aff = do
state <- R.useState' Nothing
useLoaderEffect aff state
pure state
useLoaderEffect2 :: forall st path.
R.State path -> R.State (Maybe st)
-> (path -> Aff st) -> R.Hooks Unit
useLoaderEffect2 path state loader = do
aff <- useRepointer path loader
useLoaderEffect aff state
useRepointer :: forall path st.
R.State path -> (path -> Aff st) -> R.Hooks (Aff st)
useRepointer path@(path' /\ _) loader = R.useMemo2 loader path' (\_ -> loader path')
useLoaderEffect :: forall st path. Eq path =>
path -> R.State (Maybe st)
-> (path -> Aff st) -> R.Hooks Unit
useLoaderEffect path state@(state' /\ setState) loader = do
oPath <- R.useRef path
R.useEffect' $ do
if (R.readRef oPath == path) && (isJust state') then
pure $ pure unit
else do
R.setRef oPath path
R2.affEffect "G.H.Loader.useLoaderEffect2" $ do
l <- loader path
liftEffect $ setState $ const $ Just l
module Gargantext.Hooks.Sigmax module Gargantext.Hooks.Sigmax
-- (
-- )
where where
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import Data.Array as A import Data.Array as A
import Data.Either (Either(..), either) import Data.Either (either)
import Data.Foldable (sequence_) import Data.Foldable (sequence_)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
...@@ -20,11 +18,11 @@ import Data.Tuple.Nested((/\)) ...@@ -20,11 +18,11 @@ import Data.Tuple.Nested((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Class.Console (error) import Effect.Class.Console (error)
import Effect.Timer (TimeoutId, clearTimeout) import Effect.Timer (TimeoutId, clearTimeout)
import FFI.Simple (delay, (.=)) import FFI.Simple ((.=))
import Gargantext.Hooks.Sigmax.Sigma as Sigma import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types (Graph(..), Node(..), NodesMap, SelectedNodeIds) import Gargantext.Hooks.Sigmax.Types (Graph(..), NodesMap, SelectedNodeIds)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Prelude (Unit, bind, const, discard, flip, pure, unit, ($), (*>), (<$), (<$>), (<<<), (<>), (>>=), not) import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), not)
import Reactix as R import Reactix as R
type Sigma = type Sigma =
......
...@@ -3,9 +3,9 @@ module Gargantext.Hooks.Sigmax.Sigma where ...@@ -3,9 +3,9 @@ module Gargantext.Hooks.Sigmax.Sigma where
import Prelude import Prelude
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Nullable (notNull, null, Nullable) import Data.Nullable (notNull, null, Nullable)
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import FFI.Simple (delay, (..)) import FFI.Simple ((..))
import Effect (Effect, foreachE) import Effect (Effect, foreachE)
import Effect.Timer (setTimeout) import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, mkEffectFn1, runEffectFn1, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3, EffectFn4, runEffectFn4) import Effect.Uncurried (EffectFn1, mkEffectFn1, runEffectFn1, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3, EffectFn4, runEffectFn4)
...@@ -82,19 +82,19 @@ foreign import _killRenderer ...@@ -82,19 +82,19 @@ foreign import _killRenderer
(Either err Unit) (Either err Unit)
getRendererContainer :: Sigma -> Effect Element getRendererContainer :: Sigma -> Effect Element
getRendererContainer sigma = runEffectFn1 _getRendererContainer sigma getRendererContainer = runEffectFn1 _getRendererContainer
foreign import _getRendererContainer foreign import _getRendererContainer
:: EffectFn1 Sigma Element :: EffectFn1 Sigma Element
swapRendererContainer :: R.Ref (Nullable Element) -> Sigma -> Effect Unit swapRendererContainer :: R.Ref (Nullable Element) -> Sigma -> Effect Unit
swapRendererContainer ref sigma = do swapRendererContainer ref s = do
el <- getRendererContainer sigma el <- getRendererContainer s
log2 "[swapRendererContainer] el" el log2 "[swapRendererContainer] el" el
R.setRef ref $ notNull el R.setRef ref $ notNull el
setRendererContainer :: Sigma -> Element -> Effect Unit setRendererContainer :: Sigma -> Element -> Effect Unit
setRendererContainer sigma el = runEffectFn2 _setRendererContainer sigma el setRendererContainer = runEffectFn2 _setRendererContainer
foreign import _setRendererContainer foreign import _setRendererContainer
:: EffectFn2 Sigma Element Unit :: EffectFn2 Sigma Element Unit
...@@ -119,10 +119,10 @@ bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h) ...@@ -119,10 +119,10 @@ bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
unbind_ :: forall e. Sigma -> String -> Effect Unit unbind_ :: Sigma -> String -> Effect Unit
unbind_ s e = runEffectFn2 _unbind s e unbind_ s e = runEffectFn2 _unbind s e
foreign import _unbind :: forall e. EffectFn2 Sigma String Unit foreign import _unbind :: EffectFn2 Sigma String Unit
forEachNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit forEachNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
forEachNode s f = runEffectFn2 _forEachNode s (mkEffectFn1 f) forEachNode s f = runEffectFn2 _forEachNode s (mkEffectFn1 f)
...@@ -135,17 +135,17 @@ forEachEdge s f = runEffectFn2 _forEachEdge s (mkEffectFn1 f) ...@@ -135,17 +135,17 @@ forEachEdge s f = runEffectFn2 _forEachEdge s (mkEffectFn1 f)
foreign import _forEachEdge :: EffectFn2 Sigma (EffectFn1 (Record Types.Edge) Unit) Unit foreign import _forEachEdge :: EffectFn2 Sigma (EffectFn1 (Record Types.Edge) Unit) Unit
bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindClickNode sigma f = bind_ sigma "clickNode" $ \e -> do bindClickNode s f = bind_ s "clickNode" $ \e -> do
let node = e .. "data" .. "node" :: Record Types.Node let node = e .. "data" .. "node" :: Record Types.Node
f node f node
unbindClickNode :: Sigma -> Effect Unit unbindClickNode :: Sigma -> Effect Unit
unbindClickNode sigma = unbind_ sigma "clickNode" unbindClickNode s = unbind_ s "clickNode"
setSettings :: forall settings. Sigma -> settings -> Effect Unit setSettings :: forall settings. Sigma -> settings -> Effect Unit
setSettings sigma settings = do setSettings s settings = do
runEffectFn2 _setSettings sigma settings runEffectFn2 _setSettings s settings
refresh sigma refresh s
foreign import _setSettings :: forall settings. EffectFn2 Sigma settings Unit foreign import _setSettings :: forall settings. EffectFn2 Sigma settings Unit
...@@ -153,7 +153,7 @@ startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit ...@@ -153,7 +153,7 @@ startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
startForceAtlas2 = runEffectFn2 _startForceAtlas2 startForceAtlas2 = runEffectFn2 _startForceAtlas2
restartForceAtlas2 :: Sigma -> Effect Unit restartForceAtlas2 :: Sigma -> Effect Unit
restartForceAtlas2 sigma = runEffectFn2 _startForceAtlas2 sigma null restartForceAtlas2 s = runEffectFn2 _startForceAtlas2 s null
stopForceAtlas2 :: Sigma -> Effect Unit stopForceAtlas2 :: Sigma -> Effect Unit
stopForceAtlas2 = runEffectFn1 _stopForceAtlas2 stopForceAtlas2 = runEffectFn1 _stopForceAtlas2
...@@ -170,15 +170,15 @@ foreign import _killForceAtlas2 :: EffectFn1 Sigma Unit ...@@ -170,15 +170,15 @@ foreign import _killForceAtlas2 :: EffectFn1 Sigma Unit
foreign import _isForceAtlas2Running :: EffectFn1 Sigma Boolean foreign import _isForceAtlas2Running :: EffectFn1 Sigma Boolean
refreshForceAtlas :: Sigma -> Effect Unit refreshForceAtlas :: Sigma -> Effect Unit
refreshForceAtlas sigma = do refreshForceAtlas s = do
isRunning <- isForceAtlas2Running sigma isRunning <- isForceAtlas2Running s
if isRunning then if isRunning then
pure unit pure unit
else do else do
_ <- setTimeout 100 $ do _ <- setTimeout 100 $ do
restartForceAtlas2 sigma restartForceAtlas2 s
_ <- setTimeout 100 $ _ <- setTimeout 100 $
stopForceAtlas2 sigma stopForceAtlas2 s
pure unit pure unit
pure unit pure unit
...@@ -224,6 +224,6 @@ goTo props cam = do ...@@ -224,6 +224,6 @@ goTo props cam = do
foreign import _goTo :: EffectFn2 CameraInstance (Record CameraProps) Unit foreign import _goTo :: EffectFn2 CameraInstance (Record CameraProps) Unit
goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
goToAllCameras sigma props = do goToAllCameras s props = do
cs <- cameras sigma cs <- cameras s
foreachE cs (goTo props) foreachE cs (goTo props)
module Gargantext.Hooks.Sigmax.Types where module Gargantext.Hooks.Sigmax.Types where
import Prelude (map, ($)) import Prelude (map, ($), (&&), (==))
import Data.Map as Map import Data.Map as Map
import Data.Sequence (Seq) import Data.Sequence (Seq)
import Data.Set as Set import Data.Set as Set
...@@ -35,3 +35,6 @@ nodesMap :: Graph Node Edge -> NodesMap ...@@ -35,3 +35,6 @@ nodesMap :: Graph Node Edge -> NodesMap
nodesMap graph = do nodesMap graph = do
let (Graph {nodes}) = graph let (Graph {nodes}) = graph
Map.fromFoldable $ map (\n -> Tuple n.id n) nodes Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
eqGraph :: (Graph Node Edge) -> (Graph Node Edge) -> Boolean
eqGraph (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = (n1 == n2) && (e1 == e2)
...@@ -19,6 +19,8 @@ data AppRoute ...@@ -19,6 +19,8 @@ data AppRoute
| UserPage SessionId Int | UserPage SessionId Int
| ContactPage SessionId Int Int | ContactPage SessionId Int Int
derive instance eqAppRoute :: Eq AppRoute
type AnnuaireId = Int type AnnuaireId = Int
type ContactId = Int type ContactId = Int
......
...@@ -5,6 +5,8 @@ import Data.Lens (Lens', lens) ...@@ -5,6 +5,8 @@ import Data.Lens (Lens', lens)
import Data.Newtype (class Newtype, unwrap, wrap) import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Set as Set import Data.Set as Set
import Data.Set (Set) import Data.Set (Set)
import Data.String (length)
import Math (log)
-- | Astonishingly, not in the prelude -- | Astonishingly, not in the prelude
id :: forall a. a -> a id :: forall a. a -> a
...@@ -57,5 +59,18 @@ glyphicon t = "btn glyphitem glyphicon glyphicon-" <> t ...@@ -57,5 +59,18 @@ glyphicon t = "btn glyphitem glyphicon glyphicon-" <> t
glyphiconActive :: String -> Boolean -> String glyphiconActive :: String -> Boolean -> String
glyphiconActive icon b = glyphicon icon <> if b then " active" else "" glyphiconActive icon b = glyphicon icon <> if b then " active" else ""
-- | Logarithm with given base
logb :: Number -> Number -> Number
logb base n = (log n) / (log base)
log10 :: Number -> Number
log10 = logb 10.0
-- | Format a number with specified amount of zero-padding
zeroPad :: Int -> Int -> String
zeroPad pad num = zeros <> (show num)
where
numDigits = length $ show num
zeros = if numDigits < pad then zeros' (pad - numDigits) else ""
zeros' 0 = ""
zeros' n = "0" <> (zeros' (n - 1))
module Gargantext.Utils.Reactix where module Gargantext.Utils.Reactix where
import Prelude import Prelude
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log2)
import DOM.Simple.Document (document) import DOM.Simple.Document (document)
import DOM.Simple.Event as DE
import DOM.Simple.Element as Element import DOM.Simple.Element as Element
import DOM.Simple.Event as DE
import DOM.Simple.Types (class IsNode) import DOM.Simple.Types (class IsNode)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber) import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Effect.Uncurried (EffectFn1, runEffectFn1, mkEffectFn1, mkEffectFn2) import Effect.Uncurried (EffectFn1, runEffectFn1, mkEffectFn1, mkEffectFn2)
import FFI.Simple ((...), defineProperty, delay, args2, args3) import FFI.Simple ((...), defineProperty, delay, args2, args3)
...@@ -135,7 +136,7 @@ getElementById :: String -> Effect (Maybe DOM.Element) ...@@ -135,7 +136,7 @@ getElementById :: String -> Effect (Maybe DOM.Element)
getElementById = (flip delay) h getElementById = (flip delay) h
where where
h id = pure $ toMaybe $ document ... "getElementById" $ [id] h id = pure $ toMaybe $ document ... "getElementById" $ [id]
-- We just assume it works, so make sure it's in the html -- We just assume it works, so make sure it's in the html
getPortalHost :: R.Hooks DOM.Element getPortalHost :: R.Hooks DOM.Element
getPortalHost = R.unsafeHooksEffect $ delay unit $ \_ -> pure $ document ... "getElementById" $ ["portal"] getPortalHost = R.unsafeHooksEffect $ delay unit $ \_ -> pure $ document ... "getElementById" $ ["portal"]
...@@ -191,3 +192,19 @@ appendChildToParentId ps c = delay unit $ \_ -> do ...@@ -191,3 +192,19 @@ appendChildToParentId ps c = delay unit $ \_ -> do
effectLink :: Effect Unit -> String -> R.Element effectLink :: Effect Unit -> String -> R.Element
effectLink eff msg = H.a {on: {click: const eff}} [H.text msg] effectLink eff msg = H.a {on: {click: const eff}} [H.text msg]
useCache :: forall i o. Eq i => i -> (i -> R.Hooks o) -> R.Hooks o
useCache i f = do
iRef <- R.useRef Nothing
oRef <- R.useRef Nothing
let currI = R.readRef iRef
let currO = R.readRef oRef
if currI == Just i then
case currO of
Nothing -> f i -- this one shouldn't happen, but purescript
Just v -> pure v
else do
new <- f i
R.unsafeHooksEffect (R.setRef iRef $ Just i)
R.unsafeHooksEffect (R.setRef oRef $ Just new)
pure new
module Gargantext.Utils.Spec where
import Prelude
import Data.Array (index)
import Data.Foldable (all)
import Data.Maybe (Maybe(..), isJust)
import Data.String (drop, stripPrefix, Pattern(..))
import Data.Tuple (Tuple(..))
import Gargantext.Utils as U
-- import Test.QuickCheck ((===), (/==), (<?>), Result(..))
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
import Test.Spec.QuickCheck (quickCheck')
spec :: Spec Unit
spec =
describe "G.Utils" do
it "zeroPad 1 works" do
U.zeroPad 1 0 `shouldEqual` "0"
U.zeroPad 1 1 `shouldEqual` "1"
U.zeroPad 1 10 `shouldEqual` "10"
it "zeroPad 2 works" do
U.zeroPad 2 0 `shouldEqual` "00"
U.zeroPad 2 1 `shouldEqual` "01"
U.zeroPad 2 10 `shouldEqual` "10"
U.zeroPad 2 100 `shouldEqual` "100"
it "zeroPad 3 works" do
U.zeroPad 3 0 `shouldEqual` "000"
U.zeroPad 3 1 `shouldEqual` "001"
U.zeroPad 3 10 `shouldEqual` "010"
U.zeroPad 3 99 `shouldEqual` "099"
U.zeroPad 3 100 `shouldEqual` "100"
U.zeroPad 3 101 `shouldEqual` "101"
U.zeroPad 3 1000 `shouldEqual` "1000"
it "log10 10" do
U.log10 10.0 `shouldEqual` 1.0
...@@ -5,7 +5,9 @@ import Effect (Effect) ...@@ -5,7 +5,9 @@ import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Test.Spec.Discovery (discover) import Test.Spec.Discovery (discover)
import Test.Spec.Reporter.Console (consoleReporter) import Test.Spec.Reporter.Console (consoleReporter)
import Test.Spec.Runner (run) import Test.Spec.Runner (runSpec)
main :: Effect Unit main :: Effect Unit
main = discover "Gargantext\\..*Spec" >>= run [consoleReporter] >>> launchAff_ main = launchAff_ do
specs <- discover "Gargantext\\..*Spec"
runSpec [consoleReporter] specs
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