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

[MERGE]

parents ebe7f7ef e307e00a
...@@ -40,7 +40,7 @@ getDocumentsJSON :: UserId ...@@ -40,7 +40,7 @@ getDocumentsJSON :: UserId
getDocumentsJSON uId pId = do getDocumentsJSON uId pId = do
mcId <- getClosestParentIdByType pId NodeCorpus mcId <- getClosestParentIdByType pId NodeCorpus
let cId = maybe (panic "[G.A.N.D.Export] Node has no parent") identity mcId let cId = maybe (panic "[G.A.N.D.Export] Node has no parent") identity mcId
docs <- runViewDocuments cId False Nothing Nothing Nothing Nothing docs <- runViewDocuments cId False Nothing Nothing Nothing Nothing Nothing
pure $ DocumentExport { _de_documents = mapFacetDoc <$> docs pure $ DocumentExport { _de_documents = mapFacetDoc <$> docs
, _de_garg_version = T.pack $ showVersion PG.version } , _de_garg_version = T.pack $ showVersion PG.version }
where where
......
...@@ -61,6 +61,7 @@ type TableApi = Summary "Table API" ...@@ -61,6 +61,7 @@ type TableApi = Summary "Table API"
:> QueryParam "offset" Int :> QueryParam "offset" Int
:> QueryParam "orderBy" OrderBy :> QueryParam "orderBy" OrderBy
:> QueryParam "query" Text :> QueryParam "query" Text
:> QueryParam "year" Text
:> Get '[JSON] (HashedResponse FacetTableResult) :> Get '[JSON] (HashedResponse FacetTableResult)
:<|> Summary "Table API (POST)" :<|> Summary "Table API (POST)"
:> ReqBody '[JSON] TableQuery :> ReqBody '[JSON] TableQuery
...@@ -106,14 +107,16 @@ getTableApi :: NodeId ...@@ -106,14 +107,16 @@ getTableApi :: NodeId
-> Maybe Int -> Maybe Int
-> Maybe OrderBy -> Maybe OrderBy
-> Maybe Text -> Maybe Text
-> Maybe Text
-> Cmd err (HashedResponse FacetTableResult) -> Cmd err (HashedResponse FacetTableResult)
getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery = do getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery mYear = do
printDebug "[getTableApi] mQuery" mQuery printDebug "[getTableApi] mQuery" mQuery
t <- getTable cId tabType mOffset mLimit mOrderBy mQuery printDebug "[getTableApi] mYear" mYear
t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
pure $ constructHashedResponse t pure $ constructHashedResponse t
postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
postTableApi cId (TableQuery o l order ft q) = case ft of postTableApi cId (TableQuery o l order ft q) = case ft of
Docs -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order) Docs -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order) Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
...@@ -121,7 +124,7 @@ postTableApi cId (TableQuery o l order ft q) = case ft of ...@@ -121,7 +124,7 @@ postTableApi cId (TableQuery o l order ft q) = case ft of
getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
getTableHashApi cId tabType = do getTableHashApi cId tabType = do
HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing Nothing
pure h pure h
searchInCorpus' :: CorpusId searchInCorpus' :: CorpusId
...@@ -143,10 +146,11 @@ getTable :: NodeId ...@@ -143,10 +146,11 @@ getTable :: NodeId
-> Maybe Limit -> Maybe Limit
-> Maybe OrderBy -> Maybe OrderBy
-> Maybe Text -> Maybe Text
-> Maybe Text
-> Cmd err FacetTableResult -> Cmd err FacetTableResult
getTable cId ft o l order query = do getTable cId ft o l order query year = do
docs <- getTable' cId ft o l order query docs <- getTable' cId ft o l order query year
docsCount <- runCountDocuments cId (ft == Just Trash) query docsCount <- runCountDocuments cId (ft == Just Trash) query year
pure $ TableResult { tr_docs = docs, tr_count = docsCount } pure $ TableResult { tr_docs = docs, tr_count = docsCount }
getTable' :: NodeId getTable' :: NodeId
...@@ -155,11 +159,12 @@ getTable' :: NodeId ...@@ -155,11 +159,12 @@ getTable' :: NodeId
-> Maybe Limit -> Maybe Limit
-> Maybe OrderBy -> Maybe OrderBy
-> Maybe Text -> Maybe Text
-> Maybe Text
-> Cmd err [FacetDoc] -> Cmd err [FacetDoc]
getTable' cId ft o l order query = getTable' cId ft o l order query year =
case ft of case ft of
(Just Docs) -> runViewDocuments cId False o l order query (Just Docs) -> runViewDocuments cId False o l order query year
(Just Trash) -> runViewDocuments cId True o l order query (Just Trash) -> runViewDocuments cId True o l order query year
(Just MoreFav) -> moreLike cId o l order IsFav (Just MoreFav) -> moreLike cId o l order IsFav
(Just MoreTrash) -> moreLike cId o l order IsTrash (Just MoreTrash) -> moreLike cId o l order IsTrash
x -> panic $ "not implemented in getTable: " <> (cs $ show x) x -> panic $ "not implemented in getTable: " <> (cs $ show x)
......
...@@ -44,10 +44,10 @@ getPriors :: HasDBid NodeType => FavOrTrash -> CorpusId -> Cmd err (Events Bool) ...@@ -44,10 +44,10 @@ getPriors :: HasDBid NodeType => FavOrTrash -> CorpusId -> Cmd err (Events Bool)
getPriors ft cId = do getPriors ft cId = do
docs_fav <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 2) docs_fav <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 2)
<$> runViewDocuments cId False Nothing Nothing Nothing Nothing <$> runViewDocuments cId False Nothing Nothing Nothing Nothing Nothing
docs_trash <- List.take (List.length docs_fav) docs_trash <- List.take (List.length docs_fav)
<$> runViewDocuments cId True Nothing Nothing Nothing Nothing <$> runViewDocuments cId True Nothing Nothing Nothing Nothing Nothing
let priors = priorEventsWith text (fav2bool ft) ( List.zip (repeat False) docs_fav let priors = priorEventsWith text (fav2bool ft) ( List.zip (repeat False) docs_fav
...@@ -62,7 +62,7 @@ moreLikeWith :: HasDBid NodeType ...@@ -62,7 +62,7 @@ moreLikeWith :: HasDBid NodeType
moreLikeWith cId o l order ft priors = do moreLikeWith cId o l order ft priors = do
docs_test <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 1) docs_test <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 1)
<$> runViewDocuments cId False o Nothing order Nothing <$> runViewDocuments cId False o Nothing order Nothing Nothing
let results = map fst let results = map fst
$ filter ((==) (Just $ not $ fav2bool ft) . snd) $ filter ((==) (Just $ not $ fav2bool ft) . snd)
......
...@@ -301,26 +301,28 @@ runViewDocuments :: HasDBid NodeType ...@@ -301,26 +301,28 @@ runViewDocuments :: HasDBid NodeType
-> Maybe Limit -> Maybe Limit
-> Maybe OrderBy -> Maybe OrderBy
-> Maybe Text -> Maybe Text
-> Maybe Text
-> Cmd err [FacetDoc] -> Cmd err [FacetDoc]
runViewDocuments cId t o l order query = do runViewDocuments cId t o l order query year = do
printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
runOpaQuery $ filterWith o l order sqlQuery runOpaQuery $ filterWith o l order sqlQuery
where where
sqlQuery = viewDocuments cId t (toDBid NodeDocument) query sqlQuery = viewDocuments cId t (toDBid NodeDocument) query year
runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
runCountDocuments cId t mQuery = do runCountDocuments cId t mQuery mYear = do
runCountOpaQuery sqlQuery runCountOpaQuery sqlQuery
where where
sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery mYear
viewDocuments :: CorpusId viewDocuments :: CorpusId
-> IsTrash -> IsTrash
-> NodeTypeId -> NodeTypeId
-> Maybe Text -> Maybe Text
-> Maybe Text
-> Select FacetDocRead -> Select FacetDocRead
viewDocuments cId t ntId mQuery = viewDocumentsQuery cId t ntId mQuery >>> proc (c, nc) -> do viewDocuments cId t ntId mQuery mYear = viewDocumentsQuery cId t ntId mQuery mYear >>> proc (c, nc) -> do
returnA -< FacetDoc { facetDoc_id = _cs_id c returnA -< FacetDoc { facetDoc_id = _cs_id c
, facetDoc_created = _cs_date c , facetDoc_created = _cs_date c
, facetDoc_title = _cs_name c , facetDoc_title = _cs_name c
...@@ -334,8 +336,9 @@ viewDocumentsQuery :: CorpusId ...@@ -334,8 +336,9 @@ viewDocumentsQuery :: CorpusId
-> IsTrash -> IsTrash
-> NodeTypeId -> NodeTypeId
-> Maybe Text -> Maybe Text
-> Maybe Text
-> Select (ContextSearchRead, NodeContextRead) -> Select (ContextSearchRead, NodeContextRead)
viewDocumentsQuery cId t ntId mQuery = proc () -> do viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
c <- queryContextSearchTable -< () c <- queryContextSearchTable -< ()
nc <- queryNodeContextTable -< () nc <- queryNodeContextTable -< ()
restrict -< c^.cs_id .== nc^.nc_context_id restrict -< c^.cs_id .== nc^.nc_context_id
...@@ -346,14 +349,20 @@ viewDocumentsQuery cId t ntId mQuery = proc () -> do ...@@ -346,14 +349,20 @@ viewDocumentsQuery cId t ntId mQuery = proc () -> do
let let
query = (fromMaybe "" mQuery) query = (fromMaybe "" mQuery)
year = (fromMaybe "" mYear)
iLikeQuery = T.intercalate "" ["%", query, "%"] iLikeQuery = T.intercalate "" ["%", query, "%"]
abstractLHS h = fromNullable (sqlStrictText "") abstractLHS h = fromNullable (sqlStrictText "")
$ toNullable h .->> (sqlStrictText "abstract") $ toNullable h .->> (sqlStrictText "abstract")
yearLHS h = fromNullable (sqlStrictText "")
$ toNullable h .->> (sqlStrictText "publication_year")
restrict -< restrict -<
if query == "" then sqlBool True if query == "" then sqlBool True
else ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery)) else ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
.|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery)) .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
restrict -<
if year == "" then sqlBool True
else (yearLHS (c^.cs_hyperdata)) .== (sqlStrictText year)
returnA -< (c, nc) returnA -< (c, nc)
......
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