Commit 249321f5 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[API] Search uniform table for docs and contact (WIP)

parent acd2ea75
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.Category where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>), encodeJson)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.List as L
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Ord.Down (Down(..))
import Data.Set (Set)
import Data.Set as Set
import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Utils.List (sortWith) as L
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, get, delete, put)
import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabType, showTabType')
import Gargantext.Utils.CacheAPI as GUC
------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite
categories :: Array Category
categories = [Trash, UnRead, Checked, Topic, Favorite]
derive instance genericFavorite :: Generic Category _
instance showCategory :: Show Category where
show = genericShow
instance eqCategory :: Eq Category where
eq = genericEq
instance decodeJsonCategory :: DecodeJson Category where
decodeJson json = do
obj <- decodeJson json
pure $ decodeCategory obj
instance encodeJsonCategory :: EncodeJson Category where
encodeJson cat = encodeJson (cat2score cat)
favCategory :: Category -> Category
favCategory Favorite = Topic
favCategory _ = Favorite
trashCategory :: Category -> Category
trashCategory _ = Trash
-- TODO: ?
--trashCategory Trash = UnRead
decodeCategory :: Int -> Category
decodeCategory 0 = Trash
decodeCategory 1 = UnRead
decodeCategory 2 = Checked
decodeCategory 3 = Topic
decodeCategory 4 = Favorite
decodeCategory _ = UnRead
cat2score :: Category -> Int
cat2score Trash = 0
cat2score UnRead = 1
cat2score Checked = 2
cat2score Topic = 3
cat2score Favorite = 4
-- caroussel :: Category -> R.Element
caroussel session nodeId setLocalCategories r cat = H.div {className:"flex"} divs
where
divs = map (\c -> if cat == c
then
H.div { className : icon c (cat == c) } []
else
H.div { className : icon c (cat == c)
, on: { click: onClick c}
} []
) (caroussel' cat)
caroussel' :: Category -> Array Category
caroussel' Trash = A.take 2 categories
caroussel' c = A.take 3 $ A.drop (cat2score c - 1 ) categories
onClick c = \_-> do
setLocalCategories $ Map.insert r._id c
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
icon :: Category -> Boolean -> String
icon cat b = btn b $ "glyphicon glyphicon-" <> (color $ size b $ icon' cat b)
where
icon' :: Category -> Boolean -> String
icon' Trash false = "remove"
icon' Trash true = "remove-sign"
icon' UnRead true = "question-sign"
icon' UnRead false = "question-sign"
icon' Checked true = "ok-sign"
icon' Checked false = "ok"
icon' Topic true = "star"
icon' Topic false = "star-empty"
icon' Favorite true = "heart"
icon' Favorite false = "heart-empty"
size :: Boolean -> String -> String
size true s = s <> " btn-lg"
size false s = s <> " btn-xs"
color :: String -> String
color x = x <> " text-primary"
btn :: Boolean -> String -> String
btn true s = s
btn false s = "btn " <> s
newtype CategoryQuery = CategoryQuery {
nodeIds :: Array Int
, category :: Category
}
instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
encodeJson (CategoryQuery post) =
"ntc_nodesId" := post.nodeIds
~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject
categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put session $ categoryRoute nodeId
...@@ -28,7 +28,7 @@ import Reactix as R ...@@ -28,7 +28,7 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Category
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoaderWithCacheAPI, HashedResponse(..)) import Gargantext.Hooks.Loader (useLoaderWithCacheAPI, HashedResponse(..))
...@@ -41,117 +41,6 @@ import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabType, showTa ...@@ -41,117 +41,6 @@ import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabType, showTa
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite
categories :: Array Category
categories = [Trash, UnRead, Checked, Topic, Favorite]
derive instance genericFavorite :: Generic Category _
instance showCategory :: Show Category where
show = genericShow
instance eqCategory :: Eq Category where
eq = genericEq
instance decodeJsonCategory :: DecodeJson Category where
decodeJson json = do
obj <- decodeJson json
pure $ decodeCategory obj
instance encodeJsonCategory :: EncodeJson Category where
encodeJson cat = encodeJson (cat2score cat)
favCategory :: Category -> Category
favCategory Favorite = Topic
favCategory _ = Favorite
trashCategory :: Category -> Category
trashCategory _ = Trash
-- TODO: ?
--trashCategory Trash = UnRead
decodeCategory :: Int -> Category
decodeCategory 0 = Trash
decodeCategory 1 = UnRead
decodeCategory 2 = Checked
decodeCategory 3 = Topic
decodeCategory 4 = Favorite
decodeCategory _ = UnRead
cat2score :: Category -> Int
cat2score Trash = 0
cat2score UnRead = 1
cat2score Checked = 2
cat2score Topic = 3
cat2score Favorite = 4
-- caroussel :: Category -> R.Element
caroussel session nodeId setLocalCategories r cat = H.div {className:"flex"} divs
where
divs = map (\c -> if cat == c
then
H.div { className : icon c (cat == c) } []
else
H.div { className : icon c (cat == c)
, on: { click: onClick c}
} []
) (caroussel' cat)
caroussel' :: Category -> Array Category
caroussel' Trash = A.take 2 categories
caroussel' c = A.take 3 $ A.drop (cat2score c - 1 ) categories
onClick c = \_-> do
setLocalCategories $ Map.insert r._id c
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
icon :: Category -> Boolean -> String
icon cat b = btn b $ "glyphicon glyphicon-" <> (color $ size b $ icon' cat b)
where
icon' :: Category -> Boolean -> String
icon' Trash false = "remove"
icon' Trash true = "remove-sign"
icon' UnRead true = "question-sign"
icon' UnRead false = "question-sign"
icon' Checked true = "ok-sign"
icon' Checked false = "ok"
icon' Topic true = "star"
icon' Topic false = "star-empty"
icon' Favorite true = "heart"
icon' Favorite false = "heart-empty"
size :: Boolean -> String -> String
size true s = s <> " btn-lg"
size false s = s <> " btn-xs"
color :: String -> String
color x = x <> " text-primary"
btn :: Boolean -> String -> String
btn true s = s
btn false s = "btn " <> s
newtype CategoryQuery = CategoryQuery {
nodeIds :: Array Int
, category :: Category
}
instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
encodeJson (CategoryQuery post) =
"ntc_nodesId" := post.nodeIds
~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject
categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put session $ categoryRoute nodeId
type TotalRecords = Int type TotalRecords = Int
type LayoutProps = type LayoutProps =
......
...@@ -3,27 +3,25 @@ ...@@ -3,27 +3,25 @@
-- has not been ported to this module yet. -- has not been ported to this module yet.
module Gargantext.Components.FacetsTable where module Gargantext.Components.FacetsTable where
import Prelude ------------------------------------------------------------------------
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (concat, filter) import Data.Array (concat, filter)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.List as L import Data.List as L
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Set (Set) import Data.Set (Set)
import Data.String as String
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Reactix as R import Gargantext.Components.Category (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
import Reactix.DOM.HTML as H import Gargantext.Components.Search
------------------------------------------------------------------------ import Gargantext.Components.Table as T
import Gargantext.Ends (url, Frontends) import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.DocsTable (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T
import Gargantext.Components.Search
import Gargantext.Routes (SessionRoute(Search, NodeAPI)) import Gargantext.Routes (SessionRoute(Search, NodeAPI))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody) import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
...@@ -31,6 +29,9 @@ import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..), NodeID) ...@@ -31,6 +29,9 @@ import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..), NodeID)
import Gargantext.Utils (toggleSet, zeroPad) import Gargantext.Utils (toggleSet, zeroPad)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
type Props = type Props =
...@@ -85,32 +86,6 @@ derive instance genericDocumentsView :: Generic DocumentsView _ ...@@ -85,32 +86,6 @@ derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where instance showDocumentsView :: Show DocumentsView where
show = genericShow show = genericShow
--instance decodeHyperdata :: DecodeJson Hyperdata where
-- decodeJson json = do
-- obj <- decodeJson json
-- title <- obj .: "title"
-- source <- obj .: "source"
-- pure $ Hyperdata { title,source }
instance decodePair :: DecodeJson Pair where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
label <- obj .: "label"
pure $ Pair { id, label }
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
authors <- obj .| "authors"
title <- obj .| "title"
source <- obj .| "source"
publication_year <- obj .: "publication_year"
publication_month <- obj .: "publication_month"
publication_day <- obj .: "publication_day"
pure $ Hyperdata { authors, title, source, publication_year, publication_month, publication_day }
-- | Main layout of the Documents Tab of a Corpus -- | Main layout of the Documents Tab of a Corpus
docView :: Record Props -> R.Element docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props [] docView props = R.createElement docViewCpt props []
...@@ -155,7 +130,7 @@ performDeletions session nodeId (deletions /\ setDeletions) = ...@@ -155,7 +130,7 @@ performDeletions session nodeId (deletions /\ setDeletions) =
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids = markCategory session nodeId category nids =
void $ launchAff_ $putCategories session nodeId (CategoryQuery q) void $ launchAff_ $ putCategories session nodeId (CategoryQuery q)
where -- TODO add array of delete rows here where -- TODO add array of delete rows here
q = {nodeIds: nids, category: favCategory category} q = {nodeIds: nids, category: favCategory category}
...@@ -207,8 +182,8 @@ initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, que ...@@ -207,8 +182,8 @@ initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, que
loadPage :: PagePath -> Aff (Array DocumentsView) loadPage :: PagePath -> Aff (Array DocumentsView)
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do
let p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId) let p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
res <- post session p $ SearchQuery {query, expected:searchType} searchResult <- post session p $ SearchQuery {query: concat query, expected:searchType}
pure $ res2corpus res pure $ res2view searchResult
where where
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
...@@ -219,13 +194,12 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc ...@@ -219,13 +194,12 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc
convOrderBy _ = DateAsc -- TODO convOrderBy _ = DateAsc -- TODO
res2corpus :: SearchResult -> Array DocumentsView res2view :: SearchResult -> Array DocumentsView
res2view (SearchResultDoc {docs}) = map toView docs
res2corpus :: Document -> DocumentsView where
res2corpus (Document { id toView :: Document -> DocumentsView
toView (Document { id
, created: date , created: date
, score
, category
, hyperdata: HyperdataDocument { authors , hyperdata: HyperdataDocument { authors
, title , title
, source , source
...@@ -233,24 +207,48 @@ res2corpus (Document { id ...@@ -233,24 +207,48 @@ res2corpus (Document { id
, publication_month , publication_month
, publication_day , publication_day
} }
} , category
) = , score
DocumentsView { id }
, date ) = DocumentsView { id
, title , date
, source , title: fromMaybe "Title" title
, score , source: fromMaybe "Source" source
, authors , score
, category , authors: fromMaybe "Authors" authors
, pairs: [] , category: decodeCategory category
, delete: false , pairs: []
, publication_year , delete: false
, publication_month , publication_year : fromMaybe 2020 publication_year
, publication_day , publication_month: fromMaybe 1 publication_month
} , publication_day : fromMaybe 1 publication_day
}
-- TODO Contact 2 view res2view (SearchResultContact {contacts}) = map toView contacts
where
toView :: Contact -> DocumentsView
toView (Contact { id
, created: date
, hyperdata: HyperdataContact { who
, title
, "where": contactWhere
}
, score
}
) = DocumentsView { id
, date
, title : fromMaybe "Title" title
, source: fromMaybe "Source" title
, score: 1
, authors: fromMaybe "Authors" title
, category: decodeCategory 1
, pairs: []
, delete: false
, publication_year: 2020
, publication_month: 10
, publication_day: 1
}
-- res2view (SearchNoResult {message}) = map toView contacts
......
...@@ -5,7 +5,8 @@ import Data.Array (fromFoldable) ...@@ -5,7 +5,8 @@ import Data.Array (fromFoldable)
import Data.Tuple (Tuple(..), fst) import Data.Tuple (Tuple(..), fst)
import Reactix as R import Reactix as R
import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..)) import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..))
import Gargantext.Components.FacetsTable (TextQuery, docView) import Gargantext.Components.FacetsTable (docView)
import Gargantext.Components.Search (TextQuery)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
......
...@@ -5,6 +5,7 @@ import Data.Argonaut as Argonaut ...@@ -5,6 +5,7 @@ import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson) import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Gargantext.Components.Category (Category)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Read, class Show) import Gargantext.Prelude (class Eq, class Read, class Show)
...@@ -27,7 +28,7 @@ instance encodeJsonSearchType :: Argonaut.EncodeJson SearchType where ...@@ -27,7 +28,7 @@ instance encodeJsonSearchType :: Argonaut.EncodeJson SearchType where
------------------------------------------------------------------------ ------------------------------------------------------------------------
data SearchQuery = data SearchQuery =
SearchQuery { query :: String SearchQuery { query :: Array String
, expected :: SearchType , expected :: SearchType
} }
...@@ -43,7 +44,7 @@ instance encodeJsonSearchQuery :: Argonaut.EncodeJson SearchQuery where ...@@ -43,7 +44,7 @@ instance encodeJsonSearchQuery :: Argonaut.EncodeJson SearchQuery where
------------------------------------------------------------------------ ------------------------------------------------------------------------
data SearchResult = SearchResultDoc { docs :: Array Document} data SearchResult = SearchResultDoc { docs :: Array Document}
| SearchResultContact { contacts :: Array Contact } | SearchResultContact { contacts :: Array Contact }
| SearchNoResult { message :: String } -- | SearchNoResult { message :: String }
derive instance eqSearchResult :: Eq SearchResult derive instance eqSearchResult :: Eq SearchResult
derive instance genericSearchResult :: Generic SearchResult _ derive instance genericSearchResult :: Generic SearchResult _
...@@ -56,13 +57,13 @@ instance encodeJsonSearchResult :: Argonaut.EncodeJson SearchResult where ...@@ -56,13 +57,13 @@ instance encodeJsonSearchResult :: Argonaut.EncodeJson SearchResult where
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Document = data Document =
Document { id :: Int Document { id :: Int
, created :: String , created :: String
, title :: String , title :: String
, hyperdata :: HyperdataDocument , hyperdata :: HyperdataDocument
, favorite :: Int , category :: Int
, score :: Number , score :: Int
} }
derive instance eqDocument :: Eq Document derive instance eqDocument :: Eq Document
...@@ -113,7 +114,7 @@ data Contact = ...@@ -113,7 +114,7 @@ data Contact =
Contact { id :: Int Contact { id :: Int
, created :: String , created :: String
, hyperdata :: HyperdataContact , hyperdata :: HyperdataContact
, score :: Number , score :: Int
} }
derive instance eqContact :: Eq Contact derive instance eqContact :: Eq Contact
......
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