packages feed

charter (empty) → 0.1.1.0

raw patch · 20 files changed

+832/−0 lines, 20 filesdep +MonadRandomdep +aesondep +asyncsetup-changed

Dependencies added: MonadRandom, aeson, async, base, bytestring, charter, containers, http-types, mtl, one-liner, process, random, scientific, text, wai, warp

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for charter++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,34 @@+# Charter++`charter` is a typed Haskell layer on top of [Google Charts](https://developers.google.com/chart) +which allows quickly and easily visualizing your Haskell data in the browser!++It also provides **live-updates** as your data changes in Haskell-land.++Why Google Charts?++Google Charts provides a large amount of flexible data representations which +use a relatively consistent data format, making it easy to switch between chart types.++## Goals++Goals of this library include:++* Quick to start+* Batteries Included+* Well-typed, but not at the expense of usability+* Smooth learning curve as you add more complex options to your charts+* Live chart updates!++Non-Goals of this library include:++* Writing charts to disk: sorry, try taking a screenshot of your browser instead!+* Performance: All your data turns into JSON and gets piped through the browser, it'll be slower than other solutions on large datasets.+* Composability with other solutions: This library is "battery included" and doesn't provide many extension points.++## Roadmap++* Better Date, Time, and DateTime support+* Support for Geocharts, TreeMaps, Tables, Timeline, Gauges+* Support multiple charts on a screen+* Support combo charts
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Examples/AreaChart.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+module Examples.AreaChart where++import Charts+import qualified Data.Text as T++chartColumns :: [Column]+chartColumns = [StringColumn "Year", NumberColumn "Attendance",  AnnotationColumn, NumberColumn "Other", AnnotationColumn]++areaChart :: Chart+areaChart = autoChartWithHeaders defaultChartOptions AreaChart chartColumns chartData++chartData :: [(T.Text, Int, T.Text, Int, T.Text)]+chartData =+    [ ("2004", 1000, "A'", 400, "A")+    , ("2005", 1170, "B'", 460, "B")+    , ("2006", 660, "C'", 1120, "C")+    , ("2007", 1030, "D'", 540, "D")+    ]
+ app/Examples/Auto.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+module Examples.Auto where++import qualified Data.Text as T+import Data.Aeson++import Charts++myAutoChart :: Chart+myAutoChart = autoChartWithHeaders defaultChartOptions BarChart headers myData+  where+    headers :: [Column]+    headers = [StringColumn "Series", NumberColumn "Successes", NumberColumn "Inconclusive"]+    myData :: [(T.Text, Float, Int)]+    myData = [ ("A", 16, 20)+             , ("B", 11, 23)+             , ("C", 9, 25)+             , ("D", 8, 34)+             ]+++
+ app/Examples/BarChart.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+module Examples.BarChart where++import Charts+import qualified Data.Text as T+import Data.Aeson++chartColumns :: [Column]+chartColumns = [StringColumn "Year", NumberColumn "Attendance",  AnnotationColumn, NumberColumn "Other", AnnotationColumn]++barChart :: Chart+barChart = autoChartWithHeaders chartOptions BarChart chartColumns chartData+  where+    chartOptions = ChartOptions $ object ["title" .= ("Attendance Chart" :: T.Text)]++-- chartData :: [(T.Text, Int, T.Text, Int, T.Text)]+chartData =+    [ [ "2004", Number 1000, "A'", Number 400, "A" ]+    , [ "2005", Number 1170, "B'", Number 460, "B" ]+    , [ "2006", Number 660, "C'", Number 1120, "C" ]+    , [ "2007", Number 1030, "D'", Number 540, "D" ]+    ]++-- t :: Chart+-- t = buildChart defaultChartOptions BarChart+--   [StringColumn "Year", NumberColumn "Population"]+--   [ [ String "2004", Number 1000 ]+--   , [ String "2005", Number 1170 ]+--   , [ String "2006", Number 660 ]+--   , [ String "2007", Number 1030 ]+--   ]
+ app/Examples/ColumnChart.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+module Examples.ColumnChart where++import Charts+import qualified Data.Text as T++chartColumns :: [Column]+chartColumns = [StringColumn "Year", NumberColumn "Attendance",  AnnotationColumn, NumberColumn "Other", AnnotationColumn]++columnChart :: Chart+columnChart = autoChartWithHeaders defaultChartOptions ColumnChart chartColumns chartData++chartData :: [(T.Text, Int, T.Text, Int, T.Text)]+chartData =+    [ ("2004", 1000, "A'", 400, "A")+    , ("2005", 1170, "B'", 460, "B")+    , ("2006", 660, "C'", 1120, "C")+    , ("2007", 1030, "D'", 540, "D")+    ]
+ app/Examples/Histogram.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}+module Examples.Histogram where++import Charts+import Data.Aeson+import qualified Data.Text as T++histogram :: Chart+histogram = buildChart defaultChartOptions Histogram dinoColumns dinoData++dinoColumns :: [Column]+dinoColumns = [StringColumn "Dinosaur", NumberColumn "Length"]++-- Dinosaur histogram data+dinoData :: [[Value]]+dinoData = fmap asData+    [ ("Acrocanthosaurus (top-spined lizard)", 12.2)+    , ("Albertosaurus (Alberta lizard)", 9.1)+    , ("Allosaurus (other lizard)", 12.2)+    , ("Apatosaurus (deceptive lizard)", 22.9)+    , ("Archaeopteryx (ancient wing)", 0.9)+    , ("Argentinosaurus (Argentina lizard)", 36.6)+    , ("Baryonyx (heavy claws)", 9.1)+    , ("Brachiosaurus (arm lizard)", 30.5)+    , ("Ceratosaurus (horned lizard)", 6.1)+    , ("Coelophysis (hollow form)", 2.7)+    , ("Compsognathus (elegant jaw)", 0.9)+    , ("Deinonychus (terrible claw)", 2.7)+    , ("Diplodocus (double beam)", 27.1)+    , ("Dromicelomimus (emu mimic)", 3.4)+    , ("Gallimimus (fowl mimic)", 5.5)+    , ("Mamenchisaurus (Mamenchi lizard)", 21.0)+    , ("Megalosaurus (big lizard)", 7.9)+    , ("Microvenator (small hunter)", 1.2)+    , ("Ornithomimus (bird mimic)", 4.6)+    , ("Oviraptor (egg robber)", 1.5)+    , ("Plateosaurus (flat lizard)", 7.9)+    , ("Sauronithoides (narrow-clawed lizard)", 2.0)+    , ("Seismosaurus (tremor lizard)", 45.7)+    , ("Spinosaurus (spiny lizard)", 12.2)+    , ("Supersaurus (super lizard)", 30.5)+    , ("Tyrannosaurus (tyrant lizard)", 15.2)+    , ("Ultrasaurus (ultra lizard)", 30.5)+    , ("Velociraptor (swift robber)", 1.8)+    ]+  where+    asData :: (T.Text, Float) -> [Value]+    asData (a, b) = [toJSON a, toJSON b]
+ app/Examples/LineChart.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+module Examples.LineChart where++import Charts+import Data.Aeson+import qualified Data.Text as T++chartColumns :: [Column]+chartColumns = [StringColumn "Year", NumberColumn "Attendance", NumberColumn "Other", AnnotationColumn]++lineChart :: Chart+lineChart = buildChart defaultChartOptions LineChart chartColumns chartData ++chartData :: [[Value]]+chartData = asJSON <$> +           [ ("2004",  1000,      400, "A")+           , ("2005",  1170,      460, "B")+           , ("2006",  660,       1120, "C")+           , ("2007",  1030,      540, "D")+           ]+  where+    asJSON :: (T.Text, Int, Int, T.Text) -> [Value]+    asJSON (a, b, c, d) = [toJSON a, toJSON b, toJSON c, toJSON d]
+ app/Examples/Random.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+module Examples.Random where++import Charts+import Control.Monad.Random+import Data.Traversable+import Data.Aeson+import Control.Concurrent++randomChart :: IO Chart+randomChart = do+    rows <- for [1..10] $ \i -> do+                a <- randomRIO (0, 1)+                b <- randomRIO (0, 1)+                return [toJSON @Int i, toJSON @Float a, toJSON @Double b]+    return $ buildChart defaultChartOptions ScatterChart [NumberColumn "Iteration", NumberColumn "Value A", NumberColumn "Value B"] rows++buildRandomChart :: (Chart -> IO ()) -> IO ()+buildRandomChart sendChart = forever $ do+    randomChart >>= sendChart+    threadDelay 2000000++serveUpdatingRandomChart :: IO ()+serveUpdatingRandomChart = serveDynamicChart 8080 buildRandomChart
+ app/Examples/ScatterChart.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}+module Examples.ScatterChart where++import Charts++scatterChart :: Chart+scatterChart = autoChartWithHeaders defaultChartOptions ScatterChart chartColumns chartData++chartColumns :: [Column]+chartColumns = [NumberColumn "Age", NumberColumn "Weight"]++chartData :: [(Float, Float)]+chartData =+    [ (8, 12)+    , (4, 5.5)+    , (11, 14)+    , (4, 5)+    , (3, 3.5)+    , (6.5, 7)+    ]
+ app/Main.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Charts+import Examples.Histogram+import Examples.Random+import Examples.LineChart+import Examples.Auto+import Examples.ScatterChart+import Examples.BarChart+import Examples.ColumnChart+import Examples.AreaChart++-- main :: IO ()+-- main = serveChart 8080 myAutoChart++main :: IO ()+main = serveChart 8080 myAutoChart+-- main = serveUpdatingRandomChart
+ charter.cabal view
@@ -0,0 +1,114 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: cf81c27c2154f32ddbe86abce94d1426deb270ad096348ad4ce50a26188e70e5++name:           charter+version:        0.1.1.0+description:    Please see the README on GitHub at <https://github.com/githubuser/charter#readme>+homepage:       https://github.com/githubuser/charter#readme+bug-reports:    https://github.com/githubuser/charter/issues+author:         Author name here+maintainer:     example@example.com+copyright:      2020 Author name here+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md+data-files:+    templates/index.html++source-repository head+  type: git+  location: https://github.com/githubuser/charter++library+  exposed-modules:+      Charts+      Charts.Internal.Auto+      Charts.Internal.Chart+      Charts.Internal.Server+  other-modules:+      Paths_charter+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      aeson+    , async+    , base >=4.7 && <5+    , bytestring+    , containers+    , http-types+    , mtl+    , one-liner+    , process+    , scientific+    , text+    , wai+    , warp+  default-language: Haskell2010++executable charter-exe+  main-is: Main.hs+  other-modules:+      Examples.AreaChart+      Examples.Auto+      Examples.BarChart+      Examples.ColumnChart+      Examples.Histogram+      Examples.LineChart+      Examples.Random+      Examples.ScatterChart+      Paths_charter+  hs-source-dirs:+      app+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      MonadRandom+    , aeson+    , async+    , base >=4.7 && <5+    , bytestring+    , charter+    , containers+    , http-types+    , mtl+    , one-liner+    , process+    , random+    , scientific+    , text+    , wai+    , warp+  default-language: Haskell2010++test-suite charter-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_charter+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      aeson+    , async+    , base >=4.7 && <5+    , bytestring+    , charter+    , containers+    , http-types+    , mtl+    , one-liner+    , process+    , scientific+    , text+    , wai+    , warp+  default-language: Haskell2010
+ src/Charts.hs view
@@ -0,0 +1,20 @@+module Charts ( serveChart+              , serveDynamicChart+              , Chart+              , Column(..)+              , ChartOptions(..)+              , ChartStyle(..)+              , buildChart+              , defaultChartOptions++              , autoChart+              , autoChartWithHeaders+              , ChartRowAuto+              , ChartRowHeaderAuto+              , ChartColumn(..)+    ) where++import Charts.Internal.Server+import Charts.Internal.Chart+import Charts.Internal.Auto+
+ src/Charts/Internal/Auto.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module Charts.Internal.Auto where++import Charts.Internal.Chart+import Generics.OneLiner+import Data.Aeson+import Data.Proxy+import qualified Data.Text as T+import Data.Scientific++-- | Class representing types for which a column type can be inferred.+--+-- You can implement your own instances for this if you like, but generally shouldn't need to.+class ChartColumn a where+  columnHeader :: Proxy a -> Column++instance ChartColumn Int where+  columnHeader _ = NumberColumn ""++instance ChartColumn Float where+  columnHeader _ = NumberColumn ""++instance ChartColumn Double where+  columnHeader _ = NumberColumn ""++instance ChartColumn Scientific where+  columnHeader _ = NumberColumn ""++instance ChartColumn T.Text where+  columnHeader _ = StringColumn ""++instance ChartColumn String where+  columnHeader _ = StringColumn ""++instance ChartColumn Bool where+  columnHeader _ = BoolColumn ""++-- | A constraint representing a type which can be converted into a chart row+--+-- This constraint is satisfied by tuple types containing JSON serializable types.+--+-- E.g. data rows of type @(Text, Int, Float)@ will infer a chart with a String column and two number+-- columns.+--+-- You shouldn't need to implement any instances of this constraint yourself.+type ChartRowAuto a = (ADT a, Constraints a ToJSON)++-- | A constraint that a column-type can be determined for all elements of the provided tuple+-- type.+type ChartRowHeaderAuto a = (Constraints a ChartColumn)+++-- | Create a chart from the provided options, style, and data by inferring column header+-- types.+--+-- Prefer 'autoChartWithHeaders' when you know your column headers up front.+--+-- E.g. The following generates a 2-series bar chart with 4 sections, A, B, C, D+--+-- @+-- myAutoChart :: Chart+-- myAutoChart = autoChart defaultChartOptions BarChart myData+--   where+--     myData :: [(T.Text, Float, Int)]+--     myData = [ ("A", 16, 20)+--              , ("B", 11, 23)+--              , ("C", 9, 25)+--              , ("D", 8, 34)+--              ]+-- @+autoChart :: forall row. (ChartRowHeaderAuto row, ChartRowAuto row) => ChartOptions -> ChartStyle -> [row] -> Chart+autoChart opts styl xs@[] = autoChartWithHeaders opts styl [] xs+autoChart opts styl (x:xs) = autoChartWithHeaders opts styl cols (x:xs)+  where+    cols :: [Column]+    cols = gfoldMap @ChartColumn toColumn x+    toColumn :: forall a. ChartColumn a => a -> [Column]+    toColumn _ = [columnHeader (Proxy @a)]++-- | Create a chart from the provided options, style, and data, but use the explicitly+-- provided column headers and types.+--+-- E.g. The following generates a 2-series bar chart with 4 sections, A, B, C, D+--+-- @+-- myAutoChart :: Chart+-- myAutoChart = autoChartWithHeaders defaultChartOptions BarChart headers myData+--   where+--     headers :: [Column]+--     headers = [StringColumn "Series", NumberColumn "Successes", NumberColumn "Inconclusive"]+--     myData :: [(T.Text, Float, Int)]+--     myData = [ ("A", 16, 20)+--              , ("B", 11, 23)+--              , ("C", 9, 25)+--              , ("D", 8, 34)+--              ]+-- @+autoChartWithHeaders :: forall row. (ChartRowAuto row) => ChartOptions -> ChartStyle -> [Column] -> [row] -> Chart+autoChartWithHeaders opts styl cols [] = buildChart opts styl cols []+autoChartWithHeaders opts styl cols (x:xs) = buildChart opts styl cols rows+  where+    rows :: [[Value]]+    rows = rowToJSON <$> (x:xs)+    rowToJSON :: row -> [Value]+    rowToJSON row = gfoldMap @ToJSON singleToRow row+    singleToRow :: forall a. ToJSON a => a -> [Value]+    singleToRow = (:[]) . toJSON
+ src/Charts/Internal/Chart.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Charts.Internal.Chart where++import qualified Data.Text as T+import Data.Aeson as A++-- | Valid Column types. Each "data" column also accepts a column header.+-- "Role" columns do not.+--+-- See https://developers.google.com/chart/interactive/docs/roles+data Column =+        NumberColumn T.Text+      | StringColumn T.Text+      | BoolColumn T.Text+      | DateColumn T.Text+      | DateTimeColumn T.Text+      | TimeOfDayColumn T.Text+      | AnnotationColumn+      | AnnotationTextColumn+      | CertaintyColumn+      | EmphasisColumn+      | IntervalColumn+      | ScopeColumn+      | StyleColumn+      | TooltipColumn+      | DomainColumn+    -- ^ This is typically inferred and explicitly+      | DataColumn+    -- ^ This is typically inferred and explicitly+  deriving (Show, Eq)++-- Types from https://developers.google.com/chart/interactive/docs/reference#DataTable_addColumn+instance ToJSON Column where+  toJSON col =+              case col of+                  StringColumn a -> object [ "label" .= a, "type" ~= "string"]+                  NumberColumn a -> object [ "label" .= a, "type" ~= "number"]+                  BoolColumn a -> object [ "label" .= a, "type" ~= "boolean"]+                  DateColumn a -> object [ "label" .= a, "type" ~= "date"]+                  DateTimeColumn a -> object [ "label" .= a, "type" ~= "datetime"]+                  TimeOfDayColumn a -> object [ "label" .= a, "type" ~= "timeofday"]+                  AnnotationColumn -> object ["role" ~= "annotation"]+                  AnnotationTextColumn -> object ["role" ~= "annotationText"]+                  CertaintyColumn -> object ["role" ~= "certainty"]+                  EmphasisColumn -> object ["role" ~= "emphasis"]+                  IntervalColumn -> object ["role" ~= "interval"]+                  ScopeColumn -> object ["role" ~= "scope"]+                  StyleColumn -> object ["role" ~= "style"]+                  TooltipColumn -> object ["role" ~= "tooltip"]+                  DomainColumn -> object ["role" ~= "domain"]+                  DataColumn -> object ["role" ~= "data"]+    where+      (~=):: T.Text -> T.Text -> (T.Text, Value)+      (~=) = (.=)++-- | Supported chart types+-- See https://developers.google.com/chart/interactive/docs/gallery+data ChartStyle = LineChart+                | Histogram+                | BarChart+                | ColumnChart+                | ScatterChart+                | AreaChart+                | PieChart+                | BubbleChart+                | SteppedAreaChart+                | CandlestickChart+                  deriving (Show, Eq, Ord)++instance ToJSON ChartStyle where+  toJSON = \case+    LineChart -> "line"+    Histogram -> "histogram"+    BarChart -> "bar"+    ColumnChart -> "column"+    ScatterChart -> "scatter"+    AreaChart -> "area"+    PieChart -> "pie"+    BubbleChart -> "bubble"+    SteppedAreaChart -> "steppedarea"+    CandlestickChart -> "candlestick"++-- | I plan to make this typesafe for each partiular chart type+-- but that's a LOT of work, so for now it's just free-form, if you'd actually+-- use this, please make an issue on Github so I know folks need this behaviour :)+--+-- Find your chart in the chart gallery to see which options it will accept.+--+-- https://developers.google.com/chart/interactive/docs/gallery+data ChartOptions = ChartOptions Value++instance ToJSON ChartOptions where+  toJSON (ChartOptions v) = v++-- | Empty chart options+defaultChartOptions :: ChartOptions+defaultChartOptions = ChartOptions (object [])++-- | The primary chart type. Build using 'buildChart'.+data Chart =+    Chart { options :: ChartOptions+          , style :: ChartStyle+          , columns :: [Column]+          , dataTable :: [[Value]]+          , dynamic :: Bool+          }++instance ToJSON Chart where+  toJSON (Chart{..}) =+      object [ "rows" .= dataTable+             , "options" .= options+             , "columns" .= columns+             , "style" .= style+             , "dynamic" .= dynamic+             ]++-- | Construct a chart.+--+-- e.g.+--+-- @+-- buildChart defaultChartOptions BarChart+--   [StringColumn "Year", NumberColumn "Population"]+--   [ [ String "2004", Number 1000 ]+--   , [ String "2005", Number 1170 ]+--   , [ String "2006", Number 660 ]+--   , [ String "2007", Number 1030 ]+--   ]+-- @+buildChart :: ChartOptions -> ChartStyle -> [Column] -> [[Value]] ->  Chart+buildChart opts style columns vals = Chart opts style columns vals True
+ src/Charts/Internal/Server.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}+module Charts.Internal.Server where+++import Charts.Internal.Chart+import Network.Wai+import Network.Wai.Handler.Warp+import Network.HTTP.Types.Status+import Data.Aeson+import Paths_charter+import Control.Concurrent.Async+import System.Process+import Control.Monad+import Control.Concurrent.MVar++-- | Serve a chart, updating along with the MVar+chartApp :: MVar Chart -> FilePath -> Application+chartApp chartVar indexFile req handler+      | pathInfo req == ["data"] = do+          chart <- readMVar chartVar+          handler (responseLBS ok200 [("Content-Type", "application/json")] (encode chart))+      | otherwise = do+          handler (responseFile ok200 mempty indexFile Nothing)++-- | Serve a single static chart on the given port+serveChart :: Port ->  Chart -> IO ()+serveChart port chart = do+    serveDynamicChart port (\handler -> handler (chart{dynamic=False}))++-- | Serve a chart on the given port.+-- The application can update the chart using the given handler.+serveDynamicChart :: Port -> ((Chart -> IO ()) -> IO ()) -> IO ()+serveDynamicChart port handler = do+    indexHtml <- getDataFileName "templates/index.html"+    chartVar <- newEmptyMVar+    let runServer = run port (chartApp chartVar indexHtml)+    let runHandler = handler (updateChart chartVar)+    withAsync (concurrently_ runServer runHandler) $ \procHandle -> do+        void $ spawnProcess "open" [("http://localhost:" <> show port)]+        wait procHandle+  where+    updateChart :: MVar Chart -> Chart -> IO ()+    updateChart var c = void $ do+      isEmpty <- isEmptyMVar var+      if isEmpty then putMVar var c+                 else void $ swapMVar var c+
+ templates/index.html view
@@ -0,0 +1,103 @@+<html>+    <head>+        <script type="text/javascript" src="https://www.gstatic.com/charts/loader.js"></script>+    </head>+    <body>+        <style>+            #error {+                margin: auto;+                color: maroon;+                background-color: #fdd0d0;+                padding: 1em;+                font-size: 1.5em;+            }++            #chart {+                width: 100%;+                height: 90vh;+                margin: auto;+            }++            .hidden {+                display: none;+            }+        </style>+        <div id="error" class="hidden"></div>+        <div id="chart"></div>++        <script type="text/javascript">+            var dynamic = true;+            google.charts.load('current', {'packages':['corechart']});+            google.charts.setOnLoadCallback(kickoff);+            function refresh() {+                if (!dynamic) {+                    return;+                }+                fetch('/data')+                    .then(resp => resp.json())+                    .then(chart => initChart(chart));+            }+            function kickoff() {+                refresh();+                window.setInterval(refresh, 1000)+            }+            function initChart(chart){+                dynamic = chart.dynamic;+                var errContainer = document.getElementById('error');+                errContainer.textContent = "";+                errContainer.classList.add('hidden');+                try {+                    var data = new google.visualization.DataTable();++                    chart.columns.forEach(col => {+                        data.addColumn(col);+                    })++                    data.addRows(chart.rows);++                    var destElem = document.getElementById("chart")+                    var gChart;+                    switch (chart.style) {+                        case 'line':+                            gChart = new google.visualization.LineChart(destElem);+                            break;+                        case 'histogram':+                            gChart = new google.visualization.Histogram(destElem);+                            break;+                        case 'bar':+                            gChart = new google.visualization.BarChart(destElem);+                            break;+                        case 'scatter':+                            gChart = new google.visualization.ScatterChart(destElem);+                            break;+                        case 'area':+                            gChart = new google.visualization.AreaChart(destElem);+                            break;+                        case 'column':+                            gChart = new google.visualization.ColumnChart(destElem);+                            break;+                        case 'pie':+                            gChart = new google.visualization.PieChart(destElem);+                            break;+                        case 'bubble':+                            gChart = new google.visualization.BubbleChart(destElem);+                            break;+                        case 'steppedarea':+                            gChart = new google.visualization.SteppedAreaChart(destElem);+                            break;+                        case 'candlestick':+                            gChart = new google.visualization.CandlestickChart(destElem);+                            break;+                        default:+                            alert('unknown chart style: ' + chart.style)+                            break;+                    }+                    gChart.draw(data, chart.options);+                } catch(err) {+                    errContainer.textContent = err.toString();+                    errContainer.classList.remove('hidden');+                }+            }+        </script>+    </body>+</html>
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"