chart-svg-0.1.1: 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 Lucid
import NumHask.Prelude hiding (replace)
import Web.Rep

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

chartOutputCode :: Either Text (Text, Text) -> IO [Code]
chartOutputCode ea = 
  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)
        ]
    )