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

[FIX] Type in Corpus.purs + cosmetics.

parent b457affa
...@@ -216,8 +216,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) [ ...@@ -216,8 +216,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) [
( [ text (name <> " ") ( [ text (name <> " ")
] ]
<> nodeOptionsView false <> nodeOptionsView false
<> (nodeOptionsRename d true) <> (nodeOptionsRename d false)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)] -- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
) )
] ]
] ]
...@@ -233,8 +233,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) a ...@@ -233,8 +233,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) a
map (toHtml d) ary map (toHtml d) ary
else [] else []
<> nodeOptionsView false <> nodeOptionsView false
<> (nodeOptionsRename d true) <> (nodeOptionsRename d false)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)] -- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
) )
] ]
......
...@@ -61,17 +61,17 @@ _termslens = lens (\s -> s.termsView) (\s ss -> s {termsView = ss}) ...@@ -61,17 +61,17 @@ _termslens = lens (\s -> s.termsView) (\s ss -> s {termsView = ss})
_tablens :: Lens' State Tab.State _tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss}) _tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Action = Load Int data Action = Load Int
| DocviewA D.Action | DocviewAction D.Action
| AuthorviewA A.Action | AuthorviewA A.Action
| SourceviewA S.Action | SourceviewA S.Action
| TermsviewA T.Action | TermsviewA T.Action
| TabViewA Tab.Action | TabViewA Tab.Action
_docAction :: Prism' Action D.Action _docAction :: Prism' Action D.Action
_docAction = prism DocviewA \ action -> _docAction = prism DocviewAction \ action ->
case action of case action of
DocviewA laction -> Right laction DocviewAction laction -> Right laction
_-> Left action _-> Left action
_authorAction :: Prism' Action A.Action _authorAction :: Prism' Action A.Action
...@@ -215,7 +215,7 @@ performAction (Load nId) _ _ = do ...@@ -215,7 +215,7 @@ performAction (Load nId) _ _ = do
(Left err) -> do (Left err) -> do
logs err logs err
logs $ "Node Corpus fetched." logs $ "Node Corpus fetched."
performAction (DocviewA a) _ _ = pure unit performAction (DocviewAction a) _ _ = pure unit
performAction (AuthorviewA _) _ _ = pure unit performAction (AuthorviewA _) _ _ = pure unit
performAction (SourceviewA _) _ _ = pure unit performAction (SourceviewA _) _ _ = pure unit
performAction (TabViewA _) _ _ = pure unit performAction (TabViewA _) _ _ = pure unit
......
...@@ -132,6 +132,7 @@ filterSpec = simpleSpec defaultPerformAction render ...@@ -132,6 +132,7 @@ filterSpec = simpleSpec defaultPerformAction render
, input [] , input []
]] ]]
-- | Main layout of the Documents Tab of a Corpus
layoutDocview :: Spec State {} Action layoutDocview :: Spec State {} Action
layoutDocview = simpleSpec performAction render layoutDocview = simpleSpec performAction render
where where
...@@ -168,14 +169,8 @@ layoutDocview = simpleSpec performAction render ...@@ -168,14 +169,8 @@ layoutDocview = simpleSpec performAction render
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (ChangePageSize ps) _ _ =
void $ modifyState $ changePageSize ps
performAction (ChangePage p) _ _ =
void $ modifyState \(TableData td) -> TableData
$ td { currentPage = p }
performAction (LoadData n) _ _ = do performAction (LoadData n) _ _ = do
logs "loading documents page"
res <- lift $ loadPage n res <- lift $ loadPage n
case res of case res of
Left err -> do Left err -> do
...@@ -186,9 +181,17 @@ performAction (LoadData n) _ _ = do ...@@ -186,9 +181,17 @@ performAction (LoadData n) _ _ = do
_ <- modifyState $ const resData _ <- modifyState $ const resData
pure unit pure unit
performAction (ChangePageSize ps) _ _ =
void $ modifyState $ changePageSize ps
performAction (ChangePage p) _ _ =
void $ modifyState \(TableData td) -> TableData
$ td { currentPage = p }
loadPage :: Int -> Aff (Either String CorpusTableData) loadPage :: Int -> Aff (Either String CorpusTableData)
loadPage n = do loadPage n = do
logs "loading documents page: loadPage"
res <- get $ toUrl Back Children n res <- get $ toUrl Back Children n
-- TODO: offset and limit -- TODO: offset and limit
-- res <- get "http://localhost:8008/corpus/472764/facet/documents/table?offset=0&limit=10" -- res <- get "http://localhost:8008/corpus/472764/facet/documents/table?offset=0&limit=10"
......
...@@ -43,7 +43,7 @@ dispatchAction dispatcher _ (DocView n) = do ...@@ -43,7 +43,7 @@ dispatchAction dispatcher _ (DocView n) = do
dispatchAction dispatcher _ (Corpus n) = do dispatchAction dispatcher _ (Corpus n) = do
dispatcher $ SetRoute $ Corpus n dispatcher $ SetRoute $ Corpus n
dispatcher $ CorpusAction $ Corpus.Load n dispatcher $ CorpusAction $ Corpus.Load n
dispatcher $ CorpusAction $ Corpus.DocviewA $ D.LoadData n dispatcher $ CorpusAction $ Corpus.DocviewAction $ D.LoadData n
dispatchAction dispatcher _ SearchView = do dispatchAction dispatcher _ SearchView = do
dispatcher $ SetRoute SearchView dispatcher $ SetRoute SearchView
......
...@@ -30,14 +30,14 @@ data Action ...@@ -30,14 +30,14 @@ data Action
= Initialize = Initialize
| LoginA LN.Action | LoginA LN.Action
| SetRoute Routes | SetRoute Routes
| AddCorpusA AC.Action
| DocViewA DV.Action
| SearchA S.Action
| Search String
| TreeViewA Tree.Action | TreeViewA Tree.Action
| CorpusAction Corpus.Action | CorpusAction Corpus.Action
| SearchA S.Action
| Search String
| AddCorpusA AC.Action
| DocViewA DV.Action
| GraphExplorerA GE.Action | GraphExplorerA GE.Action
| DocAnnotationViewA D.Action | DocAnnotationViewA D.Action
| AnnuaireAction Annuaire.Action | AnnuaireAction Annuaire.Action
| UserPageA U.Action | UserPageA U.Action
| Go | Go
......
...@@ -48,27 +48,27 @@ layoutSpec = ...@@ -48,27 +48,27 @@ layoutSpec =
(render d p s c) (render d p s c)
pagesComponent :: AppState -> Spec AppState {} Action pagesComponent :: AppState -> Spec AppState {} Action
pagesComponent s = pagesComponent s = case s.currentRoute of
case s.currentRoute of
Just route -> selectSpec route Just route -> selectSpec route
Nothing -> selectSpec Home Nothing -> selectSpec Home -- TODO add Error page here: url requested does not exist (with funny Garg image)
where where
selectSpec :: Routes -> Spec AppState {} Action selectSpec :: Routes -> Spec AppState {} Action
selectSpec (Corpus i) = layout0 $ focus _corpusState _corpusAction Corpus.layout
selectSpec Login = focus _loginState _loginAction LN.renderSpec
selectSpec Home = layout0 $ noState (L.layoutLanding EN) selectSpec Home = layout0 $ noState (L.layoutLanding EN)
selectSpec Login = focus _loginState _loginAction LN.renderSpec
selectSpec (Folder i) = layout0 $ noState F.layoutFolder
selectSpec (Corpus i) = layout0 $ focus _corpusState _corpusAction Corpus.layout
selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
selectSpec (DocView i) = layout0 $ focus _docViewState _docViewAction DV.layoutDocview
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction U.layoutUser
selectSpec (DocAnnotation i) = layout0 $ focus _docAnnotationViewState
_docAnnotationViewAction Annotation.docview
-- To be removed
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec selectSpec (DocAnnotation i) = layout0 $ focus _docAnnotationViewState _docAnnotationViewAction Annotation.docview
selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire
selectSpec (Folder i) = layout0 $ noState F.layoutFolder selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction U.layoutUser
-- To be removed
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec
selectSpec (DocView i) = layout0 $ focus _docViewState _docViewAction DV.layoutDocview
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender -- selectSpec _ = simpleSpec defaultPerformAction defaultRender
......
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