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

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

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

rating :: R2.Component RatingProps
rating = R.createElement ratingCpt
ratingCpt :: R.Component RatingProps
47
ratingCpt = here.component "rating" cpt where
48 49 50 51 52
  cpt { chartReload
      , nodeId
      , row: DocumentsView r
      , score
      , session
53 54
      , setLocalCategories
      } _ = do
55 56 57 58 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
    pure $ renderRatingSimple { docId: nodeId
                              , corpusId: r._id
                              , category: star2score score
                              , 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
    --     }
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120

ratingIcon Star_0 Star_0  = "times-circle"
ratingIcon _      Star_0  = "times"
ratingIcon c      s       = star2score c < star2score s ? "star-o" $ "star"

ratingVariant Star_0 Star_0 = Dark
ratingVariant _      Star_0 = Dark
ratingVariant _      _      = Dark

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 }
121 122 123 124
              , render: \{ nc_category } -> renderRatingSimple { docId
                                                               , corpusId
                                                               , category: fromMaybe 0 nc_category
                                                               , session } [] }
125 126 127 128 129 130 131 132 133 134 135 136 137 138
    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

139 140 141
type RenderRatingSimpleProps =
  ( docId    :: NodeID
  , corpusId :: NodeID
142
  , category :: Int
143 144 145
  , session  :: Session )

renderRatingSimple :: R2.Component RenderRatingSimpleProps
146
renderRatingSimple = R.createElement renderRatingSimpleCpt
147
renderRatingSimpleCpt :: R.Component RenderRatingSimpleProps
148
renderRatingSimpleCpt = here.component "renderRatingSimple" cpt where
149 150
  cpt { docId
      , corpusId
151
      , category
152
      , session
153
      } _ = do
154 155 156 157 158 159
    score <- T.useBox $ decodeStar category

    pure $ ratingSimple { docId
                        , corpusId
                        , score
                        , session } []
160 161

type RatingSimpleProps =
162 163 164 165
  ( docId    :: NodeID
  , corpusId :: NodeID
  , score    :: T.Box Star
  , session  :: Session )
166 167 168 169 170

ratingSimple :: R2.Component RatingSimpleProps
ratingSimple = R.createElement ratingSimpleCpt
ratingSimpleCpt :: R.Component RatingSimpleProps
ratingSimpleCpt = here.component "ratingSimple" cpt where
171 172 173 174
  cpt { docId
      , corpusId
      , score
      , session
175
      } _ = do
176 177 178 179 180 181 182 183 184 185 186 187
    score' <- T.useLive T.unequal score

    let
      onClick c _ = do
        let c' = score' == c ? clickAgain c $ c

        -- setLocalCategories $ Map.insert r._id c'
        launchAff_ do
          _ <- updateNodeContextCategory session docId corpusId $ star2score c'
          liftEffect $ T.write_ c' score
          pure unit

188 189 190 191 192
    pure $
      H.div
      { className: "rating-group" } $
      stars <#> \s ->
        B.iconButton
193 194
        { name: ratingIcon score' s
        , callback: onClick s
195
        , overlay: false
196 197
        , variant: ratingVariant score' s
        , className: ratingClassName score' s
198 199 200
        }


201 202 203 204
newtype RatingQuery =
  RatingQuery { nodeIds :: Array Int
              , rating  :: Star
              }
205 206 207 208
derive instance Generic RatingQuery _
instance JSON.WriteForeign RatingQuery where
  writeImpl (RatingQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
                                                , ntc_category: post.rating }
209

210
putRating :: Session -> Int -> RatingQuery -> AffRESTError (Array Int)
211 212
putRating session nodeId = put session $ ratingRoute where
  ratingRoute = NodeAPI Node (Just nodeId) "category"
213

214 215
type CarousselProps =
  ( category           :: Category
216 217 218 219 220
  , nodeId             :: NodeID
  , row                :: DocumentsView
  , session            :: Session
  , setLocalCategories :: R.Setter LocalCategories
  )
221

222 223 224 225
caroussel :: R2.Component CarousselProps
caroussel = R.createElement carousselCpt

carousselCpt :: R.Component CarousselProps
226
carousselCpt = here.component "caroussel" cpt
227
  where
228
    cpt { category, nodeId, row: DocumentsView r, session, setLocalCategories } _ = do
229
      pure $ H.div {className:"d-flex"} divs
230 231 232 233
      where
        divs = map (\c -> if category == c
                            then
                              H.div { className : icon c (category == c) } []
234

235 236 237 238 239
                            else
                              H.div { className : icon c (category == c)
                                , on: { click: onClick c}
                                } []
                        ) (caroussel' category)
240

241 242 243
        caroussel' :: Category -> Array Category
        caroussel' Trash = A.take 2 categories
        caroussel' c   = A.take 3 $ A.drop (cat2score c - 1 ) categories
244

245 246
        onClick c = \_-> do
          setLocalCategories $ Map.insert r._id c
247
          launchAff_ $ do
248 249
            _ <- putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
            pure unit
250 251

icon :: Category -> Boolean -> String
252
icon cat b = btn b $ "fa fa-" <> (color $ size b $ icon' cat b)
253 254
  where
    icon' :: Category -> Boolean -> String
255 256
    icon' Trash   false = "times"
    icon' Trash   true  = "times-circle"
257

258 259
    icon' UnRead  false = "question"
    icon' UnRead  true  = "question-circle"
260

261 262
    icon' Checked false = "check"
    icon' Checked true  = "check-circle"
263

264
    icon' Topic  false = "star-o"
265 266
    icon' Topic  true  = "star"

267
    icon' Favorite false = "heart-o"
268 269 270 271
    icon' Favorite true = "heart"

    size :: Boolean -> String -> String
    size true  s = s <> " btn-lg"
272
    size false s = s <> " btn-sm"
273 274 275 276 277 278 279 280

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

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

281
-------------------------------------------------------------------------
282 283 284 285
newtype CategoryQuery = CategoryQuery {
    nodeIds :: Array Int
  , category :: Category
  }
286 287 288 289
derive instance Generic CategoryQuery _
instance JSON.WriteForeign CategoryQuery where
  writeImpl (CategoryQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
                                                  , ntc_category: post.category }
290 291 292 293

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

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