Category.purs 5.9 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(..))
10 11
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
12 13
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (Variant(..))
14 15
import Gargantext.Components.Category.Types (Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars)
import Gargantext.Components.DocsTable.Types (DocumentsView(..), LocalCategories, LocalUserScore)
16
import Gargantext.Config.REST (AffRESTError)
17
import Gargantext.Routes (SessionRoute(NodeAPI))
18 19
import Gargantext.Sessions (Session, put)
import Gargantext.Types (NodeID, NodeType(..))
20
import Gargantext.Utils ((?))
21
import Gargantext.Utils.Reactix as R2
22
import Gargantext.Utils.Toestand as T2
23 24 25
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
26

27 28
here :: R2.Here
here = R2.here "Gargantext.Components.Category"
29

30
type RatingProps =
31
  ( chartReload        :: T2.ReloadS
32 33
  , nodeId             :: NodeID
  , row                :: DocumentsView
34
  , score              :: Star
35 36 37 38 39 40 41
  , session            :: Session
  , setLocalCategories :: R.Setter LocalUserScore
  )

rating :: R2.Component RatingProps
rating = R.createElement ratingCpt
ratingCpt :: R.Component RatingProps
42
ratingCpt = here.component "rating" cpt where
43 44 45 46 47
  cpt { chartReload
      , nodeId
      , row: DocumentsView r
      , score
      , session
48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
      , setLocalCategories
      } _ = do
    -- | Computed
    -- |
    let
      icon' Star_0 Star_0  = "times-circle"
      icon' _      Star_0  = "times"
      icon' c      s       = star2score c < star2score s ? "star-o" $ "star"

      variant' Star_0 Star_0 = Dark
      variant' _      Star_0 = Dark
      variant' _      _      = Dark

      className' Star_0 Star_0 = "rating-group__action"
      className' _      Star_0 = "rating-group__action"
      className' _      _      = "rating-group__star"

    -- | Behaviors
    -- |
    let
68
      onClick c _ = do
69
        let c' = score == c ? clickAgain c $ c
70 71

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

79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
    -- | Render
    -- |
    pure $

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


95 96 97 98
newtype RatingQuery =
  RatingQuery { nodeIds :: Array Int
              , rating  :: Star
              }
99 100 101 102
derive instance Generic RatingQuery _
instance JSON.WriteForeign RatingQuery where
  writeImpl (RatingQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
                                                , ntc_category: post.rating }
103

104
putRating :: Session -> Int -> RatingQuery -> AffRESTError (Array Int)
105 106
putRating session nodeId = put session $ ratingRoute where
  ratingRoute = NodeAPI Node (Just nodeId) "category"
107

108 109
type CarousselProps =
  ( category           :: Category
110 111 112 113 114
  , nodeId             :: NodeID
  , row                :: DocumentsView
  , session            :: Session
  , setLocalCategories :: R.Setter LocalCategories
  )
115

116 117 118 119
caroussel :: R2.Component CarousselProps
caroussel = R.createElement carousselCpt

carousselCpt :: R.Component CarousselProps
120
carousselCpt = here.component "caroussel" cpt
121
  where
122 123 124 125 126 127
    cpt { category, nodeId, row: DocumentsView r, session, setLocalCategories } _ = do
      pure $ H.div {className:"flex"} divs
      where
        divs = map (\c -> if category == c
                            then
                              H.div { className : icon c (category == c) } []
128

129 130 131 132 133
                            else
                              H.div { className : icon c (category == c)
                                , on: { click: onClick c}
                                } []
                        ) (caroussel' category)
134

135 136 137
        caroussel' :: Category -> Array Category
        caroussel' Trash = A.take 2 categories
        caroussel' c   = A.take 3 $ A.drop (cat2score c - 1 ) categories
138

139 140
        onClick c = \_-> do
          setLocalCategories $ Map.insert r._id c
141
          launchAff_ $ do
142 143
            _ <- putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
            pure unit
144 145

icon :: Category -> Boolean -> String
146
icon cat b = btn b $ "fa fa-" <> (color $ size b $ icon' cat b)
147 148
  where
    icon' :: Category -> Boolean -> String
149 150
    icon' Trash   false = "times"
    icon' Trash   true  = "times-circle"
151

152 153
    icon' UnRead  false = "question"
    icon' UnRead  true  = "question-circle"
154

155 156
    icon' Checked false = "check"
    icon' Checked true  = "check-circle"
157

158
    icon' Topic  false = "star-o"
159 160
    icon' Topic  true  = "star"

161
    icon' Favorite false = "heart-o"
162 163 164 165
    icon' Favorite true = "heart"

    size :: Boolean -> String -> String
    size true  s = s <> " btn-lg"
166
    size false s = s <> " btn-sm"
167 168 169 170 171 172 173 174

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

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

175
-------------------------------------------------------------------------
176 177 178 179
newtype CategoryQuery = CategoryQuery {
    nodeIds :: Array Int
  , category :: Category
  }
180 181 182 183
derive instance Generic CategoryQuery _
instance JSON.WriteForeign CategoryQuery where
  writeImpl (CategoryQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
                                                  , ntc_category: post.category }
184 185 186 187

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

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