Series.purs 7.02 KB
Newer Older
Sudhir Kumar's avatar
Sudhir Kumar committed
1
module Gargantext.Components.Charts.Options.Series where
2

3
import Data.Array (foldl)
4
import Data.Generic.Rep (class Generic)
5
import Data.Maybe (Maybe(..), maybe)
6
import Data.Newtype (class Newtype)
7 8 9 10
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Legend (SelectedMode)
import Gargantext.Types (class Optional)
11
import Prelude (class Eq, class Show, bind, map, pure, show, ($), (+), (<<<), (<>))
12
import Record      as Record
13
import Record.Unsafe (unsafeSet)
14
import Simple.JSON as JSON
15
import Type.Proxy (Proxy(..))
16
import Unsafe.Coerce (unsafeCoerce)
17

18

19 20
newtype SeriesType = SeriesType String

21 22
type SeriesName = String

23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43

data Chart = Line
           | Bar | PictorialBar
           | Pie
           | Scatter | EffectScatter
           | Radar
           | Trees
           | Sunburst
           | Boxplot
           | Candlestick
           | Heatmap
           | Map
           | Parallel
           | Lines
           | Graph
           | Sankey
           | Funnel
           | Gauge
           | ThemeRiver
-- Trees

44
instance Show Chart where
45
  show Bar      = "bar"
46
  show EffectScatter = "effectScatter" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-effect
47 48
  show Funnel   = "funnel"
  show Heatmap  = "heatmap"
49 50 51
  show Line     = "line"
  show Pie      = "pie"
  show Sankey   = "sankey"
52
  show Scatter  = "scatter"            -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-simple
53 54
  show Sunburst = "sunburst"
  show _        = "not implemented yet: should throw error here"
55

56
seriesType :: Chart -> SeriesType
57 58
seriesType = SeriesType <<< show

59

60 61
-- | Scatter Dimension 2 data
type OptionalSeries =
62 63 64
  ( name          :: String
  , symbolSize    :: Number
  , itemStyle     :: ItemStyle
65 66
    -- ^ Graphic style of, *emphasis* is the style when it is highlighted, like being hovered by mouse, or highlighted via legend connect.
    --   https://ecomfe.github.io/echarts-doc/public/en/option.html#series-scatter.itemStyle
67 68 69 70 71
  , tooltip       :: Tooltip
  , emphasis      :: { itemStyle :: ItemStyle }
  , selectedMode  :: SelectedMode
  , select        :: { itemStyle :: ItemStyle }
  -- ^ need "selectedMode" to be defined
72 73 74
  -- many more...
  )

75
data Series
76

77
unsafeSeries :: forall o. Record o -> Series
78 79
unsafeSeries = unsafeCoerce

80
type RequiredSeriesD1 o =
81
  { "type" :: SeriesType
82
  , "data" :: Array DataD1
83
  | o
84
  }
85

86
seriesD1 :: forall o. Optional o OptionalSeries => RequiredSeriesD1 o -> Series
87 88
seriesD1 = unsafeSeries

89 90
seriesFunnelD1 :: forall o. Optional o OptionalSeries => Record o -> Array DataD1 -> Series
seriesFunnelD1 o ds = unsafeSeries (unsafeSet "data" ds (unsafeSet "type" (seriesType Funnel) o))
91

92 93
seriesBarD1 :: forall o. Optional o OptionalSeries => Record o -> Array DataD1 -> Series
seriesBarD1 o ds = unsafeSeries (unsafeSet "data" ds (unsafeSet "type" (seriesType Bar) o))
94

95 96
seriesPieD1 :: forall o. Optional o OptionalSeries => Record o -> Array DataD1 -> Series
seriesPieD1 o ds = unsafeSeries (unsafeSet "data" ds (unsafeSet "type" (seriesType Pie) o))
97

98 99
type RequiredSeriesD2 o =
  { "data" :: Array DataD2
100
  , "type" :: SeriesType
101
  | o
102
  }
103

104
seriesD2 :: forall o. Optional o OptionalSeries => RequiredSeriesD2 o -> Series
105
seriesD2 = unsafeSeries
106

107
seriesScatterD2 :: forall o. Optional o OptionalSeries => Record o -> Array DataD2 -> Series
108
seriesScatterD2 o ds =
109
  unsafeCoerce (unsafeSet "data" ds (unsafeSet "type" (seriesType Scatter) o))
110 111 112 113 114

type Node = { name :: String}
type Link = { source :: String
            , target :: String
            , value  :: Number
115
            }
116

117 118 119 120 121 122 123 124 125 126 127 128 129 130
-- | Sankey Chart
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=sankey-simple
type RequiredSankey o =
  { "data" :: Array Node
  , links  :: Array Link
  | o
  }

type OptionalSankey =
  ( layout :: String
  )

seriesSankey :: forall o. Optional o OptionalSankey => RequiredSankey o -> Series
seriesSankey o = unsafeSeries ((unsafeCoerce o) { "type" = seriesType Sankey })
131

132 133 134 135 136 137 138
-- | * Trees Chart
-- All these Trees are hierarchical Trees structure (or diagram)
-- https://en.wikipedia.org/wiki/Tree_structure

-- Tree types
data Trees = TreeLine | TreeRadial | TreeMap

139
instance Show Trees where
140 141 142 143 144 145
  show TreeLine    = "tree"           -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=tree-radial
  show TreeRadial  = "tree"           -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-simple
  show TreeMap     = "treemap"        -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-simple


-- TreeLine is a 1-Dimension horizontal hierchical Tree
146

147 148 149 150 151 152 153
-- TreeRadial is 1-Dimension radial (as circle) Tree with no surface meaning
-- https://en.wikipedia.org/wiki/Radial_tree
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=tree-radial

-- TreeMap is a is 2-Dimension Tree with surface meaning
-- TreeMap example implementation:
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-simple
154

155 156
type RequiredTree o =
  { "type" :: SeriesType
157
  , "data" :: Array TreeNode
158 159 160 161 162 163 164 165 166
  | o
  }

type OptionalTree =
  ( layout :: String
  )

seriesTree :: forall o. Optional o OptionalTree => RequiredTree o -> Series
seriesTree = unsafeSeries
167

168
mkTree :: Trees -> Array TreeNode -> Series
169
mkTree t ts = seriesTree { "type" : SeriesType (show t)
170
                         , "data" : map (toJsTree Nothing) ts
171 172
                         , layout : layout
                         }
173 174 175 176 177 178
              where
                layout = case t of
                           TreeRadial -> "radial"
                           _          -> "none"

-- ** Data Structure of the Trees
179 180 181 182 183 184 185 186 187 188 189 190 191
data TreeData = Array TreeNode


treeValue :: TreeNode -> Int
treeValue (TreeNode x) = foldl (+) 0 $ [x.value] <> map treeValue x.children

toJsTree :: Maybe String -> TreeNode -> TreeNode
toJsTree maybeSurname (TreeNode x) =
  unsafeCoerce { name : name
               , value : foldl (+) 0 $ [x.value] <> map treeValue x.children
               , children : (map (toJsTree (Just name)) x.children)
               }
    where
192
      name = maybe "" (\x' -> x' <> ">") maybeSurname  <> x.name
193

194
newtype TreeNode = TreeNode {
195 196
    children :: Array TreeNode
  , name     :: String
197 198
  , value    :: Int
  }
199
derive instance Generic TreeNode _
200 201 202 203 204 205 206 207
derive instance Newtype TreeNode _
derive instance Eq TreeNode
instance JSON.ReadForeign TreeNode where
  readImpl f = do
    inst <- JSON.readImpl f
    pure $ TreeNode $ Record.rename labelP nameP inst
instance JSON.WriteForeign TreeNode where
  writeImpl (TreeNode t) = JSON.writeImpl $ Record.rename nameP labelP t
208 209

treeNode :: String -> Int -> Array TreeNode -> TreeNode
210
treeNode n v ts = TreeNode {name : n, value:v, children:ts}
211

212 213
treeLeaf :: String -> Int -> TreeNode
treeLeaf n v = TreeNode { name : n, value : v, children : []}
214 215


216 217
nameP = Proxy :: Proxy "name"
labelP = Proxy :: Proxy "label"
218 219


220
-- | TODO
221 222
-- https://ecomfe.github.io/echarts-examples/public/data/asset/data/life-expectancy-table.json
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter3D-dataset&gl=1