Commit 5eac69cc authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Graph FacetTable: OK for demo at EHESS with some Shuffled Portraits.

parent 94ba7eb9
...@@ -385,7 +385,7 @@ renderPage loaderDispatch { totalRecords, dispatch, container ...@@ -385,7 +385,7 @@ renderPage loaderDispatch { totalRecords, dispatch, container
] ]
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, div strikeIfDeleted [text date] , div strikeIfDeleted [text date]
, a (strikeIfDeleted <> [ href (toUrl Front Url_Document (Just id)) , a (strikeIfDeleted <> [ href (toUrl Front (ListDocument (Just listId)) (Just id))
, target "blank"]) , target "blank"])
[ text title ] [ text title ]
, div strikeIfDeleted [text source] , div strikeIfDeleted [text source]
......
...@@ -31,12 +31,14 @@ newtype Edge = Edge ...@@ -31,12 +31,14 @@ newtype Edge = Edge
derive instance newtypeEdge :: Newtype Edge _ derive instance newtypeEdge :: Newtype Edge _
type ListId = Int
type CorpusId = Int type CorpusId = Int
type CorpusLabel = String type CorpusLabel = String
newtype GraphSideCorpus = GraphSideCorpus newtype GraphSideCorpus = GraphSideCorpus
{ corpusId :: CorpusId { corpusId :: CorpusId
, corpusLabel :: CorpusLabel , corpusLabel :: CorpusLabel
, listId :: ListId
} }
newtype GraphData = GraphData newtype GraphData = GraphData
...@@ -54,6 +56,7 @@ newtype MetaData = MetaData ...@@ -54,6 +56,7 @@ newtype MetaData = MetaData
title :: String title :: String
, legend :: Array Legend , legend :: Array Legend
, corpusId :: Array Int , corpusId :: Array Int
, listId :: ListId
} }
...@@ -65,8 +68,9 @@ instance decodeJsonGraphData :: DecodeJson GraphData where ...@@ -65,8 +68,9 @@ instance decodeJsonGraphData :: DecodeJson GraphData where
-- TODO: sides -- TODO: sides
metadata <- obj .? "metadata" metadata <- obj .? "metadata"
corpusIds <- metadata .? "corpusId" corpusIds <- metadata .? "corpusId"
listId' <- metadata .? "listId"
metaData <- obj .? "metadata" metaData <- obj .? "metadata"
let side x = GraphSideCorpus { corpusId: x, corpusLabel: "Publications" } let side x = GraphSideCorpus { corpusId: x, corpusLabel: "Publications", listId : listId'}
let sides = side <$> corpusIds let sides = side <$> corpusIds
pure $ GraphData { nodes, edges, sides, metaData } pure $ GraphData { nodes, edges, sides, metaData }
...@@ -89,7 +93,8 @@ instance decodeJsonMetaData :: DecodeJson MetaData where ...@@ -89,7 +93,8 @@ instance decodeJsonMetaData :: DecodeJson MetaData where
title <- obj .? "title" title <- obj .? "title"
legend <- obj .? "legend" legend <- obj .? "legend"
corpusId <- obj .? "corpusId" corpusId <- obj .? "corpusId"
pure $ MetaData { title, legend, corpusId } listId <- obj .? "listId"
pure $ MetaData { title, legend, corpusId, listId}
instance decodeJsonLegend :: DecodeJson Legend where instance decodeJsonLegend :: DecodeJson Legend where
......
...@@ -165,6 +165,8 @@ pathUrl c (GetNgrams ...@@ -165,6 +165,8 @@ pathUrl c (GetNgrams
TabCorpus _ -> pathUrl c (NodeAPI Node) i TabCorpus _ -> pathUrl c (NodeAPI Node) i
_ -> pathUrl c (NodeAPI Url_Document) i _ -> pathUrl c (NodeAPI Url_Document) i
pathUrl c (ListDocument lId) dId =
pathUrl c (NodeAPI NodeList) lId <> "/document/" <> (show $ maybe 0 identity dId)
pathUrl c (PutNgrams t listid termList) i = pathUrl c (PutNgrams t listid termList) i =
pathUrl c (NodeAPI Node) i <> "/ngrams?ngramsType=" pathUrl c (NodeAPI Node) i <> "/ngrams?ngramsType="
...@@ -242,7 +244,6 @@ data NodeType = NodeUser ...@@ -242,7 +244,6 @@ data NodeType = NodeUser
| Tree | Tree
| NodeList | NodeList
instance showNodeType :: Show NodeType where instance showNodeType :: Show NodeType where
show NodeUser = "NodeUser" show NodeUser = "NodeUser"
show Annuaire = "Annuaire" show Annuaire = "Annuaire"
...@@ -330,6 +331,7 @@ data Path ...@@ -330,6 +331,7 @@ data Path
| PutNgrams TabType (Maybe ListId) (Maybe TermList) | PutNgrams TabType (Maybe ListId) (Maybe TermList)
-- ^ The name is not good. In particular this URL is used both in PUT and POST. -- ^ The name is not good. In particular this URL is used both in PUT and POST.
| NodeAPI NodeType | NodeAPI NodeType
| ListDocument (Maybe ListId)
| Search { {-id :: Int | Search { {-id :: Int
, query :: Array String , query :: Array String
,-} ,-}
......
...@@ -121,7 +121,7 @@ derive instance newtypeState :: Newtype State _ ...@@ -121,7 +121,7 @@ derive instance newtypeState :: Newtype State _
initialState :: State initialState :: State
initialState = State initialState = State
{ graphData : GraphData {nodes: [], edges: [], sides: [], metaData : Just $ MetaData{title : "", legend : [], corpusId : []}} { graphData : GraphData {nodes: [], edges: [], sides: [], metaData : Just $ MetaData{title : "", legend : [], corpusId : [], listId : 0}}
, filePath : "" , filePath : ""
, sigmaGraphData : Nothing , sigmaGraphData : Nothing
, legendData : [] , legendData : []
......
...@@ -27,9 +27,9 @@ pureTabs :: Spec {} Props Void ...@@ -27,9 +27,9 @@ pureTabs :: Spec {} Props Void
pureTabs = hideState (const {activeTab: 0}) statefulTabs pureTabs = hideState (const {activeTab: 0}) statefulTabs
tab :: forall props state. TextQuery -> GraphSideCorpus -> Tuple String (Spec state props Tab.Action) tab :: forall props state. TextQuery -> GraphSideCorpus -> Tuple String (Spec state props Tab.Action)
tab query (GraphSideCorpus {corpusId: nodeId, corpusLabel}) = tab query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) =
Tuple corpusLabel $ Tuple corpusLabel $
cmapProps (const {nodeId, listId: 0, query, chart, totalRecords: 4736, container}) $ cmapProps (const {nodeId, listId, query, chart, totalRecords: 4736, container}) $
noState docViewSpec noState docViewSpec
where where
-- TODO totalRecords: probably need to insert a corpusLoader. -- TODO totalRecords: probably need to insert a corpusLoader.
......
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