Commit c8584b86 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE] and making Annuaire working again.

parents 6a2394ab 0eab4c4a
#+Title: Contributing
yarn first then psc-package are used to manage dependencies
to build use ./build
to rebuild (after a major upgrade) use ./rebuild
to add a new dependency: psc-package install PACKAGE
use git, commit and pull request :)
# Gargantext Purescript
## About this project
Gargantext is a collaborative web platform for the exploration of sets
of unstructured documents. It combines tools from natural language
processing, text-mining, complex networks analysis and interactive data
visualization to pave the way toward new kinds of interactions with your
digital corpora.
This software is a free software, developed by the CNRS Complex Systems
Institute of Paris Île-de-France (ISC-PIF) and its partners.
## Installation of this library
### Dependencies warning
This library purescript-gargantext is the Front End part of Gargantext.
you need the backend (haskell-gargantext) installation too.
### Installation steps
1. Add nodes_modules/.bin to your path
2. Execute ./build
## Note to the contributors
Please follow CONTRIBUTING.md
......@@ -8,7 +8,7 @@
],
"dependencies": {
"purescript-console": "^4.1.0",
"purescript-thermite": "https://github.com/np/purescript-thermite.git#d7395aec9ff4e7b8f820e882b4b07ed15c4f804d",
"purescript-thermite": "https://github.com/np/purescript-thermite.git#cf194360c8ee440978a2b342382fc3fddc65b39e",
"purescript-affjax": "^7.0.0",
"purescript-routing": "^8.0.0",
"purescript-argonaut": "^4.0.1",
......@@ -19,6 +19,7 @@
"purescript-psci-support": "^4.0.0"
},
"resolutions": {
"purescript-react": "exports"
"purescript-react": "exports",
"purescript-profunctor-lenses": "^4.0.0"
}
}
#!/bin/bash
yarn && yarn psc-package install && yarn pulp --psc-package build && yarn pulp --psc-package browserify --to dist/bundle.js
......@@ -78,3 +78,88 @@ logoSmall {
background-color : blue;
color: white;
}
li#rename #rename-a{
display : none;
position : absolute;
left : 125px;
}
#rename-tooltip {
position : absolute;
left : 96px;
top:-64px;
background-color: white;
z-index: 1000;
}
li a#rename {
display:none;
position:absolute;
text-decoration:none;
left: 26px;
}
li:hover a#rename {
display:block;
}
.glyphitem {top: 0;
display: inline-block;
float: right;
opacity: 0.6;
padding-right: 5px;
cursor: pointer;
transition: transform 0.1s ease-out 0s;
font-size: 15px;
text-align: center;
}
.glyphitem:hover {
display: inline-block;
opacity: 1;
transform: scale(1.4);
}
#rename-tooltip:hover {
border:none;
}
#arrow {
width: 0;
height: 0;
border-top: 10px solid transparent;
border-bottom: 10px solid transparent;
border-right:10px solid darkgray;
position : relative;
top: 55px;
left: -9px;
}
#rename-tooltip a:hover
{
text-decoration:none;
}
#sp-container
{ -webkit-transition: width 2s; /* For Safari 3.1 to 6.0 */
transition: width 2s;
}
#!/bin/bash
echo "Upgrading nodeJS"
sudo npm cache clean -f
sudo npm install -g n
sudo n stable
sudo n latest
echo "Installing yarn"
curl -sS https://dl.yarnpkg.com/debian/pubkey.gpg | sudo apt-key add -
echo "deb https://dl.yarnpkg.com/debian/ stable main" | sudo tee /etc/apt/sources.list.d/yarn.list
sudo apt update
sudo apt install yarn
./build
{
"name": "gargantext",
"set": "master",
"source": "https://github.com/np/package-sets.git",
"depends": [
"psci-support",
"css",
"generics-rep",
"routing",
"foreign-object",
"argonaut",
"effect",
"web-html",
"thermite",
"integers",
"random",
"affjax",
"console",
"prelude"
]
}
#!/bin/bash
rm -rf output bower_components node_modules
bower install && yarn install && pulp build && pulp browserify --to dist/bundle.js
rm -rf .psc-package output bower_components node_modules
./build
#!/bin/bash
pulp --psc-package repl
15747
\ No newline at end of file
......@@ -88,3 +88,5 @@ t' :: Node -> Legend
t' (Node r) = Legend { id_ : clustDefault, label : r.label}
where
(Cluster {clustDefault}) = r.attributes
module Gargantext.Components.Loader where
import Control.Monad.Cont.Trans (lift)
import Data.Maybe (Maybe(..))
import Data.Either (Either(..))
import Data.Traversable (traverse_)
import React as React
import React (ReactClass)
import React (ReactClass, Children)
import Gargantext.Prelude
import Effect.Aff (Aff, launchAff, launchAff_, makeAff, nonCanceler, killFiber)
import Effect.Exception (error)
import Effect (Effect)
import Effect.Aff (Aff)
type InnerProps a b =
{ path :: a
, loaded :: Maybe b
, children :: React.Children
}
import Thermite (Render, PerformAction, simpleSpec, modifyState_, createReactSpec)
type Props a b = { path :: a
, component :: ReactClass (InnerProps a b)
}
data Action path = ForceReload | SetPath path
createLoaderClass :: forall a b
type InnerPropsRow path loaded row =
( path :: path
, loaded :: loaded
, dispatch :: Action path -> Effect Unit
| row
)
type InnerProps path loaded row = Record (InnerPropsRow path loaded row)
type InnerClass path loaded = ReactClass (InnerProps path loaded (children :: Children))
type PropsRow path loaded row =
( path :: path
, component :: InnerClass path loaded
| row
)
type Props path loaded = Record (PropsRow path loaded (children :: Children))
type Props' path loaded = Record (PropsRow path loaded ())
type State path loaded = { currentPath :: path, loaded :: Maybe loaded }
createLoaderClass' :: forall path loaded props
. Eq path
=> String
-> (path -> Aff loaded)
-> Render (State path loaded) {path :: path | props} (Action path)
-> ReactClass { path :: path, children :: Children | props }
createLoaderClass' name loader render =
React.component name
(\this -> do
s <- spec this
pure { state: s.state
, render: s.render
, componentDidMount: dispatcher this ForceReload
, componentDidUpdate: \_prevProps {currentPath} _snapshot -> do
{path} <- React.getProps this
-- This guard is the same as in performAction (SetPath ...),
-- however we need it here to avoid potential infinite loops.
-- https://reactjs.org/docs/react-component.html#componentdidupdate
when (path /= currentPath) do
dispatcher this (SetPath path)
})
where
initialState {path} = {currentPath: path, loaded: Nothing}
performAction :: PerformAction (State path loaded) {path :: path | props} (Action path)
performAction ForceReload _ {currentPath} = do
loaded <- lift $ loader currentPath
modifyState_ $ _ { loaded = Just loaded }
performAction (SetPath newPath) _ {currentPath} =
when (newPath /= currentPath) do
loaded <- lift $ loader newPath
modifyState_ $ _ { currentPath = newPath, loaded = Just loaded }
{spec, dispatcher} = createReactSpec (simpleSpec performAction render) initialState
type LoaderClass path loaded =
ReactClass (Record (PropsRow path loaded (children :: Children)))
createLoaderClass :: forall path loaded
. Eq path
=> String
-> (path -> Aff loaded)
-> LoaderClass path loaded
createLoaderClass name loader =
createLoaderClass' name loader render
where
render :: Render (State path loaded) (Props' path loaded) (Action path)
render _ _ {loaded: Nothing} _ =
-- TODO load spinner
[]
render dispatch {component} {currentPath, loaded: Just loaded} c =
[React.createElement component {path: currentPath, loaded, dispatch} c]
{-
createLoaderClass :: forall path loaded
. String
-> (a -> Aff b)
-> ReactClass (Props a b)
-> (path -> Aff loaded)
-> ReactClass (Props path loaded)
createLoaderClass name loader = React.component name mk
where
mk this =
......@@ -49,3 +119,4 @@ createLoaderClass name loader = React.component name mk
{loaded} <- React.getState this
pure $ React.createElement component {path, loaded} []
}
-}
This diff is collapsed.
This diff is collapsed.
......@@ -11,70 +11,77 @@ module Gargantext.Config where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Map (Map)
import Data.Map as DM
import Data.Maybe (maybe)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple(..))
import Gargantext.Types
endConfig :: EndConfig
endConfig = endConfig' V10
endConfig' :: ApiVersion -> EndConfig
endConfig' v = { front : frontCaddy
, back : backDev v }
endConfig' v = { front : frontRelative
, back : backLocal v }
-- | Default Root on shared database to develop
-- until authentication implementation
-- (Default Root will be given after authentication)
defaultRoot :: Int
defaultRoot = 347474
defaultRoot = 950094
------------------------------------------------------------------------
frontRelative :: Config
frontRelative = { baseUrl: ""
, prePath: "/#/"
}
frontCaddy :: Config
frontCaddy = { proto : "http://"
, port : 2015
, domain : "localhost"
, prePath : "/#/"
frontCaddy = { baseUrl: "http://localhost:2015"
, prePath: "/#/"
}
frontHaskell :: Config
frontHaskell = { proto : "http://"
, port : 8008
, domain : "localhost"
, prePath : "/index.html#/"
frontHaskell = { baseUrl: "http://localhost:8008"
, prePath: "/#/"
}
frontDev :: Config
frontDev = { baseUrl: "https://dev.gargantext.org"
, prePath: "/#/"
}
frontProd :: Config
frontProd = { proto : "https://"
, port : 8080
, domain : "gargantext.org"
, prePath : "/index.html#/"
frontProd = { baseUrl: "https://gargantext.org"
, prePath: "/#/"
}
------------------------------------------------------------------------
backLocal :: ApiVersion -> Config
backLocal v = { baseUrl: "http://localhost:8008"
, prePath: "/api/" <> show v <> "/"
}
backDev :: ApiVersion -> Config
backDev v = { proto : "http://"
, port : 8008
, domain : "localhost"
, prePath : "/api/" <> show v <> "/"
backDev v = { baseUrl: "https://dev.gargantext.org"
, prePath: "/api/" <> show v <> "/"
}
backProd :: ApiVersion -> Config
backProd v = { proto : "https://"
, port : 8080
, domain : "gargantext.org"
, prePath : "/api/" <> show v <> "/"
}
backProd v = { baseUrl: "https://gargantext.org"
, prePath: "/api/" <> show v <> "/"
}
------------------------------------------------------------------------
type EndConfig = { front :: Config
, back :: Config
}
type Config = { proto :: String
, port :: Int
, domain :: String
, prePath :: String
type Config = { baseUrl :: String
, prePath :: String
}
------------------------------------------------------------
......@@ -85,23 +92,23 @@ type Url = String
doUrl :: UrlBase -> UrlPath -> UrlParam -> Url
doUrl b p ps = b <> p <> ps
------------------------------------------------------------
endOf :: forall cfg. End -> { front :: cfg, back :: cfg } -> cfg
endOf Back = _.back
endOf Front = _.front
endBaseUrl :: End -> EndConfig -> UrlBase
endBaseUrl Back c = baseUrl c.back
endBaseUrl Front c = baseUrl c.front
endBaseUrl end c = (endOf end c).baseUrl
baseUrl :: Config -> UrlBase
baseUrl conf = conf.proto <> conf.domain <> ":" <> show conf.port
------------------------------------------------------------
endPathUrl :: End -> EndConfig -> NodeType -> Id -> UrlPath
endPathUrl Back c nt i = pathUrl c.back nt i
endPathUrl Front c nt i = pathUrl c.front nt i
endPathUrl :: End -> EndConfig -> NodeType -> Maybe Id -> UrlPath
endPathUrl end c nt i = pathUrl (endOf end c) nt i
pathUrl :: Config -> NodeType -> Id -> UrlPath
pathUrl c nt@(Tab _ _ _) i = pathUrl c Node i <> "/" <> show nt
pathUrl c nt i = c.prePath <> urlConfig nt <> "/" <> show i
pathUrl :: Config -> NodeType -> Maybe Id -> UrlPath
pathUrl c nt@(Tab _ _ _ _) i = pathUrl c Node i <> "/" <> show nt
pathUrl c nt@(Ngrams _ _) i = pathUrl c Node i <> "/" <> show nt
pathUrl c nt i = c.prePath <> urlConfig nt <> (maybe "" (\i' -> "/" <> show i') i)
------------------------------------------------------------
toUrl :: End -> NodeType -> Id -> Url
toUrl :: End -> NodeType -> Maybe Id -> Url
toUrl e nt i = doUrl base path params
where
base = endBaseUrl e endConfig
......@@ -110,7 +117,8 @@ toUrl e nt i = doUrl base path params
------------------------------------------------------------
data NodeType = NodeUser
| Annuaire
| Tab TabType Offset Limit
| Tab TabType Offset Limit (Maybe OrderBy)
| Ngrams TabType (Maybe TermList)
| Corpus
| CorpusV3
| Dashboard
......@@ -120,12 +128,21 @@ data NodeType = NodeUser
| Graph
| Individu
| Node
| Nodes
| Tree
data End = Back | Front
type Id = Int
type Limit = Int
type Offset = Int
data OrderBy = DateAsc | DateDesc
| TitleAsc | TitleDesc
| FavDesc | FavAsc
derive instance genericOrderBy :: Generic OrderBy _
instance showOrderBy :: Show OrderBy where
show = genericShow
------------------------------------------------------------
data ApiVersion = V10 | V11
......@@ -134,19 +151,21 @@ instance showApiVersion :: Show ApiVersion where
show V11 = "v1.1"
------------------------------------------------------------
data TabType = TabDocs | TabTerms | TabSources | TabAuthors | TabTrash
data TabType = TabDocs | TabTerms | TabSources | TabAuthors | TabInstitutes | TabTrash
instance showTabType :: Show TabType where
show TabDocs = "Docs"
show TabTerms = "Terms"
show TabSources = "Sources"
show TabAuthors = "Authors"
show TabTrash = "Trash"
show TabDocs = "Docs"
show TabTerms = "Terms"
show TabSources = "Sources"
show TabAuthors = "Authors"
show TabInstitutes = "Institutes"
show TabTrash = "Trash"
------------------------------------------------------------
urlConfig :: NodeType -> Url
urlConfig Annuaire = show Annuaire
urlConfig nt@(Tab _ _ _) = show nt
urlConfig nt@(Tab _ _ _ _) = show nt
urlConfig nt@(Ngrams _ _) = show nt
urlConfig Corpus = show Corpus
urlConfig CorpusV3 = show CorpusV3
urlConfig Dashboard = show Dashboard
......@@ -156,6 +175,7 @@ urlConfig Folder = show Folder
urlConfig Graph = show Graph
urlConfig Individu = show Individu
urlConfig Node = show Node
urlConfig Nodes = show Nodes
urlConfig NodeUser = show NodeUser
urlConfig Tree = show Tree
------------------------------------------------------------
......@@ -170,21 +190,35 @@ instance showNodeType :: Show NodeType where
show Graph = "graph"
show Individu = "individu"
show Node = "node"
show Nodes = "nodes"
show NodeUser = "user"
show Tree = "tree"
show (Tab t o l) = "table?view=" <> show t <> "&offset=" <> show o <> "&limit=" <> show l <> "&order=DateAsc"
show (Tab t o l s) = "table?view=" <> show t <> "&offset=" <> show o
<> "&limit=" <> show l <> os
where
os = maybe "" (\x -> "&order=" <> show x) s
show (Ngrams t listid) = "listGet?ngramsType=" <> show t <> listid'
where
listid' = maybe "" (\x -> "&list=" <> show x) listid
-- | TODO : where is the Read Class ?
-- NP: We don't need the Read class. Here are the encoding formats we need:
-- * JSON
-- * URL parts has in {To,From}HttpApiData but only for certain types
-- The Show class should only be used for dev.
-- instance readNodeType :: Read NodeType where
readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "Tab" = (Tab TabDocs 0 0)
readNodeType "Tab" = (Tab TabDocs 0 0 Nothing)
readNodeType "Ngrams" = (Ngrams TabTerms Nothing)
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = Graph
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser
......
......@@ -51,5 +51,10 @@ put url = send PUT url <<< Just
delete :: forall a. DecodeJson a => String -> Aff a
delete url = send DELETE url noReqBody
-- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
deleteWithBody :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b
deleteWithBody url = send DELETE url <<< Just
post :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b
post url = send POST url <<< Just
This diff is collapsed.
......@@ -15,11 +15,11 @@ import Gargantext.Prelude
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action(..), State, Contact, _contact)
import Thermite (PerformAction, modifyState)
getContact :: Int -> Aff (Contact Void Void)
getContact :: Maybe Int -> Aff Contact
getContact id = get $ toUrl Back Node id
fetchContact :: Int -> StateCoTransformer State Unit
fetchContact contactId = do
contact <- lift $ getContact contactId
contact <- lift $ getContact (Just contactId)
void $ modifyState $ _contact ?~ contact
logs "Fetching contact..."
......@@ -5,11 +5,11 @@ import Gargantext.Pages.Annuaire.User.Contacts.Types
import Data.List (List, zipWith, catMaybes, toUnfoldable)
import Data.Map (Map, empty, keys, values, lookup)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..), maybe)
import Data.Set (toUnfoldable) as S
import Data.Tuple (Tuple(..), uncurry)
import Data.Unfoldable (class Unfoldable)
import Prelude (Void)
import Prelude (identity)
import Prelude (($), (<<<), (<$>), flip, class Ord)
import React (ReactElement)
import React.DOM (div, h3, img, li, span, text, ul)
......@@ -22,7 +22,7 @@ render dispatch _ state _ =
[
div [className "col-md-12"]
$ case state.contact of
(Just (Contact contact)) -> display contact.name [contactInfos contact.hyperdata]
(Just (Contact contact)) -> display (maybe "no name" identity contact.name) [contactInfos contact.hyperdata]
Nothing -> display "Contact not found" []
]
......@@ -55,7 +55,7 @@ mapMyMap f m = toUnfoldable
infixl 4 mapMyMap as <.~$>
contactInfos :: HyperData Void Void -> ReactElement
contactInfos :: HyperdataContact -> ReactElement
contactInfos hyperdata =
ul [className "list-group"] [] {- $
listInfo <.~$> hyperdata
......
......@@ -2,10 +2,10 @@ module Gargantext.Pages.Annuaire.User.Contacts.Types where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Argonaut (class DecodeJson, decodeJson, (.?), (.??))
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..), maybe)
import Data.Map (Map(..))
import React (ReactElement)
......@@ -14,16 +14,36 @@ import React.DOM (div)
import Gargantext.Components.Tab as Tab
import Gargantext.Utils.DecodeMaybe ((.?|))
data Contact c s = Contact {
data Contact = Contact {
id :: Int
, typename :: Maybe Int
, userId :: Int
, userId :: Maybe Int
, parentId :: Maybe Int
, name :: String
, name :: Maybe String
, date :: Maybe String
, hyperdata :: HyperData c s
, hyperdata :: HyperdataContact
}
data HyperdataContact =
HyperdataContact { bdd :: Maybe String
, uniqId :: Maybe String
, uniqIdBdd :: Maybe String
, title :: Maybe String
, source :: Maybe String
}
instance decodeHyperdataContact :: DecodeJson HyperdataContact
where
decodeJson json = do
obj <- decodeJson json
bdd <- obj .?? "bdd"
uniqId <- obj .?? "uniqId"
uniqIdBdd <- obj .?? "uniqIdBdd"
title <- obj .?? "title"
source <- obj .?? "source"
pure $ HyperdataContact {bdd, uniqId, uniqIdBdd, title, source}
data HyperData c s =
HyperData
{ common :: c
......@@ -39,17 +59,17 @@ instance decodeUserHyperData :: (DecodeJson c, DecodeJson s) =>
specific <- decodeJson json
pure $ HyperData {common, shared, specific}
instance decodeUser :: (DecodeJson c, DecodeJson s) =>
DecodeJson (Contact c s) where
instance decodeUser :: DecodeJson Contact where
decodeJson json = do
obj <- decodeJson json
id <- obj .? "id"
typename <- obj .?| "typename"
userId <- obj .? "userId"
userId <- obj .?? "userId"
parentId <- obj .?| "parentId"
name <- obj .? "name"
name <- obj .?? "name"
date <- obj .?| "date"
hyperdata <- obj .? "hyperdata"
pure $ Contact { id, typename, userId
, parentId, name, date
, hyperdata
......@@ -61,7 +81,7 @@ data Action
type State =
{ activeTab :: Int
, contact :: Maybe (Contact Void Void)
, contact :: Maybe Contact
}
initialState :: State
......@@ -70,7 +90,7 @@ initialState =
, contact: Nothing
}
_contact :: Lens' State (Maybe (Contact Void Void))
_contact :: Lens' State (Maybe Contact)
_contact = lens (\s -> s.contact) (\s ss -> s{contact = ss})
_tablens :: Lens' State Tab.State
......
......@@ -3,12 +3,10 @@ module Gargantext.Pages.Corpus where
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (maybe)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import React as React
import React (ReactClass, ReactElement)
import React.DOM (div, h3, hr, i, p, text)
import React.DOM.Props (className, style)
import Thermite ( Render, Spec, createClass, defaultPerformAction, focus
, simpleSpec, noState )
--------------------------------------------------------
......@@ -16,9 +14,10 @@ import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Loader (createLoaderClass)
import Gargantext.Components.Table as Table
import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.Tabs.Types (CorpusInfo(..), corpusInfoDefault)
import Gargantext.Pages.Corpus.Tabs.Types (CorpusInfo(..))
import Gargantext.Pages.Corpus.Tabs.Types (Props) as Tabs
import Gargantext.Pages.Corpus.Tabs.States (State, initialState) as Tabs
import Gargantext.Pages.Corpus.Tabs.Actions (Action) as Tabs
......@@ -29,9 +28,9 @@ type Props = Tabs.Props
type State = { tabsView :: Tabs.State
}
initialState :: State
initialState = { tabsView : Tabs.initialState
}
initialState :: Props -> State
initialState _props =
{ tabsView : Tabs.initialState {} }
------------------------------------------------------------------------
_tabsView :: forall a b. Lens' { tabsView :: a | b } a
......@@ -66,44 +65,27 @@ corpusHeaderSpec = simpleSpec defaultPerformAction render
where
render :: Render {} Props Void
render dispatch {loaded} _ _ =
[ div [className "row"]
[ div [className "col-md-3"] [ h3 [] [text "Corpus " <> text title] ]
, div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
]
, div [className "row"] [ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}]
[ div [ className "col-md-8 content"]
[ p [] [ i [className "fa fa-globe"] []
, text $ " " <> corpus.desc
]
, p [] [ i [className "fab fa-searchengin"] []
, text $ " " <> corpus.query
]
]
, div [ className "col-md-4 content"]
[ p [] [ i [className "fa fa-calendar"] []
, text $ " " <> date'
]
, p [] [ i [className "fa fa-user"] []
, text $ " " <> corpus.authors
]
]
]
]
]
where
NodePoly { name: title
, date: date'
, hyperdata : CorpusInfo corpus
}
= maybe corpusInfoDefault identity loaded
Table.renderTableHeaderLayout
{ title: "Corpus " <> title
, desc: corpus.desc
, query: corpus.query
, date: date'
, user: corpus.authors
}
where
NodePoly { name: title
, date: date'
, hyperdata : CorpusInfo corpus
}
= loaded
------------------------------------------------------------------------
getCorpus :: Int -> Aff (NodePoly CorpusInfo)
getCorpus = get <<< toUrl Back Corpus
getCorpus = get <<< toUrl Back Corpus <<< Just
corpusLoaderClass :: ReactClass (Loader.Props Int (NodePoly CorpusInfo))
corpusLoaderClass = createLoaderClass "CorpusLoader" getCorpus
corpusLoader :: Loader.Props Int (NodePoly CorpusInfo) -> ReactElement
corpusLoader = React.createLeafElement corpusLoaderClass
corpusLoader :: Loader.Props' Int (NodePoly CorpusInfo) -> ReactElement
corpusLoader props = React.createElement corpusLoaderClass props []
module Gargantext.Pages.Corpus.Document where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (.??), (:=), (~>))
import Data.Generic.Rep (class Generic)
import Data.Lens (Lens', Prism', lens, prism, (?~))
import Data.Lens (Lens', lens, (?~))
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe)
import Data.Either (Either(..))
......@@ -22,12 +22,12 @@ import Gargantext.Components.Node (NodePoly(..))
type State =
{ document :: Maybe (NodePoly DocumentV3)
{ document :: Maybe (NodePoly Document)
, inputValue :: String
}
initialState :: State
initialState =
initialState :: {} -> State
initialState {} =
{ document : Nothing
, inputValue : ""
}
......@@ -99,22 +99,22 @@ data Document =
Document { abstract :: Maybe String
, authors :: Maybe String
, bdd :: Maybe String
, doi :: Maybe Int
, doi :: Maybe String
, language_iso2 :: Maybe String
, language_iso3 :: Maybe String
, page :: Maybe Int
-- , page :: Maybe Int
, publication_date :: Maybe String
, publication_second :: Maybe Int
, publication_minute :: Maybe Int
, publication_hour :: Maybe Int
, publication_day :: Maybe String
--, publication_second :: Maybe Int
--, publication_minute :: Maybe Int
--, publication_hour :: Maybe Int
, publication_day :: Maybe Int
, publication_month :: Maybe Int
, publication_year :: Maybe Int
, source :: Maybe String
, institutes :: Maybe String
, title :: Maybe String
, uniqId :: Maybe String
, url :: Maybe String
, text :: Maybe String
--, url :: Maybe String
--, text :: Maybe String
}
defaultNodeDocument :: NodePoly Document
......@@ -128,6 +128,7 @@ defaultNodeDocument =
, hyperdata : defaultDocument
}
-- TODO: BUG if DOI does not exist, page is not shown
defaultDocument :: Document
defaultDocument =
Document { abstract : Nothing
......@@ -135,20 +136,20 @@ defaultDocument =
, bdd : Nothing
, doi : Nothing
, language_iso2 : Nothing
, language_iso3 : Nothing
, page : Nothing
--, page : Nothing
, publication_date : Nothing
, publication_second : Nothing
, publication_minute : Nothing
, publication_hour : Nothing
--, publication_second : Nothing
--, publication_minute : Nothing
--, publication_hour : Nothing
, publication_day : Nothing
, publication_month : Nothing
, publication_year : Nothing
, source : Nothing
, institutes : Nothing
, title : Nothing
, uniqId : Nothing
, url : Nothing
, text : Nothing
--, url : Nothing
--, text : Nothing
}
derive instance genericDocument :: Generic Document _
......@@ -178,7 +179,7 @@ instance decodeDocumentV3 :: DecodeJson DocumentV3
where
decodeJson json = do
obj <- decodeJson json
abstract <- obj .? "abstract"
abstract <- obj .?? "abstract"
authors <- obj .? "authors"
--error <- obj .? "error"
language_iso2 <- obj .? "language_iso2"
......@@ -218,59 +219,60 @@ instance decodeDocument :: DecodeJson Document
where
decodeJson json = do
obj <- decodeJson json
abstract <- obj .? "abstract"
authors <- obj .? "authors"
bdd <- obj .? "bdd"
doi <- obj .? "doi"
language_iso2 <- obj .? "language_iso2"
language_iso3 <- obj .? "language_iso3"
page <- obj .? "page"
publication_date <- obj .? "publication_date"
publication_second <- obj .? "publication_second"
publication_minute <- obj .? "publication_minute"
publication_hour <- obj .? "publication_hour"
publication_day <- obj .? "publication_day"
publication_month <- obj .? "publication_month"
publication_year <- obj .? "publication_year"
source <- obj .? "source"
title <- obj .? "title"
uniqId <- obj .? "uniqId"
url <- obj .? "url"
text <- obj .? "text"
abstract <- obj .?? "abstract"
authors <- obj .?? "authors"
bdd <- obj .?? "bdd"
doi <- obj .?? "doi"
language_iso2 <- obj .?? "language_iso2"
-- page <- obj .?? "page"
publication_date <- obj .?? "publication_date"
--publication_second <- obj .?? "publication_second"
--publication_minute <- obj .?? "publication_minute"
--publication_hour <- obj .?? "publication_hour"
publication_day <- obj .?? "publication_day"
publication_month <- obj .?? "publication_month"
publication_year <- obj .?? "publication_year"
source <- obj .?? "sources"
institutes <- obj .?? "institutes"
title <- obj .?? "title"
uniqId <- obj .?? "uniqId"
--url <- obj .? "url"
--text <- obj .? "text"
pure $ Document { abstract
, authors
, bdd
, doi
, language_iso2
, language_iso3
, page
-- , page
, publication_date
, publication_second
, publication_minute
, publication_hour
--, publication_second
--, publication_minute
--, publication_hour
, publication_day
, publication_month
, publication_year
, source
, institutes
, title
, uniqId
, url
, text
--, url
--, text
}
------------------------------------------------------------------------
performAction :: PerformAction State {} Action
performAction (Load nId) _ _ = do
node <- lift $ getNode nId
node <- lift $ getNode (Just nId)
void $ modifyState $ _document ?~ node
logs $ "Node Document " <> show nId <> " fetched."
performAction (ChangeString ps) _ _ = pure unit
performAction (SetInput ps) _ _ = void <$> modifyState $ _ { inputValue = ps }
getNode :: Int -> Aff (NodePoly DocumentV3)
getNode :: Maybe Int -> Aff (NodePoly Document)
getNode = get <<< toUrl Back Node
_document :: Lens' State (Maybe (NodePoly DocumentV3))
_document :: Lens' State (Maybe (NodePoly Document))
_document = lens (\s -> s.document) (\s ss -> s{document = ss})
------------------------------------------------------------------------
......@@ -394,8 +396,8 @@ docview = simpleSpec performAction render
text' x = text $ maybe "Nothing" identity x
badge s = span [className "badge badge-default badge-pill"] [text s]
NodePoly {hyperdata : DocumentV3 document} =
maybe defaultNodeDocumentV3 identity state.document
NodePoly {hyperdata : Document document} =
maybe defaultNodeDocument identity state.document
aryPS :: Array String
aryPS = ["Map", "Main", "Stop"]
......
module Gargantext.Pages.Corpus.Graph where
import Gargantext.Prelude
import Affjax (defaultRequest, request)
import Affjax.ResponseFormat (printResponseFormatError)
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (decodeJson)
import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Config.REST (get)
import Gargantext.Utils (getter)
import Math (cos, sin)
import Partial.Unsafe (unsafePartial)
import React (ReactElement)
import React.DOM (a, br', button, div, form', input, li, li', menu, option, p, select, span, text, ul, ul')
import React.DOM.Props (_id, _type, checked, className, href, name, onChange, placeholder, style, title, value)
import React.DOM.Props (_id, _type, checked, className, href, name, onChange, onClick,placeholder, style, title, value)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Config.REST (get)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter)
data Action
= LoadGraph String
= LoadGraph Int
| SelectNode SelectedNode
| ShowSidePanel
newtype SelectedNode = SelectedNode {id :: String, label :: String}
......@@ -37,6 +46,7 @@ newtype State = State
, sigmaGraphData :: Maybe SigmaGraphData
, legendData :: Array Legend
, selectedNode :: Maybe SelectedNode
, showSidePanel :: Boolean
}
initialState :: State
......@@ -46,6 +56,7 @@ initialState = State
, sigmaGraphData : Nothing
, legendData : []
, selectedNode : Nothing
, showSidePanel : false
}
graphSpec :: Spec State {} Action
......@@ -54,19 +65,22 @@ graphSpec = simpleSpec performAction render
performAction :: PerformAction State {} Action
performAction (LoadGraph fp) _ _ = void do
_ <- logs fp
case fp of
"" -> do
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing}
_ -> do
_ <- modifyState \(State s) -> State s {filePath = fp, sigmaGraphData = Nothing}
gd <- lift $ getGraphData fp
_ <- modifyState \(State s) -> State s { sigmaGraphData = Nothing}
gd <- lift $ getNodes fp
-- TODO: here one might `catchError getGraphData` to visually empty the
-- graph.
modifyState \(State s) -> State s {filePath = fp, graphData = gd, sigmaGraphData = Just $ convert gd, legendData = getLegendData gd}
case gd of
Left err -> do
_ <- liftEffect $ log err
modifyState identity
Right resp -> modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp}
performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node}
performAction (ShowSidePanel) _ (State state) = void do
modifyState $ \(State s) -> State s {showSidePanel = not (state.showSidePanel) }
convert :: GraphData -> SigmaGraphData
convert (GraphData r) = SigmaGraphData { nodes, edges}
where
......@@ -87,18 +101,7 @@ convert (GraphData r) = SigmaGraphData { nodes, edges}
render :: Render State {} Action
render d p (State s) c =
[ select [ onChange $ \e -> d $ LoadGraph (unsafeCoerce e).target.value, value s.filePath]
[ option [value ""] [text ""]
, option [value "example_01_clean.json"] [text "example_01_clean.json"]
, option [value "example_01_conditional.json"] [text "example_01_conditional.json"]
, option [value "example_01_distributional.json"] [text "example_01_distributional.json"]
, option [value "example_02.json"] [text "example_02.json"]
, option [value "example_02_clean.json"] [text "example_02_clean.json"]
, option [value "example_03.json"] [text "example_03.json"]
, option [value "example_03_clean.json"] [text "example_03_clean.json"]
, option [value "imtNew.json"] [text "imtNew.json"]
-- , option [value "exemplePhyloBipartite.gexf"] [text "exemplePhyloBipartite.gexf"]
]
[
]
<>
case s.sigmaGraphData of
......@@ -271,7 +274,7 @@ specOld = simpleSpec performAction render'
render' :: Render State {} Action
render' d _ (State st) _ =
[ div [className "row"] [
div [className "col-md-12", style {marginTop : "21px", marginBottom : "21px"}]
div [className "col-md-12", style {marginBottom : "21px"}]
[ menu [_id "toolbar"]
[ ul'
[
......@@ -334,27 +337,15 @@ specOld = simpleSpec performAction render'
, li'
[ button [className "btn btn-primary"] [text "Save"] -- TODO: Implement Save!
]
]
]
]
]
, div [className "row"]
[ div [className "col-md-9"]
[ div [if (st.showSidePanel) then className "col-md-10" else className "col-md-11"]
[ div [style {border : "1px black solid", height: "90%"}] $
[ select [ onChange $ \e -> d $ LoadGraph (unsafeCoerce e).target.value
, value st.filePath
]
[ option [value ""] [text ""]
, option [value "example_01_clean.json"] [text "example_01_clean.json"]
, option [value "example_01_conditional.json"] [text "example_01_conditional.json"]
, option [value "example_01_distributional.json"] [text "example_01_distributional.json"]
, option [value "example_02.json"] [text "example_02.json"]
, option [value "example_02_clean.json"] [text "example_02_clean.json"]
, option [value "example_03.json"] [text "example_03.json"]
, option [value "example_03_clean.json"] [text "example_03_clean.json"]
, option [value "imtNew.json"] [text "imtNew.json"]
-- , option [value "exemplePhyloBipartite.gexf"] [text "exemplePhyloBipartite.gexf"]
]
[
]
<>
case st.sigmaGraphData of
......@@ -377,9 +368,11 @@ specOld = simpleSpec performAction render'
<>
if length st.legendData > 0 then [div [style {position : "absolute", bottom : "10px", border: "1px solid black", boxShadow : "rgb(0, 0, 0) 0px 2px 6px", marginLeft : "10px", padding: "16px"}] [dispLegend st.legendData]] else []
]
, div [className "col-md-3", style {border : "1px black solid", backgroundColor : "beige"}]
, button [onClick \_ -> d ShowSidePanel, className "btn btn-primary", style {right:"0px",position : "relative",zIndex:"1000"}] [text "show sidepanel"]
, if (st.showSidePanel) then
div [_id "sp-container",className "col-md-2", style {border : "1px black solid", backgroundColor : "beige", position:"absolute",right: "0px",top:"265px"}]
[ div [className "row"]
[ div [_id "sidepanel" , className "col-md-12", style {borderBottom : "1px solid black"}]
[ div [_id "sidepanel" , style {borderBottom : "1px solid black"}]
[ case st.selectedNode of
Nothing -> span [] []
Just selectedNode -> p [] [text $ "selected Node : " <> getter _.label selectedNode
......@@ -475,5 +468,31 @@ specOld = simpleSpec performAction render'
]
]
]
else
div [] [] -- ends sidepanel column here
]
]
getNodes :: Int -> Aff (Either String GraphData)
getNodes graphId = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/api/v1.0/graph/"<> show graphId
, responseFormat = ResponseFormat.json
, method = Left GET
, headers = []
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
......@@ -3,42 +3,27 @@ module Gargantext.Pages.Corpus.Tabs.Actions where
import Data.Lens (Prism', prism)
import Data.Either (Either(..))
import Data.Void (Void)
import Gargantext.Pages.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.Tabs.Sources as SV
import Gargantext.Pages.Corpus.Tabs.Authors as AV
import Gargantext.Pages.Corpus.Tabs.Terms as TV
import Gargantext.Pages.Corpus.Tabs.Ngrams.NgramsTable as NG
import Gargantext.Components.Tab as Tab
data Action
= DocviewA DV.Action
| SourceviewA SV.Action
| AuthorviewA AV.Action
| TermsviewA TV.Action
| TabViewA Tab.Action
= DocViewA DV.Action -- = Void
| NgramViewA Void -- NG.Action TODO needed ?
| TabViewA Tab.Action -- = ChangeTab which is only used locally
_docAction :: Prism' Action DV.Action
_docAction = prism DocviewA \ action ->
_docAction = prism DocViewA \ action ->
case action of
DocviewA laction -> Right laction
DocViewA laction -> Right laction
_-> Left action
_authorAction :: Prism' Action AV.Action
_authorAction = prism AuthorviewA \ action ->
_NgramViewA :: Prism' Action Void -- NG.Action
_NgramViewA = prism NgramViewA \ action ->
case action of
AuthorviewA laction -> Right laction
_-> Left action
_sourceAction :: Prism' Action SV.Action
_sourceAction = prism SourceviewA \ action ->
case action of
SourceviewA laction -> Right laction
_-> Left action
_termsAction :: Prism' Action TV.Action
_termsAction = prism TermsviewA \ action ->
case action of
TermsviewA laction -> Right laction
NgramViewA laction -> Right laction
_-> Left action
_tabAction :: Prism' Action Tab.Action
......
module Gargantext.Pages.Corpus.Tabs.Authors where
import Prelude hiding (div)
import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = {}
initialState :: State
initialState = {}
type Action = Void
authorSpec :: Spec State {} Action
authorSpec = simpleSpec defaultPerformAction render
where
render :: Render State {} Action
render dispatch _ state _ =
[ h3 [] [text "AuthorView"]]
This diff is collapsed.
module Gargantext.Pages.Corpus.Tabs.Sources where
import Prelude hiding (div)
import React.DOM (h3, text)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
type State = {}
initialState :: State
initialState = {}
type Action = Void
sourceSpec :: Spec State {} Action
sourceSpec = simpleSpec defaultPerformAction render
where
render :: Render State {} Action
render dispatch _ state _ =
[ h3 [] [text "Source view"]]
......@@ -6,39 +6,49 @@ import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Gargantext.Pages.Corpus.Tabs.Types (Props)
import Gargantext.Pages.Corpus.Tabs.States (State(), _doclens, _sourcelens, _authorlens, _termslens, _tablens, initialState)
import Gargantext.Pages.Corpus.Tabs.Actions (Action(), _docAction, _sourceAction, _authorAction, _termsAction, _tabAction)
import Gargantext.Pages.Corpus.Tabs.States (State(), _doclens, _ngramsView, _tablens, initialState)
import Gargantext.Pages.Corpus.Tabs.Actions (Action(), _docAction, _NgramViewA, _tabAction)
import Gargantext.Pages.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.Tabs.Sources as SV
import Gargantext.Pages.Corpus.Tabs.Authors as AV
import Gargantext.Pages.Corpus.Tabs.Terms as TV
import Gargantext.Pages.Corpus.Tabs.Ngrams.NgramsTable as NV
import Gargantext.Components.Tab as Tab
import Thermite (Spec, focus, hideState, cmapProps)
pureTabs :: Spec {} Props Void
pureTabs = hideState initialState statefulTabs
-- pureTabs :: Spec {} Props Void
-- pureTabs = hideState initialState statefulTabs
statefulTabs :: Spec State Props Action
statefulTabs =
Tab.tabs _tablens _tabAction $ fromFoldable [ Tuple "Documents" docPageSpec
, Tuple "Authors" authorPageSpec
, Tuple "Sources" sourcePageSpec
, Tuple "Institutes" institutesPageSpec
, Tuple "Terms" termsPageSpec
, Tuple "Trash" trashPageSpec
]
docPageSpec :: Spec State Props Action
docPageSpec = focus _doclens _docAction DV.layoutDocview
authorPageSpec :: Spec State Props Action
authorPageSpec = cmapProps (const {}) (focus _authorlens _authorAction AV.authorSpec)
<> docPageSpec
ngramsViewSpec :: {mode :: NV.Mode} -> Spec State Props Action
ngramsViewSpec {mode} =
cmapProps (\{loaded, path, dispatch} -> {mode,loaded,path, dispatch})
(focus _ngramsView _NgramViewA NV.ngramsTableSpec)
authorPageSpec :: Spec State Props Action
authorPageSpec = ngramsViewSpec {mode: NV.Authors}
sourcePageSpec :: Spec State Props Action
sourcePageSpec = cmapProps (const {}) (focus _sourcelens _sourceAction SV.sourceSpec)
<> docPageSpec
sourcePageSpec = ngramsViewSpec {mode: NV.Sources}
institutesPageSpec :: Spec State Props Action
institutesPageSpec = ngramsViewSpec {mode: NV.Institutes}
termsPageSpec :: Spec State Props Action
termsPageSpec = cmapProps (const {}) (focus _termslens _termsAction TV.termsSpec)
<> docPageSpec
termsPageSpec = ngramsViewSpec {mode: NV.Terms}
trashPageSpec :: Spec State Props Action
trashPageSpec = focus _doclens _docAction DV.layoutDocview
module Gargantext.Pages.Corpus.Tabs.States where
import Data.Lens (Lens', lens)
import Gargantext.Prelude
import Gargantext.Pages.Corpus.Tabs.Documents as D
import Gargantext.Pages.Corpus.Tabs.Sources as S
import Gargantext.Pages.Corpus.Tabs.Authors as A
import Gargantext.Pages.Corpus.Tabs.Terms as T
import Gargantext.Pages.Corpus.Tabs.Ngrams.NgramsTable as N
import Gargantext.Components.Tab as Tab
type State =
{ docsView :: D.State
, authorsView :: A.State
, sourcesView :: S.State
, termsView :: T.State
, ngramsView :: {} -- N.State TODO needed
, activeTab :: Int
}
initialState :: State
initialState =
{ docsView : D.initialState
, authorsView : A.initialState
, sourcesView : S.initialState
, termsView : T.initialState
, activeTab : 0
initialState :: {} -> State
initialState _ =
{ docsView :
{ documentIdsToDelete : mempty
}
, ngramsView : {} -- N.initialState
, activeTab : 0
}
_doclens :: Lens' State D.State
_doclens = lens (\s -> s.docsView) (\s ss -> s {docsView = ss})
_authorlens :: Lens' State A.State
_authorlens = lens (\s -> s.authorsView) (\s ss -> s {authorsView = ss})
_sourcelens :: Lens' State S.State
_sourcelens = lens (\s -> s.sourcesView) (\s ss -> s {sourcesView = ss})
_termslens :: Lens' State T.State
_termslens = lens (\s -> s.termsView) (\s ss -> s {termsView = ss})
_ngramsView :: Lens' State {} -- N.State
_ngramsView = lens (\s -> s.ngramsView) (\s ss -> s {ngramsView = ss})
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
module Gargantext.Pages.Corpus.Tabs.Terms where
import Data.Array (fold)
import Prelude hiding (div)
import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = {}
initialState :: State
initialState = {}
type Action = Void
termsSpec :: Spec State {} Action
termsSpec = simpleSpec defaultPerformAction render
where
render :: Render State {} Action
render dispatch _ state _ =
[ h3 [] [text "Terms view"]]
module Gargantext.Pages.Corpus.Tabs.Terms.NgramsItem where
import Prelude
import Data.Newtype (class Newtype, unwrap)
import Data.Lens.Iso (re)
import Data.Lens.Iso.Newtype (_Newtype)
import React (ReactElement)
import React.DOM (input, span, td, text, tr)
import React.DOM.Props (_type, checked, className, onChange, style, title)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec, hideState, focusState)
import Gargantext.Utils (getter, setter)
newtype State = State
{ term :: Term
}
derive instance newtypeState :: Newtype State _
initialState :: State
initialState = State {term : Term {id : 10, term : "hello", occurrence : 10, _type : None, children : []}}
newtype Term = Term {id :: Int, term :: String, occurrence :: Int, _type :: TermType, children :: Array Term}
derive instance newtypeTerm :: Newtype Term _
data TermType = MapTerm | StopTerm | None
derive instance eqTermType :: Eq TermType
instance showTermType :: Show TermType where
show MapTerm = "MapTerm"
show StopTerm = "StopTerm"
show None = "None"
data Action
= SetMap Boolean
| SetStop Boolean
ngramsItemSpec :: Spec {} {} Void
ngramsItemSpec = hideState (unwrap initialState) $
focusState (re _Newtype) $
simpleSpec performAction render
where
performAction :: PerformAction State {} Action
performAction (SetMap b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then MapTerm else None)}) s.term}
performAction (SetStop b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then StopTerm else None)}) s.term}
render :: Render State {} Action
render dispatch _ (State state) _ =
[
tr []
[ td [] [ checkbox_map]
, td [] [ checkbox_stop]
, td [] [ dispTerm (getter _.term state.term) (getter _._type state.term) ]
, td [] [ text $ show $ getter _.occurrence state.term]
]
]
where
checkbox_map =
input [ _type "checkbox"
, className "checkbox"
, checked $ getter _._type state.term == MapTerm
, title "Mark as completed"
, onChange $ dispatch <<< ( const $ SetMap $ not (getter _._type state.term == MapTerm))
]
checkbox_stop =
input
[ _type "checkbox"
, className "checkbox"
, checked $ getter _._type state.term == StopTerm
, title "Mark as completed"
, onChange $ dispatch <<< ( const $ SetStop $ not (getter _._type state.term == StopTerm))
]
dispTerm :: String -> TermType -> ReactElement
dispTerm term MapTerm = span [style {color :"green"}] [text $ term]
dispTerm term StopTerm = span [style {color :"red", textDecoration : "line-through"}] [text $ term]
dispTerm term None = span [style {color :"black"}] [text term]
......@@ -5,6 +5,7 @@ import Data.Maybe (Maybe(..))
--------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Loader as Loader
newtype CorpusInfo = CorpusInfo { title :: String
, desc :: String
......@@ -43,7 +44,8 @@ instance decodeCorpusInfo :: DecodeJson CorpusInfo where
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
-- TODO type Props = {nodeId :: Int, info :: Maybe (NodePoly CorpusInfo) }
type Props = {path :: Int, loaded :: Maybe (NodePoly CorpusInfo) }
type PropsRow = Loader.InnerPropsRow Int (NodePoly CorpusInfo) ()
type Props = Record PropsRow
-- TODO include Gargantext.Pages.Corpus.Tabs.States
-- TODO include Gargantext.Pages.Corpus.Tabs.Actions
......@@ -26,7 +26,7 @@ landingData FR = Fr.landingData
landingData EN = En.landingData
layoutLanding :: Lang -> Spec {} {} Void
layoutLanding = hideState (unwrap initialState)
layoutLanding = hideState (const $ unwrap initialState)
<<< focusState (re _Newtype)
<<< layoutLanding' <<< landingData
......
......@@ -11,7 +11,6 @@ import Gargantext.Pages.Corpus.Graph as GE
-- import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Annuaire as Annuaire
-- import Gargantext.Pages.Home as L
-- import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..))
......@@ -21,12 +20,10 @@ dispatchAction :: forall ignored m.
(Action -> m Unit) -> ignored -> Routes -> m Unit
dispatchAction dispatcher _ Home = do
dispatcher Initialize
dispatcher $ SetRoute Home
-- dispatcher $ LandingA TODO
dispatchAction dispatcher _ Login = do
dispatcher Initialize
dispatcher $ SetRoute Login
-- dispatcher $ LoginA TODO
......@@ -47,8 +44,7 @@ dispatchAction dispatcher _ (UserPage id) = do
dispatcher $ UserPageA $ C.FetchContact id
dispatchAction dispatcher _ (Annuaire id) = do
dispatcher $ SetRoute $ Annuaire id
dispatcher $ AnnuaireAction $ Annuaire.Load id
dispatcher $ SetRoute $ Annuaire id
dispatchAction dispatcher _ (Folder id) = do
dispatcher $ SetRoute $ Folder id
......@@ -57,13 +53,10 @@ dispatchAction dispatcher _ (Document n) = do
dispatcher $ SetRoute $ Document n
dispatcher $ DocumentViewA $ Document.Load n
dispatchAction dispatcher _ PGraphExplorer = do
dispatcher $ SetRoute PGraphExplorer
dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
dispatchAction dispatcher _ NGramsTable = do
dispatcher $ SetRoute NGramsTable
-- dispatcher $ NgramsA TODO
dispatchAction dispatcher _ (PGraphExplorer nid) = do
dispatcher $ SetRoute $ PGraphExplorer nid
dispatcher $ GraphExplorerA $ GE.LoadGraph nid
--dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
dispatchAction dispatcher _ Dashboard = do
dispatcher $ SetRoute Dashboard
......@@ -6,8 +6,9 @@ import Control.Monad.Cont.Trans (lift)
import Data.Either (Either(..))
import Data.Lens (Prism', prism)
import Effect.Class (liftEffect)
import Thermite (PerformAction, modifyState)
import Thermite (PerformAction, modifyState, modifyState_)
import Gargantext.Config (defaultRoot)
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree
......@@ -24,10 +25,8 @@ import Gargantext.Router (Routes)
------------------------------------------------------------------------
data Action
= Initialize
| LoginA LN.Action
= LoginA LN.Action
| SetRoute Routes
| TreeViewA Tree.Action
| SearchA S.Action
| Search String
| AddCorpusA AC.Action
......@@ -38,6 +37,7 @@ data Action
| Go
| ShowLogin
| ShowAddcorpus
| ShowTree
performAction :: PerformAction AppState {} Action
......@@ -46,6 +46,9 @@ performAction (SetRoute route) _ _ = void do
performAction (Search s) _ _ = void do
modifyState $ _ {search = s}
performAction (ShowTree) _ (state) = void do
modifyState $ _ {showTree = not (state.showTree)}
performAction (ShowLogin) _ _ = void do
liftEffect $ modalShow "loginModal"
modifyState $ _ {showLogin = true}
......@@ -63,21 +66,11 @@ performAction Go _ _ = void do
--modifyState id
---------------------------------------------------------
performAction Initialize _ state = void do
_ <- logs "loading Initial nodes"
case state.initialized of
false -> do
lnodes <- lift $ Tree.loadDefaultNode
void $ modifyState $ _ { initialized = true, ntreeState = lnodes }
_ -> do
pure unit
performAction (LoginA _) _ _ = pure unit
performAction (AddCorpusA _) _ _ = pure unit
performAction (SearchA _) _ _ = pure unit
performAction (UserPageA _) _ _ = pure unit
performAction (DocumentViewA _) _ _ = pure unit
performAction (TreeViewA _) _ _ = pure unit
performAction (GraphExplorerA _) _ _ = pure unit
performAction (AnnuaireAction _) _ _ = pure unit
......@@ -119,12 +112,6 @@ _documentViewAction = prism DocumentViewA \action ->
DocumentViewA caction -> Right caction
_-> Left action
_treeAction :: Prism' Action Tree.Action
_treeAction = prism TreeViewA \action ->
case action of
TreeViewA caction -> Right caction
_-> Left action
_graphExplorerAction :: Prism' Action GE.Action
_graphExplorerAction = prism GraphExplorerA \action ->
case action of
......
......@@ -11,6 +11,7 @@ import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, foc
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Config (defaultRoot)
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree
......@@ -21,12 +22,12 @@ import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Document as Annotation
import Gargantext.Pages.Corpus.Dashboard as Dsh
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.Tabs.Ngrams.NgramsTable as NG
import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _documentViewAction, _graphExplorerAction, _loginAction, _searchAction, _treeAction, _userPageAction, performAction, _annuaireAction)
import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _documentViewAction, _graphExplorerAction, _loginAction, _searchAction, _userPageAction, performAction)
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _documentViewState, _graphExplorerState, _loginState, _searchState, _treeState, _userPageState, _annuaireState)
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _documentViewState, _graphExplorerState, _loginState, _searchState, _userPageState)
import Gargantext.Router (Routes(..))
layoutSpec :: Spec AppState {} Action
......@@ -59,13 +60,11 @@ pagesComponent s = case s.currentRoute of
selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec (Document i) = layout0 $ focus _documentViewState _documentViewAction Annotation.docview
selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec (PGraphExplorer i) = layout1 $ focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire
selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser
-- To be removed
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender
......@@ -87,14 +86,17 @@ layout0 layout =
cont $ fold
[ withState \st ->
if ((\(LN.State s) -> s.loginC) st.loginState == true)
then ls as
then ls $ cmapProps (const {root: defaultRoot}) as
else outerLayout1
, rs bs ]
ls = over _render \render d p s c -> [ div [className "col-md-2" ] (render d p s c) ]
rs = over _render \render d p s c -> [ div [className "col-md-10"] (render d p s c) ]
, rs bs
]
ls = over _render \render d p s c -> [
div [ className "col-md-2"] (render d p s c)
]
rs = over _render \render d p s c -> [ div [ className "col-md-10"] (render d p s c) ]
cont = over _render \render d p s c -> [ div [className "row" ] (render d p s c) ]
as = focus _treeState _treeAction Tree.treeview
as = noState Tree.treeview
bs = innerLayout $ layout
......@@ -107,13 +109,56 @@ layout0 layout =
]
]
-- TODO avoid code duplication with layout0
layout1 :: Spec AppState {} Action
-> Spec AppState {} Action
layout1 layout =
fold
[ layoutSidebar divSearchBar
, outerLayout
, layoutFooter
]
where
outerLayout1 = simpleSpec defaultPerformAction defaultRender
outerLayout :: Spec AppState {} Action
outerLayout =
cont $ fold
[ withState \st ->
if ((\(LN.State s) -> s.loginC) st.loginState == true)
then ls $ cmapProps (const {root: defaultRoot}) as
else outerLayout1
, rs bs
]
ls = over _render \render d p s c -> [
button [onClick $ \e -> d ShowTree, className "btn btn-primary",style {position:"relative", top: "68px",left:"-264px",zIndex : "1000"}] [text "ShowTree"]
, div [if (s.showTree) then className "col-md-2" else className "col-md-2"] if (s.showTree) then (render d p s c) else []
]
rs = over _render \render d p s c -> [ div [if (s.showTree) then className "col-md-10" else className "col-md-12"] (render d p s c) ]
cont = over _render \render d p s c -> [ div [className "row" ] (render d p s c) ]
as = noState Tree.treeview
bs = innerLayout $ layout
innerLayout :: Spec AppState {} Action
-> Spec AppState {} Action
innerLayout = over _render \render d p s c ->
[ div [_id "page-wrapper"]
[
div [className "container-fluid"] (render d p s c)
]
]
layoutSidebar :: Spec AppState {} Action
-> Spec AppState {} Action
layoutSidebar = over _render \render d p s c ->
[ div [ _id "dafixedtop"
, className "navbar navbar-inverse navbar-fixed-top"
, role "navigation"
] [ div [className "container"]
] [ div [className "container-fluid"]
[ div [ className "navbar-inner" ]
[ divLogo
, div [ className "collapse navbar-collapse"]
......@@ -284,6 +329,7 @@ divDropdownRight d =
-- else
[text " Login / Signup"]
]
]
layoutFooter :: Spec AppState {} Action
......
......@@ -8,8 +8,6 @@ import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus.Document as D
import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
......@@ -20,17 +18,14 @@ type AppState =
{ currentRoute :: Maybe Routes
, loginState :: LN.State
, addCorpusState :: AC.State
, docViewState :: DV.State
, searchState :: S.State
, userPageState :: C.State
, documentState :: D.State
, annuaireState :: Annuaire.State
, ntreeState :: Tree.State
, search :: String
, showLogin :: Boolean
, showCorpus :: Boolean
, graphExplorerState :: GE.State
, initialized :: Boolean
, showTree :: Boolean
}
initAppState :: AppState
......@@ -38,17 +33,14 @@ initAppState =
{ currentRoute : Just Home
, loginState : LN.initialState
, addCorpusState : AC.initialState
, docViewState : DV.initialState
, searchState : S.initialState
, userPageState : C.initialState
, documentState : D.initialState
, ntreeState : Tree.exampleTree
, annuaireState : Annuaire.initialState
, documentState : D.initialState {}
, search : ""
, showLogin : false
, showCorpus : false
, graphExplorerState : GE.initialState
, initialized : false
, showTree : false
}
---------------------------------------------------------
......@@ -58,23 +50,14 @@ _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
_addCorpusState :: Lens' AppState AC.State
_addCorpusState = lens (\s -> s.addCorpusState) (\s ss -> s{addCorpusState = ss})
_docViewState :: Lens' AppState DV.State
_docViewState = lens (\s -> s.docViewState) (\s ss -> s{docViewState = ss})
_searchState :: Lens' AppState S.State
_searchState = lens (\s -> s.searchState) (\s ss -> s{searchState = ss})
_userPageState :: Lens' AppState C.State
_userPageState = lens (\s -> s.userPageState) (\s ss -> s{userPageState = ss})
_annuaireState :: Lens' AppState Annuaire.State
_annuaireState = lens (\s -> s.annuaireState) (\s ss -> s{annuaireState = ss})
_documentViewState :: Lens' AppState D.State
_documentViewState = lens (\s -> s.documentState) (\s ss -> s{documentState = ss})
_treeState :: Lens' AppState Tree.State
_treeState = lens (\s -> s.ntreeState) (\s ss -> s {ntreeState = ss})
_graphExplorerState :: Lens' AppState GE.State
_graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss})
......@@ -20,8 +20,7 @@ data Routes
| Corpus Int
| AddCorpus
| Document Int
| PGraphExplorer
| NGramsTable
| PGraphExplorer Int
| Dashboard
| Annuaire Int
| UserPage Int
......@@ -33,10 +32,9 @@ routing =
<|> AddCorpus <$ route "addCorpus"
<|> Folder <$> (route "folder" *> int)
<|> Corpus <$> (route "corpus" *> int)
<|> NGramsTable <$ route "ngrams"
<|> Document <$> (route "document" *> int)
<|> Document <$> (route "document" *> int)
<|> Dashboard <$ route "dashboard"
<|> PGraphExplorer <$ route "graph"
<|> PGraphExplorer <$> (route "graph" *> int )
<|> Annuaire <$> (route "annuaire" *> int)
<|> UserPage <$> (route "user" *> int)
<|> Home <$ lit ""
......@@ -52,13 +50,12 @@ instance showRoutes :: Show Routes where
show AddCorpus = "AddCorpus"
show SearchView = "Search"
show (UserPage i) = "User" <> show i
show (Document i)= "Document"
show (Document i) = "Document"
show (Corpus i) = "Corpus" <> show i
show NGramsTable = "NGramsTable"
show (Annuaire i) = "Annuaire" <> show i
show (Folder i) = "Folder" <> show i
show Dashboard = "Dashboard"
show PGraphExplorer = "graphExplorer"
show (PGraphExplorer i) = "graphExplorer" <> show i
show Home = "Home"
......
module Gargantext.Types where
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Maybe (Maybe(..))
import Gargantext.Prelude
data TermType = MonoTerm | MultiTerm
derive instance eqTermType :: Eq TermType
instance showTermType :: Show TermType where
show MonoTerm = "MonoTerm"
show MultiTerm = "MultiTerm"
readTermType :: String -> Maybe TermType
readTermType "MonoTerm" = Just MonoTerm
readTermType "MultiTerm" = Just MultiTerm
readTermType _ = Nothing
termTypes :: Array { desc :: String, mval :: Maybe TermType }
termTypes = [ { desc: "All types", mval: Nothing }
, { desc: "One-word terms", mval: Just MonoTerm }
, { desc: "Multi-word terms", mval: Just MultiTerm }
]
data TermList = GraphTerm | StopTerm | CandidateTerm
derive instance eqTermList :: Eq TermList
instance decodeJsonTermList :: DecodeJson TermList where
decodeJson json = pure GraphTerm -- TODO
type ListTypeId = Int
listTypeId :: TermList -> ListTypeId
listTypeId GraphTerm = 1
listTypeId StopTerm = 2
listTypeId CandidateTerm = 3
instance showTermList :: Show TermList where
show GraphTerm = "Graph"
show StopTerm = "Stop"
show CandidateTerm = "Candidate"
readTermList :: String -> Maybe TermList
readTermList "Graph" = Just GraphTerm
readTermList "Stop" = Just StopTerm
readTermList "Candidate" = Just CandidateTerm
readTermList _ = Nothing
termLists :: Array { desc :: String, mval :: Maybe TermList }
termLists = [ { desc: "All terms", mval: Nothing }
, { desc: "Graph terms", mval: Just GraphTerm }
, { desc: "Stop terms", mval: Just StopTerm }
, { desc: "Candidate terms", mval: Just CandidateTerm }
]
......@@ -24,7 +24,7 @@ setUnsafeComponentWillMount = unsafeSet "unsafeComponentWillMount"
main :: Effect Unit
main = do
case T.createReactSpec layoutSpec initAppState of
case T.createReactSpec layoutSpec (const initAppState) of
{ spec, dispatcher } -> void $ do
let setRouting this = void $ do
matches routing (routeHandler (dispatchAction (dispatcher this)))
......
This diff is collapsed.
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