Skip to content

P
purescript-gargantext
Commit 1105cefb authored by James Laver's avatar James Laver
Browse files
Options

re-refactor to enable backend chooser

parent 80557556
Show whitespace changes
Inline Side-by-side
Showing with 1544 additions and 1618 deletions
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @ 1105cefb
......@@ -22,10 +22,9 @@ import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Gargantext.Config (CTabNgramType(..))
import Gargantext.Types ( TermList )
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Components.NgramsTable.Core ( NgramsTerm, NgramsTable(..), highlightNgrams, findNgramTermList )
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams)
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel
......@@ -69,6 +68,7 @@ annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
pure $ HTML.div wrapperProps [maybeAddMenu setMenu runs menu]
-- forall e. IsMouseEvent e => R2.Setter (Maybe AnnotationMenu) -> R2.Setter ? -> ? -> e -> Effect Unit
maybeShowMenu setMenu setTermList ngrams event = do
s <- Sel.getSelection
case s of
......@@ -118,6 +118,6 @@ annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
HTML.span { className: className list
, onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e} [ HTML.text text ]
where
className list = "annotation-run bg-" <> termBootstrapClass list
className list' = "annotation-run bg-" <> termBootstrapClass list'
src/Gargantext/Components/Annotation/Menu.purs
View file @ 1105cefb
......@@ -2,16 +2,16 @@
module Gargantext.Components.Annotation.Menu where
import Prelude ( Unit, (==), ($), (<>), unit, pure, otherwise, const )
import Prelude (Unit, pure, ($), (<>), (==))
import Data.Array as A
import Data.Maybe ( Maybe(..), maybe' )
import Effect ( Effect )
import Effect.Uncurried ( mkEffectFn1 )
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import Reactix as R
import Reactix.DOM.HTML as HTML
import Gargantext.Types ( TermList(..), termListName )
import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Types (TermList(..), termListName)
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
import Gargantext.Components.ContextMenu.ContextMenu as CM
import Gargantext.Utils.Reactix as R2
......
src/Gargantext/Components/Layout.purs → src/Gargantext/Components/App.purs
View file @ 1105cefb
module Gargantext.Components.Layout where
module Gargantext.Components.App where
import Prelude
import Data.Array (fromFoldable)
import Data.Foldable (fold, intercalate)
import Data.Lens (over)
import Data.Maybe (Maybe(..), maybe')
import Data.Map as Map
import Data.Newtype (unwrap)
import Data.Maybe (Maybe(..))
import Data.Tuple (fst, snd)
import Data.Tuple.Nested((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff)
import React.DOM (button, div, text)
import React.DOM.Props (_id, className, onClick, role, style)
import Reactix as R
import Reactix.DOM.HTML as H
-- import Unsafe.Coerce (unsafeCoerce)
import Gargantext.BootstrapNative (createDropdown)
import Gargantext.Prelude
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.EndsChooser as EndsChooser
import Gargantext.Components.EndsSummary (endsSummary)
import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Login.Types (AuthData(..))
import Gargantext.Components.Login (Auths, getCurrentAuth, setAuths, login)
import Gargantext.Components.Login (login)
import Gargantext.Components.Search.SearchBar as SB
import Gargantext.Components.Tree as Tree
import Gargantext.Config (Ends, defaultEnds, backendKey)
import Gargantext.Components.Search.Types (allDatabases)
import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Components.Folder (folder)
import Gargantext.Ends (Frontends)
import Gargantext.Pages.Annuaire (annuaireLayout)
import Gargantext.Pages.Annuaire.User.Contacts (userLayout)
import Gargantext.Pages.Corpus (corpusLayout)
......@@ -35,99 +24,76 @@ import Gargantext.Pages.Corpus.Document (documentLayout)
import Gargantext.Pages.Corpus.Dashboard (dashboardLayout)
import Gargantext.Pages.Lists (listsLayout)
import Gargantext.Pages.Texts (textsLayout)
import Gargantext.Pages.Home (layoutLanding)
import Gargantext.Router (Routes(..), routing, useHashRouter)
import Gargantext.Pages.Home (homeLayout)
import Gargantext.Router (router)
import Gargantext.Routes (AppRoute(..))
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.Utils.Reactix as R2
import Gargantext.Global (Global, defaultGlobal)
import Gargantext.Sessions (Session, Sessions, useSessions, unSessions)
-- TODO (what does this mean?)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
type State =
( ends :: R.State Ends
, auths :: R.State Auths
, route :: R.State Routes
, showLogin :: R.State Boolean
, showCorpus :: R.State Boolean
, showTree :: R.State Boolean )
app :: {} -> R.Element
app props = R.createElement appCpt props []
layout :: _ -> R.Element
layout _ = R.createElement layoutCpt {} []
layoutCpt :: R.Component ( )
layoutCpt = R.hooksComponent "Layout" cpt
where
appCpt :: R.Component ()
appCpt = R.hooksComponent "G.C.App.app" cpt where
frontends = defaultFrontends
cpt _ _ = do
state <- usePagesState
pure $ pages state
pages :: Record State -> R.Element
pages props = R.createElement pagesCpt props []
pagesCpt :: R.Component State
pagesCpt = R.staticComponent "Pages" cpt
where
cpt state@{ends, route, showLogin, showCorpus, showTree} _ = do
sessions <- useSessions
route <- useHashRouter router Home
showLogin <- R.useState' false
showCorpus <- R.useState' false
let tree = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
let mCurrentRoute = Just $ fst route
let setVisible = snd showLogin
let backends = fromFoldable defaultBackends
pure $ case unSessions (fst sessions) of
Nothing -> tree $ homeLayout EN
Just session ->
case (fst route) of
Home -> tree $ layoutLanding EN
Login -> login { ends: (fst ends), setVisible: (snd showLogin) }
Home -> tree $ homeLayout EN
Login -> login { sessions, backends, setVisible }
Folder _ -> tree $ folder {}
Corpus nodeId -> tree $ corpusLayout {nodeId, ends: fst ends}
Texts nodeId -> tree $ textsLayout {nodeId, ends: fst ends}
Lists nodeId -> tree $ listsLayout {nodeId, ends: fst ends}
Corpus nodeId -> tree $ corpusLayout { nodeId }
Texts nodeId -> tree $ textsLayout { nodeId, session }
Lists nodeId -> tree $ listsLayout { nodeId, session }
Dashboard -> tree $ dashboardLayout {}
Annuaire annuaireId -> tree $ annuaireLayout { annuaireId, ends: fst ends }
UserPage nodeId -> tree $ userLayout { nodeId, ends: fst ends }
ContactPage nodeId -> tree $ userLayout { nodeId, ends: fst ends }
Annuaire annuaireId -> tree $ annuaireLayout { annuaireId, session }
UserPage nodeId -> tree $ userLayout { nodeId, session }
ContactPage nodeId -> tree $ userLayout { nodeId, session }
CorpusDocument corpusId listId nodeId ->
tree $ documentLayout { nodeId, listId, corpusId: Just corpusId, ends: fst ends }
tree $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
Document listId nodeId ->
tree $ documentLayout { nodeId, listId, corpusId: Nothing, ends: fst ends }
tree $ documentLayout { nodeId, listId, session, corpusId: Nothing }
PGraphExplorer graphId ->
simpleLayout state $ explorerLayout {graphId, mCurrentRoute, treeId: Nothing, ends: fst ends}
where
mCurrentRoute = Just $ fst route
tree = treeLayout state
usePagesState :: R.Hooks (Record State)
usePagesState = do
ends <- R.useState' defaultEnds
auths <- R.useState' Map.empty
route <- useHashRouter routing Home
showLogin <- R.useState' false
showCorpus <- R.useState' false
showTree <- R.useState' false
pure $ {ends, auths, route, showLogin, showCorpus, showTree}
simpleLayout (fst sessions) $
explorerLayout { graphId, mCurrentRoute, session, treeId: Nothing }
treeLayout :: Record State -> R.Element -> R.Element
treeLayout state@{ends, auths, route, showTree} child =
R.fragment [ searchBar state, row layout', footer {} ]
forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element
forestLayout frontends sessions route showLogin child =
R.fragment [ searchBar sessions, row main, footer {} ]
where
backendAuth = getCurrentAuth (fst ends) (fst auths)
layout' = maybe' (\_ -> mainPage false child) (withTree <<< unwrap) backendAuth
withTree {tree_id} =
row child' = H.div {className: "row"} [child']
main =
R.fragment
[ H.div {className: "col-md-2", style: {paddingTop: "60px"}}
[ Tree.treeView { root: tree_id, mCurrentRoute: Just (fst route), ends: (fst ends) } ]
, mainPage true child ]
row child' = H.div {className: "row"} [child']
[ forest {sessions, route, frontends, showLogin} ]
, mainPage child ]
-- Simple layout does not accommodate the tree
simpleLayout :: Record State -> R.Element -> R.Element
simpleLayout state child = R.fragment [ searchBar state, child, footer {}]
simpleLayout :: Sessions -> R.Element -> R.Element
simpleLayout sessions child = R.fragment [ searchBar sessions, child, footer {}]
mainPage :: Boolean -> R.Element -> R.Element
mainPage showTree child =
H.div {className}
mainPage :: R.Element -> R.Element
mainPage child =
H.div {className: "col-md-10"}
[ H.div {id: "page-wrapper"}
[ H.div {className: "container-fluid"} [ child ] ] ]
where
className
| showTree = "col-md-10"
| otherwise = "col-md-12"
searchBar :: Record State -> R.Element
searchBar state@{ends} =
searchBar :: Sessions -> R.Element
searchBar sessions =
H.div { id: "dafixedtop", role: "navigation"
, className: "navbar navbar-inverse navbar-fixed-top" }
[ H.div { className: "container-fluid" }
......@@ -135,8 +101,11 @@ searchBar state@{ends} =
[ logo
, H.div { className: "collapse navbar-collapse" }
[ divDropdownLeft
, SB.searchBar (SB.defaultProps (fst ends))
, divDropdownRight state ] ] ] ]
, search ] ] ] ]
where
search = case unSessions sessions of
Just session -> SB.searchBar {session, databases: allDatabases}
Nothing -> R.fragment []
logo :: R.Element
logo =
......@@ -244,49 +213,6 @@ liNav (LiNav { title : title'
]
]
loginLinks :: Record State -> R.Element
loginLinks state@{ends, auths, showLogin} =
case getCurrentAuth (fst ends) (fst auths) of
Nothing -> loginLink
Just _ -> logoutLink
where
loginLink =
H.a { aria: {hidden : true}
, className: "glyphicon glyphicon-log-in"
, on: {click: \e -> (snd showLogin) (const true)}
, style: {color:"white"}
, title: "Log in and save your time"
-- TODO hover: bold
}
[H.text " Login / Signup"]
-- TODO dropdown to logout
logoutLink =
H.a { aria: {hidden : true}
, className: "glyphicon glyphicon-log-out"
, on: {click: \e -> logout state}
, style: {color:"white"}
, title: "Log out" -- TODO
-- TODO hover: bold
}
[H.text " Logout"]
logout :: Record State -> Effect Unit
logout {ends, auths} = (snd auths) (const auths2) *> setAuths (Just auths2)
where
key = backendKey (fst ends).backend
auths2 = Map.delete key (fst auths)
divDropdownRight :: Record State -> R.Element
divDropdownRight props = R.createElement divDropdownRightCpt props []
divDropdownRightCpt :: R.Component State
divDropdownRightCpt = R.staticComponent "G.C.Layout.divDropdownRight" cpt
where
cpt state@{ends} _ =
H.ul {className: "nav navbar-nav pull-right"}
[ endsSummary (fst ends), loginLinks state ]
footer :: {} -> R.Element
footer props = R.createElement footerCpt props []
......
src/Gargantext/Components/Charts/Options/Series.purs
View file @ 1105cefb
module Gargantext.Components.Charts.Options.Series where
import Data.Maybe
import Prelude (class Show, bind, map, pure, show, ($), (+), (<<<), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Array (foldl)
import Data.Maybe (Maybe(..), maybe)
import Record.Unsafe (unsafeSet)
import Unsafe.Coerce (unsafeCoerce)
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Gargantext.Types (class Optional)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
......@@ -181,7 +180,7 @@ toJsTree maybeSurname (TreeNode x) =
, children : (map (toJsTree (Just name)) x.children)
}
where
name = maybe "" (\x -> x <> ">") maybeSurname <> x.name
name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name
data TreeNode = TreeNode { name :: String
, value :: Int
......
src/Gargantext/Components/ContextMenu/ContextMenu.purs
View file @ 1105cefb
......@@ -15,7 +15,7 @@ import DOM.Simple.Window ( window )
import DOM.Simple.Document ( document )
import DOM.Simple.Types ( DOMRect )
import Effect (Effect)
import FFI.Simple ( (...), (..), delay )
import FFI.Simple ((..))
import Reactix as R
import Reactix.DOM.HTML as HTML
......
src/Gargantext/Components/DocsTable.purs
View file @ 1105cefb
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (drop, take)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
......@@ -15,24 +16,24 @@ import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log)
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (Ends, NodeType(..), OrderBy(..), BackendRoute(..), TabType, TabPostQuery(..), url)
import Gargantext.Config.REST (get, put, post, deleteWithBody, delete)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Config.REST (post, delete)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Utils.Reactix as R2
import Gargantext.Router as Router
import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..))
------------------------------------------------------------------------
type NodeID = Int
......@@ -46,7 +47,7 @@ type Props =
, listId :: Int
, corpusId :: Maybe Int
, showSearch :: Boolean
, ends :: Ends )
, session :: Session )
-- ^ tabType is not ideal here since it is too much entangled with tabs and
-- ngramtable. Let's see how this evolves. )
......@@ -57,7 +58,7 @@ type PageLoaderProps =
, listId :: Int
, corpusId :: Maybe Int
, query :: Query
, ends :: Ends )
, session :: Session )
type LocalCategories = Map Int Category
type Query = String
......@@ -136,23 +137,22 @@ layoutDocview :: R.State Query -> R.State T.Params -> Record Props -> R.Element
layoutDocview query tableParams@(params /\ _) p = R.createElement el p []
where
el = R.hooksComponent "LayoutDocView" cpt
cpt {ends, nodeId, tabType, listId, corpusId, totalRecords, chart, showSearch} _children = do
cpt {session, nodeId, tabType, listId, corpusId, totalRecords, chart, showSearch} _children = do
pure $ H.div {className: "container1"}
[ H.div {className: "row"}
[ chart
, if showSearch then searchBar query else H.div {} []
, H.div {className: "col-md-12"}
[ pageLoader tableParams {ends, nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ] ] ]
onClickTrashAll nodeId = mkEffectFn1 $ \_ -> do
launchAff $ deleteAllDocuments p.ends nodeId
[ pageLoader tableParams {session, nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ] ] ]
-- onClickTrashAll nodeId _ = do
-- launchAff $ deleteAllDocuments p.session nodeId
{-, H.div {className: "col-md-1 col-md-offset-11"}
[ pageLoader p.ends tableParams {nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ]
[ pageLoader p.session tableParams {nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ]
, H.div {className: "col-md-1 col-md-offset-11"}
[ H.button { className: "btn"
, style: {backgroundColor: "peru", color : "white", border : "white"}
, onClick: onClickTrashAll nodeId
}
, on: { click: onClickTrashAll nodeId } }
[ H.i {className: "glyphitem glyphicon glyphicon-trash"} []
, H.text "Trash all"
]
......@@ -211,11 +211,11 @@ type PageParams = { nodeId :: Int
, query :: Query
, params :: T.Params}
loadPage :: Ends -> PageParams -> Aff (Array DocumentsView)
loadPage ends {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do
logs "loading documents page: loadPage with Offset and limit"
loadPage :: Session -> PageParams -> Aff (Array DocumentsView)
loadPage session {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do
liftEffect $ log "loading documents page: loadPage with Offset and limit"
-- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
let url2 = (url ends (NodeAPI Node (Just nodeId))) <> "/table"
let url2 = (url session (NodeAPI Node (Just nodeId))) <> "/table"
res <- post url2 $ TabPostQuery {
offset
, limit
......@@ -256,10 +256,10 @@ renderPage (_ /\ setTableParams) p res = R.createElement el p []
gi _ = "glyphicon glyphicon-star-empty"
trashStyle Trash = {textDecoration: "line-through"}
trashStyle _ = {textDecoration: "none"}
corpusDocument (Just corpusId) = Router.CorpusDocument corpusId
corpusDocument _ = Router.Document
corpusDocument (Just corpusId) = Routes.CorpusDocument corpusId
corpusDocument _ = Routes.Document
cpt {ends, nodeId, corpusId, listId, totalRecords} _children = do
cpt {session, nodeId, corpusId, listId, totalRecords} _children = do
localCategories <- R.useState' (mempty :: LocalCategories)
pure $ T.table
{ rows: rows localCategories
......@@ -292,15 +292,15 @@ renderPage (_ /\ setTableParams) p res = R.createElement el p []
onClick (_ /\ setLocalCategories) catType nid cat = \_-> do
let newCat = if (catType == Favorite) then (favCategory cat) else (trashCategory cat)
setLocalCategories $ insert nid newCat
void $ launchAff $ putCategories ends nodeId $ CategoryQuery {nodeIds: [nid], category: newCat}
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [nid], category: newCat}
pageLoader :: R.State T.Params -> Record PageLoaderProps -> R.Element
pageLoader tableParams@(pageParams /\ _) p = R.createElement el p []
where
el = R.hooksComponent "PageLoader" cpt
cpt p@{ends, nodeId, listId, corpusId, tabType, query} _children = do
useLoader {nodeId, listId, corpusId, tabType, query, params: pageParams} (loadPage ends) $
\loaded -> renderPage tableParams p loaded
cpt props@{session, nodeId, listId, corpusId, tabType, query} _children = do
useLoader {nodeId, listId, corpusId, tabType, query, params: pageParams} (loadPage session) $
\loaded -> renderPage tableParams props loaded
---------------------------------------------------------
sampleData' :: DocumentsView
......@@ -344,11 +344,11 @@ searchResults :: SearchQuery -> Aff Int
searchResults squery = post "http://localhost:8008/count" unit
-- TODO
documentsUrl :: Ends -> Int -> String
documentsUrl ends nodeId = url ends (NodeAPI Node (Just nodeId)) <> "/documents"
documentsUrl :: Session -> Int -> String
documentsUrl session nodeId = url session (NodeAPI Node (Just nodeId)) <> "/documents"
deleteAllDocuments :: Ends -> Int -> Aff (Array Int)
deleteAllDocuments ends = delete <<< documentsUrl ends
deleteAllDocuments :: Session -> Int -> Aff (Array Int)
deleteAllDocuments session = delete <<< documentsUrl session
-- TODO: not optimal but Data.Set lacks some function (Set.alter)
toggleSet :: forall a. Ord a => a -> Set a -> Set a
......
src/Gargantext/Components/EndsChooser.purs deleted 100644 → 0
View file @ 80557556
-- |
module Gargantext.Components.EndsChooser
-- (
-- )
where
import Prelude (($), pure)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Config (Backend, Ends, defaultEnds, defaultEnds')
import Gargantext.Utils.Reactix as R2
type Props = ( ends :: R.State Ends )
useEnds :: R.Hooks (R.State Ends)
useEnds = R.useState' defaultEnds
endsChooser :: Record Props -> R.Element
endsChooser props = R.createElement endsChooserCpt props []
endsChooserCpt :: R.Component Props
endsChooserCpt = R.hooksComponent "G.C.EndsChooser.endsChooser" cpt
where
cpt {ends} _ = do
pure $ R.fragment []
-- el = R.hooksComponent "EndConfigChooserCpt" cpt
-- cpt {state} _children = do
-- R.useEffect $ pure $
-- if (configState /= state) then do
-- _ <- log2 "update state: " configState
-- _ <- d $ ConfigStateA $ C.UpdateState configState
-- _ <- log2 "logout" ""
-- d $ Logout
-- else
-- pure $ unit
-- pure $ H.span {}
-- [ endConfigChooser (configState /\ setConfigState)
-- , H.span {className: "text-info"}
-- [ H.text $ C.endConfigDisplayName configState.endConfig ]
-- , H.span {className: "text-danger"}
-- [ H.text $ C.endConfigDisplayName state.endConfig ]
-- ]
-- endConfigChooser :: R.State Ends -> R.Element
-- endConfigChooser (configState /\ setConfigState) = R.createElement el {} []
-- where
-- el = R.hooksComponent "EndConfigChooser" cpt
-- cpt {} _ = do
-- -- NOTE Need to rebind the component after rerender
-- R.useEffect do
-- _ <- pure $ createDropdown "end-config-chooser"
-- pure $ pure unit
-- pure $ H.li {className: "dropdown"}
-- [ H.a { className: "navbar-text dropdown-toggle"
-- , href: "#"
-- , role: "button"
-- , data: {toggle: "dropdown"}
-- , id: "end-config-chooser"
-- }
-- [ H.text $ C.endConfigDisplayName configState.endConfig ]
-- , H.ul { className: "dropdown-menu"
-- } (liItem <$> C.endConfigOptions)
-- ]
-- liItem :: C.EndConfigOption -> R.Element
-- liItem {endConfig, displayName} =
-- H.li {on: {click: onClick endConfig}}
-- [ H.a {href: "#"} [H.text displayName] ]
-- onClick endConfig = \_ -> do
-- log2 "set end config" endConfig
-- setConfigState $ \st -> st {endConfig = endConfig}
-- type BackendProps = ( ends :: R.State Ends, backend :: Backend )
-- backendCpt :: R.Component BackendProps
-- backendCpt = R.hooksComponent "G.C.EndsChooser.backend" cpt
-- where
-- cpt {ends, backend} _ = do
src/Gargantext/Components/EndsSummary.purs deleted 100644 → 0
View file @ 80557556
module Gargantext.Components.EndsSummary
-- (
-- )
where
import Reactix as R
import Reactix.DOM.HTML as H
import Data.Semigroup ((<>))
import Gargantext.Config (Ends)
endsSummary :: Ends -> R.Element
endsSummary ends = H.div {className: "text-info"} [ H.text text ]
where text = "Connected to " <> ends.backend.name
src/Gargantext/Components/FacetsTable.purs
View file @ 1105cefb
......@@ -3,10 +3,9 @@
-- has not been ported to this module yet.
module Gargantext.Components.FacetsTable where
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter, (!!))
import Data.Foldable (intercalate)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
......@@ -14,23 +13,24 @@ import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (Ends, NodeType(..), OrderBy(..), NodePath(..), BackendRoute(..), TabType, url)
import Gargantext.Config.REST (put, post, deleteWithBody)
import Gargantext.Config.REST (post, deleteWithBody)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T
import Gargantext.Router as Router
import Gargantext.Routes (SessionRoute(Search,NodeAPI))
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..))
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Utils.Reactix as R2
------------------------------------------------------------------------
type NodeID = Int
......@@ -63,7 +63,7 @@ type Props =
, totalRecords :: Int
, chart :: R.Element
, container :: Record T.TableContainerProps -> R.Element
, ends :: Ends
, session :: Session
)
-- | Tracks the ids of documents to delete and that have been deleted
......@@ -164,14 +164,14 @@ docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component Props
docViewCpt = R.hooksComponent "G.C.FacetsTable.DocView" cpt
where
cpt {ends, nodeId, listId, query, totalRecords, chart, container} _ = do
cpt {session, nodeId, listId, query, totalRecords, chart, container} _ = do
deletions <- R.useState' initialDeletions
path <- R.useState' $ initialPagePath {nodeId, listId, query, ends}
path <- R.useState' $ initialPagePath {nodeId, listId, query, session}
pure $ H.div { className: "container1" }
[ H.div { className: "row" }
[ chart
, H.div { className: "col-md-12" }
[ pageLayout { deletions, totalRecords, container, ends, path } ]
[ pageLayout { deletions, totalRecords, container, session, path } ]
, H.div { className: "col-md-12" }
[ H.button { style: buttonStyle, on: { click: trashClick deletions } }
[ H.i { className: "glyphitem glyphicon glyphicon-trash"
......@@ -181,19 +181,19 @@ docViewCpt = R.hooksComponent "G.C.FacetsTable.DocView" cpt
buttonStyle =
{ backgroundColor: "peru", padding: "9px", color: "white"
, border: "white", float: "right" }
trashClick deletions _ = performDeletions ends nodeId deletions
trashClick deletions _ = performDeletions session nodeId deletions
performDeletions :: Ends -> Int -> R.State Deletions -> Effect Unit
performDeletions ends nodeId (deletions /\ setDeletions) =
performDeletions :: Session -> Int -> R.State Deletions -> Effect Unit
performDeletions session nodeId (deletions /\ setDeletions) =
launchAff_ call *> setDeletions del
where
q = {documents: Set.toUnfoldable deletions.pending}
call = deleteDocuments ends nodeId (DeleteDocumentQuery q)
call = deleteDocuments session nodeId (DeleteDocumentQuery q)
del {pending, deleted} = {pending: mempty, deleted: deleted <> pending}
-- markCategory :: Ends -> NodeID -> _ -> Array NodeID -> Effect Unit
markCategory ends nodeId category nids =
void $ launchAff_ $putCategories ends nodeId (CategoryQuery q)
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids =
void $ launchAff_ $putCategories session nodeId (CategoryQuery q)
where -- TODO add array of delete rows here
q = {nodeIds: nids, category: favCategory category}
......@@ -207,12 +207,12 @@ docViewGraph props = R.createElement docViewCpt props []
docViewGraphCpt :: R.Component Props
docViewGraphCpt = R.hooksComponent "FacetsDocViewGraph" cpt
where
cpt {ends, nodeId, listId, query, totalRecords, chart, container} _ = do
cpt {session, nodeId, listId, query, totalRecords, chart, container} _ = do
deletions <- R.useState' initialDeletions
let buttonStyle = { backgroundColor: "peru", padding : "9px"
, color : "white", border : "white", float: "right"}
let performClick = \_ -> performDeletions ends nodeId deletions
path <- R.useState' $ initialPagePath { nodeId, listId, query, ends }
let performClick = \_ -> performDeletions session nodeId deletions
path <- R.useState' $ initialPagePath { nodeId, listId, query, session }
pure $ R.fragment
[ H.br {}
, H.p {} [ H.text "" ]
......@@ -221,21 +221,21 @@ docViewGraphCpt = R.hooksComponent "FacetsDocViewGraph" cpt
[ H.div { className: "row" }
[ chart
, H.div { className: "col-md-12" }
[ pageLayout { totalRecords, deletions, container, ends, path }
[ pageLayout { totalRecords, deletions, container, session, path }
, H.button { style: buttonStyle, on: { click: performClick } }
[ H.i { className: "glyphitem glyphicon glyphicon-trash"
, style: { marginRight : "9px" } } []
, H.text "Delete document!" ] ] ] ] ]
type PagePath = {nodeId :: Int, listId :: Int, query :: TextQuery, params :: T.Params, ends :: Ends}
type PagePath = {nodeId :: Int, listId :: Int, query :: TextQuery, params :: T.Params, session :: Session}
initialPagePath :: {ends :: Ends, nodeId :: Int, listId :: Int, query :: TextQuery} -> PagePath
initialPagePath {ends, nodeId, listId, query} = {ends, nodeId, listId, query, params: T.initialParams}
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: TextQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
loadPage :: PagePath -> Aff (Array DocumentsView)
loadPage {ends, nodeId, listId, query, params: {limit, offset, orderBy}} = do
logs "loading documents page: loadPage with Offset and limit"
let url2 = url ends $ Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do
liftEffect $ log "loading documents page: loadPage with Offset and limit"
let url2 = url session $ Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
SearchResults res <- post url2 $ SearchQuery {query}
pure $ res2corpus <$> res.results
where
......@@ -255,7 +255,7 @@ type PageLayoutProps =
( totalRecords :: Int
, deletions :: R.State Deletions
, container :: Record T.TableContainerProps -> R.Element
, ends :: Ends
, session :: Session
, path :: R.State PagePath
)
......@@ -268,9 +268,9 @@ pageLayout props = R.createElement pageLayoutCpt props []
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponent "G.C.FacetsTable.PageLayout" cpt
where
cpt {totalRecords, deletions, container, ends, path} _ = do
cpt {totalRecords, deletions, container, session, path} _ = do
useLoader (fst path) loadPage $ \documents ->
page {totalRecords, deletions, container, ends, path, documents}
page {totalRecords, deletions, container, session, path, documents}
page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []
......@@ -278,7 +278,7 @@ page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps
pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
where
cpt {totalRecords, container, deletions, documents, ends, path: path@({nodeId, listId, query} /\ setPath)} _ = do
cpt {totalRecords, container, deletions, documents, session, path: path@({nodeId, listId, query} /\ setPath)} _ = do
T.table { rows, container, colNames, totalRecords, setParams }
where
setParams params = setPath (_ {params = params})
......@@ -290,7 +290,7 @@ pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
isDeleted (DocumentsView {id}) = Set.member id (fst deletions).deleted
pairUrl (Pair {id,label})
| id > 1 = H.a { href, target: "blank" } [ H.text label ]
where href = url ends $ NodePath NodeContact (Just id)
where href = url session $ NodePath NodeContact (Just id)
| otherwise = H.text label
comma = H.span {} [ H.text ", " ]
rows = row <$> filter (not <<< isDeleted) documents
......@@ -307,7 +307,7 @@ pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
] ]
, delete: true }
where
markClick _ = markCategory ends nodeId category [id]
markClick _ = markCategory session nodeId category [id]
toggleClick _ = togglePendingDeletion deletions id
className = gi category
maybeStricken
......@@ -323,6 +323,6 @@ instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
encodeJson (DeleteDocumentQuery post) =
"documents" := post.documents ~> jsonEmptyObject
deleteDocuments :: Ends -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments ends nodeId = deleteWithBody to
where to = url ends (NodeAPI Node (Just nodeId)) <> "/documents"
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId = deleteWithBody to
where to = url session (NodeAPI Node (Just nodeId)) <> "/documents"
src/Gargantext/Components/Forest.purs 0 → 100644
View file @ 1105cefb
module Gargantext.Components.Forest where
import Prelude (const, show)
import Data.Maybe (Maybe(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, unSessions)
import Gargantext.Components.Tree (treeView)
import Gargantext.Utils.Reactix as R2
type Props =
( sessions :: Sessions
, route :: AppRoute
, frontends :: Frontends
, showLogin :: R2.Setter Boolean )
forest :: Record Props -> R.Element
forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props
forestCpt = R.staticComponent "G.C.Forest.forest" cpt where
cpt {sessions, route, frontends, showLogin} _ =
R.fragment [ plus showLogin, trees ]
where
trees =
case unSessions sessions of
Nothing -> R.fragment []
Just s@(Session {treeId}) ->
R.fragment
[ H.text (show s)
, treeView { root: treeId, mCurrentRoute: Just route, session: s } ]
plus :: R2.Setter Boolean -> R.Element
plus showLogin =
H.button {on: {click: \_ -> showLogin (const true)}}
[ H.text "+" ]
src/Gargantext/Components/Forms.purs 0 → 100644
View file @ 1105cefb
module Gargantext.Components.Forms where
import Reactix as R
import Reactix.DOM.HTML as H
clearfix :: _ -> R.Element
clearfix _ = H.div {className: "clearfix"} []
formGroup :: Array R.Element -> R.Element
formGroup = H.div {className: "form-group"}
center :: Array R.Element -> R.Element
center = H.div {className: "center"}
card :: Array R.Element -> R.Element
card = H.div {className: "card"}
cardBlock :: Array R.Element -> R.Element
cardBlock = H.div {className: "card-block"}
cardGroup :: Array R.Element -> R.Element
cardGroup = H.div {className: "card-group"}
src/Gargantext/Components/Graph.purs
View file @ 1105cefb
......@@ -4,10 +4,9 @@ module Gargantext.Components.Graph
-- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings
-- )
where
import Prelude
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null)
import DOM.Simple.Console (log2)
import Prelude (bind, discard, pure, ($))
import Data.Maybe (Maybe)
import Data.Nullable (null)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Sigmax
......
src/Gargantext/Components/GraphExplorer.purs
View file @ 1105cefb
......@@ -5,19 +5,16 @@ import Gargantext.Prelude hiding (max,min)
import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Foldable (foldMap)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import Thermite (Render, Spec, simpleSpec)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma (Sigma)
import Gargantext.Hooks.Sigmax (Sigma)
import Gargantext.Hooks.Sigmax.Types as Sigmax
import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Sidebar as Sidebar
......@@ -25,19 +22,19 @@ import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Graph as Graph
import Gargantext.Components.Tree as Tree
import Gargantext.Config (Ends, url)
import Gargantext.Config as Config
import Gargantext.Config.REST (get)
import Gargantext.Router (Routes(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(Graph))
type GraphId = Int
type LayoutProps =
( graphId :: GraphId
, mCurrentRoute :: Maybe Routes
, mCurrentRoute :: Maybe AppRoute
, treeId :: Maybe Int
, ends :: Ends )
, session :: Session )
type Props = ( graph :: Maybe Graph.Graph | LayoutProps )
......@@ -48,10 +45,10 @@ explorerLayout props = R.createElement explorerLayoutCpt props []
explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt
where
cpt {graphId, mCurrentRoute, treeId, ends} _ =
useLoader graphId (getNodes ends) handler
cpt {graphId, mCurrentRoute, treeId, session} _ =
useLoader graphId (getNodes session) handler
where
handler loaded = explorer {graphId, mCurrentRoute, treeId, ends, graph}
handler loaded = explorer {graphId, mCurrentRoute, treeId, session, graph}
where graph = Just (convert loaded)
explorer :: Record Props -> R.Element
......@@ -60,7 +57,7 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props
explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where
cpt {ends, graphId, mCurrentRoute, treeId, graph} _ = do
cpt {session, graphId, mCurrentRoute, treeId, graph} _ = do
controls <- Controls.useGraphControls
state <- useExplorerState
pure $
......@@ -88,9 +85,9 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where
tree {treeId: Nothing} _ = RH.div { id: "tree" } []
tree _ {showTree: false /\ _} = RH.div { id: "tree" } []
tree {mCurrentRoute, treeId: Just treeId} _ =
tree {mCurrentRoute: m, treeId: Just root} _ =
RH.div { id: "tree", className: "col-md-2" }
[ Tree.treeView {mCurrentRoute, root: treeId, ends: ends} ]
[ Tree.treeView {mCurrentRoute: m, root, session: session} ]
outer = RH.div { className: "col-md-12" }
inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } }
row1 = RH.div { className: "row", style: { paddingBottom: "10px", marginTop: "-24px" } }
......@@ -100,7 +97,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
pullRight = RH.div { className: "pull-right" }
mGraph :: R.Ref (Maybe Sigmax.Sigma) -> {graphId :: GraphId, graph :: Maybe Graph.Graph} -> R.Element
mGraph :: R.Ref (Maybe Sigma) -> {graphId :: GraphId, graph :: Maybe Graph.Graph} -> R.Element
mGraph _ {graph: Nothing} = RH.div {} []
mGraph sigmaRef {graphId, graph: Just graph} = graphView sigmaRef {graphId, graph}
......@@ -127,7 +124,7 @@ type GraphProps = (
, graph :: Graph.Graph
)
graphView :: R.Ref (Maybe Sigmax.Sigma) -> Record GraphProps -> R.Element
graphView :: R.Ref (Maybe Sigma) -> Record GraphProps -> R.Element
--graphView sigmaRef props = R.createElement (R.memo el memoCmp) props []
graphView sigmaRef props = R.createElement el props []
where
......@@ -288,5 +285,5 @@ defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","#
-- ]
getNodes :: Ends -> GraphId -> Aff GET.GraphData
getNodes ends graphId = get $ url ends $ Config.NodeAPI Config.Graph (Just graphId)
getNodes :: Session -> GraphId -> Aff GET.GraphData
getNodes session graphId = get $ url session $ NodeAPI Graph (Just graphId)
src/Gargantext/Components/GraphExplorer/Button.purs
View file @ 1105cefb
module Gargantext.Components.GraphExplorer.Button
(
centerButton
( centerButton
, Props
, simpleButton
) where
import Global (readFloat)
import Prelude
import Data.Maybe (Maybe(..))
import Data.Tuple (snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Reactix as R2
type Props = (
onClick :: forall e. e -> Effect Unit
......
src/Gargantext/Components/GraphExplorer/Controls.purs
View file @ 1105cefb
......@@ -11,8 +11,7 @@ module Gargantext.Components.GraphExplorer.Controls
, getMultiNodeSelect, setMultiNodeSelect
) where
import Data.Maybe (Maybe(..))
import DOM.Simple as DOM
import Data.Maybe (Maybe)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Prelude
......
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ 1105cefb
module Gargantext.Components.GraphExplorer.Sidebar
(Props, sidebar)
where
import Data.Tuple.Nested ((/\))
import Prelude
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Utils.Reactix as R2
type Props = (
showSidePanel :: Boolean
)
type Props = ( showSidePanel :: Boolean )
sidebar :: Record Props -> R.Element
sidebar props = R.createElement sidebarCpt props []
......@@ -24,72 +18,44 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
pure $ RH.div {} []
cpt props _children = do
pure $
RH.div { id: "sp-container"
, className: "col-md-2" }
[
RH.div {}
[
RH.div { className: "row" }
[
RH.div { className: "col-md-12" }
[
RH.ul { id: "myTab"
, className: "nav nav-tabs"
, role: "tablist"}
[
RH.li { className: "nav-item" }
[
RH.a { id: "home-tab"
RH.div { id: "sp-container", className: "col-md-2" }
[ RH.div {}
[ RH.div { className: "row" }
[ RH.div { className: "col-md-12" }
[ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist"}
[ RH.li { className: "nav-item" }
[ RH.a { id: "home-tab"
, className: "nav-link active"
, data: {toggle: "tab"}
, href: "#home"
, role: "tab"
, aria: {controls: "home", selected: "true"}}
[
RH.text "Neighbours"
]
]
]
, RH.div { className: "tab-content"
, id: "myTabContent" }
[ RH.div { className: ""
, id: "home"
, role: "tabpanel" }
[ badge "objects"
, badge "evaluation"
, badge "dynamics"
, badge "virtual environments"
, badge "virtual reality"
, badge "performance analysis"
, badge "software engineering"
, badge "complex systems"
, badge "wireless communications"
]
]
]
, RH.div { className: "col-md-12"
, id: "horizontal-checkbox" }
[
RH.ul {}
[
checkbox "Pubs"
[ RH.text "Neighbours" ] ] ]
, RH.div { className: "tab-content", id: "myTabContent" }
[ RH.div { className: "", id: "home", role: "tabpanel" }
(badge <$> badges) ] ]
, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
[ RH.ul {}
[ checkbox "Pubs"
, checkbox "Projects"
, checkbox "Patents"
, checkbox "Others"
]
]
]
]
]
, checkbox "Others" ] ] ] ] ]
badge text =
RH.a { className: "badge badge-light" } [ RH.text text ]
checkbox text =
RH.li {}
[
RH.span {} [ RH.text text ]
[ RH.span {} [ RH.text text ]
, RH.input { type: "checkbox"
, className: "checkbox"
, checked: true
, title: "Mark as completed" }
]
, title: "Mark as completed" } ]
badges =
[ "objects"
, "evaluation"
, "dynamics"
, "virtual environments"
, "virtual reality"
, "performance analysis"
, "software engineering"
, "complex systems"
, "wireless communications" ]
src/Gargantext/Components/GraphExplorer/ToggleButton.purs
View file @ 1105cefb
......@@ -12,15 +12,12 @@ import Prelude
import Data.Maybe (Maybe(..))
import Data.Tuple (snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Reactix as R2
type Props = (
state :: R.State Boolean
......
src/Gargantext/Components/Login.purs
View file @ 1105cefb
-- The Login component is a modal which allows the user to:
-- See the current login session
-- Select a backend and log into it
module Gargantext.Components.Login where
import Control.Monad.Except (runExcept)
import Prelude (Unit, bind, const, discard, pure, ($), (<>))
import Data.Either (Either(..))
import Data.Int as Int
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Traversable (traverse)
import Data.Tuple.Nested((/\))
import DOM.Simple.Console (log2)
import Effect.Class (liftEffect)
import Data.Tuple (fst, snd)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Foreign (MultipleErrors)
import Foreign.Generic (encodeJSON, decodeJSON)
import Effect.Class (liftEffect)
import Effect.Aff (launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem, setItem, removeItem)
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (Ends, BackendRoute(..), backendKey, url)
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Components.Login.Types
import Gargantext.Components.Forms (clearfix, card, cardBlock, cardGroup, center, formGroup)
import Gargantext.Components.Login.Types (AuthRequest(..))
import Gargantext.Ends (Backend)
import Gargantext.Sessions (Session, Sessions, postAuthRequest, unSessions)
import Gargantext.Sessions as Sessions
import Gargantext.Utils (csrfMiddlewareToken)
import Gargantext.Utils.Reactix as R2
-- TODO: ask for login (modal) or account creation after 15 mn when user
-- is not logged and has made one search at least
type Auths = Map String AuthData
type Props = ( ends :: Ends, setVisible :: R2.Setter Boolean)
type Props =
( backends :: Array Backend
, sessions :: R2.Reductor Sessions Sessions.Action
, setVisible :: R2.Setter Boolean )
type ModalProps = ( visible :: Boolean )
......@@ -41,15 +36,16 @@ modal :: Record ModalProps -> Array R.Element -> R.Element
modal = R.createElement modalCpt
modalCpt :: R.Component ModalProps
modalCpt = R.staticComponent "Modal" cpt
where
modalCpt = R.staticComponent "Modal" cpt where
cpt {visible} children =
H.div { id: "loginModal", className: modalClass visible, role: "dialog", "data": {show: true}}
H.div { id: "loginModal", className: modalClass visible
, role: "dialog", "data": {show: true}}
[ H.div { className: "modal-dialog", role: "document"}
[ H.div { className: "modal-content" }
[ H.div { className: "modal-header" }
[ H.h5 { className: "modal-title" } []
, H.button { "type": "button", className: "close", "data": { dismiss: "modal" } }
, H.button { "type": "button", className: "close"
, "data": { dismiss: "modal" } }
[ H.span { aria: { hidden: true } } [ H.text "X" ] ]
, H.div { className: "modal-body" } children ] ] ] ]
modalClass s = "modal myModal" <> if s then "" else " fade"
......@@ -58,140 +54,137 @@ login :: Record Props -> R.Element
login props = R.createElement loginCpt props []
loginCpt :: R.Component Props
loginCpt = R.hooksComponent "Login" cpt
loginCpt = R.hooksComponent "G.C.Login.login" cpt
where
cpt {ends, setVisible} _children = do
(username /\ setUsername) <- R.useState' ""
(password /\ setPassword) <- R.useState' ""
(error /\ setError) <- R.useState' ""
(authData /\ setAuthData) <- R.useState' Nothing
cpt props@{backends, sessions, setVisible} _ = do
backend <- R.useState' Nothing
pure $ case (fst backend) of
Nothing -> chooser { backends, backend, sessions, setVisible }
Just b -> form { sessions, setVisible, backend: b }
type ChooserProps = ( backend :: R.State (Maybe Backend) | Props )
chooser :: Record ChooserProps -> R.Element
chooser props = R.createElement chooserCpt props []
chooserCpt :: R.Component ChooserProps
chooserCpt = R.staticComponent "G.C.Login.chooser" cpt where
cpt :: Record ChooserProps -> Array R.Element -> R.Element
cpt {backend, backends, sessions, setVisible} _ =
R.fragment
[ renderSessions sessions, renderBackends backends backend ]
renderSessions :: R2.Reductor Sessions Sessions.Action -> R.Element
renderSessions sessions = render (unSessions $ fst sessions) where
render Nothing = R.fragment []
render (Just s) = renderSession s
renderSession :: Session -> R.Element
renderSession session = R.fragment []
renderBackends :: Array Backend -> R.State (Maybe Backend) -> R.Element
renderBackends backends state = R.fragment []
renderBackend :: Backend -> R.State (Maybe Backend) -> R.Element
renderBackend backend state = R.fragment []
type FormProps =
( backend :: Backend
, sessions :: R2.Reductor Sessions Sessions.Action
, setVisible :: R2.Setter Boolean )
form :: Record FormProps -> R.Element
form props = R.createElement formCpt props []
formCpt :: R.Component FormProps
formCpt = R.hooksComponent "G.C.Login.form" cpt where
cpt :: Record FormProps -> Array R.Element -> R.Hooks R.Element
cpt props@{backend, sessions, setVisible} _ = do
error <- R.useState' ""
username <- R.useState' ""
password <- R.useState' ""
pure $ H.div {className: "row"}
[ gargLogo
, H.div {className: "card-group"}
[ H.div {className: "card"}
[ H.div {className: "card-block"}
[ H.div {className: "center"}
[ logo
, cardGroup
[ card
[ cardBlock
[ center
[ H.h4 {className: "m-b-0"}
[ H.span {className: "icon-text"}
[ H.text "Welcome :)"]
]
[ H.span {className: "icon-text"} [ H.text "Welcome :)" ] ]
, H.p {className: "text-muted"}
[ H.text $ "Login to your account or",
H.a { target: "blank"
, href: "https://iscpif.fr/services/applyforourservices/"
}
[H.text " request access"]
]
]
[ H.text $ "Login to your account or", requestAccessLink {} ] ]
, H.div {}
[ H.input { type: "hidden"
, name: "csrfmiddlewaretoken"
-- TODO hard-coded CSRF token
, value: "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
}
, H.div {className: "form-group"}
[ H.p {} [H.text error]
, usernameInput username setUsername
]
, H.div {className: "form-group"}
[ passwordInput password setPassword
, H.div {className: "clearfix"} []
]
, H.div {className: "center"}
[ csrfTokenInput {}
, formGroup [ H.p {} [ H.text (fst error) ], usernameInput username ]
, formGroup [ passwordInput password, clearfix [] ]
, center
[ H.label {}
[ H.div {className: "checkbox"}
[ H.input { id: "terms-accept"
, type: "checkbox"
, value: ""
, className: "checkbox"
}
, H.text "I accept the terms of use "
, H.a {href: "http://gitlab.iscpif.fr/humanities/tofu/tree/master"}
[ H.text " [ Read the terms of use ] "]
]
]
, H.button { id: "login-button"
, className: "btn btn-primary btn-rounded"
, type: "submit"
-- TODO
--, on: {click: \_ -> dispatch $ PostAuth}
, on: {click: onClick ends setError setAuthData setVisible username password}
}
[H.text "Login"]
]
]
]
]
]
]
gargLogo =
[ termsCheckbox {}, H.text "I accept the terms of use ", termsLink {} ] ]
, loginSubmit $
onClick props error username password ] ] ] ] ] ]
onClick {backend, sessions, setVisible} error username password e =
launchAff_ $ do
let req = AuthRequest {username: fst username, password: fst password}
res <- postAuthRequest backend req
case res of
Left message -> liftEffect $ (snd error) (const message)
Right sess -> liftEffect $ do
(snd sessions) (Sessions.Login sess)
(snd error) (const "")
setVisible (const false)
logo =
H.div {className: "col-md-10 col-md-push-1"}
[ H.h2 {className: "text-primary center m-a-2"}
[ H.i {className: "material-icons md-36"} [ H.text "control_point" ]
, H.span {className: "icon-text"} [ H.text "Gargantext" ] ] ]
usernameInput username setUsername =
csrfTokenInput :: {} -> R.Element
csrfTokenInput _ =
H.input { type: "hidden", name: "csrfmiddlewaretoken"
, value: csrfMiddlewareToken }-- TODO hard-coded CSRF token
termsCheckbox :: {} -> R.Element
termsCheckbox _ =
H.input { id: "terms-accept", type: "checkbox", value: "", className: "checkbox" }
termsLink :: {} -> R.Element
termsLink _ =
H.a { target: "_blank", href: termsUrl } [ H.text " [ Read the terms of use ] " ]
where termsUrl = "http://gitlab.iscpif.fr/humanities/tofu/tree/master"
requestAccessLink :: {} -> R.Element
requestAccessLink _ =
H.a { target: "_blank", href: applyUrl } [ H.text " request access" ]
where applyUrl = "https://iscpif.fr/services/applyforourservices/"
usernameInput :: R.State String -> R.Element
usernameInput username =
H.input { className: "form-control"
, id: "id_username"
, maxLength: "254"
, name: "username"
, placeholder: "username"
, type: "text"
, defaultValue: username
, defaultValue: (fst username)
--, on: {input: \e -> dispatch (SetUserName $ R2.unsafeEventValue e)}
, on: {change: \e -> setUsername $ const $ R2.unsafeEventValue e}
}
, on: {change: \e -> (snd username) $ const $ R2.unsafeEventValue e} }
passwordInput password setPassword =
passwordInput :: R.State String -> R.Element
passwordInput password =
H.input { className: "form-control"
, id: "id_password"
, name: "password"
, placeholder: "password"
, type: "password"
, defaultValue: password
, defaultValue: (fst password)
--, on: {input: \e -> dispatch (SetPassword $ R2.unsafeEventValue e)}
, on: {change: \e -> setPassword $ const $ R2.unsafeEventValue e}
}
onClick ends setError setAuthData setVisible username password = \e ->
launchAff_ $ do
res <- postAuthRequest ends $ AuthRequest {username, password}
case res of
AuthResponse {inval: Just (AuthInvalid {message})} -> liftEffect $ do
setError (const message)
setAuthData (const Nothing)
AuthResponse {valid} -> liftEffect $ do
setAuthData (const valid)
setError (const "")
setVisible (const false)
-- getAuth :: Effect Auth
-- getAuth = do
-- window >>= localStorage >>= getItem
-- setAuth :: Auth -> Effect Unit
getAuths :: Effect (Maybe Auths)
getAuths = pure Nothing
, on: {change: \e -> (snd password) $ const $ R2.unsafeEventValue e} }
-- getAuths = window >>= localStorage >>= getItem "auths" >>= traverse decode
-- where
-- decode :: String -> Effect (Maybe Auths)
-- decode = ret <<< runExcept <<< decodeJSON
-- ret (Right v) = pure $ Just v
-- ret (Left e) = log2 "Error reading serialised auths:" e *> pure Nothing
setAuths :: Maybe Auths -> Effect Unit
-- setAuths Map.empty = -- window >>= localStorage >>= removeItem "auths"
setAuths _ = pure unit -- auths = window >>= localStorage >>= setItem "auths" (encodeJSON auths)
-- TODO
-- useLocalStorageAuths :: String -> R.Hooks (R.State Auths)
-- useLocalStorageAuths key = do
postAuthRequest :: Ends -> AuthRequest -> Aff AuthResponse
postAuthRequest ends = post $ url ends Auth
loginSubmit :: forall e. (e -> Effect Unit) -> R.Element
loginSubmit click =
H.button { id, className, type: "submit", on: {click} } [ H.text "Login" ]
where
id = "login-button"
className = "btn btn-primary btn-rounded"
getCurrentAuth :: Ends -> Auths -> Maybe AuthData
getCurrentAuth ends = Map.lookup (backendKey ends.backend)
src/Gargantext/Components/Modal.purs
View file @ 1105cefb
......@@ -3,23 +3,17 @@
-- | content. Clicking outside of the box will close the modal
module Gargantext.Components.Modal where
import Prelude hiding (div)
import Data.Maybe ( Maybe(..), maybe )
import Data.Nullable ( Nullable, null, toMaybe )
import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) )
import Prelude (Unit, bind, const, discard, pure, unit, ($))
import Data.Maybe ( maybe )
import Data.Nullable ( Nullable, null )
import DOM.Simple as DOM
import DOM.Simple.Console
import DOM.Simple.EventListener ( Callback, callback )
import DOM.Simple.EventListener ( callback )
import DOM.Simple.Element as Element
import DOM.Simple.Event (MouseEvent, target)
import DOM.Simple.Document ( document )
import Effect (Effect)
import Effect.Uncurried ( mkEffectFn1 )
import FFI.Simple ( (...), (..), delay )
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.SyntheticEvent as E
import Gargantext.Utils.Reactix as R2
type Props = ( setVisible :: R2.Setter Boolean )
......
src/Gargantext/Components/NgramsTable.purs
View file @ 1105cefb
module Gargantext.Components.NgramsTable where
import Prelude
import Data.Array as A
import Data.Lens (to, view, (%~), (.~), (^.), (^..))
import Data.Lens.Common (_Just)
......@@ -25,13 +26,12 @@ import React.DOM.Props (_id, _type, checked, className, name, onChange, onClick,
import React.DOM.Props as DOM
import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_, simpleSpec, createClass)
import Gargantext.Types (TermList(..), readTermList, readTermSize, termLists, termSizes)
import Gargantext.Config (Ends, OrderBy(..), TabType, CTabNgramType(..))
import Gargantext.Types (TermList(..), OrderBy(..), TabType, CTabNgramType(..), readTermList, readTermSize, termLists, termSizes)
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.Table as T
import Gargantext.Prelude
import Gargantext.Hooks.Loader (useLoader, useLoader2)
import Gargantext.Components.NgramsTable.Core
import Gargantext.Sessions (Session)
import Gargantext.Utils.Reactix as R2
type State =
......@@ -173,10 +173,10 @@ performNgramsAction st (ToggleChild' b c) = st
performNgramsAction st Refresh' = st
useNgramsReducer :: State -> R.Hooks (R.Reducer State Action')
useNgramsReducer init = R.useReducer performNgramsAction identity init
useNgramsReducer init = R.useReducer' performNgramsAction init
type Props =
( ends :: Ends
( session :: Session
, tabNgramType :: CTabNgramType
, path :: R.State PageParams
, versioned :: VersionedNgramsTable )
......@@ -191,8 +191,8 @@ ngramsTableCpt = R.hooksComponent "G.C.NgramsTable.ngramsTable" cpt
state <- useNgramsReducer (initialState versioned)
pure $ R.fragment []
ngramsTableSpec :: Ends -> CTabNgramType -> R2.Setter PageParams -> Spec State (Record LoadedNgramsTableProps) Action
ngramsTableSpec ends ntype setPath = simpleSpec performAction render
ngramsTableSpec :: Session -> CTabNgramType -> R2.Setter PageParams -> Spec State (Record LoadedNgramsTableProps) Action
ngramsTableSpec session ntype setPath = simpleSpec performAction render
where
setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }
......@@ -203,9 +203,9 @@ ngramsTableSpec ends ntype setPath = simpleSpec performAction render
performAction (ToggleChild b c) _ _ =
modifyState_ $ _ngramsChildren <<< at c %~ toggleMap b
performAction Refresh {path: {nodeId, listIds, tabType}} {ngramsVersion} = do
commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty})
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty})
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt = singletonNgramsTablePatch ntype n pe
......@@ -218,13 +218,13 @@ ngramsTableSpec ends ntype setPath = simpleSpec performAction render
, ngramsVersion
} = do
modifyState_ $ setParentResetChildren Nothing
commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
pc = patchSetFromMap ngramsChildren
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch ntype parent pe
performAction (AddNewNgram ngram) {path: {listIds, nodeId, tabType}} {ngramsVersion} =
commitPatch ends {listIds, nodeId, tabType} (Versioned {version: ngramsVersion, data: pt})
commitPatch session {listIds, nodeId, tabType} (Versioned {version: ngramsVersion, data: pt})
where
pt = addNewNgram ntype ngram CandidateTerm
......@@ -273,18 +273,18 @@ ngramsTableSpec ends ntype setPath = simpleSpec performAction render
, delete: false
}
-- ngramsTableClass :: Ends -> CTabNgramType -> R2.Setter PageParams -> Loader.InnerClass PageParams (Versioned NgramsTable)
-- ngramsTableClass ends ct setPath = createClass "NgramsTable" (ngramsTableSpec ends ct setPath) initialState
-- ngramsTableClass :: Session -> CTabNgramType -> R2.Setter PageParams -> Loader.InnerClass PageParams (Versioned NgramsTable)
-- ngramsTableClass session ct setPath = createClass "NgramsTable" (ngramsTableSpec session ct setPath) initialState
-- ngramsTable' :: Ends -> CTabNgramType -> R2.Setter PageParams -> Record LoadedNgramsTableProps -> R.Element
-- ngramsTable' ends ct setPath props = R2.createElement' (ngramsTableClass ends ct setPath) props []
-- ngramsTable' :: Session -> CTabNgramType -> R2.Setter PageParams -> Record LoadedNgramsTableProps -> R.Element
-- ngramsTable' session ct setPath props = R2.createElement' (ngramsTableClass session ct setPath) props []
type MainNgramsTableProps =
( nodeId :: Int
-- ^ This node can be a corpus or contact.
, defaultListId :: Int
, tabType :: TabType
, ends :: Ends
, session :: Session
, tabNgramType :: CTabNgramType
)
......@@ -294,10 +294,10 @@ mainNgramsTable props = R.createElement mainNgramsTableCpt props []
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt
where
cpt {nodeId, defaultListId, tabType, ends, tabNgramType} _ = do
path <- R.useState' $ initialPageParams ends nodeId [defaultListId] tabType
useLoader2 path (loadNgramsTable ends) $
\versioned -> ngramsTable {ends, tabNgramType, path, versioned}
cpt {nodeId, defaultListId, tabType, session, tabNgramType} _ = do
path <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType
useLoader2 path (loadNgramsTable session) $
\versioned -> ngramsTable {session, tabNgramType, path, versioned}
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
......
src/Gargantext/Components/NgramsTable/Core.purs
View file @ 1105cefb
......@@ -44,6 +44,7 @@ module Gargantext.Components.NgramsTable.Core
)
where
import Prelude
import Control.Monad.State (class MonadState, execState)
import Control.Monad.Cont.Trans (lift)
import Data.Array (head)
......@@ -84,13 +85,14 @@ import Thermite (StateCoTransformer, modifyState_)
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Gargantext.Utils.KarpRabin (indicesOfAny)
import Gargantext.Types (TermList(..), TermSize)
import Gargantext.Config (Ends, BackendRoute(..), TabType, OrderBy(..), CTabNgramType(..), url)
import Gargantext.Config.REST (get, put, post)
import Gargantext.Components.Table as T
import Gargantext.Prelude
import Gargantext.Components.Loader as Loader
import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (OrderBy(..), CTabNgramType(..), TabType, TermList(..), TermSize)
import Gargantext.Utils.KarpRabin (indicesOfAny)
type CoreParams s =
{ nodeId :: Int
......@@ -106,11 +108,11 @@ type PageParams =
, searchQuery :: String
, termListFilter :: Maybe TermList -- Nothing means all
, termSizeFilter :: Maybe TermSize -- Nothing means all
, ends :: Ends
, session :: Session
)
initialPageParams :: Ends -> Int -> Array Int -> TabType -> PageParams
initialPageParams ends nodeId listIds tabType =
initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams
initialPageParams session nodeId listIds tabType =
{ nodeId
, listIds
, params: T.initialParams
......@@ -118,7 +120,7 @@ initialPageParams ends nodeId listIds tabType =
, termSizeFilter: Nothing
, termListFilter: Just GraphTerm
, searchQuery: ""
, ends
, session
}
type NgramsTerm = String
......@@ -563,43 +565,43 @@ type CoreState s =
| s
}
postNewNgrams :: forall s. Ends -> Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
postNewNgrams ends newNgrams mayList {nodeId, listIds, tabType} =
postNewNgrams :: forall s. Session -> Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
postNewNgrams session newNgrams mayList {nodeId, listIds, tabType} =
when (not (A.null newNgrams)) $ do
(_ :: Array Unit) <- post (url ends put) newNgrams
(_ :: Array Unit) <- post (url session put) newNgrams
pure unit
where put = PutNgrams tabType (head listIds) mayList (Just nodeId)
postNewElems :: forall s. Ends -> NewElems -> CoreParams s -> Aff Unit
postNewElems ends newElems params = void $ traverseWithIndex postNewElem newElems
postNewElems :: forall s. Session -> NewElems -> CoreParams s -> Aff Unit
postNewElems session newElems params = void $ traverseWithIndex postNewElem newElems
where
postNewElem ngrams list = postNewNgrams ends [ngrams] (Just list) params
postNewElem ngrams list = postNewNgrams session [ngrams] (Just list) params
addNewNgram :: CTabNgramType -> NgramsTerm -> TermList -> NgramsTablePatch
addNewNgram ntype ngrams list = { ngramsPatches: mempty
, ngramsNewElems: Map.singleton (normNgram ntype ngrams) list }
putNgramsPatches :: Ends -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
putNgramsPatches ends {nodeId, listIds, tabType} = put $ url ends putNgrams
putNgramsPatches :: Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
putNgramsPatches session {nodeId, listIds, tabType} = put $ url session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
commitPatch :: forall s. Ends -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
commitPatch :: forall s. Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
-> Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit
commitPatch ends props (Versioned {version, data: tablePatch@{ngramsPatches, ngramsNewElems}}) = do
commitPatch session props (Versioned {version, data: tablePatch@{ngramsPatches, ngramsNewElems}}) = do
let pt = Versioned { version, data: ngramsPatches }
lift $ postNewElems ends ngramsNewElems props
Versioned {version: newVersion, data: newPatch} <- lift $ putNgramsPatches ends props pt
lift $ postNewElems session ngramsNewElems props
Versioned {version: newVersion, data: newPatch} <- lift $ putNgramsPatches session props pt
modifyState_ $ \s ->
s { ngramsVersion = newVersion
, ngramsTablePatch = fromNgramsPatches newPatch <> tablePatch <> s.ngramsTablePatch
}
-- TODO: check that pt.version == s.ngramsTablePatch.version
loadNgramsTable :: Ends -> PageParams -> Aff VersionedNgramsTable
loadNgramsTable ends
loadNgramsTable :: Session -> PageParams -> Aff VersionedNgramsTable
loadNgramsTable session
{ nodeId, listIds, termListFilter, termSizeFilter
, searchQuery, tabType, params: {offset, limit, orderBy}}
= get $ url ends query
= get $ url session query
where query = GetNgrams { tabType, offset, limit, listIds
, orderBy: convOrderBy <$> orderBy
, termListFilter, termSizeFilter
......@@ -612,10 +614,10 @@ convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.DESC _) = TermDesc
ngramsLoaderClass :: Ends -> Loader.LoaderClass PageParams VersionedNgramsTable
ngramsLoaderClass ends = Loader.createLoaderClass "NgramsTableLoader" (loadNgramsTable ends)
ngramsLoaderClass :: Session -> Loader.LoaderClass PageParams VersionedNgramsTable
ngramsLoaderClass session = Loader.createLoaderClass "NgramsTableLoader" (loadNgramsTable session)
ngramsLoader :: Ends -> Loader.Props' PageParams VersionedNgramsTable -> ReactElement
ngramsLoader ends props = React.createElement (ngramsLoaderClass ends) props []
ngramsLoader :: Session -> Loader.Props' PageParams VersionedNgramsTable -> ReactElement
ngramsLoader session props = React.createElement (ngramsLoaderClass session) props []
type LoadedNgramsTableProps = ( path :: PageParams, loaded :: VersionedNgramsTable )
src/Gargantext/Components/RangeSlider.purs
View file @ 1105cefb
......@@ -9,25 +9,20 @@ module Gargantext.Components.RangeSlider where
import Prelude
import Data.Int (fromNumber)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Nullable (Nullable, null)
import Data.Traversable (traverse_)
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM
import DOM.Simple.Console (log2)
import DOM.Simple.Document (document)
import DOM.Simple.Element as Element
import DOM.Simple.Event as Event
import DOM.Simple.EventListener as EL
import DOM.Simple.Types (DOMRect, Element)
import DOM.Simple (DOMRect)
import Global (toFixed)
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
--import Global (toFixed)
import Effect.Uncurried (mkEffectFn1)
import Math as M
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.SyntheticEvent as RE
import Gargantext.Utils.Math (roundToMultiple)
import Gargantext.Utils.Range as Range
......
src/Gargantext/Components/Search/SearchBar.purs
View file @ 1105cefb
module Gargantext.Components.Search.SearchBar
( Props, defaultProps, searchBar, searchBarCpt
( Props, searchBar, searchBarCpt
) where
import Prelude (Unit, bind, const, discard, not, pure, show, ($), (<>))
import Prelude (Unit, bind, discard, not, pure, show, ($), (<>))
import Data.Maybe (Maybe(..))
import Data.Newtype (over)
import Data.Traversable (traverse_)
import Data.Tuple.Nested ( (/\) )
import Data.Tuple (snd)
import Data.Tuple.Nested ((/\))
import Effect.Class (liftEffect)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
import Reactix as R
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff)
import Effect.Aff (Aff, launchAff_)
import Reactix.DOM.HTML as H
import Gargantext.Config (Ends)
import Gargantext.Components.Search.Types (Database, SearchQuery(..), allDatabases, defaultSearchQuery, performSearch)
import Gargantext.Components.Search.Types (Database, SearchQuery(..), defaultSearchQuery, performSearch)
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Search.SearchField (Search, searchField)
import Gargantext.Sessions (Session)
type Props = ( ends :: Ends, open :: Boolean, databases :: Array Database )
defaultProps :: Ends -> Record Props
defaultProps ends = { open: false, databases: allDatabases, ends }
type Props = ( session :: Session, databases :: Array Database )
searchBar :: Record Props -> R.Element
searchBar p = R.createElement searchBarCpt p []
searchBar props = R.createElement searchBarCpt props []
searchBarCpt :: R.Component Props
searchBarCpt = R.hooksComponent "SearchBar" cpt
searchBarCpt = R.hooksComponent "G.C.Search.SearchBar.searchBar" cpt
where
cpt {ends, databases, open} _ = do
open' <- R.useState $ const open
search <- R.useState $ const Nothing
onSearchChange ends search
pure $ H.div { className: "search-bar-container" }
[ toggleButton open'
, searchFieldContainer open' databases search ]
cpt {session, databases} _ = do
open <- R.useState' false
search <- R.useState' Nothing
onSearchChange session search
pure $ H.div { className: "search-bar-container pull-right" }
[ toggleButton open
, searchFieldContainer open databases search ]
searchFieldContainer :: R.State Boolean -> Array Database -> R.State (Maybe Search) -> R.Element
searchFieldContainer (open /\ _) databases search =
......@@ -43,25 +40,25 @@ searchFieldContainer (open /\ _) databases search =
where
openClass = if open then "open" else "closed"
onSearchChange :: Ends -> R.State (Maybe Search) -> R.Hooks Unit
onSearchChange ends (search /\ setSearch) =
onSearchChange :: Session -> R.State (Maybe Search) -> R.Hooks Unit
onSearchChange session (search /\ setSearch) =
R.useLayoutEffect1' search $ traverse_ triggerSearch search
where
triggerSearch q = do
launchAff $ do
liftEffect $ log2 "Searching db: " $ show q.database
liftEffect $ log2 "Searching term: " q.term
r <- (performSearch ends $ searchQuery q) :: Aff Unit
liftEffect $ log2 "Return:" r
liftEffect $ modalShow "addCorpus"
triggerSearch q =
launchAff_ $ do
liftEffect $ do
log2 "Searching db: " $ show q.database
log2 "Searching term: " q.term
r <- (performSearch session $ searchQuery q) :: Aff Unit
liftEffect $ do
log2 "Return:" r
modalShow "addCorpus"
searchQuery {database: Nothing, term} = over SearchQuery (_ {query=term}) defaultSearchQuery
searchQuery {database: Just db, term} = over SearchQuery (_ {databases=[db], query=term}) defaultSearchQuery
toggleButton :: R.State Boolean -> R.Element
toggleButton open =
H.button { onClick: onToggleExpanded open, className: "search-bar-toggle" }
H.button { on: {click: \_ -> (snd open) not}, className: "search-bar-toggle" }
[ H.i { className: "material-icons md-24", style } [ H.text "control_point" ] ]
where style = { marginTop: "-2px", color: "#000" }
onToggleExpanded :: forall e. R.State Boolean -> EffectFn1 e Unit
onToggleExpanded (_open /\ setOpen) = mkEffectFn1 $ \_ -> setOpen not
src/Gargantext/Components/Search/SearchField.purs
View file @ 1105cefb
......@@ -2,14 +2,12 @@ module Gargantext.Components.Search.SearchField
( Search, Props, searchField, searchFieldComponent )where
import Prelude (bind, const, identity, pure, show, ($), (/=), (<$>), (||))
import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( fst )
import Data.Tuple.Nested ( (/\) )
import Effect ( Effect )
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.DOM.HTML (text, button, div, input, span, ul, li, a)
import Gargantext.Components.Search.Types (Database)
......
src/Gargantext/Components/Search/Types.purs
View file @ 1105cefb
module Gargantext.Components.Search.Types where
import Prelude (class Eq, class Show, show, ($), (<>))
import Data.Argonaut (class EncodeJson, class DecodeJson, jsonEmptyObject, (:=), (~>), encodeJson)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
......@@ -9,10 +10,11 @@ import Data.Newtype (class Newtype)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Config (Ends, NodeType(..), class Path, PathType(..), BackendRoute(..), url)
import Gargantext.Config.REST (post, put)
import Gargantext.Ends (class ToUrl, backendUrl, url)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session(..))
import Gargantext.Types (class ToQuery, toQuery, NodeType(..))
import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP
import URI.Query as Q
......@@ -108,9 +110,9 @@ defaultSearchQuery = SearchQuery
, limit: Nothing
, order: Nothing }
instance pathSearchQuery :: Path SearchQuery where
pathType _ = BackendPath
path q = "new" <> Q.print (toQuery q)
instance toUrlSessionSearchQuery :: ToUrl Session SearchQuery where
toUrl (Session {backend}) q = backendUrl backend q2
where q2 = "new" <> Q.print (toQuery q)
instance searchQueryToQuery :: ToQuery SearchQuery where
toQuery (SearchQuery {offset, limit, order}) =
......@@ -157,8 +159,6 @@ decodeCategory 1 = Normal
decodeCategory 2 = Favorite
decodeCategory _ = Normal
newtype CategoryQuery = CategoryQuery {
nodeIds :: Array Int
, category :: Category
......@@ -170,12 +170,12 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject
categoryUrl :: Ends -> Int -> String
categoryUrl ends nodeId = url ends (NodeAPI Node $ Just nodeId) <> "/category"
categoryUrl :: Session -> Int -> String
categoryUrl session nodeId = url session (NodeAPI Node $ Just nodeId) <> "/category"
putCategories :: Ends -> Int -> CategoryQuery -> Aff (Array Int)
putCategories ends nodeId = put $ categoryUrl ends nodeId
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put $ categoryUrl session nodeId
performSearch :: forall a. DecodeJson a => Ends -> SearchQuery -> Aff a
performSearch ends q = post (url ends q) q
performSearch :: forall a. DecodeJson a => Session -> SearchQuery -> Aff a
performSearch session q = post (url session q) q
src/Gargantext/Components/Table.purs
View file @ 1105cefb
module Gargantext.Components.Table where
import Gargantext.Prelude
import Prelude
import Data.Array (filter)
import Data.Maybe (Maybe(..), maybe)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
type TableContainerProps =
......
src/Gargantext/Components/Tree.purs
View file @ 1105cefb
......@@ -4,7 +4,7 @@ import Prelude hiding (div)
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter, sortWith, head)
import Data.Array (filter)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
......@@ -14,25 +14,25 @@ import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff, runAff)
import Effect.Class (liftEffect)
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (PerformAction, Spec, Render, modifyState_, simpleSpec, defaultPerformAction)
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Config (Ends, NodeType(..), BackendRoute(..), NodePath(..), readNodeType, url)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Router as Router
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Routes as Routes
import Gargantext.Routes (AppRoute, SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
......@@ -44,9 +44,12 @@ type Reload = Int
data NodePopup = CreatePopup | NodePopup
type Props = ( root :: ID, mCurrentRoute :: Maybe Router.Routes, ends :: Ends )
type Props = ( root :: ID, mCurrentRoute :: Maybe AppRoute, session :: Session )
type TreeViewProps = ( tree :: FTree, mCurrentRoute :: Maybe Router.Routes, ends :: Ends )
type TreeViewProps =
( tree :: FTree
, mCurrentRoute :: Maybe AppRoute
, session :: Session )
data NTree a = NTree a (Array (NTree a))
......@@ -118,38 +121,38 @@ type Tree = { tree :: FTree }
mapFTree :: (FTree -> FTree) -> Tree -> Tree
mapFTree f s@{tree} = s {tree = f tree}
performAction :: Ends -> R.State Int -> R.State Tree -> Action -> Aff Unit
performAction :: Session -> R.State Int -> R.State Tree -> Action -> Aff Unit
performAction ends (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode ends id
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode session id
liftEffect $ setReload (_ + 1)
performAction ends _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode ends id $ RenameValue {name}
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode session id $ RenameValue {name}
liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
performAction ends (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode ends id $ CreateValue {name, nodeType}
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode session id $ CreateValue {name, nodeType}
liftEffect $ setReload (_ + 1)
performAction ends _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- uploadFile ends id fileType contents
performAction session _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- uploadFile session id fileType contents
liftEffect $ log2 "uploaded:" hashes
------------------------------------------------------------------------
mCorpusId :: Maybe Router.Routes -> Maybe Int
mCorpusId (Just (Router.Corpus id)) = Just id
mCorpusId (Just (Router.CorpusDocument id _ _)) = Just id
mCorpusId :: Maybe AppRoute -> Maybe Int
mCorpusId (Just (Routes.Corpus id)) = Just id
mCorpusId (Just (Routes.CorpusDocument id _ _)) = Just id
mCorpusId _ = Nothing
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "TreeView" cpt
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where
cpt props _children = do
-- NOTE: this is a hack to reload the tree view on demand
......@@ -160,36 +163,36 @@ treeLoadView :: R.State Reload -> Record Props -> R.Element
treeLoadView reload p = R.createElement el p []
where
el = R.hooksComponent "TreeLoadView" cpt
cpt {root, mCurrentRoute, ends} _ = do
useLoader root (loadNode ends) $ \loaded ->
loadedTreeView reload {tree: loaded, mCurrentRoute, ends}
cpt {root, mCurrentRoute, session} _ = do
useLoader root (loadNode session) $ \loaded ->
loadedTreeView reload {tree: loaded, mCurrentRoute, session}
loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element
loadedTreeView reload p = R.createElement el p []
where
el = R.hooksComponent "LoadedTreeView" cpt
cpt {tree, mCurrentRoute, ends} _ = do
cpt {tree, mCurrentRoute, session} _ = do
treeState <- R.useState' {tree}
pure $ H.div {className: "tree"}
[ toHtml reload treeState ends mCurrentRoute ]
[ toHtml reload treeState session mCurrentRoute ]
-- START toHtml
toHtml :: R.State Reload -> R.State Tree -> Ends -> Maybe Router.Routes -> R.Element
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) ends mCurrentRoute = R.createElement el {} []
toHtml :: R.State Reload -> R.State Tree -> Session -> Maybe AppRoute -> R.Element
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) session mCurrentRoute = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
pAction = performAction ends reload treeState
pAction = performAction session reload treeState
cpt props _ = do
folderOpen <- R.useState' true
let withId (NTree (LNode {id}) _) = id
let withId (NTree (LNode {id: id'}) _) = id'
pure $ H.ul {}
[ H.li {}
( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen ends ]
<> childNodes ends reload folderOpen mCurrentRoute ary
( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen session ]
<> childNodes session reload folderOpen mCurrentRoute ary
)
]
......@@ -197,14 +200,14 @@ type NodeMainSpanProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
, mCurrentRoute :: Maybe Router.Routes)
, mCurrentRoute :: Maybe AppRoute)
nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps
-> R.State Boolean
-> Ends
-> Session
-> R.Element
nodeMainSpan d p folderOpen ends = R.createElement el p []
nodeMainSpan d p folderOpen session = R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentRoute} _ = do
......@@ -215,7 +218,7 @@ nodeMainSpan d p folderOpen ends = R.createElement el p []
pure $ H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen
, H.a { href: (url ends (NodePath nodeType (Just id)))
, H.a { href: (url session (NodePath nodeType (Just id)))
, style: {marginLeft: "22px"}
}
[ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name} ]
......@@ -224,27 +227,26 @@ nodeMainSpan d p folderOpen ends = R.createElement el p []
, createNodeView d {id, name} popupOpen
, fileTypeView d {id} droppedFile isDragOver
]
folderIcon folderOpen@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen}
folderIcon folderOpen'@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen'}
[ H.i {className: fldr open} [] ]
popOverIcon (popOver /\ setPopOver) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, onClick: mkEffectFn1 $ \_ -> setPopOver $ toggle
, on: { click: \_ -> setPopOver $ toggle }
} []
where
toggle Nothing = Just NodePopup
toggle _ = Nothing
dropProps droppedFile isDragOver = {
className: dropClass droppedFile isDragOver
, onDrop: dropHandler droppedFile
, onDragOver: onDragOverHandler isDragOver
, onDragLeave: onDragLeave isDragOver
}
dropProps droppedFile isDragOver =
{ className: dropClass droppedFile isDragOver
, on: { drop: dropHandler droppedFile
, dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver } }
dropClass (Just _ /\ _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped"
dropClass (Nothing /\ _) _ = ""
dropHandler (_ /\ setDroppedFile) = mkEffectFn1 $ \e -> unsafePartial $ do
dropHandler (_ /\ setDroppedFile) e = unsafePartial $ do
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
liftEffect $ log2 "drop:" ff
-- prevent redirection when file is dropped
......@@ -254,23 +256,23 @@ nodeMainSpan d p folderOpen ends = R.createElement el p []
void $ runAff (\_ -> pure unit) do
contents <- readAsText blob
liftEffect $ setDroppedFile $ const $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
onDragOverHandler (_ /\ setIsDragOver) = mkEffectFn1 $ \e -> do
onDragOverHandler (_ /\ setIsDragOver) e = do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver $ const true
onDragLeave (_ /\ setIsDragOver) = mkEffectFn1 $ \_ -> setIsDragOver $ const false
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
fldr :: Boolean -> String
fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close"
childNodes :: Ends -> R.State Reload -> R.State Boolean -> Maybe Router.Routes -> Array FTree -> Array R.Element
childNodes :: Session -> R.State Reload -> R.State Boolean -> Maybe AppRoute -> Array FTree -> Array R.Element
childNodes _ _ _ _ [] = []
childNodes _ _ (false /\ _) _ _ = []
childNodes ends reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary
childNodes session reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary
where
childNode :: Tree -> R.Element
childNode props = R.createElement el props []
......@@ -278,7 +280,7 @@ childNodes ends reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode
cpt {tree} _ = do
treeState <- R.useState' {tree}
pure $ toHtml reload treeState ends mCurrentRoute
pure $ toHtml reload treeState session mCurrentRoute
-- END toHtml
......@@ -512,13 +514,13 @@ createNodeView d p (Just CreatePopup /\ setPopupOpen) = R.createElement el p []
]
renderOption (opt :: NodeType) = H.option {} [ H.text $ show opt ]
panelFooter :: R.State String -> R.State NodeType -> R.Element
panelFooter (name /\ _) (nt /\ _) =
panelFooter (name' /\ _) (nt /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setPopupOpen $ const Nothing
launchAff $ d $ CreateSubmit name nt
launchAff $ d $ CreateSubmit name' nt
} [H.text "Create"]
]
createNodeView _ _ _ = R.createElement el {} []
......@@ -618,8 +620,8 @@ nodeText p = R.createElement el p []
-- END node text
loadNode :: Ends -> ID -> Aff FTree
loadNode ends = get <<< url ends <<< NodeAPI Tree <<< Just
loadNode :: Session -> ID -> Aff FTree
loadNode session = get <<< url session <<< NodeAPI Tree <<< Just
----- TREE CRUD Operations
......@@ -645,15 +647,15 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
~> "pn_typename" := nodeType
~> jsonEmptyObject
createNode :: Ends -> ID -> CreateValue -> Aff ID
createNode :: Session -> ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new"
createNode ends parentId = post $ url ends (NodeAPI Node $ Just parentId)
createNode session parentId = post $ url session (NodeAPI Node $ Just parentId)
renameNode :: Ends -> ID -> RenameValue -> Aff (Array ID)
renameNode ends renameNodeId = put $ url ends (NodeAPI Node $ Just renameNodeId) <> "/rename"
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put $ url session (NodeAPI Node $ Just renameNodeId) <> "/rename"
deleteNode :: Ends -> ID -> Aff ID
deleteNode ends = delete <<< url ends <<< NodeAPI Node <<< Just
deleteNode :: Session -> ID -> Aff ID
deleteNode session = delete <<< url session <<< NodeAPI Node <<< Just
newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
......@@ -666,11 +668,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: Ends -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile ends id fileType (UploadFileContents fileContents) = postWwwUrlencoded url2 fileContents
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile session id fileType (UploadFileContents fileContents) = postWwwUrlencoded url2 fileContents
where
q = FileUploadQuery { fileType: fileType }
url2 = url ends (NodeAPI Node (Just id)) <> "/upload" <> Q.print (toQuery q)
url2 = url session (NodeAPI Node (Just id)) <> "/upload" <> Q.print (toQuery q)
fnTransform :: LNode -> FTree
fnTransform n = NTree n []
src/Gargantext/Config.purs
View file @ 1105cefb
{- | Main Configuration of Gargantext Front-End
The main function to use for internal link in the Front-End
developpement is : toUrl.
* Example usage (depending on your Config):
toUrl Back Corpus 1 == "http://localhost:8008/api/v1.0/corpus/1"
toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1"
-}
module Gargantext.Config where
import Prelude
import Control.Plus (empty)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject)
import Data.Array (filter, head)
import Data.NonEmpty (NonEmpty, (:|))
import Data.NonEmpty as NonEmpty
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe, fromJust)
import Partial.Unsafe (unsafePartial)
import Gargantext.Router as R
import Gargantext.Types (TermList, TermSize(..))
data PathType = BackendPath | FrontendPath | StaticPath
class Path t where
pathType :: t -> PathType
path :: t -> String
url :: forall t. Path t => Ends -> t -> String
url e p = h (pathType p)
where
h BackendPath = back e.backend (path p)
h FrontendPath = front e.frontend (path p)
h StaticPath = front e.static (path p)
back e path = e.baseUrl <> e.prePath <> show e.version <> "/" <> path
front e path = e.baseUrl <> e.prePath <> path
type Backend =
{ name :: String, version :: ApiVersion
, prePath :: String, baseUrl :: String
}
backendKey :: Backend -> String
backendKey {prePath, baseUrl} = prePath <> baseUrl
type Frontend = { name :: String, baseUrl :: String, prePath :: String }
backend :: ApiVersion -> String -> String -> String -> Backend
backend version baseUrl prePath name = { name, version, prePath, baseUrl }
frontend :: String -> String -> String -> Frontend
frontend baseUrl prePath name = { name, baseUrl, prePath }
import Data.NonEmpty (NonEmpty, (:|), head)
import Gargantext.Ends
import Gargantext.Types (ApiVersion(..))
defaultBackends :: NonEmpty Array Backend
defaultBackends = prod :| [dev, demo, local]
where
prod = backend V10 "http://gargantext.org" "/api/" "gargantext.org"
dev = backend V10 "http://dev.gargantext.org" "/api/" "gargantext.org (dev)"
demo = backend V10 "http://demo.gargantext.org" "/api/" "gargantext.org (demo)"
local = backend V10 "http://localhost:8008" "/api/" "local"
prod = backend V10 "/api/" "http://gargantext.org" "gargantext.org"
dev = backend V10 "/api/" "http://dev.gargantext.org" "dev.gargantext.org"
demo = backend V10 "/api/" "http://demo.gargantext.org" "demo.gargantext.org"
local = backend V10 "/api/" "http://localhost:8008" "localhost"
defaultFrontends :: NonEmpty Array Frontend
defaultFrontends = relative :| [prod, dev, demo, haskell, caddy]
defaultApps :: NonEmpty Array Frontend
defaultApps = relative :| [prod, dev, demo, haskell, caddy]
where
relative = frontend "" "/" "Relative"
prod = frontend "https://gargantext.org" "/#/" "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" "/#/" "local (gargantext)"
python = frontend "http://localhost:8000" "/#/" "local (python)"
caddy = frontend "http://localhost:2015" "/#/" "local (caddy)"
relative = frontend "/" "" "Relative"
prod = frontend "/#/" "https://gargantext.org" "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"
defaultStatics :: NonEmpty Array Frontend
defaultStatics = relative :| []
where
relative = frontend "" "/" "relative"
type Ends =
{ backend :: Backend
, frontend :: Frontend
, static :: Frontend }
type Ends' =
{ backend :: NonEmpty Array Backend
, frontend :: NonEmpty Array Frontend
, static :: NonEmpty Array Frontend }
defaultEnds :: Ends
defaultEnds =
{ backend: NonEmpty.head defaultBackends
, frontend: NonEmpty.head defaultFrontends
, static: NonEmpty.head defaultStatics }
defaultEnds' :: Ends'
defaultEnds' =
{ backend: defaultBackends
, frontend: defaultFrontends
, static: defaultStatics }
limitUrl :: Limit -> String
limitUrl l = "&limit=" <> show l
offsetUrl :: Offset -> String
offsetUrl o = "&offset=" <> show o
orderUrl :: forall a. Show a => Maybe a -> String
orderUrl = maybe "" (\x -> "&order=" <> show x)
orderByUrl :: forall a. Show a => Maybe a -> String
orderByUrl = maybe "" (\x -> "&orderBy=" <> show x)
showTabType' :: TabType -> String
showTabType' (TabCorpus t) = show t
showTabType' (TabDocument t) = show t
showTabType' (TabPairing t) = show t
data TabPostQuery = TabPostQuery {
offset :: Int
, limit :: Int
, orderBy :: OrderBy
, tabType :: TabType
, query :: String
}
instance encodeJsonTabPostQuery :: EncodeJson TabPostQuery where
encodeJson (TabPostQuery post) =
"view" := showTabType' post.tabType
~> "offset" := post.offset
~> "limit" := post.limit
~> "orderBy" := show post.orderBy
~> "query" := post.query
~> jsonEmptyObject
------------------------------------------------------------
instance pathRoutes :: Path R.Routes where
pathType _ = FrontendPath
path = routesPath
routesPath :: R.Routes -> String
routesPath R.Home = ""
routesPath R.Login = "login"
routesPath (R.Folder i) = "folder/" <> show i
routesPath (R.Corpus i) = "corpus/" <> show i
routesPath (R.CorpusDocument c l i) = "corpus/" <> show c <> "/list/" <> show l <> "/document/" <> show i
routesPath (R.Document l i) = "list/" <> show l <> "/document/" <> show i
routesPath (R.PGraphExplorer i) = "#/"
routesPath (R.Texts i) = "texts/" <> show i
routesPath (R.Lists i) = "lists/" <> show i
routesPath R.Dashboard = "dashboard"
routesPath (R.Annuaire i) = "annuaire/" <> show i
routesPath (R.UserPage i) = "user/" <> show i
routesPath (R.ContactPage i) = "contact/" <> show i
-- nodeTypePath :: NodeType -> Path
-- nodeTypePath = NodeAPI
-- instance toUrlNodeType :: ToUrl NodeType where
-- toUrl ec e nt i = toUrl ec e (NodeAPI nt) i
-- instance toUrlPath :: ToUrl Path where
-- toUrl ec e p i = doUrl base path params
-- where
-- base = endBaseUrl e ec
-- path = endPathUrl e ec p i
-- params = ""
------------------------------------------------------------
data NodeType = NodeUser
| Annuaire
| NodeContact
| Corpus
| Url_Document
| CorpusV3
| Dashboard
| Error
| Folder
| Graph
| Phylo
| Individu
| Node
| Nodes
| Tree
| NodeList
| Texts
derive instance eqNodeType :: Eq NodeType
instance showNodeType :: Show NodeType where
show NodeUser = "NodeUser"
show Annuaire = "Annuaire"
show NodeContact = "NodeContact"
show Corpus = "NodeCorpus"
show CorpusV3 = "NodeCorpusV3"
show Dashboard = "NodeDashboard"
show Url_Document = "NodeDocument"
show Error = "NodeError"
show Folder = "NodeFolder"
show Graph = "NodeGraph"
show Phylo = "NodePhylo"
show Individu = "NodeIndividu"
show Node = "Node"
show Nodes = "Nodes"
show Tree = "NodeTree"
show NodeList = "NodeList"
show Texts = "NodeTexts"
readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = Graph
readNodeType "NodePhylo" = Phylo
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser
readNodeType "NodeContact" = NodeContact
readNodeType "Tree" = Tree
readNodeType "NodeList" = NodeList
readNodeType "NodeTexts" = Texts
readNodeType _ = Error
{-
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
compare n1 n2 = compare (show n1) (show n2)
instance eqNodeType :: Eq NodeType where
eq n1 n2 = eq (show n1) (show n2)
-}
------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ readNodeType obj
instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType
nodeTypePath :: NodeType -> String
nodeTypePath Annuaire = "annuaire"
nodeTypePath Corpus = "corpus"
nodeTypePath CorpusV3 = "corpus"
nodeTypePath Dashboard = "dashboard"
nodeTypePath Url_Document = "document"
nodeTypePath Error = "ErrorNodeType"
nodeTypePath Folder = "folder"
nodeTypePath Graph = "graph"
nodeTypePath Phylo = "phylo"
nodeTypePath Individu = "individu"
nodeTypePath Node = "node"
nodeTypePath Nodes = "nodes"
nodeTypePath NodeUser = "user"
nodeTypePath NodeContact = "contact"
nodeTypePath Tree = "tree"
nodeTypePath NodeList = "lists"
nodeTypePath Texts = "texts"
------------------------------------------------------------
type ListId = Int
type NgramsGetOpts =
{ tabType :: TabType
, offset :: Offset
, limit :: Limit
, orderBy :: Maybe OrderBy
, listIds :: Array ListId
, termListFilter :: Maybe TermList
, termSizeFilter :: Maybe TermSize
, searchQuery :: String
}
type SearchOpts =
{ {-id :: Int
, query :: Array String
,-}
listId :: Int
, limit :: Limit
, offset :: Offset
, orderBy :: Maybe OrderBy
}
type CorpusMetricOpts =
{ tabType :: TabType
, listId :: ListId
, limit :: Maybe Limit
}
type ChartOpts =
{ chartType :: ChartType
, tabType :: TabType
-- , listId :: ListId
-- , limit :: Maybe Limit
}
data BackendRoute
= Auth
| Tab TabType (Maybe Id)
| Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
| GetNgrams NgramsGetOpts (Maybe Id)
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
-- ^ The name is not good. In particular this URL is used both in PUT and POST.
| NodeAPI NodeType (Maybe Id)
| ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id)
| Chart ChartOpts (Maybe Id)
instance pathBackendRoute :: Path BackendRoute where
pathType _ = BackendPath
path = backendPath
backendPath :: BackendRoute -> String
backendPath (Tab t i) = backendPath (NodeAPI Node i) <> "/" <> showTabType' t
backendPath (Children n o l s i) = root <> "children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s
where root = backendPath (NodeAPI Node i) <> "/"
backendPath (NodeAPI Phylo pId) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId)
backendPath (GetNgrams opts i) =
base opts.tabType
<> "/ngrams?ngramsType="
<> showTabType' opts.tabType
<> offsetUrl opts.offset
<> limitUrl opts.limit
<> orderByUrl opts.orderBy
<> foldMap (\x -> "&list=" <> show x) opts.listIds
<> foldMap (\x -> "&listType=" <> show x) opts.termListFilter
<> foldMap termSizeFilter opts.termSizeFilter
<> search opts.searchQuery
where
base (TabCorpus _) = backendPath (NodeAPI Node i)
base _ = backendPath (NodeAPI Url_Document i)
termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
termSizeFilter MultiTerm = "&minTermSize=2"
search "" = ""
search s = "&search=" <> s
backendPath (ListDocument lId dId) =
backendPath (NodeAPI NodeList lId) <> "/document/" <> (show $ maybe 0 identity dId)
backendPath (PutNgrams t listId termList i) =
backendPath (NodeAPI Node i)
<> "/ngrams?ngramsType="
<> showTabType' t
<> maybe "" (\x -> "&list=" <> show x) listId
<> foldMap (\x -> "&listType=" <> show x) termList
backendPath Auth = "auth"
backendPath (NodeAPI nt i) = nodeTypePath nt <> (maybe "" (\i' -> "/" <> show i') i)
backendPath (Search {listId,limit,offset,orderBy} i) =
backendPath (NodeAPI Corpus i)
<> "/search?list_id=" <> show listId
<> offsetUrl offset
<> limitUrl limit
<> orderUrl orderBy
backendPath (CorpusMetrics {tabType, listId, limit} i) =
backendPath (NodeAPI Corpus i) <> "/metrics"
<> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
<> maybe "" (\x -> "&limit=" <> show x) limit
-- TODO fix this url path
backendPath (Chart {chartType, tabType} i) =
backendPath (NodeAPI Corpus i) <> "/" <> show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId
-- <> maybe "" (\x -> "&limit=" <> show x) limit
data NodePath = NodePath NodeType (Maybe Id)
instance pathNodePath :: Path NodePath where
pathType _ = FrontendPath
path (NodePath nt i) = nodeTypePath nt <> id
where id = maybe "" (\i' -> "/" <> show i') i
data ChartType = Histo | Scatter | ChartPie | ChartTree
instance showChartType :: Show ChartType
where
show Histo = "chart"
show Scatter = "scatter"
show ChartPie = "pie"
show ChartTree = "tree"
type Id = Int
type Limit = Int
type Offset = Int
data OrderBy = DateAsc | DateDesc
| TitleAsc | TitleDesc
| ScoreAsc | ScoreDesc
| TermAsc | TermDesc
| SourceAsc | SourceDesc
derive instance genericOrderBy :: Generic OrderBy _
instance showOrderBy :: Show OrderBy where
show = genericShow
------------------------------------------------------------
data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where
show V10 = "v1.0"
show V11 = "v1.1"
------------------------------------------------------------
instance eqApiVersion :: Eq ApiVersion where
eq V10 V10 = true
eq V11 V11 = true
eq _ _ = false
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
derive instance eqCTabNgramType :: Eq CTabNgramType
instance showCTabNgramType :: Show CTabNgramType where
show CTabTerms = "Terms"
show CTabSources = "Sources"
show CTabAuthors = "Authors"
show CTabInstitutes = "Institutes"
data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
derive instance eqPTabNgramType :: Eq PTabNgramType
instance showPTabNgramType :: Show PTabNgramType where
show PTabPatents = "Patents"
show PTabBooks = "Books"
show PTabCommunication = "Communication"
data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
derive instance eqTabSubType :: Eq a => Eq (TabSubType a)
instance showTabSubType :: Show a => Show (TabSubType a) where
show TabDocs = "Docs"
show (TabNgramType a) = show a
show TabTrash = "Trash"
show TabMoreLikeFav = "MoreFav"
show TabMoreLikeTrash = "MoreTrash"
data TabType
= TabCorpus (TabSubType CTabNgramType)
| TabPairing (TabSubType PTabNgramType)
| TabDocument (TabSubType CTabNgramType)
derive instance eqTabType :: Eq TabType
defaultApp :: Frontend
defaultApp = head defaultApps
derive instance genericTabType :: Generic TabType _
defaultStatic :: Frontend
defaultStatic = head defaultStatics
instance showTabType :: Show TabType where
show = genericShow
defaultFrontends :: Frontends
defaultFrontends = Frontends { app: defaultApp, static: defaultStatic }
src/Gargantext/Ends.purs 0 → 100644
View file @ 1105cefb
-- | Those things at the end of urls
module Gargantext.Ends
-- ( )
where
import Prelude (class Eq, class Show, identity, show, ($), (<>))
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe, maybe)
import Gargantext.Routes as R
import Gargantext.Types (ApiVersion, Limit, NodeType(..), Offset, TabType(..), TermSize(..), nodeTypePath, showTabType')
-- | A means of generating a url to visit, a destination
class ToUrl conf p where
toUrl :: conf -> p -> String
url :: forall conf p. ToUrl conf p => conf -> p -> String
url = toUrl
-- | Encapsulates the data we need to talk to a backend server
newtype Backend = Backend
{ name :: String
, baseUrl :: String
, prePath :: String
, version :: ApiVersion }
backend :: ApiVersion -> String -> String -> String -> Backend
backend version prePath baseUrl name = Backend { name, version, prePath, baseUrl }
-- | Creates a backend url from a backend and the path as a string
backendUrl :: Backend -> String -> String
backendUrl (Backend b) path = b.baseUrl <> b.prePath <> show b.version <> "/" <> path
derive instance genericBackend :: Generic Backend _
instance eqBackend :: Eq Backend where
eq = genericEq
instance showBackend :: Show Backend where
show (Backend {name}) = name
instance toUrlBackendString :: ToUrl Backend String where
toUrl = backendUrl
-- | Encapsulates the data needed to construct a url to a frontend
-- | server (either for the app or static content)
newtype Frontend = Frontend
{ name :: String
, baseUrl :: String
, prePath :: String }
derive instance genericFrontend :: Generic Frontend _
instance eqFrontend :: Eq Frontend where
eq = genericEq
-- | Creates a frontend
frontend :: String -> String -> String -> Frontend
frontend baseUrl prePath name = Frontend { name, baseUrl, prePath }
-- | Creates a url from a frontend and the path as a string
frontendUrl :: Frontend -> String -> String
frontendUrl (Frontend f) path = f.baseUrl <> f.prePath <> path
instance showFrontend :: Show Frontend where
show (Frontend {name}) = name
instance toUrlFrontendString :: ToUrl Frontend String where
toUrl = frontendUrl
instance toUrlFrontendAppRoute :: ToUrl Frontend R.AppRoute where
toUrl f r = frontendUrl f (R.appPath r)
-- | The currently selected App and Static configurations
newtype Frontends = Frontends { app :: Frontend, static :: Frontend }
-- | Creates an app url from a Frontends and the path as a string
appUrl :: Frontends -> String -> String
appUrl (Frontends {app}) = frontendUrl app
-- | Creates a static url from a Frontends and the path as a string
staticUrl :: Frontends -> String -> String
staticUrl (Frontends {static}) = frontendUrl static
instance toUrlFrontendsRoutes :: ToUrl Frontends R.AppRoute where
toUrl f r = appUrl f (R.appPath r)
sessionPath :: R.SessionRoute -> String
sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i) <> "/" <> showTabType' t
sessionPath (R.Children n o l s i) = root <> "children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s
where root = sessionPath (R.NodeAPI Node i) <> "/"
sessionPath (R.NodeAPI Phylo pId) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId)
sessionPath (R.GetNgrams opts i) =
base opts.tabType
<> "/ngrams?ngramsType="
<> showTabType' opts.tabType
<> offsetUrl opts.offset
<> limitUrl opts.limit
<> orderByUrl opts.orderBy
<> foldMap (\x -> "&list=" <> show x) opts.listIds
<> foldMap (\x -> "&listType=" <> show x) opts.termListFilter
<> foldMap termSizeFilter opts.termSizeFilter
<> search opts.searchQuery
where
base (TabCorpus _) = sessionPath (R.NodeAPI Node i)
base _ = sessionPath (R.NodeAPI Url_Document i)
termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
termSizeFilter MultiTerm = "&minTermSize=2"
search "" = ""
search s = "&search=" <> s
sessionPath (R.ListDocument lId dId) =
sessionPath (R.NodeAPI NodeList lId) <> "/document/" <> (show $ maybe 0 identity dId)
sessionPath (R.PutNgrams t listId termList i) =
sessionPath (R.NodeAPI Node i)
<> "/ngrams?ngramsType="
<> showTabType' t
<> maybe "" (\x -> "&list=" <> show x) listId
<> foldMap (\x -> "&listType=" <> show x) termList
sessionPath (R.NodeAPI nt i) = nodeTypePath nt <> (maybe "" (\i' -> "/" <> show i') i)
sessionPath (R.Search {listId,limit,offset,orderBy} i) =
sessionPath (R.NodeAPI Corpus i)
<> "/search?list_id=" <> show listId
<> offsetUrl offset
<> limitUrl limit
<> orderUrl orderBy
sessionPath (R.CorpusMetrics {tabType, listId, limit} i) =
sessionPath (R.NodeAPI Corpus i) <> "/metrics"
<> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
<> maybe "" (\x -> "&limit=" <> show x) limit
-- TODO fix this url path
sessionPath (R.Chart {chartType, tabType} i) =
sessionPath (R.NodeAPI Corpus i) <> "/" <> show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId
-- <> maybe "" (\x -> "&limit=" <> show x) limit
------- misc routing stuff
limitUrl :: Limit -> String
limitUrl l = "&limit=" <> show l
offsetUrl :: Offset -> String
offsetUrl o = "&offset=" <> show o
orderUrl :: forall a. Show a => Maybe a -> String
orderUrl = maybe "" (\x -> "&order=" <> show x)
orderByUrl :: forall a. Show a => Maybe a -> String
orderByUrl = maybe "" (\x -> "&orderBy=" <> show x)
-- nodeTypePath :: NodeType -> Path
-- nodeTypePath = NodeAPI
-- instance toUrlNodeType :: ToUrl NodeType where
-- toUrl ec e nt i = toUrl ec e (NodeAPI nt) i
-- instance toUrlPath :: ToUrl Path where
-- toUrl ec e p i = doUrl base path params
-- where
-- base = endBaseUrl e ec
-- path = endPathUrl e ec p i
-- params = ""
------------------------------------------------------------
src/Gargantext/Global.purs deleted 100644 → 0
View file @ 80557556
module Gargantext.Global
( Global, defaultGlobal )
where
import Prelude (pure)
import Effect (Effect)
import Data.Maybe (Maybe(..))
import Gargantext.Config (Ends, defaultEnds)
import Gargantext.Components.Login.Types (AuthData(..))
type Global =
{ ends :: Ends
, authData :: Maybe AuthData }
defaultGlobal :: Effect Global
defaultGlobal = pure { ends: defaultEnds, authData: Nothing }
src/Gargantext/Hooks/Loader.purs
View file @ 1105cefb
module Gargantext.Hooks.Loader where
import Data.Functor ((<$>))
import Control.Monad ((=<<))
import Gargantext.Prelude
import Data.Maybe (Maybe(..), isNothing, maybe, maybe')
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Gargantext.Prelude
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R
......
src/Gargantext/Hooks/Router.purs 0 → 100644
View file @ 1105cefb
module Gargantext.Hooks.Router (useHashRouter) where
import Prelude (($), bind, discard, const, pure)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Routing.Match (Match)
import Routing.Hash (matches)
-- | Ties the hash router to a state hook of routes
-- | Note: if it gets sent to an unrecognised url, it will quietly drop the change
useHashRouter :: forall routes. Match routes -> routes -> R.Hooks (R.State routes)
useHashRouter routes init = do
route@(_ /\ setRoute) <- R.useState' init
R.useEffectOnce $ matches routes $ \_old new -> setRoute (const new)
pure route
src/Gargantext/Hooks/Sigmax.purs
View file @ 1105cefb
......@@ -3,27 +3,23 @@ module Gargantext.Hooks.Sigmax
-- )
where
import Prelude
import Prelude (Unit, bind, const, discard, flip, pure, unit, ($), (*>), (<$), (<$>), (<<<), (<>), (>>=))
import Data.Array as A
import Data.Bitraversable (bitraverse)
import Data.Either (Either(..), either)
import Data.Foldable (sequence_)
import Data.Maybe (Maybe(..), maybe)
import Data.Nullable (Nullable, null)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Traversable (for, for_, traverse, traverse_)
import Data.Traversable (traverse_)
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
import Effect (Effect)
import FFI.Simple (delay)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Utils.Reactix as R2
import Gargantext.Types (class Optional)
import Gargantext.Hooks.Sigmax.Sigma (SigmaOpts)
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types
import Gargantext.Hooks.Sigmax.Types (Graph(..))
type Sigma =
{ sigma :: R.Ref (Maybe Sigma.Sigma)
......@@ -88,8 +84,8 @@ useSigma container settings sigmaRef = do
delay unit $ handleSigma sigma (readSigma sigma)
pure $ {sigma, isNew}
where
newSigma sigmaRef = do
let mSigma = R.readRef sigmaRef
newSigma sigmaRef' = do
let mSigma = R.readRef sigmaRef'
case mSigma of
Just sigma -> pure sigma
Nothing -> do
......
src/Gargantext/Hooks/Sigmax/Sigmajs.purs
View file @ 1105cefb
......@@ -3,10 +3,8 @@ module Gargantext.Hooks.Sigmax.Sigmajs where
import Prelude
import Data.Nullable (Nullable)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Effect (Effect)
import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, runEffectFn1)
import Effect.Uncurried (EffectFn1, runEffectFn1)
import React (ReactRef, SyntheticEventHandler)
import React.SyntheticEvent (SyntheticMouseEvent)
import Record.Unsafe (unsafeGet)
......
src/Gargantext/Pages/Annuaire.purs
View file @ 1105cefb
module Gargantext.Pages.Annuaire where
import Gargantext.Prelude
import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Array (head)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (fst, snd)
import Effect.Aff (Aff)
import Gargantext.Components.Table as T
import Gargantext.Config (NodeType(..), Ends, BackendRoute(..), NodePath(..), url)
import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (NodePath(..), NodeType(..))
import Gargantext.Config.REST (get)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperdataContact(..), ContactWhere(..))
......@@ -27,7 +29,7 @@ toRows (AnnuaireTable a) = a.annuaireTable
-- | Top level layout component. Loads an annuaire by id and renders
-- | the annuaire using the result
type LayoutProps = ( annuaireId :: Int, ends :: Ends )
type LayoutProps = ( annuaireId :: Int, session :: Session )
annuaireLayout :: Record LayoutProps -> R.Element
annuaireLayout props = R.createElement annuaireLayoutCpt props []
......@@ -35,13 +37,13 @@ annuaireLayout props = R.createElement annuaireLayoutCpt props []
annuaireLayoutCpt :: R.Component LayoutProps
annuaireLayoutCpt = R.hooksComponent "G.P.Annuaire.annuaireLayout" cpt
where
cpt {annuaireId, ends} _ = do
cpt {annuaireId, session} _ = do
path <- R.useState' annuaireId
useLoader (fst path) (getAnnuaireInfo ends) $
\info -> annuaire {ends, path, info}
useLoader (fst path) (getAnnuaireInfo session) $
\info -> annuaire {session, path, info}
type AnnuaireProps =
( ends :: Ends
( session :: Session
, path :: R.State Int
, info :: AnnuaireInfo )
......@@ -53,13 +55,13 @@ annuaire props = R.createElement annuaireCpt props []
annuaireCpt :: R.Component AnnuaireProps
annuaireCpt = R.staticComponent "G.P.Annuaire.annuaire" cpt
where
cpt {ends, path, info: info@(AnnuaireInfo {name, date: date'})} _ = R.fragment
cpt {session, path, info: info@(AnnuaireInfo {name, date: date'})} _ = R.fragment
[ T.tableHeaderLayout headerProps
, H.p {} []
, H.div {className: "col-md-3"}
[ H.text " Filter ", H.input { className: "form-control", style } ]
, H.br {}
, pageLayout { info, ends, annuairePath: path } ]
, pageLayout { info, session, annuairePath: path } ]
where
headerProps = { title: name, desc: name, query: "", date, user: ""}
date = "Last update: " <> date'
......@@ -67,7 +69,7 @@ annuaireCpt = R.staticComponent "G.P.Annuaire.annuaire" cpt
type PagePath = { nodeId :: Int, params :: T.Params }
type PageLayoutProps =
( ends :: Ends
( session :: Session
, annuairePath :: R.State Int
, info :: AnnuaireInfo )
......@@ -77,14 +79,14 @@ pageLayout props = R.createElement pageLayoutCpt props []
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = R.hooksComponent "G.P.Annuaire.pageLayout" cpt
where
cpt {annuairePath, info, ends} _ = do
cpt {annuairePath, info, session} _ = do
pagePath <- R.useState' (initialPagePath (fst annuairePath))
useLoader (fst pagePath) (loadPage ends) $
\table -> page {ends, table, pagePath, annuairePath}
useLoader (fst pagePath) (loadPage session) $
\table -> page {session, table, pagePath, annuairePath}
initialPagePath nodeId = {nodeId, params: T.initialParams}
type PageProps =
( ends :: Ends
( session :: Session
, annuairePath :: R.State Int
, pagePath :: R.State PagePath
-- , info :: AnnuaireInfo
......@@ -96,21 +98,21 @@ page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps
pageCpt = R.staticComponent "LoadedAnnuairePage" cpt
where
cpt { ends, annuairePath, pagePath, table: (AnnuaireTable {annuaireTable}) } _ = do
cpt { session, annuairePath, pagePath, table: (AnnuaireTable {annuaireTable}) } _ = do
T.table { rows, setParams, container, colNames, totalRecords }
where
totalRecords =4361 -- TODO
rows = (\c -> {row: contactCells ends c, delete: false}) <$> annuaireTable
rows = (\c -> {row: contactCells session c, delete: false}) <$> annuaireTable
setParams params = snd pagePath $ const {params, nodeId: fst annuairePath}
container = T.defaultContainer { title: "Annuaire" } -- TODO
colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
contactCells :: Ends -> Maybe Contact -> Array R.Element
contactCells ends = maybe [] render
contactCells :: Session -> Maybe Contact -> Array R.Element
contactCells session = maybe [] render
where
render (Contact { id, hyperdata : (HyperdataContact contact@{who: who, ou:ou} ) }) =
let nodepath = NodePath NodeContact (Just id)
href = url ends nodepath in
href = url session nodepath in
[ H.text ""
, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
, H.text $ maybe "No ContactWhere" contactWhereOrg (head $ ou)
......@@ -175,9 +177,9 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
rows <- decodeJson json
pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------
loadPage :: Ends -> PagePath -> Aff AnnuaireTable
loadPage ends {nodeId, params: { offset, limit, orderBy }} =
get $ url ends children
loadPage :: Session -> PagePath -> Aff AnnuaireTable
loadPage session {nodeId, params: { offset, limit, orderBy }} =
get $ url session children
-- TODO orderBy
-- where
-- convOrderBy (T.ASC (T.ColumnName "Name")) = NameAsc
......@@ -190,6 +192,6 @@ loadPage ends {nodeId, params: { offset, limit, orderBy }} =
------ Annuaire loading ------
getAnnuaireInfo :: Ends -> Int -> Aff AnnuaireInfo
getAnnuaireInfo ends id = get $ url ends (NodeAPI Node (Just id))
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
getAnnuaireInfo session id = get $ url session (NodeAPI Node (Just id))
src/Gargantext/Pages/Annuaire/User/Contacts.purs
View file @ 1105cefb
......@@ -3,31 +3,26 @@ module Gargantext.Pages.Annuaire.User.Contacts
, userLayout )
where
import Prelude ((<$>))
import Data.List (List, zipWith, catMaybes, toUnfoldable)
import Data.Map (Map, empty, keys, values, lookup)
import Prelude (bind, pure, ($), (<<<), (<>), (<$>))
import Data.Array (head)
import Data.Semigroup ((<>))
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Set (toUnfoldable) as S
import Data.Tuple (Tuple(..), uncurry)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Data.Unfoldable (class Unfoldable)
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.String (joinWith)
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Config (Ends, BackendRoute(..), NodeType(..), url)
import Gargantext.Config.REST (get)
import Gargantext.Components.Node (NodePoly(..), HyperdataList(..))
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Annuaire.User.Contacts.Types
( Contact(..), ContactData, ContactTouch(..), ContactWhere(..)
, ContactWho(..), HyperData(..), HyperdataContact(..) )
import Gargantext.Pages.Annuaire.User.Contacts.Tabs.Specs as Tabs
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..))
display :: String -> Array R.Element -> R.Element
display title elems =
......@@ -129,7 +124,7 @@ infoRender (Tuple title content) =
[ H.span { className: "badge badge-default badge-pill"} [ H.text title ]
, H.span {} [H.text content] ]
type LayoutProps = ( nodeId :: Int, ends :: Ends )
type LayoutProps = ( nodeId :: Int, session :: Session )
userLayout :: Record LayoutProps -> R.Element
userLayout props = R.createElement userLayoutCpt props []
......@@ -137,17 +132,17 @@ userLayout props = R.createElement userLayoutCpt props []
userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = R.hooksComponent "G.P.Annuaire.UserLayout" cpt
where
cpt {nodeId, ends} _ =
useLoader nodeId (getContact ends) $
cpt {nodeId, session} _ =
useLoader nodeId (getContact session) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
[ display (fromMaybe "no name" name) (contactInfos hyperdata)
, Tabs.tabs {nodeId, contactData, ends} ]
, Tabs.tabs {nodeId, contactData, session} ]
-- | toUrl to get data
getContact :: Ends -> Int -> Aff ContactData
getContact ends id = do
contactNode <- get $ url ends (NodeAPI NodeContact (Just id))
getContact :: Session -> Int -> Aff ContactData
getContact session id = do
contactNode <- get $ url session (NodeAPI NodeContact (Just id))
-- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
......
src/Gargantext/Pages/Annuaire/User/Contacts/Tabs.purs
View file @ 1105cefb
......@@ -2,7 +2,6 @@
module Gargantext.Pages.Annuaire.User.Contacts.Tabs.Specs where
import Prelude hiding (div)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.List (fromFoldable)
......@@ -10,11 +9,12 @@ import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import Gargantext.Config (Ends, TabType(..), TabSubType(..), PTabNgramType(..), CTabNgramType(..))
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab
import Gargantext.Pages.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Sessions (Session)
import Gargantext.Types (TabType(..), TabSubType(..), CTabNgramType(..), PTabNgramType(..))
import Gargantext.Utils.Reactix as R2
import Reactix as R
......@@ -43,7 +43,7 @@ modeTabType' Communication = CTabAuthors
type Props =
( nodeId :: Int
, contactData :: ContactData
, ends :: Ends )
, session :: Session )
tabs :: Record Props -> R.Element
tabs props = R.createElement tabsCpt props []
......@@ -51,7 +51,7 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component Props
tabsCpt = R.hooksComponent "G.P.Annuaire.User.Contacts.Tabs.tabs" cpt
where
cpt {nodeId, contactData: {defaultListId}, ends} _ = do
cpt {nodeId, contactData: {defaultListId}, session} _ = do
active <- R.useState' 0
pure $
Tab.tabs { tabs: tabs', selected: fst active }
......@@ -64,13 +64,13 @@ tabsCpt = R.hooksComponent "G.P.Annuaire.User.Contacts.Tabs.tabs" cpt
, "Trash" /\ docs -- TODO pass-in trash mode
]
where
patentsView = {ends, defaultListId, nodeId, mode: Patents}
booksView = {ends, defaultListId, nodeId, mode: Books}
commView = {ends, defaultListId, nodeId, mode: Communication}
patentsView = {session, defaultListId, nodeId, mode: Patents}
booksView = {session, defaultListId, nodeId, mode: Books}
commView = {session, defaultListId, nodeId, mode: Communication}
chart = mempty
totalRecords = 4736 -- TODO
docs = DT.docView
{ ends, nodeId, chart, totalRecords
{ session, nodeId, chart, totalRecords
, tabType: TabPairing TabDocs
, listId: defaultListId
, corpusId: Nothing
......@@ -78,15 +78,15 @@ tabsCpt = R.hooksComponent "G.P.Annuaire.User.Contacts.Tabs.tabs" cpt
type NgramsViewProps =
( ends :: Ends
( session :: Session
, mode :: Mode
, defaultListId :: Int
, nodeId :: Int )
ngramsView :: Record NgramsViewProps -> R.Element
ngramsView {ends,mode, defaultListId, nodeId} =
ngramsView {session,mode, defaultListId, nodeId} =
NT.mainNgramsTable
{ nodeId, defaultListId, tabType, ends, tabNgramType }
{ nodeId, defaultListId, tabType, session, tabNgramType }
where
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode
src/Gargantext/Pages/Corpus.purs
View file @ 1105cefb
......@@ -2,10 +2,8 @@ module Gargantext.Pages.Corpus where
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Config (Ends)
import Gargantext.Utils.Reactix as R2
type Props = ( nodeId :: Int, ends :: Ends )
type Props = ( nodeId :: Int )
corpusLayout :: Record Props -> R.Element
corpusLayout props = R.createElement corpusLayoutCpt props []
......@@ -13,7 +11,7 @@ corpusLayout props = R.createElement corpusLayoutCpt props []
corpusLayoutCpt :: R.Component Props
corpusLayoutCpt = R.staticComponent "G.P.Corpus.corpusLayout" cpt
where
cpt {nodeId} _children =
cpt {nodeId} _ =
H.div {}
[ H.h1 {} [H.text "Corpus Description"]
, H.p {} [H.text "Soon: corpus synthesis here (when all others charts/features will be stabilized)."] ]
src/Gargantext/Pages/Corpus/Chart/Histo.purs
View file @ 1105cefb
module Gargantext.Pages.Corpus.Chart.Histo where
import Prelude (bind, map, pure, ($))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Config
import Gargantext.Config.REST (get)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Types (TermList(..))
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Charts.Options.ECharts
import Gargantext.Components.Charts.Options.Series
import Gargantext.Components.Charts.Options.Color
import Gargantext.Components.Charts.Options.Font
import Gargantext.Components.Charts.Options.Data
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.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Pages.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (ChartType(..), TabType)
type Path = { corpusId :: Int, tabType :: TabType }
type Props = ( path :: Path, ends :: Ends )
type Props = ( path :: Path, session :: Session )
newtype ChartMetrics = ChartMetrics { "data" :: HistoMetrics }
......@@ -49,14 +48,14 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
, subTitle : "Distribution of publications over time"
, xAxis : xAxis' dates'
, yAxis : yAxis' { position: "left", show: true, min:0}
, series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count']
, addZoom : true
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
}
, series : [seriesBarD1 {name: "Number of publication / year"} $
map (\n -> dataSerie {value: n, itemStyle : itemStyle {color:grey}}) count'] }
getMetrics :: Ends -> Path -> Aff HistoMetrics
getMetrics ends {corpusId, tabType} = do
ChartMetrics ms <- get $ url ends chart
getMetrics :: Session -> Path -> Aff HistoMetrics
getMetrics session {corpusId, tabType} = do
ChartMetrics ms <- get $ url session chart
pure ms."data"
where chart = Chart {chartType: Histo, tabType: tabType} (Just corpusId)
......@@ -66,16 +65,16 @@ histo props = R.createElement histoCpt props []
histoCpt :: R.Component Props
histoCpt = R.hooksComponent "LoadedMetricsHisto" cpt
where
cpt {ends,path} _ = do
cpt {session,path} _ = do
setReload <- R.useState' 0
pure $ metricsLoadView ends setReload path
pure $ metricsLoadView session setReload path
metricsLoadView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadView ends setReload path = R.createElement el {ends,path} []
metricsLoadView :: Session -> R.State Int -> Path -> R.Element
metricsLoadView s setReload p = R.createElement el {session: s, path: p} []
where
el = R.hooksComponent "MetricsLoadedHistoView" cpt
cpt {path,ends} _ = do
useLoader path (getMetrics ends) $ \loaded ->
cpt {path,session} _ = do
useLoader path (getMetrics session) $ \loaded ->
loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> HistoMetrics -> R.Element
......
src/Gargantext/Pages/Corpus/Chart/Metrics.purs
View file @ 1105cefb
module Gargantext.Pages.Corpus.Chart.Metrics where
import Prelude (bind, negate, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Map as Map
import Data.Map (Map)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Effect.Aff (Aff)
import Gargantext.Config (Ends, BackendRoute(..), TabType, url)
import Gargantext.Config.REST (get)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Types (TermList(..))
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Charts.Options.ECharts
import Gargantext.Components.Charts.Options.Type
import Gargantext.Components.Charts.Options.Series
import Gargantext.Components.Charts.Options.Color
import Gargantext.Components.Charts.Options.Font
import Gargantext.Components.Charts.Options.Data
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis')
import Gargantext.Components.Charts.Options.Type (xAxis)
import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2)
import Gargantext.Components.Charts.Options.Color (green, grey, red)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Pages.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (TabType, TermList(..))
type Path =
{ corpusId :: Int
......@@ -31,7 +30,7 @@ type Path =
, limit :: Maybe Int
}
type Props = ( path :: Path, ends :: Ends )
type Props = ( path :: Path, session :: Session )
newtype Metric = Metric
{ label :: String
......@@ -62,12 +61,12 @@ instance decodeMetrics :: DecodeJson Metrics where
type Loaded = Array Metric
scatterOptions :: Array Metric -> Options
scatterOptions metrics = Options
scatterOptions metrics' = Options
{ mainTitle : "Ngrams Selection Metrics"
, subTitle : "Local metrics (Inc/Exc, Spe/Gen), Global metrics (TFICF maillage)"
, xAxis : xAxis { min: -1 }
, yAxis : yAxis' { position : "", show: true, min : -2}
, series : map2series $ metric2map metrics
, series : map2series $ metric2map metrics'
, addZoom : false
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
}
......@@ -95,11 +94,11 @@ scatterOptions metrics = Options
}
--}
getMetrics :: Ends -> Path -> Aff Loaded
getMetrics ends {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url ends metrics
getMetrics :: Session -> Path -> Aff Loaded
getMetrics session {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url session metrics'
pure ms."data"
where metrics = CorpusMetrics {listId, tabType, limit} (Just corpusId)
where metrics' = CorpusMetrics {listId, tabType, limit} (Just corpusId)
metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props []
......@@ -107,16 +106,16 @@ metrics props = R.createElement metricsCpt props []
metricsCpt :: R.Component Props
metricsCpt = R.hooksComponent "LoadedMetrics" cpt
where
cpt {path, ends} _ = do
cpt {path, session} _ = do
setReload <- R.useState' 0
pure $ metricsLoadView ends setReload path
pure $ metricsLoadView session setReload path
metricsLoadView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadView ends setReload path = R.createElement el {ends,path} []
metricsLoadView :: Session -> R.State Int -> Path -> R.Element
metricsLoadView s setReload p = R.createElement el {session: s, path: p} []
where
el = R.hooksComponent "MetricsLoadedView" cpt
cpt {ends, path} _ = do
useLoader path (getMetrics ends) $ \loaded ->
cpt {session, path} _ = do
useLoader path (getMetrics session) $ \loaded ->
loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> Loaded -> R.Element
......
src/Gargantext/Pages/Corpus/Chart/Pie.purs
View file @ 1105cefb
module Gargantext.Pages.Corpus.Chart.Pie where
import Prelude (bind, map, pure, ($), (>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Array (zip, filter)
import Data.Array as A
......@@ -7,28 +8,27 @@ import Data.Maybe (Maybe(..))
import Data.String (take, joinWith, Pattern(..), split, length)
import Data.Tuple (Tuple(..))
import Effect.Aff (Aff)
import Gargantext.Config (Ends, BackendRoute(..), TabType, ChartType(..), url)
import Gargantext.Config.REST (get)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Types (TermList(..))
import Gargantext.Components.Charts.Options.ECharts
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
import Gargantext.Components.Charts.Options.Data
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Pages.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (ChartType(..), TabType)
type Path =
{ corpusId :: Int
, tabType :: TabType
}
type Props = ( ends :: Ends, path :: Path )
type Props = ( session :: Session, path :: Path )
newtype ChartMetrics = ChartMetrics
{ "data" :: HistoMetrics
......@@ -78,9 +78,9 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
}
getMetrics :: Ends -> Path -> Aff HistoMetrics
getMetrics ends {corpusId, tabType:tabType} = do
ChartMetrics ms <- get $ url ends chart
getMetrics :: Session -> Path -> Aff HistoMetrics
getMetrics session {corpusId, tabType:tabType} = do
ChartMetrics ms <- get $ url session chart
pure ms."data"
where chart = Chart {chartType: ChartPie, tabType: tabType} (Just corpusId)
......@@ -90,16 +90,16 @@ pie props = R.createElement pieCpt props []
pieCpt :: R.Component Props
pieCpt = R.hooksComponent "LoadedMetricsPie" cpt
where
cpt {path,ends} _ = do
cpt {path,session} _ = do
setReload <- R.useState' 0
pure $ metricsLoadPieView ends setReload path
pure $ metricsLoadPieView session setReload path
metricsLoadPieView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadPieView ends setReload path = R.createElement el {ends,path} []
metricsLoadPieView :: Session -> R.State Int -> Path -> R.Element
metricsLoadPieView s setReload p = R.createElement el {session: s,path: p} []
where
el = R.hooksComponent "MetricsLoadedPieView" cpt
cpt {ends,path} _ = do
useLoader path (getMetrics ends) $ \loaded ->
cpt {session,path} _ = do
useLoader path (getMetrics session) $ \loaded ->
loadedMetricsPieView setReload loaded
loadedMetricsPieView :: R.State Int -> HistoMetrics -> R.Element
......@@ -112,17 +112,17 @@ bar props = R.createElement barCpt props []
barCpt :: R.Component Props
barCpt = R.hooksComponent "LoadedMetricsBar" cpt
where
cpt {path, ends} _ = do
cpt {path, session} _ = do
setReload <- R.useState' 0
pure $ metricsLoadBarView ends setReload path
pure $ metricsLoadBarView session setReload path
metricsLoadBarView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadBarView ends setReload path = R.createElement el {ends,path} []
metricsLoadBarView :: Session -> R.State Int -> Path -> R.Element
metricsLoadBarView s setReload p = R.createElement el {path: p, session: s} []
where
el = R.hooksComponent "MetricsLoadedBarView" cpt
cpt {path, ends} _ = do
useLoader path (getMetrics ends) $ \loaded ->
cpt {path, session} _ = do
useLoader path (getMetrics session) $ \loaded ->
loadedMetricsBarView setReload loaded
loadedMetricsBarView :: R.State Int -> Loaded -> R.Element
......
src/Gargantext/Pages/Corpus/Chart/Tree.purs
View file @ 1105cefb
module Gargantext.Pages.Corpus.Chart.Tree where
import Prelude (bind, pure, ($))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Config (Ends, BackendRoute(..), TabType, ChartType(..), url)
import Gargantext.Config.REST (get)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Types (TermList(..))
import Gargantext.Components.Charts.Options.ECharts
import Gargantext.Components.Charts.Options.Series
import Gargantext.Components.Charts.Options.Font
import Gargantext.Components.Charts.Options.Data
import Gargantext.Config.REST (get)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Pages.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (ChartType(..), TabType)
type Path =
{ corpusId :: Int
......@@ -25,7 +24,7 @@ type Path =
, tabType :: TabType
, limit :: Maybe Int
}
type Props = ( path :: Path, ends :: Ends )
type Props = ( path :: Path, session :: Session )
newtype Metrics = Metrics
{ "data" :: Array TreeNode
......@@ -53,9 +52,9 @@ scatterOptions nodes = Options
}
getMetrics :: Ends -> Path -> Aff Loaded
getMetrics ends {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url ends chart
getMetrics :: Session -> Path -> Aff Loaded
getMetrics session {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url session chart
pure ms."data"
where
chart = Chart {chartType : ChartTree, tabType: tabType} (Just corpusId)
......@@ -66,16 +65,16 @@ tree props = R.createElement treeCpt props []
treeCpt :: R.Component Props
treeCpt = R.hooksComponent "LoadedMetrics" cpt
where
cpt {path, ends} _ = do
cpt {path, session} _ = do
setReload <- R.useState' 0
pure $ metricsLoadView ends setReload path
pure $ metricsLoadView session setReload path
metricsLoadView :: Ends -> R.State Int -> Path -> R.Element
metricsLoadView ends setReload p = R.createElement el p []
metricsLoadView :: Session -> R.State Int -> Path -> R.Element
metricsLoadView session setReload path = R.createElement el path []
where
el = R.hooksComponent "MetricsLoadView" cpt
cpt p _ = do
useLoader p (getMetrics ends) $ \loaded ->
useLoader p (getMetrics session) $ \loaded ->
loadedMetricsView setReload loaded
loadedMetricsView :: R.State Int -> Loaded -> R.Element
......
src/Gargantext/Pages/Corpus/Dashboard.purs
View file @ 1105cefb
module Gargantext.Pages.Corpus.Dashboard where
import Prelude hiding (div)
import Prelude (map, show, ($), (<$>), (<>))
import Data.Array (zipWith)
import Data.Int (toNumber)
import Data.Tuple (Tuple(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis', tooltipTriggerAxis)
import Gargantext.Components.Charts.Options.Data
import Gargantext.Components.Charts.Options.Series
import Data.Int (toNumber)
import React.DOM.Props (className)
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (Render, Spec, simpleSpec, defaultPerformAction)
( TreeNode, Trees(..), mkTree, seriesBarD1, seriesFunnelD1, seriesPieD1
, seriesSankey, seriesScatterD2, treeLeaf, treeNode )
dashboardLayout :: {} -> R.Element
dashboardLayout props = R.createElement dashboardLayoutCpt props []
......
src/Gargantext/Pages/Corpus/Document.purs
View file @ 1105cefb
module Gargantext.Pages.Corpus.Document where
import Prelude (class Show, bind, identity, mempty, pure, ($), (<<<))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
......@@ -11,16 +12,19 @@ import React.DOM.Props (className)
import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, createClass)
import Gargantext.Prelude
import Gargantext.Config
( NodeType(..), Ends, TabSubType(..), TabType(..), CTabNgramType(..), BackendRoute(..), url )
import Gargantext.Config.REST (get)
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..)
, VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatch
, loadNgramsTable, replace, singletonNgramsTablePatch )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Types (TermList)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList)
import Gargantext.Utils.Reactix as R2
type DocPath = { nodeId :: Int, listIds :: Array Int, corpusId :: Maybe Int, tabType :: TabType }
......@@ -35,7 +39,7 @@ type LoadedData =
type Props =
{ loaded :: LoadedData
, path :: DocPath
, ends :: Ends
, session :: Session
}
-- This is a subpart of NgramsTable.State.
......@@ -283,15 +287,15 @@ docViewSpec :: Spec State Props Action
docViewSpec = simpleSpec performAction render
where
performAction :: PerformAction State Props Action
performAction Refresh {path: {nodeId, listIds, tabType}, ends} {ngramsVersion} = do
commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty})
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}, ends} {ngramsVersion} =
commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
performAction Refresh {path: {nodeId, listIds, tabType}, session} {ngramsVersion} = do
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty})
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}, session} {ngramsVersion} =
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt = singletonNgramsTablePatch CTabTerms n pe
performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType},ends} {ngramsVersion} =
commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType},session} {ngramsVersion} =
commitPatch session {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where
pt = addNewNgram CTabTerms ngram termList
......@@ -341,13 +345,13 @@ docViewSpec = simpleSpec performAction render
docViewClass
:: ReactClass
{ ends :: Ends
{ session :: Session
, children :: Children
, loaded :: LoadedData
, path :: DocPath }
docViewClass = createClass "DocumentView" docViewSpec initialState
type LayoutProps = ( ends :: Ends, nodeId :: Int, listId :: Int, corpusId :: Maybe Int )
type LayoutProps = ( session :: Session, nodeId :: Int, listId :: Int, corpusId :: Maybe Int )
documentLayout :: Record LayoutProps -> R.Element
documentLayout props = R.createElement documentLayoutCpt props []
......@@ -355,23 +359,23 @@ documentLayout props = R.createElement documentLayoutCpt props []
documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt
where
cpt {ends, nodeId, listId, corpusId} _ = do
useLoader path (loadData ends) $ \loaded ->
R2.createElement' docViewClass {ends, path, loaded} []
cpt {session, nodeId, listId, corpusId} _ = do
useLoader path (loadData session) $ \loaded ->
R2.createElement' docViewClass {session, path, loaded} []
where
tabType = TabDocument (TabNgramType CTabTerms)
path = {nodeId, listIds: [listId], corpusId, tabType}
------------------------------------------------------------------------
loadDocument :: Ends -> Int -> Aff NodeDocument
loadDocument ends = get <<< url ends <<< NodeAPI Node <<< Just
loadDocument :: Session -> Int -> Aff NodeDocument
loadDocument session = get <<< url session <<< NodeAPI Node <<< Just
loadData :: Ends -> DocPath -> Aff LoadedData
loadData ends {nodeId, listIds, tabType} = do
document <- loadDocument ends nodeId
ngramsTable <- loadNgramsTable ends
{ ends
loadData :: Session -> DocPath -> Aff LoadedData
loadData session {nodeId, listIds, tabType} = do
document <- loadDocument session nodeId
ngramsTable <- loadNgramsTable session
{ session
, nodeId
, listIds: listIds
, params: { offset : 0, limit : 100, orderBy: Nothing}
......
src/Gargantext/Pages/Corpus/Graph/Tabs.purs
View file @ 1105cefb
......@@ -3,15 +3,14 @@ module Gargantext.Pages.Corpus.Graph.Tabs where
import Prelude hiding (div)
import Data.Array (fromFoldable)
import Data.Tuple (Tuple(..), fst)
import Gargantext.Config (Ends)
import Reactix as R
import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..))
import Gargantext.Components.FacetsTable (TextQuery, docView)
import Gargantext.Components.Table as T
import Gargantext.Components.Tab as Tab
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Sessions (Session)
type Props = ( ends :: Ends, query :: TextQuery, sides :: Array GraphSideCorpus )
type Props = ( session :: Session, query :: TextQuery, sides :: Array GraphSideCorpus )
tabs :: Record Props -> R.Element
tabs props = R.createElement tabsCpt props []
......@@ -20,17 +19,17 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component Props
tabsCpt = R.hooksComponent "G.P.Corpus.Graph.Tabs.tabs" cpt
where
cpt {ends, query, sides} _ = do
cpt {session, query, sides} _ = do
active <- R.useState' 0
pure $ Tab.tabs {tabs: tabs', selected: fst active}
where
tabs' = fromFoldable $ tab ends query <$> sides
tabs' = fromFoldable $ tab session query <$> sides
tab :: Ends -> TextQuery -> GraphSideCorpus -> Tuple String R.Element
tab ends query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) =
tab :: Session -> TextQuery -> GraphSideCorpus -> Tuple String R.Element
tab session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) =
Tuple corpusLabel (docView dvProps)
where
dvProps = {ends, nodeId, listId, query, chart, totalRecords: 4736, container}
dvProps = {session, nodeId, listId, query, chart, totalRecords: 4736, container}
-- TODO totalRecords: probably need to insert a corpusLoader.
chart = mempty
container = T.graphContainer {title: corpusLabel}
......
src/Gargantext/Pages/Home.purs
View file @ 1105cefb
module Gargantext.Pages.Home where
import Prelude
import Data.Lens (re)
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Newtype (class Newtype, unwrap)
import Data.Newtype (class Newtype)
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -12,7 +10,6 @@ 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.Data.Lang (Lang(..))
import Gargantext.Utils.Reactix as R2
type Props = ()
......@@ -38,28 +35,24 @@ performAction Enter = void $ setHash "/search"
performAction Login = void $ setHash "/login"
performAction SignUp = pure unit
-- Layout |
landingData :: Lang -> LandingData
landingData FR = Fr.landingData
landingData EN = En.landingData
langLandingData :: Lang -> LandingData
langLandingData FR = Fr.landingData
langLandingData EN = En.landingData
------------------------------------------------------------------------
layoutLanding :: Lang -> R.Element
layoutLanding lang = R.createElement layoutLandingCpt props []
where props = { landingData: landingData lang }
homeLayout :: Lang -> R.Element
homeLayout lang = R.createElement homeLayoutCpt {landingData} []
where landingData = langLandingData lang
layoutLandingCpt :: R.Component ( landingData :: LandingData )
layoutLandingCpt = R.hooksComponent "LayoutLanding" cpt
homeLayoutCpt :: R.Component ( landingData :: LandingData )
homeLayoutCpt = R.staticComponent "LayoutLanding" cpt
where
cpt {landingData} _ = do
pure $ H.span {} [
H.div { className: "container1" }
[ jumboTitle landingData false ]
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 ]
]
, H.div { className: "container1" } [ blocksRandomText' landingData ] ]
------------------------------------------------------------------------
......
src/Gargantext/Pages/Lists.purs
View file @ 1105cefb
......@@ -10,15 +10,17 @@ import Reactix as R
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Table as Table
import Gargantext.Config
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Lists.Tabs as Tabs
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..))
------------------------------------------------------------------------
type Props = ( nodeId :: Int, ends :: Ends )
type Props = ( nodeId :: Int, session :: Session )
listsLayout :: Record Props -> R.Element
listsLayout props = R.createElement listsLayoutCpt props []
......@@ -26,19 +28,19 @@ listsLayout props = R.createElement listsLayoutCpt props []
listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponent "G.P.Lists.listsLayout" cpt
where
cpt {nodeId, ends} _ =
useLoader nodeId (getCorpus ends) $
cpt {nodeId, session} _ =
useLoader nodeId (getCorpus session) $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} ->
let { name, date, hyperdata: Tabs.CorpusInfo corpus } = poly
{ desc, query, authors: user } = corpus in
R.fragment
[ Table.tableHeaderLayout
{ title: "Corpus " <> name, desc, query, user, date }
, Tabs.tabs {ends, corpusId, corpusData}]
, Tabs.tabs {session, corpusId, corpusData}]
------------------------------------------------------------------------
getCorpus :: Ends -> Int -> Aff Tabs.CorpusData
getCorpus ends listId = do
getCorpus :: Session -> Int -> Aff Tabs.CorpusData
getCorpus session listId = do
-- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get nodePolyUrl
corpusNode <- get $ corpusNodeUrl corpusId
......@@ -49,6 +51,6 @@ getCorpus ends listId = do
Nothing ->
throwError $ error "Missing default list"
where
nodePolyUrl = url ends (NodeAPI Corpus (Just listId))
corpusNodeUrl = url ends <<< NodeAPI Corpus <<< Just
defaultListIdsUrl = url ends <<< Children NodeList 0 1 Nothing <<< Just
nodePolyUrl = url session (NodeAPI Corpus (Just listId))
corpusNodeUrl = url session <<< NodeAPI Corpus <<< Just
defaultListIdsUrl = url session <<< Children NodeList 0 1 Nothing <<< Just
src/Gargantext/Pages/Lists/Tabs.purs
View file @ 1105cefb
......@@ -17,12 +17,12 @@ import Gargantext.Components.Loader as Loader
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Tab as Tab
import Gargantext.Config
import Gargantext.Pages.Corpus.Chart.Histo (histo)
import Gargantext.Pages.Corpus.Chart.Metrics (metrics)
import Gargantext.Pages.Corpus.Chart.Pie (pie, bar)
import Gargantext.Pages.Corpus.Chart.Tree (tree)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabType(..), TabSubType(..))
import Gargantext.Utils.Reactix as R2
data Mode = Authors | Sources | Institutes | Terms
......@@ -41,7 +41,7 @@ modeTabType Institutes = CTabInstitutes
modeTabType Terms = CTabTerms
type Props =
( ends :: Ends
( session :: Session
, corpusId :: Int
, corpusData :: CorpusData )
......@@ -51,15 +51,15 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component Props
tabsCpt = R.hooksComponent "CorpusTabs" cpt
where
cpt {ends, corpusId, corpusData: corpusData@{defaultListId}} _ = do
cpt {session, corpusId, corpusData: corpusData@{defaultListId}} _ = do
(selected /\ setSelected) <- R.useState' 0
pure $ Tab.tabs { tabs, selected }
pure $ Tab.tabs { tabs: tabs', selected }
where
tabs = [ "Sources" /\ view Sources
tabs' = [ "Sources" /\ view Sources
, "Authors" /\ view Authors
, "Institutes" /\ view Institutes
, "Terms" /\ view Terms ]
view mode = ngramsView {mode, ends, corpusId, corpusData}
view mode = ngramsView {mode, session, corpusId, corpusData}
type NgramsViewProps = ( mode :: Mode | Props )
......@@ -69,19 +69,19 @@ ngramsView props = R.createElement ngramsViewCpt props []
ngramsViewCpt :: R.Component NgramsViewProps
ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt
where
cpt {mode, ends, corpusId, corpusData: {defaultListId}} _ =
cpt {mode, session, corpusId, corpusData: {defaultListId}} _ =
NT.mainNgramsTable
{ends, defaultListId, nodeId: corpusId, tabType, tabNgramType}
{session, defaultListId, nodeId: corpusId, tabType, tabNgramType}
where
tabNgramType = modeTabType mode
tabType = TabCorpus (TabNgramType tabNgramType)
listId = 0 -- TODO!
path = {corpusId, tabType}
path2 = {corpusId, listId, tabType, limit: (Just 1000)} -- todo
chart Authors = pie {ends, path}
chart Sources = bar {ends, path}
chart Institutes = tree {ends, path: path2}
chart Terms = metrics {ends, path: path2}
chart Authors = pie {session, path}
chart Sources = bar {session, path}
chart Institutes = tree {session, path: path2}
chart Terms = metrics {session, path: path2}
newtype CorpusInfo =
CorpusInfo
......
src/Gargantext/Pages/Texts.purs
View file @ 1105cefb
......@@ -10,14 +10,16 @@ import Reactix as R
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Table as Table
import Gargantext.Config
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Pages.Texts.Tabs (CorpusData, CorpusInfo(..))
import Gargantext.Pages.Texts.Tabs as Tabs
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..))
type Props = ( ends :: Ends, nodeId :: Int )
type Props = ( session :: Session, nodeId :: Int )
textsLayout :: Record Props -> R.Element
textsLayout props = R.createElement textsLayoutCpt props []
......@@ -26,13 +28,13 @@ textsLayout props = R.createElement textsLayoutCpt props []
textsLayoutCpt :: R.Component Props
textsLayoutCpt = R.hooksComponent "TextsLoader" cpt
where
cpt {nodeId,ends} _ =
useLoader nodeId (getCorpus ends) $
cpt {nodeId,session} _ =
useLoader nodeId (getCorpus session) $
\corpusData@{corpusId, corpusNode, defaultListId} ->
let
NodePoly { name, date, hyperdata: CorpusInfo corpus } = corpusNode
{desc, query, authors: user} = corpus
tabs = Tabs.tabs {ends, corpusId, corpusData}
tabs = Tabs.tabs {session, corpusId, corpusData}
title = "Corpus " <> name
headerProps = { title, desc, query, date, user } in
R.fragment [Table.tableHeaderLayout headerProps, tabs]
......@@ -41,8 +43,8 @@ textsLayoutCpt = R.hooksComponent "TextsLoader" cpt
------------------------------------------------------------------------
getCorpus :: Ends -> Int -> Aff CorpusData
getCorpus ends textsId = do
getCorpus :: Session -> Int -> Aff CorpusData
getCorpus session textsId = do
-- fetch corpus via texts parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get nodePolyUrl
corpusNode <- get $ corpusNodeUrl corpusId
......@@ -53,6 +55,6 @@ getCorpus ends textsId = do
Nothing ->
throwError $ error "Missing default list"
where
nodePolyUrl = url ends $ NodeAPI NodeList (Just textsId)
corpusNodeUrl = url ends <<< NodeAPI Corpus <<< Just
defaultListIdsUrl = url ends <<< Children NodeList 0 1 Nothing <<< Just
nodePolyUrl = url session $ NodeAPI NodeList (Just textsId)
corpusNodeUrl = url session <<< NodeAPI Corpus <<< Just
defaultListIdsUrl = url session <<< Children NodeList 0 1 Nothing <<< Just
src/Gargantext/Pages/Texts/Tabs.purs
View file @ 1105cefb
module Gargantext.Pages.Texts.Tabs where
import Data.Argonaut (class DecodeJson, decodeJson, (.?), (.??))
import Data.Maybe (Maybe(..))
--------------------------------------------------------
import Gargantext.Prelude
import Prelude hiding (div)
import Data.Array as Array
import Prelude (class Eq, class Show, bind, pure, ($))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.List (fromFoldable)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Charts.Options.ECharts (chart) as ECharts
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.Loader as Loader
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Tab as Tab
import Gargantext.Config (CTabNgramType(..), TabSubType(..), TabType(..), Ends)
import Gargantext.Pages.Corpus.Chart.Histo (histo)
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
data Mode = MoreLikeFav | MoreLikeTrash
......@@ -39,7 +30,7 @@ modeTabType :: Mode -> CTabNgramType
modeTabType MoreLikeFav = CTabAuthors -- TODO
modeTabType MoreLikeTrash = CTabSources -- TODO
type Props = ( ends :: Ends, corpusId :: Int, corpusData :: CorpusData )
type Props = ( session :: Session, corpusId :: Int, corpusData :: CorpusData )
tabs :: Record Props -> R.Element
tabs props = R.createElement tabsCpt props []
......@@ -47,21 +38,21 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component Props
tabsCpt = R.hooksComponent "CorpusTabs" cpt
where
cpt {ends, corpusId, corpusData} _ = do
cpt {session, corpusId, corpusData} _ = do
(selected /\ setSelected) <- R.useState' 0
pure $ Tab.tabs { tabs, selected }
pure $ Tab.tabs { tabs: tabs', selected }
where
tabs = [ "Documents" /\ docs, "Trash" /\ trash
tabs' = [ "Documents" /\ docs, "Trash" /\ trash
, "More like fav" /\ moreLikeFav, "More like trash" /\ moreLikeTrash ]
docView' tabType = docView { ends, corpusId, corpusData, tabType }
docView' tabType = docView { session, corpusId, corpusData, tabType }
docs = R.fragment [ docsHisto, docView' TabDocs ]
docsHisto = histo { path, ends }
docsHisto = histo { path, session }
where path = { corpusId, tabType: TabCorpus TabDocs }
moreLikeFav = docView' TabMoreLikeFav
moreLikeTrash = docView' TabMoreLikeTrash
trash = docView' TabTrash
type DocViewProps a = ( ends :: Ends, corpusId :: Int, corpusData :: CorpusData, tabType :: TabSubType a )
type DocViewProps a = ( session :: Session, corpusId :: Int, corpusData :: CorpusData, tabType :: TabSubType a )
docView :: forall a. Record (DocViewProps a) -> R.Element
docView props = R.createElement docViewCpt props []
......@@ -70,10 +61,10 @@ docView props = R.createElement docViewCpt props []
docViewCpt :: forall a. R.Component (DocViewProps a)
docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt
where
cpt {ends, corpusId, corpusData: {defaultListId}, tabType} _children = do
cpt {session, corpusId, corpusData: {defaultListId}, tabType} _children = do
pure $ DT.docView $ params tabType
where
params :: forall a. TabSubType a -> Record DT.Props
params :: forall b. TabSubType b -> Record DT.Props
params TabDocs =
{ nodeId: corpusId
-- ^ TODO merge nodeId and corpusId in DT
......@@ -83,7 +74,7 @@ docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt
, listId: defaultListId
, corpusId: Just corpusId
, showSearch: true
, ends }
, session }
params TabMoreLikeFav =
{ nodeId: corpusId
-- ^ TODO merge nodeId and corpusId in DT
......@@ -93,7 +84,7 @@ docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt
, listId: defaultListId
, corpusId: Just corpusId
, showSearch: false
, ends }
, session }
params TabMoreLikeTrash =
{ nodeId: corpusId
-- ^ TODO merge nodeId and corpusId in DT
......@@ -103,7 +94,7 @@ docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt
, listId: defaultListId
, corpusId: Just corpusId
, showSearch: false
, ends }
, session }
params TabTrash =
{ nodeId: corpusId
-- ^ TODO merge nodeId and corpusId in DT
......@@ -113,7 +104,7 @@ docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt
, listId: defaultListId
, corpusId: Nothing
, showSearch: true
, ends }
, session }
-- DUMMY
params _ =
{ nodeId: corpusId
......@@ -124,7 +115,7 @@ docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt
, listId: defaultListId
, corpusId: Nothing
, showSearch: true
, ends }
, session }
newtype CorpusInfo = CorpusInfo { title :: String
, desc :: String
......@@ -154,11 +145,11 @@ corpusInfoDefault = NodePoly { id : 0
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .? "title"
desc <- obj .? "desc"
query <- obj .? "query"
authors <- obj .? "authors"
chart <- obj .?? "chart"
title <- obj .: "title"
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .:! "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
......
src/Gargantext/Router.purs
View file @ 1105cefb
module Gargantext.Router where
import Gargantext.Prelude
import Prelude
import Data.Foldable (oneOf)
import Data.Int (floor)
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
-- import Effect (Effect)
-- import Effect.Class (liftEffect)
import Reactix as R
import Routing.Hash (matches)
import Routing.Match (Match, lit, num)
-- import Web.HTML (window)
-- import Web.HTML.Window (localStorage)
-- import Web.Storage.Storage (getItem)
data Routes
= Home
| Login
| Folder Int
| Corpus Int
| Document Int Int
| CorpusDocument Int Int Int
| PGraphExplorer Int
| Dashboard
| Texts Int
| Lists Int
| Annuaire Int
| UserPage Int
| ContactPage Int
import Gargantext.Routes (AppRoute(..))
routing :: Match Routes
routing = oneOf
router :: Match AppRoute
router = oneOf
[ Login <$ route "login"
, Folder <$> (route "folder" *> int)
, CorpusDocument <$> (route "corpus" *> int) <*> (lit "list" *> int) <*> (lit "document" *> int)
......@@ -46,32 +22,8 @@ routing = oneOf
, ContactPage <$> (route "contact" *> int)
, Home <$ lit ""
]
where
route str = lit "" *> lit str
int :: Match Int
int = floor <$> num
instance showRoutes :: Show Routes where
show Login = "Login"
show (UserPage i) = "User" <> show i
show (ContactPage i) = "Contact" <> show i
show (CorpusDocument _ _ i) = "Document" <> show i
show (Document _ i) = "Document" <> show i
show (Corpus i) = "Corpus" <> show i
show (Annuaire i) = "Annuaire" <> show i
show (Folder i) = "Folder" <> show i
show Dashboard = "Dashboard"
show (PGraphExplorer i) = "graphExplorer" <> show i
show (Texts i) = "texts" <> show i
show (Lists i) = "lists" <> show i
show Home = "Home"
-- | Ties the hash router to a state hook of routes
-- | Note: if it gets sent to an unrecognised url, it will quietly drop the change
useHashRouter :: forall routes. Match routes -> routes -> R.Hooks (R.State routes)
useHashRouter routes init = do
route@(_ /\ setRoute) <- R.useState' init
R.useEffectOnce $ matches routes $ \_old new -> setRoute (const new)
pure route
src/Gargantext/Routes.purs 0 → 100644
View file @ 1105cefb
module Gargantext.Routes where
import Prelude
import Data.Maybe (Maybe)
import Gargantext.Types
data AppRoute
= Home
| Login
| Folder Int
| Corpus Int
| Document Int Int
| CorpusDocument Int Int Int
| PGraphExplorer Int
| Dashboard
| Texts Int
| Lists Int
| Annuaire Int
| UserPage Int
| ContactPage Int
data SessionRoute
= Tab TabType (Maybe Id)
| Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
| GetNgrams NgramsGetOpts (Maybe Id)
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
-- ^ This name is not good. In particular this URL is used both in PUT and POST.
| NodeAPI NodeType (Maybe Id)
| ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id)
| Chart ChartOpts (Maybe Id)
instance showAppRoute :: Show AppRoute where
show Home = "Home"
show Login = "Login"
show (Folder i) = "Folder" <> show i
show (Corpus i) = "Corpus" <> show i
show (Document _ i) = "Document" <> show i
show (CorpusDocument _ _ i) = "Document" <> show i
show (PGraphExplorer i) = "graphExplorer" <> show i
show Dashboard = "Dashboard"
show (Texts i) = "texts" <> show i
show (Lists i) = "lists" <> show i
show (Annuaire i) = "Annuaire" <> show i
show (UserPage i) = "User" <> show i
show (ContactPage i) = "Contact" <> show i
appPath :: AppRoute -> String
appPath Home = ""
appPath Login = "login"
appPath (Folder i) = "folder/" <> show i
appPath (CorpusDocument c l i) = "corpus/" <> show c <> "/list/" <> show l <> "/document/" <> show i
appPath (Corpus i) = "corpus/" <> show i
appPath (Document l i) = "list/" <> show l <> "/document/" <> show i
appPath Dashboard = "dashboard"
appPath (PGraphExplorer i) = "graph/" <> show i
appPath (Texts i) = "texts/" <> show i
appPath (Lists i) = "lists/" <> show i
appPath (Annuaire i) = "annuaire/" <> show i
appPath (UserPage i) = "user/" <> show i
appPath (ContactPage i) = "contact/" <> show i
src/Gargantext/Sessions.purs 0 → 100644
View file @ 1105cefb
-- | A module for authenticating to create sessions and handling them
module Gargantext.Sessions where
import Prelude (class Eq, class Show, const, otherwise, pure, show, unit, ($), (*>), (<$>), (<>), (==), (>>=))
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem, setItem, removeItem)
import Gargantext.Components.Login.Types
(AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..))
import Gargantext.Config.REST (post)
import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath)
import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, nodePath)
import Gargantext.Utils.Reactix as R2
-- | A Session represents an authenticated session for a user at a
-- | backend. It contains a token and root tree id.
newtype Session = Session
{ backend :: Backend
, username :: String
, token :: String
, treeId :: Int }
derive instance genericSession :: Generic Session _
instance eqSession :: Eq Session where
eq = genericEq
instance showSession :: Show Session where
show (Session {backend, username}) = username <> "@" <> show backend
instance toUrlSessionRoute :: ToUrl Session SessionRoute where
toUrl (Session {backend}) r = backendUrl backend (sessionPath r)
instance toUrlSessionNodePath :: ToUrl Session NodePath where
toUrl (Session {backend}) np = backendUrl backend (nodePath np)
sessionUrl :: Session -> String -> String
sessionUrl (Session {backend}) = backendUrl backend
instance toUrlSessionString :: ToUrl Session String where
toUrl = sessionUrl
newtype Sessions = Sessions (Maybe Session)
unSessions :: Sessions -> Maybe Session
unSessions (Sessions s) = s
useSessions :: R.Hooks (R2.Reductor Sessions Action)
useSessions = R2.useReductor actAndSave (const loadSessions) unit
where
actAndSave :: R2.Actor Sessions Action
actAndSave s a = act s a >>= saveSessions
data Action
= Login Session
| Logout Session
act :: Sessions -> Action -> Effect Sessions
act _ (Login session) = pure $ Sessions (Just session)
act (Sessions s) (Logout session)
| Just session == s = pure (Sessions Nothing)
| Just s2 <- s = log2 "Alien session:" s2 *> pure (Sessions Nothing)
| otherwise = log "Can't log out of nonexistent session" *> pure (Sessions Nothing)
-- Key we will store the data under
localStorageKey :: String
localStorageKey = "garg-sessions"
empty :: Sessions
empty = Sessions Nothing
-- True if there are no sessions stored
null :: Sessions -> Boolean
null (Sessions Nothing) = true
null _ = false
-- | Will attempt to load saved sessions from localstorage. should log if decoding fails
loadSessions :: Effect Sessions
loadSessions = pure empty
-- loadSessions = window >>= localStorage >>= getItem "auths" >>= traverse decode
-- where
-- decode :: String -> Effect (Maybe Sessions)
-- decode = ret <<< runExcept <<< decodeJSON
-- ret (Right v) = pure $ Just v
-- ret (Left e) = log2 "Error reading serialised sessions:" e *> pure (Malformed e)
saveSessions :: Sessions -> Effect Sessions
saveSessions sessions = effect *> pure sessions
where
effect
| null sessions = window >>= localStorage >>= removeItem localStorageKey
| otherwise = pure unit
-- | otherwise = window >>= localStorage >>= setItem localStorageKey (encodeJSON sessions)
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) =
decode <$> post (toUrl backend "auth") ar
where
decode (AuthResponse ar2)
| {inval: Just (AuthInvalid {message})} <- ar2 = Left message
| {valid: Just (AuthData {token, tree_id})} <- ar2 =
Right $ Session { backend, username, token, treeId: tree_id }
| otherwise = Left "Invalid response from server"
src/Gargantext/Types.purs
View file @ 1105cefb
module Gargantext.Types where
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson )
import Data.Maybe (Maybe(..))
import Prelude
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject)
import Data.Maybe (Maybe(..), maybe, fromJust)
import Data.Either (Either(..))
import Prim.Row (class Union)
import URI.Query (Query)
import Gargantext.Prelude
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
data TermSize = MonoTerm | MultiTerm
......@@ -86,3 +88,238 @@ termLists = [ { desc: "All terms", mval: Nothing }
-- | Proof that row `r` is a subset of row `s`
class Optional (r :: # Type) (s :: # Type)
instance optionalInstance :: Union r t s => Optional r s
showTabType' :: TabType -> String
showTabType' (TabCorpus t) = show t
showTabType' (TabDocument t) = show t
showTabType' (TabPairing t) = show t
data TabPostQuery = TabPostQuery {
offset :: Int
, limit :: Int
, orderBy :: OrderBy
, tabType :: TabType
, query :: String
}
instance encodeJsonTabPostQuery :: EncodeJson TabPostQuery where
encodeJson (TabPostQuery post) =
"view" := showTabType' post.tabType
~> "offset" := post.offset
~> "limit" := post.limit
~> "orderBy" := show post.orderBy
~> "query" := post.query
~> jsonEmptyObject
data NodeType = NodeUser
| Annuaire
| NodeContact
| Corpus
| Url_Document
| CorpusV3
| Dashboard
| Error
| Folder
| Graph
| Phylo
| Individu
| Node
| Nodes
| Tree
| NodeList
| Texts
derive instance eqNodeType :: Eq NodeType
instance showNodeType :: Show NodeType where
show NodeUser = "NodeUser"
show Annuaire = "Annuaire"
show NodeContact = "NodeContact"
show Corpus = "NodeCorpus"
show CorpusV3 = "NodeCorpusV3"
show Dashboard = "NodeDashboard"
show Url_Document = "NodeDocument"
show Error = "NodeError"
show Folder = "NodeFolder"
show Graph = "NodeGraph"
show Phylo = "NodePhylo"
show Individu = "NodeIndividu"
show Node = "Node"
show Nodes = "Nodes"
show Tree = "NodeTree"
show NodeList = "NodeList"
show Texts = "NodeTexts"
readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = Graph
readNodeType "NodePhylo" = Phylo
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser
readNodeType "NodeContact" = NodeContact
readNodeType "Tree" = Tree
readNodeType "NodeList" = NodeList
readNodeType "NodeTexts" = Texts
readNodeType _ = Error
{-
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
compare n1 n2 = compare (show n1) (show n2)
instance eqNodeType :: Eq NodeType where
eq n1 n2 = eq (show n1) (show n2)
-}
------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ readNodeType obj
instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType
nodeTypePath :: NodeType -> String
nodeTypePath Annuaire = "annuaire"
nodeTypePath Corpus = "corpus"
nodeTypePath CorpusV3 = "corpus"
nodeTypePath Dashboard = "dashboard"
nodeTypePath Url_Document = "document"
nodeTypePath Error = "ErrorNodeType"
nodeTypePath Folder = "folder"
nodeTypePath Graph = "graph"
nodeTypePath Phylo = "phylo"
nodeTypePath Individu = "individu"
nodeTypePath Node = "node"
nodeTypePath Nodes = "nodes"
nodeTypePath NodeUser = "user"
nodeTypePath NodeContact = "contact"
nodeTypePath Tree = "tree"
nodeTypePath NodeList = "lists"
nodeTypePath Texts = "texts"
------------------------------------------------------------
type ListId = Int
type NgramsGetOpts =
{ tabType :: TabType
, offset :: Offset
, limit :: Limit
, orderBy :: Maybe OrderBy
, listIds :: Array ListId
, termListFilter :: Maybe TermList
, termSizeFilter :: Maybe TermSize
, searchQuery :: String
}
type SearchOpts =
{ {-id :: Int
, query :: Array String
,-}
listId :: Int
, limit :: Limit
, offset :: Offset
, orderBy :: Maybe OrderBy
}
type CorpusMetricOpts =
{ tabType :: TabType
, listId :: ListId
, limit :: Maybe Limit
}
type ChartOpts =
{ chartType :: ChartType
, tabType :: TabType
-- , listId :: ListId
-- , limit :: Maybe Limit
}
data NodePath = NodePath NodeType (Maybe Id)
nodePath :: NodePath -> String
nodePath (NodePath t i) = nodeTypePath t <> "/" <> id
where id = maybe "" (\j -> "/" <> show j) i
data ChartType = Histo | Scatter | ChartPie | ChartTree
instance showChartType :: Show ChartType
where
show Histo = "chart"
show Scatter = "scatter"
show ChartPie = "pie"
show ChartTree = "tree"
type Id = Int
type Limit = Int
type Offset = Int
data OrderBy = DateAsc | DateDesc
| TitleAsc | TitleDesc
| ScoreAsc | ScoreDesc
| TermAsc | TermDesc
| SourceAsc | SourceDesc
derive instance genericOrderBy :: Generic OrderBy _
instance showOrderBy :: Show OrderBy where
show = genericShow
------------------------------------------------------------
data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where
show V10 = "v1.0"
show V11 = "v1.1"
------------------------------------------------------------
instance eqApiVersion :: Eq ApiVersion where
eq V10 V10 = true
eq V11 V11 = true
eq _ _ = false
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
derive instance eqCTabNgramType :: Eq CTabNgramType
instance showCTabNgramType :: Show CTabNgramType where
show CTabTerms = "Terms"
show CTabSources = "Sources"
show CTabAuthors = "Authors"
show CTabInstitutes = "Institutes"
data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
derive instance eqPTabNgramType :: Eq PTabNgramType
instance showPTabNgramType :: Show PTabNgramType where
show PTabPatents = "Patents"
show PTabBooks = "Books"
show PTabCommunication = "Communication"
data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
derive instance eqTabSubType :: Eq a => Eq (TabSubType a)
instance showTabSubType :: Show a => Show (TabSubType a) where
show TabDocs = "Docs"
show (TabNgramType a) = show a
show TabTrash = "Trash"
show TabMoreLikeFav = "MoreFav"
show TabMoreLikeTrash = "MoreTrash"
data TabType
= TabCorpus (TabSubType CTabNgramType)
| TabPairing (TabSubType PTabNgramType)
| TabDocument (TabSubType CTabNgramType)
derive instance eqTabType :: Eq TabType
derive instance genericTabType :: Generic TabType _
instance showTabType :: Show TabType where
show = genericShow
src/Gargantext/Utils.purs
View file @ 1105cefb
......@@ -31,6 +31,10 @@ invertOrdering LT = GT
invertOrdering GT = LT
invertOrdering EQ = EQ
csrfMiddlewareToken :: String
csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
-- A lens that always returns unit
_unit :: forall s. Lens' s Unit
_unit = lens (\_ -> unit) (\s _ -> s)
src/Gargantext/Utils/Reactix.purs
View file @ 1105cefb
module Gargantext.Utils.Reactix
where
module Gargantext.Utils.Reactix where
import Prelude
import DOM.Simple as DOM
import DOM.Simple.Document (document)
import DOM.Simple.Event as DE
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Element as Element
import DOM.Simple.Event as DE
import DOM.Simple as DOM
import DOM.Simple.Document (document)
import DOM.Simple.Event as DE
import DOM.Simple.Element as Element
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Exception (error)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
import FFI.Simple ((...), defineProperty, delay)
import React (ReactClass, ReactElement, Children, class IsReactElement, class ReactPropFields)
import Effect.Uncurried (EffectFn1, mkEffectFn1, mkEffectFn2)
import FFI.Simple ((...), defineProperty, delay, args3)
import React (class ReactPropFields, Children, ReactClass, ReactElement)
import React as React
import Reactix as R
import Reactix.DOM.HTML (ElemFactory, text)
import Reactix.React (createDOMElement)
import Reactix.React (react, createDOMElement)
import Reactix.SyntheticEvent as RE
import Reactix.Utils (currySecond, hook, tuple)
import Thermite (Spec, simpleSpec, Render, defaultPerformAction)
import Unsafe.Coerce (unsafeCoerce)
newtype Point = Point { x :: Number, y :: Number }
-- a setter function, for useState
type Setter t = (t -> t) -> Effect Unit
-- a reducer function living in effector, for useReductor
type Actor t a = (t -> a -> Effect t)
-- | Turns a ReactElement into aReactix Element
-- | buff (v.) to polish
......@@ -163,3 +162,19 @@ childless cpt props = R.createElement cpt props []
showText :: forall s. Show s => s -> R.Element
showText = text <<< show
----- Reactix's new effectful reducer: sneak-peek because anoe wants to demo on tuesday
-- | Like a reducer, but lives in Effect
type Reductor state action = Tuple state (action -> Effect Unit)
-- | Like useReductor, but lives in Effect
useReductor :: forall s a i. Actor s a -> (i -> Effect s) -> i -> R.Hooks (Reductor s a)
useReductor f i j =
hook $ \_ ->
pure $ currySecond $ tuple $ react ... "useReducer" $ args3 (mkEffectFn2 f) j (mkEffectFn1 i)
-- | Like `useReductor`, but takes an initial state instead of an
-- | initialiser function and argument
useReductor' :: forall s a. Actor s a -> s -> R.Hooks (Reductor s a)
useReductor' r = useReductor r pure
src/Main.purs
View file @ 1105cefb
module Main where
module Main (main) where
import Prelude (Unit, ($))
import Data.Maybe (Maybe(..))
import Data.Nullable (toMaybe)
import DOM.Simple (Element)
import DOM.Simple.Document (document)
import DOM.Simple.Console (log)
import Effect (Effect)
import FFI.Simple ((...))
import Reactix as R
import Gargantext.Components.Layout (layout)
import Gargantext.Components.App (app)
main :: Effect Unit
main = paint $ toMaybe $ document ... "getElementById" $ [ "app" ]
where
paint Nothing = log "[main] Container not found"
paint (Just c) = R.render (layout {}) c
main = paint $ toMaybe (document ... "getElementById" $ [ "app" ])
paint :: Maybe Element -> Effect Unit
paint Nothing = log "[main] Container not found"
paint (Just c) = R.render (app {}) c
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