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 +3/−0
- LICENSE +30/−0
- README.md +34/−0
- Setup.hs +2/−0
- app/Examples/AreaChart.hs +19/−0
- app/Examples/Auto.hs +24/−0
- app/Examples/BarChart.hs +31/−0
- app/Examples/ColumnChart.hs +19/−0
- app/Examples/Histogram.hs +48/−0
- app/Examples/LineChart.hs +23/−0
- app/Examples/Random.hs +25/−0
- app/Examples/ScatterChart.hs +20/−0
- app/Main.hs +19/−0
- charter.cabal +114/−0
- src/Charts.hs +20/−0
- src/Charts/Internal/Auto.hs +112/−0
- src/Charts/Internal/Chart.hs +137/−0
- src/Charts/Internal/Server.hs +47/−0
- templates/index.html +103/−0
- test/Spec.hs +2/−0
+ 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"