Skip to content

P
purescript-gargantext
Commit 015011ca authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[DocsTable] caroussel tags.

parent 2e48353f
Show whitespace changes
Inline Side-by-side
Showing with 124 additions and 67 deletions
src/Gargantext/Components/DocsTable.purs
View file @ 015011ca
......@@ -2,14 +2,16 @@
module Gargantext.Components.DocsTable where
import Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>), encodeJson)
import Data.Array (drop, take)
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.Map (Map, insert)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Set (Set)
import Data.Set as Set
......@@ -24,19 +26,123 @@ import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T
import Gargantext.Components.Loader (loader)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T
import Gargantext.Ends (Frontends, url)
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes
import Gargantext.Routes (AppRoute, SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, post, delete)
import Gargantext.Sessions (Session, sessionId, post, delete, put)
import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..))
------------------------------------------------------------------------
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 encodeJsonCategory :: EncodeJson Category where
encodeJson cat = encodeJson (cat2score cat)
favCategory :: Category -> Category
favCategory Favorite = Topic
favCategory _ = Favorite
trashCategory :: Category -> Category
trashCategory _ = Trash
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 {} 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 nodeId setLocalCategories r c}
} []
) (caroussel' cat)
caroussel' :: Category -> Array Category
caroussel' Trash = take 2 categories
caroussel' cat = take 3 $ drop (cat2score cat - 1 ) categories
onClick nodeId setLocalCategories r cat = \_-> do
setLocalCategories $ Map.insert r._id cat
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: cat}
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 NodeID = Int
type TotalRecords = Int
......@@ -295,31 +401,28 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
corpusDocument
| Just cid <- corpusId = Routes.CorpusDocument sid cid listId
| otherwise = Routes.Document sid listId
colNames = T.ColumnName <$> [ "Map", "Stop", "Date", "Title", "Source"]
colNames = T.ColumnName <$> [ "Tag", "Date", "Title", "Source"]
getCategory (localCategories /\ _) {_id, category} = maybe category identity (localCategories ^. at _id)
rows localCategories = row <$> documents
where
row (DocumentsView r) =
{ row:
[ H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
[ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
caroussel session nodeId setLocalCategories r cat
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only
, H.div { style } [ R2.showText r.date ]
, H.div { style }
[ H.a { href: url frontends $ corpusDocument r._id } [ H.text r.title ] ]
, H.div { style } [ H.text r.source ]
, H.div { style } [ H.text $ if r.source == "" then "Source" else r.source ]
]
, delete: true }
where
cat = getCategory localCategories r
click cat2 = onClick localCategories cat2 r._id cat
(_ /\ setLocalCategories) = localCategories
checked = Trash == cat
style = trashStyle cat
className = gi cat
onClick (_ /\ setLocalCategories) catType nid cat = \_-> do
let newCat = if (catType == Favorite) then (favCategory cat) else (trashCategory cat)
setLocalCategories $ insert nid newCat
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [nid], category: newCat}
---------------------------------------------------------
sampleData' :: DocumentsView
......@@ -328,7 +431,7 @@ sampleData' = DocumentsView { _id : 1
, date : 2010
, title : "title"
, source : "source"
, category : Normal
, category : UnRead
, ngramCount : 1}
sampleData :: Array DocumentsView
......@@ -338,7 +441,7 @@ sampleData = map (\(Tuple t s) -> DocumentsView { _id : 1
, date : 2017
, title: t
, source: s
, category : Normal
, category : UnRead
, ngramCount : 10}) sampleDocuments
sampleDocuments :: Array (Tuple String String)
......
src/Gargantext/Components/FacetsTable.purs
View file @ 015011ca
......@@ -22,7 +22,7 @@ import Reactix.DOM.HTML as H
------------------------------------------------------------------------
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
import Gargantext.Components.DocsTable (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(Search,NodeAPI))
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
......
src/Gargantext/Components/Search/Types.purs
View file @ 015011ca
......@@ -352,52 +352,6 @@ instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
~> "lang" := maybe "EN" show lang
~> jsonEmptyObject
data Category = Trash | Normal | Favorite
derive instance genericFavorite :: Generic Category _
instance showCategory :: Show Category where
show = genericShow
instance eqCategory :: Eq Category where
eq = genericEq
instance encodeJsonCategory :: EncodeJson Category where
encodeJson Trash = encodeJson 0
encodeJson Normal = encodeJson 1
encodeJson Favorite = encodeJson 2
favCategory :: Category -> Category
favCategory Normal = Favorite
favCategory Trash = Favorite
favCategory Favorite = Normal
trashCategory :: Category -> Category
trashCategory Normal = Trash
trashCategory Trash = Normal
trashCategory Favorite = Trash
decodeCategory :: Int -> Category
decodeCategory 0 = Trash
decodeCategory 1 = Normal
decodeCategory 2 = Favorite
decodeCategory _ = Normal
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
performSearch :: forall a. DecodeJson a => Session -> SearchQuery -> Aff a
performSearch session q = post session q q
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