chart-svg-0.1.0: app/examples.hs

{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

import Chart
import Chart.Examples
import Control.Lens
import NumHask.Prelude hiding (replace)
import Web.Rep
import Lucid

chartServer :: SharedRep IO (Text, Text) -> IO ()
chartServer srep = sharedServer srep defaultSocketConfig (chartStyler True) defaultInputCode chartOutputCode

chartOutputCode :: Either Text (Text,Text) -> IO [Code]
chartOutputCode ea = do
    pure $ case ea of
        Left err -> [Append "debug" ("hashmap error: " <> err)]
        Right (chart',debug') ->
          [ Replace "output" chart',
            Replace "debug" debug'
          ]

chartStyler :: Bool -> Page
chartStyler doDebug =
  mathjaxSvgPage "hasmathjax"
    <> bootstrapPage
    <> socketPage
    & #htmlHeader .~ title_ "chart styler"
    & #htmlBody
      .~ divClass_
        "container"
        ( divClass_
            "row d-flex justify-content-between"
            ( sec "col4" "input"
                <> sec "col8" "output"
            )
            <> bool mempty (divClass_ "row" (with div_ [id_ "debug"] mempty)) doDebug
        )
  where
    sec d n = divClass_ d (with div_ [id_ n] mempty)

-- main example
main :: IO ()
main =
  chartServer 
  ( repChoice
    5
    [ ("mempty", repEx memptyExample),
      ("unit", repEx unitExample),
      ("hud", repEx hudExample),
      ("rect", repEx rectExample),
      ("line", repEx lineExample),
      ("wave", repEx mainExample),
      ("text", repEx textExample),
      ("glyphs", repEx glyphExample),
      ("bar", repBarChart defaultSvgOptions barDataExample defaultBarOptions),
      ("pixel", repPixelChart
        (defaultSvgOptions,
          defaultPixelOptions &
          #poGrain .~ Point 20 20 &
          #poRange .~ Rect 1 2 1 2,
          defaultHudOptions,
          defaultPixelLegendOptions "pixel test",
          f1)),
      ("bound text bug", repEx (makeExample defaultHudOptions boundTextBug)),
      ("compound chart", repEx (makeExample defaultHudOptions (lglyph <> glines))),
      ("label", repEx (makeExample defaultHudOptions label)),
      ("legend test", repNoData defaultSvgOptions BlankA legendTest)
    ]
  )