Category.purs 9.72 KB
Newer Older
1 2 3
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.Category where

4 5
import Gargantext.Prelude

6
import Data.Array as A
7
import Data.Enum (fromEnum)
8
import Data.Generic.Rep (class Generic)
9
import Data.Map as Map
10
import Data.Maybe (Maybe(..), fromMaybe)
11
import Data.Tuple.Nested ((/\))
12 13
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
14 15
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (Variant(..))
16 17
import Gargantext.Components.Category.Types (Category(..), Star(..), cat2score, cat2star, categories, categoryNextState, decodeCategory, stars)
import Gargantext.Components.DocsTable.Types (DocumentsView(..), LocalCategories)
18
import Gargantext.Components.GraphQL.Context (NodeContext)
19
import Gargantext.Components.GraphQL.Endpoints (getNodeContext, updateNodeContextCategory)
20 21
import Gargantext.Config.REST (AffRESTError, RESTError(..))
import Gargantext.Hooks.Loader (useLoader)
22
import Gargantext.Routes (SessionRoute(NodeAPI))
23 24
import Gargantext.Sessions (Session, put)
import Gargantext.Types (NodeID, NodeType(..))
25
import Gargantext.Utils ((?))
26
import Gargantext.Utils.Reactix as R2
27
import Gargantext.Utils.Toestand as T2
28 29 30
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
31
import Toestand as T
32

33 34
here :: R2.Here
here = R2.here "Gargantext.Components.Category"
35

36
type RatingProps =
37
  ( chartReload        :: T2.ReloadS
38 39
  , nodeId             :: NodeID
  , row                :: DocumentsView
40
  , score              :: Category
41
  , session            :: Session
42
  -- , setLocalCategories :: R.Setter LocalCategories
43 44 45 46 47
  )

rating :: R2.Component RatingProps
rating = R.createElement ratingCpt
ratingCpt :: R.Component RatingProps
48
ratingCpt = here.component "rating" cpt where
49 50 51 52 53
  cpt { chartReload
      , nodeId
      , row: DocumentsView r
      , score
      , session
54
      -- , setLocalCategories
55
      } _ = do
56 57
    pure $ renderRatingSimple { docId: r._id
                              , corpusId: nodeId
58
                              , category: score
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
                              , session } []

    -- -- | Behaviors
    -- -- |
    -- let
    --   onClick c _ = do
    --     let c' = score == c ? clickAgain c $ c

    --     setLocalCategories $ Map.insert r._id c'
    --     launchAff_ do
    --       _ <- putRating session nodeId $ RatingQuery
    --         { nodeIds: [r._id]
    --         , rating: c'
    --         }
    --       liftEffect $ T2.reload chartReload

    -- -- | Render
    -- -- |
    -- pure $

    --   H.div
    --   { className: "rating-group" } $
    --   stars <#> \s ->
    --     B.iconButton
    --     { name: ratingIcon score s
    --     , callback: onClick s
    --     , overlay: false
    --     , variant: ratingVariant score s
    --     , className: ratingClassName score s
    --     }
89

90 91
ratingIcon :: Category -> Star -> String
ratingIcon Trash  Star_0  = "recycle"
92
ratingIcon _      Star_0  = "trash"
93
ratingIcon c      s       = fromEnum (cat2star c) < fromEnum s ? "star-o" $ "star"
94

95
ratingVariant :: Star -> Star -> Variant
96 97 98 99
ratingVariant Star_0 Star_0 = Dark
ratingVariant _      Star_0 = Dark
ratingVariant _      _      = Dark

100
ratingClassName :: Star -> Star -> String
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
ratingClassName Star_0 Star_0 = "rating-group__action"
ratingClassName _      Star_0 = "rating-group__action"
ratingClassName _      _      = "rating-group__star"


------------------------------------------------

type RatingSimpleLoaderProps =
  ( docId    :: NodeID
  , corpusId :: NodeID
  , session  :: Session
)

ratingSimpleLoader :: R2.Component RatingSimpleLoaderProps
ratingSimpleLoader = R.createElement ratingSimpleLoaderCpt
ratingSimpleLoaderCpt :: R.Component RatingSimpleLoaderProps
ratingSimpleLoaderCpt = here.component "ratingSimpleLoader" cpt where
  cpt { docId
      , corpusId
      , session
      } _ = do
    useLoader { errorHandler
              , loader: loadDocumentContext session
              , path: { docId, corpusId }
125 126 127 128 129 130
              , render: \{ nc_category } -> do
                  let category = fromMaybe UnRead $ decodeCategory <$> nc_category
                  renderRatingSimple { docId
                                     , corpusId
                                     , category
                                     , session } [] }
131 132 133 134 135 136 137 138 139 140 141 142 143 144
    where
      errorHandler err = do
        here.warn2 "[pageLayout] RESTError" err
        case err of
          ReadJSONError err' -> here.warn2 "[pageLayout] ReadJSONError" $ show err'
          _ -> pure unit

type ContextParams =
  ( docId    :: NodeID
  , corpusId :: NodeID )

loadDocumentContext :: Session -> Record ContextParams -> AffRESTError NodeContext
loadDocumentContext session { docId, corpusId } = getNodeContext session docId corpusId

145 146 147
type RenderRatingSimpleProps =
  ( docId    :: NodeID
  , corpusId :: NodeID
148
  , category :: Category
149 150 151
  , session  :: Session )

renderRatingSimple :: R2.Component RenderRatingSimpleProps
152
renderRatingSimple = R.createElement renderRatingSimpleCpt
153
renderRatingSimpleCpt :: R.Component RenderRatingSimpleProps
154
renderRatingSimpleCpt = here.component "renderRatingSimple" cpt where
155 156
  cpt { docId
      , corpusId
157
      , category
158
      , session
159
      } _ = do
160
    categoryS <- T.useBox category
161 162 163

    pure $ ratingSimple { docId
                        , corpusId
164
                        , category: categoryS
165
                        , session } []
166 167

type RatingSimpleProps =
168 169
  ( docId    :: NodeID
  , corpusId :: NodeID
170
  , category :: T.Box Category
171
  , session  :: Session )
172 173 174 175 176

ratingSimple :: R2.Component RatingSimpleProps
ratingSimple = R.createElement ratingSimpleCpt
ratingSimpleCpt :: R.Component RatingSimpleProps
ratingSimpleCpt = here.component "ratingSimple" cpt where
177 178
  cpt { docId
      , corpusId
179
      , category
180
      , session
181
      } _ = do
182 183
    category' <- T.useLive T.unequal category
    let star' = cat2star category'
184 185 186

    let
      onClick c _ = do
187 188
        -- let c' = score' == c ? clickAgain c $ c
        let c' = categoryNextState category' c
189 190 191

        -- setLocalCategories $ Map.insert r._id c'
        launchAff_ do
192 193
          _ <- updateNodeContextCategory session docId corpusId $ cat2score c'
          liftEffect $ T.write_ c' category
194 195
          pure unit

196 197 198 199 200
    pure $
      H.div
      { className: "rating-group" } $
      stars <#> \s ->
        B.iconButton
201
        { name: ratingIcon category' s
202
        , callback: onClick s
203
        , overlay: false
204 205
        , variant: ratingVariant star' s
        , className: ratingClassName star' s
206 207 208
        }


209 210
newtype RatingQuery =
  RatingQuery { nodeIds :: Array Int
211
              , rating  :: Category
212
              }
213 214 215 216
derive instance Generic RatingQuery _
instance JSON.WriteForeign RatingQuery where
  writeImpl (RatingQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
                                                , ntc_category: post.rating }
217

218
putRating :: Session -> Int -> RatingQuery -> AffRESTError (Array Int)
219 220
putRating session nodeId = put session $ ratingRoute where
  ratingRoute = NodeAPI Node (Just nodeId) "category"
221

222 223
type CarousselProps =
  ( category           :: Category
224 225 226 227 228
  , nodeId             :: NodeID
  , row                :: DocumentsView
  , session            :: Session
  , setLocalCategories :: R.Setter LocalCategories
  )
229

230 231 232 233
caroussel :: R2.Component CarousselProps
caroussel = R.createElement carousselCpt

carousselCpt :: R.Component CarousselProps
234
carousselCpt = here.component "caroussel" cpt
235
  where
236
    cpt { category, nodeId, row: DocumentsView r, session, setLocalCategories } _ = do
237
      pure $ H.div {className:"d-flex"} divs
238 239 240 241
      where
        divs = map (\c -> if category == c
                            then
                              H.div { className : icon c (category == c) } []
242

243 244 245 246 247
                            else
                              H.div { className : icon c (category == c)
                                , on: { click: onClick c}
                                } []
                        ) (caroussel' category)
248

249 250 251
        caroussel' :: Category -> Array Category
        caroussel' Trash = A.take 2 categories
        caroussel' c   = A.take 3 $ A.drop (cat2score c - 1 ) categories
252

253 254
        onClick c = \_-> do
          setLocalCategories $ Map.insert r._id c
255
          launchAff_ $ do
256 257
            _ <- putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
            pure unit
258 259

icon :: Category -> Boolean -> String
260
icon cat b = btn b $ "fa fa-" <> (color $ size b $ icon' cat b)
261 262
  where
    icon' :: Category -> Boolean -> String
263 264
    icon' Trash   false = "times"
    icon' Trash   true  = "times-circle"
265

266 267
    icon' UnRead  false = "question"
    icon' UnRead  true  = "question-circle"
268

269 270
    icon' Checked false = "check"
    icon' Checked true  = "check-circle"
271

272
    icon' Topic  false = "star-o"
273 274
    icon' Topic  true  = "star"

275
    icon' Favorite false = "heart-o"
276 277
    icon' Favorite true = "heart"

278 279 280
    icon' ToCite false = "quote-left-o"
    icon' ToCite true = "quote-left"

281 282
    size :: Boolean -> String -> String
    size true  s = s <> " btn-lg"
283
    size false s = s <> " btn-sm"
284 285 286 287 288 289 290 291

    color :: String -> String
    color x = x <> " text-primary"

    btn :: Boolean -> String -> String
    btn true s = s
    btn false s = "btn " <> s

292
-------------------------------------------------------------------------
293 294 295 296
newtype CategoryQuery = CategoryQuery {
    nodeIds :: Array Int
  , category :: Category
  }
297 298 299 300
derive instance Generic CategoryQuery _
instance JSON.WriteForeign CategoryQuery where
  writeImpl (CategoryQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
                                                  , ntc_category: post.category }
301 302 303 304

categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"

305
putCategories :: Session -> Int -> CategoryQuery -> AffRESTError (Array Int)
306
putCategories session nodeId = put session $ categoryRoute nodeId