chart-svg-0.0.1: app/examples.hs

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

import Chart
import Chart.Examples
import Control.Category (id)
import Control.Lens
import Control.Monad.Trans.State.Lazy
import Network.Wai.Middleware.Static ((>->), addBase, noDots, staticPolicy)
import Web.Page
import Web.Scotty
import Protolude hiding ((<<*>>), Rep, replace)

repNoData :: (Monad m) => SvgOptions -> Annotation -> HudOptions -> SharedRep m (Text, Text)
repNoData css ann hc =
  repChartsWithStaticData css hc 10 [Chart ann [SR (-0.5) 0.5 (-0.5) 0.5]]

repEx :: (Monad m) => Ex -> SharedRep m (Text, Text)
repEx (Ex css hc maxcs anns xs) =
  repChartsWithStaticData css hc maxcs (zipWith Chart anns xs)

midChart ::
  SharedRep IO (Text, Text) ->
  Application ->
  Application
midChart sr = midShared sr initChartRender updateChart

initChartRender ::
  Engine ->
  Rep (Text, Text) ->
  StateT (HashMap Text Text) IO ()
initChartRender e r =
  void $
    oneRep
      r
      ( \(Rep h fa) m -> do
          append e "input" (toText h)
          replace e "output" (either id fst . snd $ fa m)
          replace e "debug" (either id snd . snd $ fa m)
      )

updateChart :: Engine -> Either Text (HashMap Text Text, Either Text (Text, Text)) -> IO ()
updateChart e (Left err) = append e "debug" ("map error: " <> err)
updateChart e (Right (_, Left err)) = append e "debug" ("parse error: " <> err)
updateChart e (Right (_, Right (c, d))) = do
  replace e "output" c
  replace e "debug" d

-- main example

main :: IO ()
main =
  scotty 3000 $ do
    middleware $ staticPolicy (noDots >-> addBase "other")
    middleware
      ( midChart
          ( repChoice
              0
              [ ( "examples",
                  repChoice
                    0
                    [ ("mempty", repEx memptyExample),
                      ("unit", repEx unitExample),
                      ("hud", repEx hudExample),
                      ("rect", repEx rectExample),
                      ("line", repEx lineExample),
                      ("text", repEx textExample),
                      ("glyph", repEx glyphExample),
                      ("bar", repBarChart defaultSvgOptions barDataExample defaultBarOptions),
                      ( "pixel", repPixelChart (defaultSvgOptions, defaultPixelOptions & #poGrain .~ Point 100 100 & #poRange .~ Rect 1 2 1 2, defaultHudOptions, defaultPixelLegendOptions "pixel test", f1))
                    ]
                ),
                ( "stuff",
                  repChoice
                    0
                    [ ("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)
                    ]
                ),
                ( "main", repEx mainExample)
              ]
          )
      )
    servePageWith "" (defaultPageConfig "default") (chartStyler True)