{-# 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) ] )