Commit 71e71397 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FEAT] Node corpus : we can now write. TODO: hash perm url.

parent 98a290ef
......@@ -58,13 +58,13 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
case fst route of
Home -> forested $ homeLayout EN
Login -> login { sessions, backends, visible: showLogin }
Folder sid _ -> withSession sid $ \_ -> forested (folder {})
Folder sid _ -> withSession sid $ \_ -> forested (folder {})
Corpus sid nodeId -> withSession sid $ \_ -> forested $ corpusLayout { nodeId }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
Dashboard sid _nodeId -> withSession sid $ \session -> forested $ dashboardLayout {}
Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { nodeId, session }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
Dashboard sid _nodeId -> withSession sid $ \session -> forested $ dashboardLayout {}
Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { nodeId, session }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session }
ContactPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session }
CorpusDocument sid corpusId listId nodeId ->
withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
......
module Gargantext.Components.Nodes.Corpus where
import Prelude ((<<<))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.??))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Array (head)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, throwError)
......@@ -24,10 +24,9 @@ corpusLayoutCpt = R.staticComponent "G.P.Corpus.corpusLayout" cpt
where
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)."]
[ H.iframe { src: gargMd , width: "100%", height: "100%"} []
]
gargMd = "https://hackmd.iscpif.fr/g9Aah4iwQtCayIzsKQjA0Q#"
newtype CorpusInfo =
CorpusInfo
{ title :: String
......@@ -65,7 +64,7 @@ instance decodeCorpusInfo :: DecodeJson CorpusInfo where
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .?? "chart"
chart <- obj .:? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
......
......@@ -17,7 +17,6 @@ import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
......
......@@ -14,7 +14,7 @@ router = oneOf
, CorpusDocument <$> (route "corpus" *> sid) <*> int
<*> (lit "list" *> int)
<*> (lit "document" *> int)
, Corpus <$> (route "corpus" *> sid) <*> int
, Corpus <$> (route "corpus" *> sid) <*> int
, Document <$> (route "list" *> sid) <*> int
<*> (lit "document" *> int)
, Dashboard <$> (route "dashboard" *> sid) <*> int
......
......@@ -38,25 +38,25 @@ instance showAppRoute :: Show AppRoute where
show (Corpus s i) = "Corpus" <> show i <> " (" <> show s <> ")"
show (Document _ s i) = "Document" <> show i <> " (" <> show s <> ")"
show (CorpusDocument s _ _ i) = "CorpusDocument" <> show i <> " (" <> show s <> ")"
show (PGraphExplorer s i) = "graphExplorer" <> show i <> " (" <> show s <> ")"
show (Dashboard s i) = "Dashboard" <> show i <> " (" <> show s <> ")"
show (Texts s i) = "texts" <> show i <> " (" <> show s <> ")"
show (Lists s i) = "lists" <> show i <> " (" <> show s <> ")"
show (PGraphExplorer s i) = "graphExplorer" <> show i <> " (" <> show s <> ")"
show (Dashboard s i) = "Dashboard" <> show i <> " (" <> show s <> ")"
show (Texts s i) = "texts" <> show i <> " (" <> show s <> ")"
show (Lists s i) = "lists" <> show i <> " (" <> show s <> ")"
show (Annuaire s i) = "Annuaire" <> show i <> " (" <> show s <> ")"
show (UserPage s i) = "User" <> show i <> " (" <> show s <> ")"
show (ContactPage s i) = "Contact" <> show i <> " (" <> show s <> ")"
appPath :: AppRoute -> String
appPath Home = ""
appPath Login = "login"
appPath (Folder s i) = "folder/" <> show s <> "/" <> show i
appPath Home = ""
appPath Login = "login"
appPath (Folder s i) = "folder/" <> show s <> "/" <> show i
appPath (CorpusDocument s c l i) = "corpus/" <> show s <> "/" <> show c <> "/list/" <> show l <> "/document/" <> show i
appPath (Corpus s i) = "corpus/" <> show s <> "/" <> show i
appPath (Document s l i) = "list/" <> show s <> "/" <> show l <> "/document/" <> show i
appPath (Dashboard s i) = "dashboard/" <> show s <> "/" <> show i
appPath (PGraphExplorer s i) = "graph/" <> show s <> "/" <> show i
appPath (Texts s i) = "texts/" <> show s <> "/" <> show i
appPath (Lists s i) = "lists/" <> show s <> "/" <> show i
appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i
appPath (UserPage s i) = "user/" <> show s <> "/" <> show i
appPath (ContactPage s i) = "contact/" <> show s <> "/" <> show i
appPath (Corpus s i) = "corpus/" <> show s <> "/" <> show i
appPath (Document s l i) = "list/" <> show s <> "/" <> show l <> "/document/" <> show i
appPath (Dashboard s i) = "dashboard/" <> show s <> "/" <> show i
appPath (PGraphExplorer s i) = "graph/" <> show s <> "/" <> show i
appPath (Texts s i) = "texts/" <> show s <> "/" <> show i
appPath (Lists s i) = "lists/" <> show s <> "/" <> show i
appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i
appPath (UserPage s i) = "user/" <> show s <> "/" <> show i
appPath (ContactPage s i) = "contact/" <> show s <> "/" <> show i
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