Commit 0df854d6 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Annuaire] Route of Table changed, need to adapt NodeContact type.

parent 1acb85b6
...@@ -105,6 +105,12 @@ pathUrl c (Tab t o l s) i = ...@@ -105,6 +105,12 @@ pathUrl c (Tab t o l s) i =
<> "&limit=" <> show l <> os <> "&limit=" <> show l <> os
where where
os = maybe "" (\x -> "&order=" <> show x) s os = maybe "" (\x -> "&order=" <> show x) s
pathUrl c (Children n o l s) i =
pathUrl c (NodeAPI Node) i <>
"/" <> "children?type=" <> show n <> "&offset=" <> show o
<> "&limit=" <> show l <> os
where
os = maybe "" (\x -> "&order=" <> show x) s
pathUrl c (Ngrams t listid) i = pathUrl c (Ngrams t listid) i =
pathUrl c (NodeAPI Node) i <> "/" <> "listGet?ngramsType=" <> show t <> listid' pathUrl c (NodeAPI Node) i <> "/" <> "listGet?ngramsType=" <> show t <> listid'
where where
...@@ -112,6 +118,9 @@ pathUrl c (Ngrams t listid) i = ...@@ -112,6 +118,9 @@ pathUrl c (Ngrams t listid) i =
pathUrl c Auth Nothing = c.prePath <> "auth" pathUrl c Auth Nothing = c.prePath <> "auth"
pathUrl c Auth (Just _) = "impossible" -- TODO better types pathUrl c Auth (Just _) = "impossible" -- TODO better types
pathUrl c (NodeAPI nt) i = c.prePath <> nodeTypeUrl nt <> (maybe "" (\i' -> "/" <> show i') i) pathUrl c (NodeAPI nt) i = c.prePath <> nodeTypeUrl nt <> (maybe "" (\i' -> "/" <> show i') i)
------------------------------------------------------------ ------------------------------------------------------------
class ToUrl a where class ToUrl a where
...@@ -130,7 +139,9 @@ instance toUrlPath :: ToUrl Path where ...@@ -130,7 +139,9 @@ instance toUrlPath :: ToUrl Path where
data NodeType = NodeUser data NodeType = NodeUser
| Annuaire | Annuaire
| NodeContact
| Corpus | Corpus
-- | NodeDocument
| CorpusV3 | CorpusV3
| Dashboard | Dashboard
| Url_Document | Url_Document
...@@ -142,9 +153,30 @@ data NodeType = NodeUser ...@@ -142,9 +153,30 @@ data NodeType = NodeUser
| Nodes | Nodes
| Tree | Tree
instance showNodeType :: Show NodeType where
show NodeUser = "NodeUser"
show Annuaire = "Annuaire"
show NodeContact = "NodeDocument"
show Corpus = "NodeCorpus"
show CorpusV3 = "NodeCorpusV3"
show Dashboard = "NodeDashboard"
show Url_Document = "NodeDashboard"
--show NodeDocument = "NodeDocument"
show Error = "NodeError"
show Folder = "NodeFolder"
show Graph = "NodeGraph"
show Individu = "NodeIndividu"
show Node = "Node"
show Nodes = "Nodes"
show Tree = "NodeTree"
data Path data Path
= Auth = Auth
| Tab TabType Offset Limit (Maybe OrderBy) | Tab TabType Offset Limit (Maybe OrderBy)
| Children NodeType Offset Limit (Maybe OrderBy)
| Ngrams TabType (Maybe TermList) | Ngrams TabType (Maybe TermList)
| NodeAPI NodeType | NodeAPI NodeType
...@@ -193,22 +225,24 @@ nodeTypeUrl Individu = "individu" ...@@ -193,22 +225,24 @@ nodeTypeUrl Individu = "individu"
nodeTypeUrl Node = "node" nodeTypeUrl Node = "node"
nodeTypeUrl Nodes = "nodes" nodeTypeUrl Nodes = "nodes"
nodeTypeUrl NodeUser = "user" nodeTypeUrl NodeUser = "user"
nodeTypeUrl NodeContact = "contact"
nodeTypeUrl Tree = "tree" nodeTypeUrl Tree = "tree"
readNodeType :: String -> NodeType readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeDashboard" = Dashboard readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = Graph readNodeType "NodeGraph" = Graph
readNodeType "Individu" = Individu readNodeType "Individu" = Individu
readNodeType "Node" = Node readNodeType "Node" = Node
readNodeType "Nodes" = Nodes readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3 readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser readNodeType "NodeUser" = NodeUser
readNodeType "Tree" = Tree readNodeType "NodeContact" = NodeContact
readNodeType _ = Error readNodeType "Tree" = Tree
readNodeType _ = Error
{- {-
------------------------------------------------------------ ------------------------------------------------------------
instance ordNodeType :: Ord NodeType where instance ordNodeType :: Ord NodeType where
......
...@@ -168,7 +168,7 @@ renderContactCells :: Maybe Contact -> Array ReactElement ...@@ -168,7 +168,7 @@ renderContactCells :: Maybe Contact -> Array ReactElement
renderContactCells Nothing = [] renderContactCells Nothing = []
renderContactCells (Just (Contact { id, hyperdata : (HyperdataContact contact) })) = renderContactCells (Just (Contact { id, hyperdata : (HyperdataContact contact) })) =
[ text "" [ text ""
, a [ href (toUrl Front NodeUser (Just id)) ] [ text $ maybe "name" identity contact.title ] , a [ href (toUrl Front NodeContact (Just id)) ] [ text $ maybe "name" identity contact.title ]
, text $ maybe "ecole" identity contact.source , text $ maybe "ecole" identity contact.source
, text "" -- $ maybe' contact.groupe , text "" -- $ maybe' contact.groupe
, text "" -- $ maybe' contact.groupe , text "" -- $ maybe' contact.groupe
...@@ -226,7 +226,7 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where ...@@ -226,7 +226,7 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
pure $ AnnuaireTable { annuaireTable : rows} pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------ ------------------------------------------------------------------------
loadPage :: PageParams -> Aff AnnuaireTable loadPage :: PageParams -> Aff AnnuaireTable
loadPage {nodeId, params} = get $ toUrl Back (Tab TabDocs 0 10 Nothing) (Just nodeId) loadPage {nodeId, params} = get $ toUrl Back (Children NodeContact 0 10 Nothing) (Just nodeId)
-- TODO Tab TabDocs is not the right API call -- TODO Tab TabDocs is not the right API call
-- TODO params, see loadPage in Documents -- TODO params, see loadPage in Documents
......
...@@ -12,7 +12,7 @@ import Data.Unfoldable (class Unfoldable) ...@@ -12,7 +12,7 @@ import Data.Unfoldable (class Unfoldable)
import Prelude (identity) import Prelude (identity)
import Prelude (($), (<<<), (<$>), flip, class Ord) import Prelude (($), (<<<), (<$>), flip, class Ord)
import React (ReactElement) import React (ReactElement)
import React.DOM (div, h3, img, li, span, text, ul) import React.DOM (div, h3, img, li, span, text, ul, text)
import React.DOM.Props (_id, className, src) import React.DOM.Props (_id, className, src)
import Thermite (Render) import Thermite (Render)
...@@ -38,7 +38,8 @@ display title elems = ...@@ -38,7 +38,8 @@ display title elems =
[ div [className "col-md-12"] [ div [className "col-md-12"]
[ div [className "row"] [ div [className "row"]
[ div [className "col-md-2"] [ div [className "col-md-2"]
[ img [src "/images/Gargantextuel-212x300.jpg"] ] [ ]
-- [ img [src "/images/Gargantextuel-212x300.jpg"] ]
, div [className "col-md-1"] [] , div [className "col-md-1"] []
, div [className "col-mdData.Unfoldable-8"] elems , div [className "col-mdData.Unfoldable-8"] elems
] ]
...@@ -56,8 +57,8 @@ mapMyMap f m = toUnfoldable ...@@ -56,8 +57,8 @@ mapMyMap f m = toUnfoldable
infixl 4 mapMyMap as <.~$> infixl 4 mapMyMap as <.~$>
contactInfos :: HyperdataContact -> ReactElement contactInfos :: HyperdataContact -> ReactElement
contactInfos hyperdata = contactInfos (HyperdataContact hyperdata) =
ul [className "list-group"] [] {- $ ul [className "list-group"] (infoRender (Tuple "Name" $ maybe "no title" identity hyperdata.role)) {- $
listInfo <.~$> hyperdata listInfo <.~$> hyperdata
where where
checkMaybe (Nothing) = empty checkMaybe (Nothing) = empty
...@@ -72,6 +73,6 @@ listElement = li [className "list-group-item justify-content-between"] ...@@ -72,6 +73,6 @@ listElement = li [className "list-group-item justify-content-between"]
infoRender :: Tuple String String -> Array ReactElement infoRender :: Tuple String String -> Array ReactElement
infoRender (Tuple title content) = infoRender (Tuple title content) =
[ span [] [text title] [ span [className "badge badge-default badge-pill"] [text title]
, span [className "badge badge-default badge-pill"] [text content] , span [] [text content]
] ]
...@@ -30,6 +30,7 @@ data HyperdataContact = ...@@ -30,6 +30,7 @@ data HyperdataContact =
, uniqIdBdd :: Maybe String , uniqIdBdd :: Maybe String
, title :: Maybe String , title :: Maybe String
, source :: Maybe String , source :: Maybe String
, role :: Maybe String
} }
instance decodeHyperdataContact :: DecodeJson HyperdataContact instance decodeHyperdataContact :: DecodeJson HyperdataContact
...@@ -41,7 +42,8 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact ...@@ -41,7 +42,8 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
uniqIdBdd <- obj .?? "uniqIdBdd" uniqIdBdd <- obj .?? "uniqIdBdd"
title <- obj .?? "title" title <- obj .?? "title"
source <- obj .?? "source" source <- obj .?? "source"
pure $ HyperdataContact {bdd, uniqId, uniqIdBdd, title, source} role <- obj .?? "role"
pure $ HyperdataContact {bdd, uniqId, uniqIdBdd, title, source, role}
data HyperData c s = data HyperData c s =
......
...@@ -43,6 +43,11 @@ dispatchAction dispatcher _ (UserPage id) = do ...@@ -43,6 +43,11 @@ dispatchAction dispatcher _ (UserPage id) = do
-- dispatcher $ UserPageA TODO -- dispatcher $ UserPageA TODO
dispatcher $ UserPageA $ C.FetchContact id dispatcher $ UserPageA $ C.FetchContact id
dispatchAction dispatcher _ (ContactPage id) = do
dispatcher $ SetRoute $ ContactPage id
-- dispatcher $ UserPageA TODO
dispatcher $ UserPageA $ C.FetchContact id
dispatchAction dispatcher _ (Annuaire id) = do dispatchAction dispatcher _ (Annuaire id) = do
dispatcher $ SetRoute $ Annuaire id dispatcher $ SetRoute $ Annuaire id
......
...@@ -58,12 +58,13 @@ pagesComponent s = case s.currentRoute of ...@@ -58,12 +58,13 @@ pagesComponent s = case s.currentRoute of
selectSpec (Corpus i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout selectSpec (Corpus i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout
selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec (Document i) = layout0 $ focus _documentViewState _documentViewAction Annotation.docview selectSpec (Document i) = layout0 $ focus _documentViewState _documentViewAction Annotation.docview
selectSpec (PGraphExplorer i) = layout1 $ focus _graphExplorerState _graphExplorerAction GE.specOld selectSpec (PGraphExplorer i)= layout1 $ focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser
selectSpec (ContactPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender -- selectSpec _ = simpleSpec defaultPerformAction defaultRender
......
...@@ -24,6 +24,7 @@ data Routes ...@@ -24,6 +24,7 @@ data Routes
| Dashboard | Dashboard
| Annuaire Int | Annuaire Int
| UserPage Int | UserPage Int
| ContactPage Int
routing :: Match Routes routing :: Match Routes
routing = routing =
...@@ -37,6 +38,7 @@ routing = ...@@ -37,6 +38,7 @@ routing =
<|> PGraphExplorer <$> (route "graph" *> int ) <|> PGraphExplorer <$> (route "graph" *> int )
<|> Annuaire <$> (route "annuaire" *> int) <|> Annuaire <$> (route "annuaire" *> int)
<|> UserPage <$> (route "user" *> int) <|> UserPage <$> (route "user" *> int)
<|> ContactPage <$> (route "contact" *> int)
<|> Home <$ lit "" <|> Home <$ lit ""
where where
...@@ -50,6 +52,7 @@ instance showRoutes :: Show Routes where ...@@ -50,6 +52,7 @@ instance showRoutes :: Show Routes where
show AddCorpus = "AddCorpus" show AddCorpus = "AddCorpus"
show SearchView = "Search" show SearchView = "Search"
show (UserPage i) = "User" <> show i show (UserPage i) = "User" <> show i
show (ContactPage i) = "Contact" <> show i
show (Document i) = "Document" show (Document i) = "Document"
show (Corpus i) = "Corpus" <> show i show (Corpus i) = "Corpus" <> show i
show (Annuaire i) = "Annuaire" <> show i show (Annuaire i) = "Annuaire" <> 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