Skip to content

P
purescript-gargantext
Verified Commit c9d48a87 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[doc table] fixes to stars (add 1 more state, refactor)

parent d720b1a6
Hide whitespace changes
Inline Side-by-side
Showing with 268 additions and 154 deletions
spago.dhall
View file @ c9d48a87
......@@ -33,6 +33,7 @@ to generate this file without the comments in this block.
, "dom-simple"
, "effect"
, "either"
, "enums"
, "exceptions"
, "ffi-simple"
, "foldable-traversable"
......
src/Gargantext/Components/Category.purs
View file @ c9d48a87
......@@ -4,6 +4,7 @@ module Gargantext.Components.Category where
import Gargantext.Prelude
import Data.Array as A
import Data.Enum (fromEnum)
import Data.Generic.Rep (class Generic)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
......@@ -12,8 +13,8 @@ import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (Variant(..))
import Gargantext.Components.Category.Types (Category(..), Star(..), cat2score, categories, clickAgain, decodeStar, star2score, stars)
import Gargantext.Components.DocsTable.Types (DocumentsView(..), LocalCategories, LocalUserScore)
import Gargantext.Components.Category.Types (Category(..), Star(..), cat2score, cat2star, categories, categoryNextState, decodeCategory, stars)
import Gargantext.Components.DocsTable.Types (DocumentsView(..), LocalCategories)
import Gargantext.Components.GraphQL.Context (NodeContext)
import Gargantext.Components.GraphQL.Endpoints (getNodeContext, updateNodeContextCategory)
import Gargantext.Config.REST (AffRESTError, RESTError(..))
......@@ -36,9 +37,9 @@ type RatingProps =
( chartReload :: T2.ReloadS
, nodeId :: NodeID
, row :: DocumentsView
, score :: Star
, score :: Category
, session :: Session
, setLocalCategories :: R.Setter LocalUserScore
-- , setLocalCategories :: R.Setter LocalCategories
)
rating :: R2.Component RatingProps
......@@ -50,11 +51,11 @@ ratingCpt = here.component "rating" cpt where
, row: DocumentsView r
, score
, session
, setLocalCategories
-- , setLocalCategories
} _ = do
pure $ renderRatingSimple { docId: r._id
, corpusId: nodeId
, category: star2score score
, category: score
, session } []
-- -- | Behaviors
......@@ -86,14 +87,17 @@ ratingCpt = here.component "rating" cpt where
-- , className: ratingClassName score s
-- }
ratingIcon Star_0 Star_0 = "recycle"
ratingIcon :: Category -> Star -> String
ratingIcon Trash Star_0 = "recycle"
ratingIcon _ Star_0 = "trash"
ratingIcon c s = star2score c < star2score s ? "star-o" $ "star"
ratingIcon c s = fromEnum (cat2star c) < fromEnum s ? "star-o" $ "star"
ratingVariant :: Star -> Star -> Variant
ratingVariant Star_0 Star_0 = Dark
ratingVariant _ Star_0 = Dark
ratingVariant _ _ = Dark
ratingClassName :: Star -> Star -> String
ratingClassName Star_0 Star_0 = "rating-group__action"
ratingClassName _ Star_0 = "rating-group__action"
ratingClassName _ _ = "rating-group__star"
......@@ -118,10 +122,12 @@ ratingSimpleLoaderCpt = here.component "ratingSimpleLoader" cpt where
useLoader { errorHandler
, loader: loadDocumentContext session
, path: { docId, corpusId }
, render: \{ nc_category } -> renderRatingSimple { docId
, corpusId
, category: fromMaybe 0 nc_category
, session } [] }
, render: \{ nc_category } -> do
let category = fromMaybe UnRead $ decodeCategory <$> nc_category
renderRatingSimple { docId
, corpusId
, category
, session } [] }
where
errorHandler err = do
here.warn2 "[pageLayout] RESTError" err
......@@ -139,7 +145,7 @@ loadDocumentContext session { docId, corpusId } = getNodeContext session docId c
type RenderRatingSimpleProps =
( docId :: NodeID
, corpusId :: NodeID
, category :: Int
, category :: Category
, session :: Session )
renderRatingSimple :: R2.Component RenderRatingSimpleProps
......@@ -151,17 +157,17 @@ renderRatingSimpleCpt = here.component "renderRatingSimple" cpt where
, category
, session
} _ = do
score <- T.useBox $ decodeStar category
categoryS <- T.useBox category
pure $ ratingSimple { docId
, corpusId
, score
, category: categoryS
, session } []
type RatingSimpleProps =
( docId :: NodeID
, corpusId :: NodeID
, score :: T.Box Star
, category :: T.Box Category
, session :: Session )
ratingSimple :: R2.Component RatingSimpleProps
......@@ -170,19 +176,21 @@ ratingSimpleCpt :: R.Component RatingSimpleProps
ratingSimpleCpt = here.component "ratingSimple" cpt where
cpt { docId
, corpusId
, score
, category
, session
} _ = do
score' <- T.useLive T.unequal score
category' <- T.useLive T.unequal category
let star' = cat2star category'
let
onClick c _ = do
let c' = score' == c ? clickAgain c $ c
-- let c' = score' == c ? clickAgain c $ c
let c' = categoryNextState category' c
-- setLocalCategories $ Map.insert r._id c'
launchAff_ do
_ <- updateNodeContextCategory session docId corpusId $ star2score c'
liftEffect $ T.write_ c' score
_ <- updateNodeContextCategory session docId corpusId $ cat2score c'
liftEffect $ T.write_ c' category
pure unit
pure $
......@@ -190,17 +198,17 @@ ratingSimpleCpt = here.component "ratingSimple" cpt where
{ className: "rating-group" } $
stars <#> \s ->
B.iconButton
{ name: ratingIcon score' s
{ name: ratingIcon category' s
, callback: onClick s
, overlay: false
, variant: ratingVariant score' s
, className: ratingClassName score' s
, variant: ratingVariant star' s
, className: ratingClassName star' s
}
newtype RatingQuery =
RatingQuery { nodeIds :: Array Int
, rating :: Star
, rating :: Category
}
derive instance Generic RatingQuery _
instance JSON.WriteForeign RatingQuery where
......@@ -267,6 +275,9 @@ icon cat b = btn b $ "fa fa-" <> (color $ size b $ icon' cat b)
icon' Favorite false = "heart-o"
icon' Favorite true = "heart"
icon' ToCite false = "quote-left-o"
icon' ToCite true = "quote-left"
size :: Boolean -> String -> String
size true s = s <> " btn-lg"
size false s = s <> " btn-sm"
......
src/Gargantext/Components/Category/Types.purs
View file @ c9d48a87
module Gargantext.Components.Category.Types where
import Data.Generic.Rep (class Generic)
import Data.Bounded.Generic (genericTop, genericBottom)
import Data.Enum (class Enum, class BoundedEnum, succ, pred, fromEnum, toEnumWithDefaults)
import Data.Enum.Generic (genericPred, genericSucc, genericCardinality, genericFromEnum, genericToEnum)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (fromMaybe)
import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow)
import Simple.JSON as JSON
import Gargantext.Prelude
------------------------------------------------------------------------
data Star = Star_0 | Star_1 | Star_2 | Star_3 | Star_4
stars :: Array Star
stars = [Star_0, Star_1, Star_2, Star_3, Star_4]
derive instance Generic Star _
instance Show Star where show = genericShow
instance Eq Star where eq = genericEq
instance JSON.ReadForeign Star where
readImpl f = do
inst <- JSON.readImpl f
pure $ decodeStar inst
instance JSON.WriteForeign Star where writeImpl = JSON.writeImpl <<< star2score
decodeStar :: Int -> Star
decodeStar 0 = Star_0
decodeStar 1 = Star_1
decodeStar 2 = Star_2
decodeStar 3 = Star_3
decodeStar 4 = Star_4
decodeStar _ = Star_4
star2score :: Star -> Int
star2score Star_0 = 0
star2score Star_1 = 1
star2score Star_2 = 2
star2score Star_3 = 3
star2score Star_4 = 4
clickAgain :: Star -> Star
clickAgain Star_0 = Star_1
clickAgain s = decodeStar (star2score s - 1)
------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite
data Category = Trash | UnRead | Checked | Topic | Favorite | ToCite
{-
- `UnRead` is assigned initially for new docs
- After reading a doc, `Checked` should be assigned automatically
- Both `Trash` and `UnRead` map to 0 stars in the doc list
-}
categories :: Array Category
categories = [Trash, UnRead, Checked, Topic, Favorite]
categories = [Trash, UnRead, Checked, Topic, Favorite, ToCite]
derive instance Generic Category _
instance Ord Category where compare = genericCompare
instance Enum Category where
pred = genericPred
succ = genericSucc
instance Bounded Category where
bottom = genericBottom
top = genericTop
instance BoundedEnum Category where
cardinality = genericCardinality
fromEnum = genericFromEnum
toEnum = genericToEnum
instance Show Category where show = genericShow
instance Eq Category where eq = genericEq
instance JSON.ReadForeign Category where
......@@ -58,26 +43,75 @@ instance JSON.ReadForeign Category where
pure $ decodeCategory inst
instance JSON.WriteForeign Category where writeImpl = JSON.writeImpl <<< cat2score
catSucc :: Category -> Category
catSucc c = fromMaybe ToCite $ succ c
catPred :: Category -> Category
catPred c = fromMaybe Trash $ pred c
clickAgain :: Category -> Category
clickAgain _ = UnRead
-- | `categoryNextState :: current -> clicked -> new State`
categoryNextState :: Category -> Star -> Category
categoryNextState Trash Star_0 = UnRead
categoryNextState _ Star_0 = Trash
categoryNextState current clicked =
if (cat2star current) == clicked then
clickAgain current
else
star2catSimple clicked
favCategory :: Category -> Category
favCategory Favorite = Topic
favCategory _ = Favorite
trashCategory :: Category -> Category
trashCategory _ = Trash
-- TODO: ?
--trashCategory Trash = UnRead
trashCategory = const Trash
decodeCategory :: Int -> Category
decodeCategory 0 = Trash
decodeCategory 1 = UnRead
decodeCategory 2 = Checked
decodeCategory 3 = Topic
decodeCategory 4 = Favorite
decodeCategory _ = UnRead
decodeCategory = toEnumWithDefaults UnRead UnRead
cat2score :: Category -> Int
cat2score Trash = 0
cat2score UnRead = 1
cat2score Checked = 2
cat2score Topic = 3
cat2score Favorite = 4
cat2score = fromEnum
------------------------------------------------------------------------
-- | This is just a helper to visualize categories.
data Star = Star_0 | Star_1 | Star_2 | Star_3 | Star_4
stars :: Array Star
stars = [Star_0, Star_1, Star_2, Star_3, Star_4]
derive instance Generic Star _
instance Show Star where show = genericShow
instance Eq Star where eq = genericEq
instance Ord Star where compare = genericCompare
instance Enum Star where
pred = genericPred
succ = genericSucc
instance Bounded Star where
bottom = genericBottom
top = genericTop
instance BoundedEnum Star where
cardinality = genericCardinality
fromEnum = genericFromEnum
toEnum = genericToEnum
cat2star :: Category -> Star
cat2star Trash = Star_0
cat2star UnRead = Star_0
cat2star Checked = Star_1
cat2star Topic = Star_2
cat2star Favorite = Star_3
cat2star ToCite = Star_4
-- | This is a "reverse" of `cat2star`
star2catSimple :: Star -> Category
star2catSimple Star_0 = UnRead
star2catSimple Star_1 = Checked
star2catSimple Star_2 = Topic
star2catSimple Star_3 = Favorite
star2catSimple Star_4 = ToCite
src/Gargantext/Components/DocsTable.purs
View file @ c9d48a87
......@@ -26,10 +26,10 @@ import Effect.Timer (setTimeout)
import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), ModalSizing(..), Variant(..))
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.Category (rating, ratingSimple)
import Gargantext.Components.Category.Types (Category(..), Star(..))
import Gargantext.Components.DocsTable.DocumentFormCreation as DFC
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData, showSource)
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalCategories, Query, Response(..), Year, sampleData, showSource)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Reload (textsReloadContext)
......@@ -192,7 +192,7 @@ docViewCpt = here.component "docView" cpt where
, H.div { className: "col d-flex mt-5 mb-2" }
[ H.div { className: "doc-add-action" }
[ H.button
[ H.button
{ className: "btn btn-light text-primary border-primary"
, on: { click: toggleModal } }
[ H.i { className: "fa fa-plus mr-1" } []
......@@ -304,9 +304,9 @@ searchBarCpt = here.component "searchBar" cpt
, placeholder: "Search in documents"
, type: "text" }
, H.div {className: "input-group-append"}
[
if query' /= ""
then
[
if query' /= ""
then
R.fragment
[ clearButton query
, searchButton query queryText'
......@@ -450,7 +450,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where
, spinnerClass: Nothing
}
NT.CacheOff -> do
localCategories <- T.useBox (Map.empty :: LocalUserScore)
localCategories <- T.useBox (Map.empty :: LocalCategories)
paramsS <- T.useBox params
paramsS' <- T.useLive T.unequal paramsS
let loader p = do
......@@ -501,7 +501,7 @@ pagePaintCpt = here.component "pagePaintCpt" cpt
cpt { documents, layout, params } _ = do
params' <- T.useLive T.unequal params
localCategories <- T.useBox (Map.empty :: LocalUserScore)
localCategories <- T.useBox (Map.empty :: LocalCategories)
pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params')
, layout
, localCategories
......@@ -522,7 +522,7 @@ pagePaintCpt = here.component "pagePaintCpt" cpt
type PagePaintRawProps =
( documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, localCategories :: T.Box LocalUserScore
, localCategories :: T.Box LocalCategories
, params :: T.Box TT.Params
)
......@@ -557,73 +557,141 @@ pagePaintRawCpt = here.component "pagePaintRaw" cpt where
{ colNames
, container: TT.defaultContainer
, params
, rows: rows reload chartReload localCategories' mCurrentDocId'
, rows: rows { boxes
, reload
, chartReload
, frontends
, listId
, localCategories: localCategories'
, mCorpusId
, mCurrentDocId
, nodeId
, session
, sidePanel }
, syncResetButton : [ H.div {} [] ]
, totalRecords
, wrapColElts
}
where
colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
wrapColElts = const identity
rows { boxes
, chartReload
, frontends
, listId
, localCategories
, mCorpusId
, mCurrentDocId
, nodeId
, reload
, session
, sidePanel } =
(\documentsView -> { row: tableRow { boxes
, chartReload
, documentsView
, frontends
, listId
, localCategories
, mCorpusId
, mCurrentDocId
, nodeId
, session
, sidePanel } []
, delete: true } ) <$> A.toUnfoldable documents
trashClassName :: Category -> Boolean -> String
trashClassName Trash _ = "page-paint-row page-paint-row--trash"
trashClassName _ true = "page-paint-row page-paint-row--active"
trashClassName _ false = ""
type TableRowProps =
( boxes :: Boxes
, chartReload :: T2.ReloadS
, documentsView :: DocumentsView
, frontends :: Frontends
, listId :: Int
, localCategories :: LocalCategories
, mCorpusId :: Maybe Int
, mCurrentDocId :: T.Box (Maybe Int)
, nodeId :: Int
, session :: Session
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel)) )
tableRow :: R2.Component TableRowProps
tableRow = R.createElement tableRowCpt
tableRowCpt :: R.Component TableRowProps
tableRowCpt = here.component "tableRow" cpt where
cpt { boxes
, chartReload
, documentsView: dv@(DocumentsView r@{ _id, category })
, frontends
, listId
, localCategories
, mCorpusId
, mCurrentDocId
, nodeId
, session
, sidePanel } _ = do
mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
let cat :: Category
cat = fromMaybe category (localCategories ^. at _id)
-- checked = Star_1 == cat
selected = mCurrentDocId' == Just r._id
sid = sessionId session
trashClassName Star_0 _ = "page-paint-row page-paint-row--trash"
trashClassName _ true = "page-paint-row page-paint-row--active"
trashClassName _ false = ""
corpusDocument
| Just cid <- mCorpusId = Routes.CorpusDocument sid cid listId
| otherwise = Routes.Document sid listId
colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
wrapColElts = const identity
rows reload chartReload localCategories' mCurrentDocId' = row <$> A.toUnfoldable documents
where
row dv@(DocumentsView r@{ _id, category }) =
{ row:
TT.makeRow'
{ className: "page-paint-raw " <>
(selected ?
"page-paint-raw--selected" $
""
)
}
[ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
H.div { className: "" }
[ docChooser { boxes
, listId
, mCorpusId
, nodeId: r._id
, sidePanel } []
]
--, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
, H.div { className: "column-tag flex" }
[ rating { chartReload
, nodeId
, row: dv
, score: cat
, setLocalCategories: \lc -> T.modify_ lc localCategories
, session } [] ]
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only
, H.div { className: tClassName } [ R2.showText r.date ]
,
H.div
{ className: tClassName }
[
H.a
{ href: url frontends $ corpusDocument r._id
, target: "_blank"
, className: "text-primary"
}
[ H.text r.title
, H.i { className: "fa fa-external-link mx-1 small" } []
]
]
, H.div { className: tClassName } [ H.text $ showSource r.source ]
, H.div {} [ H.text $ maybe "-" show r.ngramCount ]
]
, delete: true }
where
cat = fromMaybe category (localCategories' ^. at _id)
-- checked = Star_1 == cat
selected = mCurrentDocId' == Just r._id
tClassName = trashClassName cat selected
categoryS <- T.useBox cat
categoryS' <- T.useLive T.unequal categoryS
let tClassName = trashClassName categoryS' selected
pure $ TT.makeRow' { className: "page-paint-raw " <>
(selected ?
"page-paint-raw--selected" $
""
)
}
[ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
H.div { className: "" }
[ docChooser { boxes
, listId
, mCorpusId
, nodeId: r._id
, sidePanel } []
]
--, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
, H.div { className: "column-tag flex" }
[ ratingSimple { -- chartReload
docId: _id
, category: categoryS
, corpusId: nodeId
-- , row: dv
, session
-- , setLocalCategories: \lc -> T.modify_ lc localCategories
} [] ]
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only
, H.div { className: tClassName } [ R2.showText r.date ]
,
H.div
{ className: tClassName }
[
H.a
{ href: url frontends $ corpusDocument r._id
, target: "_blank"
, className: "text-primary"
}
[ H.text r.title
, H.i { className: "fa fa-external-link mx-1 small" } []
]
]
, H.div { className: tClassName } [ H.text $ showSource r.source ]
, H.div {} [ H.text $ maybe "-" show r.ngramCount ]
]
type DocChooser = (
boxes :: Boxes
......
src/Gargantext/Components/DocsTable/Types.purs
View file @ c9d48a87
......@@ -7,14 +7,14 @@ import Data.Generic.Rep (class Generic)
import Data.Map (Map)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..))
import Gargantext.Components.Category.Types (Category, Star(..), decodeStar)
import Gargantext.Components.Category.Types (Category(..), Star(..), decodeCategory)
import Simple.JSON as JSON
data Action
= MarkCategory Int Category
type DocumentsViewT =
( category :: Star
( category :: Category
, date :: Int
, ngramCount :: Maybe Int
, score :: Maybe Int
......@@ -65,8 +65,8 @@ type ResponseT =
, score :: Maybe Int
, title :: String )
newtype Response = Response
{ cid :: Int
, category :: Star
{ cid :: Int
, category :: Category
| ResponseT
}
......@@ -74,7 +74,7 @@ instance JSON.ReadForeign Response where
readImpl f = do
{ category, id, hyperdata, ngramCount, score, title } :: { category :: Int, id :: Int | ResponseT } <- JSON.readImpl f
--pure $ Response { category: decodeCategory category, cid, hyperdata, ngramCount, score, title }
pure $ Response { category: decodeStar category
pure $ Response { category: decodeCategory category
, cid: id
, hyperdata
, ngramCount
......@@ -110,7 +110,7 @@ sampleData' = DocumentsView { _id : 1
, date : 2010
, title : "title"
, source : Just "source"
, category : Star_1
, category : UnRead
, ngramCount : Just 1
, score: Just 1 }
......@@ -121,7 +121,7 @@ sampleData = map (\(Tuple t s) -> DocumentsView { _id : 1
, date : 2017
, title: t
, source: Just s
, category : Star_1
, category : UnRead
, ngramCount : Just 10
, score: Just 1 }) sampleDocuments
......
src/Gargantext/Components/Document/Layout.purs
View file @ c9d48a87
......@@ -16,7 +16,6 @@ import Gargantext.Components.AutoUpdate (autoUpdate)
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), SpinnerTheme(..))
import Gargantext.Components.Category (ratingSimpleLoader)
import Gargantext.Components.Category.Types (decodeStar)
import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData, initialState)
import Gargantext.Components.NgramsTable.AutoSync (useAutoSync)
import Gargantext.Components.Node (NodePoly(..))
......
src/Gargantext/Components/FacetsTable.purs
View file @ c9d48a87
......@@ -395,6 +395,7 @@ pageCpt = here.component "page" cpt
wrapColElts = const identity
-- TODO: how to interprete other scores?
gi Trash = "fa fa-star-empty"
gi UnRead = "fa fa-star-empty"
gi _ = "fa fa-star"
documentUrl id { listId, nodeId } =
......
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