add a heatmap calendar DSL (#39)

add a heatmap calendar DSL

Author: justinwoo

example/src/HeatmapCalendar.purs

@@ -0,0 +1,108 @@
+module HeatmapCalendar where
+
+import Prelude
+
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Exception (EXCEPTION)
+
+import Data.Array as A
+import Data.Date as D
+import Data.Enum (toEnum)
+import Data.Foldable (traverse_)
+import Data.Maybe (Maybe(..), fromJust)
+
+import Debug.Trace as DT
+
+import DOM (DOM)
+import DOM.Node.Types (ElementId(..))
+
+import ECharts.Chart as EC
+import ECharts.Types as ET
+import ECharts.Types.Phantom as ETP
+import ECharts.Commands as E
+import ECharts.Monad (DSL)
+
+import Partial.Unsafe (unsafePartial)
+import Utils as U
+
+arrValues ∷ Array (Array String)
+arrValues =
+  [ [ "2017-01-01", "203" ], [ "2017-01-02", "980" ], [ "2017-01-03", "14" ]
+  , [ "2017-01-04", "284" ], [ "2017-01-05", "584" ], [ "2017-01-06", "723" ]
+  , [ "2017-01-07", "209" ], [ "2017-01-08", "219" ], [ "2017-01-09", "916" ]
+  , [ "2017-01-10", "747" ], [ "2017-01-11", "702" ], [ "2017-01-12", "749" ]
+  , [ "2017-01-13", "815" ], [ "2017-01-14", "777" ], [ "2017-01-15", "831" ]
+  , [ "2017-01-16", "109" ], [ "2017-01-17", "385" ], [ "2017-01-18", "428" ]
+  , [ "2017-01-19", "499" ], [ "2017-01-20", "58" ], [ "2017-01-21", "818" ]
+  , [ "2017-01-22", "455" ], [ "2017-01-23", "40" ], [ "2017-01-24", "612" ]
+  , [ "2017-01-25", "219" ], [ "2017-01-26", "854" ], [ "2017-01-27", "398" ]
+  , [ "2017-01-28", "193" ], [ "2017-01-29", "31" ], [ "2017-01-30", "575" ]
+  , [ "2017-01-31", "541" ], [ "2017-02-01", "548" ], [ "2017-02-02", "915" ]
+  , [ "2017-02-03", "606" ], [ "2017-02-04", "380" ], [ "2017-02-05", "853" ]
+  , [ "2017-02-06", "530" ], [ "2017-02-07", "295" ], [ "2017-02-08", "424" ]
+  , [ "2017-02-09", "593" ], [ "2017-02-10", "352" ], [ "2017-02-11", "939" ]
+  , [ "2017-02-12", "244" ], [ "2017-02-13", "726" ], [ "2017-02-14", "624" ]
+  , [ "2017-02-15", "38" ], [ "2017-02-16", "87" ], [ "2017-02-17", "905" ]
+  , [ "2017-02-18", "925" ], [ "2017-02-19", "477" ], [ "2017-02-20", "514" ]
+  , [ "2017-02-21", "762" ], [ "2017-02-22", "365" ], [ "2017-02-23", "425" ]
+  , [ "2017-02-24", "528" ], [ "2017-02-25", "859" ], [ "2017-02-26", "802" ]
+  , [ "2017-02-27", "992" ], [ "2017-02-28", "342" ] ]
+
+values ∷ ∀ i. Array (DSL (value ∷ ETP.I|i))
+values = A.catMaybes $ arrValues <#> case _ of
+  [x, y] → pure $ E.buildValues do
+    E.addStringValue x
+    E.addStringValue y
+  _ → Nothing
+
+options ∷ DSL ETP.OptionI
+options = do
+  E.tooltip do
+    E.positionTop
+  E.visualMap $ E.continuous do
+    E.min 0.0
+    E.max 1000.0
+    E.calculable true
+    E.orient ET.Horizontal
+    E.leftCenter
+    E.bottom $ ET.Percent 15.0
+  E.calendar do
+    E.calendarSpec do
+      E.buildRange do
+        E.addDateValue $ D.canonicalDate year D.January day
+        E.addDateValue $ D.canonicalDate year D.January day'
+      E.buildCellSize do
+        E.autoValue
+        E.addValue 12.0
+    E.calendarSpec do
+      E.buildRange do
+        E.addStringValue "2017-02"
+      E.buildCellSize do
+        E.autoValue
+        E.addValue 12.0
+      E.top (ET.Pixel 300)
+  E.series do
+    E.heatMap do
+      E.calendarCoordinateSystem
+      E.calendarIndex 0
+      E.buildItems
+        $ traverse_ E.addItem values
+    E.heatMap do
+      E.calendarCoordinateSystem
+      E.calendarIndex 1
+      E.buildItems
+        $ traverse_ E.addItem values
+  where
+    year = unsafePartial $ fromJust <<< toEnum $ 2017
+    day = unsafePartial $ fromJust <<< toEnum $ 1
+    day' = unsafePartial $ fromJust <<< toEnum $ 31
+
+
+chart ∷ ∀ e. Eff (dom ∷ DOM,  echarts ∷ ET.ECHARTS, exception ∷ EXCEPTION|e) Unit
+chart = do
+  mbEl ← U.getElementById $ ElementId "heatmap-calendar"
+  case mbEl of
+    Nothing → DT.traceAnyA "There is no element with 'heatmap-calendar' id"
+    Just el → do
+      ch ← EC.init el
+      EC.setOption options ch

example/src/Main.purs

@@ -21,6 +21,7 @@ import Radar as Radar
 import Graph as Graph
 import K as K
 import Heatmap as Heatmap
+import HeatmapCalendar as HeatmapCalendar
 
 import Utils as U
 
@@ -36,3 +37,4 @@ main = U.onLoad do
   Graph.chart
   K.chart
   Heatmap.chart
+  HeatmapCalendar.chart

public/index.html

@@ -43,5 +43,7 @@
     </div>
     <div id="heatmap" class="example">
     </div>
+    <div id="heatmap-calendar" class="example">
+    </div>
   </body>
 </html>

src/ECharts/Commands.purs

@@ -5,6 +5,8 @@ import Prelude
 import Color as C
 
 import Data.Array as Arr
+import Data.Date (Date, year, month, day)
+import Data.Enum (fromEnum)
 import Data.Foldable as F
 import Data.Foreign (toForeign)
 
@@ -113,6 +115,9 @@ addItem = set "" <<< buildObj
 buildItems ∷ ∀ i. DSL TP.ItemsI → DSL (items ∷ I|i)
 buildItems is = set "data" $ buildArr is
 
+calendarIndex ∷ ∀ i. Int → DSL (calendarIndex ∷ I|i)
+calendarIndex i = set "calendarIndex" $ toForeign i
+
 visibleContent ∷ ∀ i. Boolean → DSL (showContent ∷ I|i)
 visibleContent a = set "showContent" $ toForeign a
 
@@ -170,6 +175,9 @@ candlestick = set "candlestick" <<< buildObj
 heatMap ∷ ∀ i. DSL TP.HeatMapI → DSL (heatMap ∷ I|i)
 heatMap = set "heatmap" <<< buildObj
 
+calendarSpec ∷ ∀ i. DSL TP.CalendarSpecI → DSL (calendarSpec ∷ I|i)
+calendarSpec = set "calendar" <<< buildObj
+
 map_ ∷ ∀ i. DSL TP.MapI → DSL (map ∷ I|i)
 map_ = set "map" <<< buildObj
 
@@ -260,6 +268,9 @@ addValue = set "" <<< toForeign
 addStringValue ∷ ∀ i. String → DSL (addValue ∷ I|i)
 addStringValue = set "" <<< toForeign
 
+autoValue ∷ ∀ i. DSL (addValue ∷ I|i)
+autoValue = set "" $ toForeign "auto"
+
 buildNames ∷ ∀ i. DSL TP.NamesI → DSL (name ∷ I|i)
 buildNames = set "name" <<< buildArr
 
@@ -476,6 +487,9 @@ inverse a = set "inverse" $ toForeign a
 visualMap ∷ ∀ i. DSL TP.VisualMapI → DSL (visualMap ∷ I|i)
 visualMap a = set "visualMap" $ buildSeries a
 
+calendar ∷ ∀ i. DSL TP.CalendarI → DSL (calendar ∷ I|i)
+calendar a = set "calendar" $ buildSeries a
+
 continuous ∷ ∀ i. DSL TP.ContinuousVisualMapI → DSL (continuousVisualMap ∷ I|i)
 continuous a = set "continuous" $ buildObj a
 
@@ -587,6 +601,9 @@ readOnly = set "readOnly" <<< toForeign
 positionInside ∷ ∀ i. DSL (position ∷ I|i)
 positionInside = set "position" $ toForeign "inside"
 
+positionTop ∷ ∀ i. DSL (position ∷ I|i)
+positionTop = set "position" $ toForeign "top"
+
 labelLine ∷ ∀ i. DSL TP.LabelLineI → DSL (labelLine ∷ I|i)
 labelLine = set "labelLine" <<< buildObj
 
@@ -991,6 +1008,9 @@ cartesianCoordinateSystem = set "coordinateSystem" $ toForeign "cartesian2d"
 geoCoordinateSystem ∷ ∀ i. DSL (coordinateSystem ∷ I|i)
 geoCoordinateSystem = set "coordinateSystem" $ toForeign "geo"
 
+calendarCoordinateSystem ∷ ∀ i. DSL (coordinateSystem ∷ I|i)
+calendarCoordinateSystem = set "coordinateSystem" $ toForeign "calendar"
+
 dim ∷ ∀ i. Int → DSL (dim ∷ I|i)
 dim = set "dim" <<< toForeign
 
@@ -999,3 +1019,22 @@ nameLocationStart = set "nameLocation" $ toForeign "start"
 
 nameLocationEnd ∷ ∀ i. DSL (nameLocation ∷ I|i)
 nameLocationEnd = set "nameLocation" $ toForeign "end"
+
+buildCellSize ∷ ∀ i. DSL TP.ValuesI → DSL (cellSize ∷ I|i)
+buildCellSize = set "cellSize" <<< buildArr
+
+buildRange ∷ ∀ i. DSL TP.ValuesI → DSL (range ∷ I|i)
+buildRange = set "range" <<< buildArr
+
+addDateValue ∷ ∀ i. Date → DSL (addValue ∷ I|i)
+addDateValue dt =
+  set "" <<< toForeign
+    $ year' dt
+    <> "-"
+    <> month' dt
+    <> "-"
+    <> day' dt
+  where
+    year' = show <<< fromEnum <<< year
+    month' = show <<< fromEnum <<< month
+    day' = show <<< fromEnum <<< day

src/ECharts/Types/Phantom.purs

@@ -130,7 +130,7 @@ type TooltipI =
    , showDelay ∷ I
    , hideDelay ∷ I
    , enterable ∷ I
-   , tooltipPosition ∷ I
+   , position ∷ I
    , transitionDuration ∷ I
    , formatter ∷ I
    , animation ∷ I
@@ -182,6 +182,7 @@ type OptionI =
   , brush ∷ I
   , toolbox ∷ I
   , visualMap ∷ I
+  , calendar :: I
   , radar ∷ I
   , polar ∷ I
   , radiusAxis ∷ I
@@ -347,6 +348,17 @@ type VisualMapI =
   ( continuousVisualMap ∷ I
   , piecewiseVisualMap ∷ I)
 
+type CalendarI =
+  ( calendarSpec :: I )
+
+type CalendarSpecI =
+  PositionMixin
+  (ZMixin
+   (SizeMixin
+    ( range :: I
+    , cellSize :: I
+    , orient :: I )))
+
 type ContinuousVisualMapI =
   PositionMixin
   (ZMixin
@@ -823,6 +835,7 @@ type HeatMapI =
     ( name ∷ I
     , xAxisIndex ∷ I
     , yAxisIndex ∷ I
+    , calendarIndex :: I
     , geoIndex ∷ I
     , blurSize ∷ I
     , minOpacity ∷ I