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

[TREE] Rest.

parent 6b1c237c
...@@ -63,7 +63,6 @@ backProd v = { proto : "https://" ...@@ -63,7 +63,6 @@ backProd v = { proto : "https://"
} }
------------------------------------------------------------------------ ------------------------------------------------------------------------
type EndConfig = { front :: Config type EndConfig = { front :: Config
, back :: Config , back :: Config
} }
...@@ -90,7 +89,6 @@ endBaseUrl Front c = baseUrl c.front ...@@ -90,7 +89,6 @@ endBaseUrl Front c = baseUrl c.front
baseUrl :: Config -> UrlBase baseUrl :: Config -> UrlBase
baseUrl conf = conf.proto <> conf.domain <> ":" <> show conf.port baseUrl conf = conf.proto <> conf.domain <> ":" <> show conf.port
------------------------------------------------------------ ------------------------------------------------------------
endPathUrl :: End -> EndConfig -> NodeType -> Id -> UrlPath endPathUrl :: End -> EndConfig -> NodeType -> Id -> UrlPath
endPathUrl Back c nt i = pathUrl c.back nt i endPathUrl Back c nt i = pathUrl c.back nt i
endPathUrl Front c nt i = pathUrl c.front nt i endPathUrl Front c nt i = pathUrl c.front nt i
...@@ -98,15 +96,24 @@ endPathUrl Front c nt i = pathUrl c.front nt i ...@@ -98,15 +96,24 @@ endPathUrl Front c nt i = pathUrl c.front nt i
pathUrl :: Config -> NodeType -> Id -> UrlPath pathUrl :: Config -> NodeType -> Id -> UrlPath
pathUrl c nt i = c.prePath <> urlConfig nt <> "/" <> show i pathUrl c nt i = c.prePath <> urlConfig nt <> "/" <> show i
------------------------------------------------------------ ------------------------------------------------------------
toUrl :: End -> NodeType -> Id -> Url toUrl :: End -> NodeType -> Id -> Url
toUrl e nt i = doUrl base path params toUrl e nt i = doUrl base path params
where where
base = endBaseUrl e endConfig base = endBaseUrl e endConfig
path = endPathUrl e endConfig nt i path = endPathUrl e endConfig nt i
params = "" params = ""
------------------------------------------------------------ ------------------------------------------------------------
data NodeType = UserPage | Folder | Corpus | Document | Annuaire | Individu | Project | Tree | Error data NodeType = NodeUser
| Annuaire
| Corpus
| Dashboard
| Document
| Folder
| Graph
| Individu
| Project
| Tree
| Error
data End = Back | Front data End = Back | Front
type Id = Int type Id = Int
------------------------------------------------------------ ------------------------------------------------------------
...@@ -117,35 +124,41 @@ instance showApiVersion :: Show ApiVersion where ...@@ -117,35 +124,41 @@ instance showApiVersion :: Show ApiVersion where
------------------------------------------------------------ ------------------------------------------------------------
------------------------------------------------------------ ------------------------------------------------------------
urlConfig :: NodeType -> Url urlConfig :: NodeType -> Url
urlConfig UserPage = "user" urlConfig NodeUser = show NodeUser
urlConfig Corpus = show Corpus urlConfig Annuaire = show Annuaire
urlConfig Project = show Project urlConfig Corpus = show Corpus
urlConfig Project = show Project urlConfig Dashboard = show Dashboard
urlConfig Document = show Document urlConfig Document = show Document
urlConfig Annuaire = show Annuaire urlConfig Folder = show Folder
urlConfig Individu = show Individu urlConfig Graph = show Graph
urlConfig Tree = show Tree urlConfig Individu = show Individu
urlConfig _ = "error Url Config with That Node Type" urlConfig Project = show Project
urlConfig Tree = show Tree
urlConfig Error = show Error
------------------------------------------------------------ ------------------------------------------------------------
instance showNodeType :: Show NodeType where instance showNodeType :: Show NodeType where
show UserPage = "user" show NodeUser = "user"
show Project = "project" show Annuaire = "annuaire"
show Folder = "folder" show Corpus = "corpus"
show Corpus = "corpus" show Dashboard = "dashboard"
show Document = "document" show Document = "document"
show Annuaire = "annuaire" show Folder = "folder"
show Individu = "individu" show Graph = "graph"
show Tree = "tree" show Individu = "individu"
show Error = "errNodeType" show Project = "project"
show Tree = "tree"
show Error = "ErrorShowNodeType"
readNodeType :: String -> NodeType readNodeType :: String -> NodeType
readNodeType "NodeUser" = UserPage readNodeType "NodeUser" = NodeUser
readNodeType "Project" = Project
readNodeType "Folder" = Folder
readNodeType "NodeCorpus" = Corpus readNodeType "NodeCorpus" = Corpus
readNodeType "Document" = Document
readNodeType "Annuaire" = Annuaire readNodeType "Annuaire" = Annuaire
readNodeType "Dashboard" = Dashboard
readNodeType "Document" = Document
readNodeType "Folder" = Folder
readNodeType "Graph" = Graph
readNodeType "Individu" = Individu readNodeType "Individu" = Individu
readNodeType "Project" = Project
readNodeType "Tree" = Tree readNodeType "Tree" = Tree
readNodeType _ = Error readNodeType _ = Error
------------------------------------------------------------ ------------------------------------------------------------
......
...@@ -271,7 +271,7 @@ showRow {row : (Corpus c), delete} = ...@@ -271,7 +271,7 @@ showRow {row : (Corpus c), delete} =
[ td [] [div [className $ fa <> "fa-star"][]] [ td [] [div [className $ fa <> "fa-star"][]]
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, td [] [text c.date] , td [] [text c.date]
, td [] [ a [ if c.fav == true then href "#/userPage" else href "#/documentView/1" ] [ text c.title ] ] , td [] [ a [ if c.fav == true then href "#/user" else href "#/document/1" ] [ text c.title ] ]
, td [] [text c.source] , td [] [text c.source]
, td [] [input [ _type "checkbox"]] , td [] [input [ _type "checkbox"]]
] ]
......
...@@ -55,7 +55,7 @@ routing = ...@@ -55,7 +55,7 @@ routing =
<|> DocView <$ route "docView" <|> DocView <$ route "docView"
<|> AddCorpus <$ route "addCorpus" <|> AddCorpus <$ route "addCorpus"
<|> CorpusAnalysis <$ route "corpus" <|> CorpusAnalysis <$ route "corpus"
<|> PGraphExplorer <$ route "graphExplorer" <|> PGraphExplorer <$ route "graph"
<|> NGramsTable <$ route "ngrams" <|> NGramsTable <$ route "ngrams"
<|> Dashboard <$ route "dashboard" <|> Dashboard <$ route "dashboard"
<|> Home <$ lit "" <|> Home <$ lit ""
......
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