diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Anders Jellinggaard + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Text/DocL.hs b/src/Text/DocL.hs new file mode 100644 --- /dev/null +++ b/src/Text/DocL.hs @@ -0,0 +1,182 @@ +{-| +Module : Text.DocL +Copyright : 2015 Anders Jellinggaard +License : MIT +Maintainer : anders.jel@gmail.com +Stability : experimental + +Haskell mini-language to create HTML documents with a mixture of markup and +plots based on the library. + +See the for an +introduction. + +Notes: + +* The generated documents relies on to serve + and friends. + +* This library should not be used on a public facing server with input supplied + by the user. The library has not been properly vetted for security issues. +-} + +module Text.DocL ( + Doc, + -- * Markup + text, header, markdown, html, + -- * Output + render, renderToFile, + -- * Plotting + Column, col, col', + plot, plot', rawPlot, + -- * Utilities + linspace + ) where + +import Data.Aeson (ToJSON, object, toJSON, (.=)) +import Data.Foldable +import Data.HashMap.Strict (insert, unionWith) +import Data.Monoid +import Data.Sequence (Seq, singleton) +import Data.String (IsString (..)) +import Text.Blaze.Html.Renderer.Utf8 (renderHtml) +import Text.Blaze.Html5 ((!)) + +import qualified Text.Markdown as Markdown +import qualified Data.Aeson as Aeson +import qualified System.IO as IO +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as A +import qualified Data.ByteString.Lazy as B + +data Node = Chart Aeson.Value | Html H.Html + +-- | Base type representing a document. This type allows composition via the +-- 'Monoid' instance. +newtype Doc = Doc (Seq Node) deriving Monoid + +-- | Represent a column of a dataset where each row has type /a/. See 'col' for +-- details. +data Column a = Column + { _header :: String + , _extract :: a -> Aeson.Value + } + +-- | Deep merge of two 'Aeson.Value's. Used to merge in options in 'plot''. +merge :: Aeson.Value -> Aeson.Value -> Aeson.Value +merge (Aeson.Object x) (Aeson.Object y) = Aeson.Object $ unionWith merge x y +merge _ x = x + +-- | Polymorphic version of 'col'. This allows, for instance, 'Int' and 'String' +-- values to be used in plots. It is up to the caller to ensure that the values +-- make sense to . +col' :: ToJSON b => String -> (a -> b) -> Column a +col' h f = Column h (toJSON . f) + +-- | Data sets are supplied to 'plot' as a collection of elements of type /a/. +-- This function sets up a 'Column', which knows how to extract one 'Double' +-- value from each value of type /a/ in the collection. +-- +-- The first argument to 'col' is the header of the column, which is used in the +-- legend of the plot. +-- +-- The simplest plot that can be created consist of one column for the /x/ +-- values and one column for the /y/ values. +-- +-- @ +-- -- Plot x² vs x. +-- plot [1..10] (col "x" id) [col "x²" $ \\x -> x*x] +-- @ +col :: String -> (a -> Double) -> Column a +col = col' + +-- | > plot ds x ys +-- +-- Plots the data in /ds/ using the column /x/ for the values on the /x/-axis +-- and with one line on the plot for each column in /ys/. See also 'col'. +plot :: Foldable f => f a -> Column a -> [Column a] -> Doc +plot d x ys = plot' d x ys (Aeson.Object mempty) + +-- | Same as 'plot', but takes a final argument which should be a "Data.Aeson" +-- object. This is merged with the configuration object supplied to +-- . This allows the caller to customize the plot. +-- +-- @ +-- -- Plot x² vs x with the points hidden. +-- plot' [1..10] (col "x" id) [col "x²" $ \\x -> x*x] $ +-- object ["point" .= object ["show" .= False]] +-- @ +-- +-- See for the many properties that can be used +-- here. +plot' :: Foldable f => f a -> Column a -> [Column a] -> Aeson.Value -> Doc +plot' d x ys options = rawPlot $ merge obj options + where + obj = object + [ "data" .= object + [ "rows" .= (toJSON (_header x : map _header ys) : map f (toList d)) + , "x" .= _header x + ] + ] + f p = toJSON $ map (`_extract` p) (x:ys) + +-- | This function sends the supplied json object directly to +-- . This is the do-it-yourself option which exposes all +-- of . The object receives a +-- property, +-- targeting a @\@ tag placed appropriately. +rawPlot :: Aeson.ToJSON a => a -> Doc +rawPlot = Doc . singleton . Chart . Aeson.toJSON + +-- | Creates a 'Doc' representing raw html. +html :: H.Html -> Doc +html = Doc . singleton . Html + +-- | Creates a 'Doc' representing plain text. The string will be properly +-- escaped. +text :: String -> Doc +text = html . H.p . H.toMarkup + +-- | Creates a 'Doc' representing @\@ header tag. The string will be +-- properly escaped. +header :: String -> Doc +header = html . H.h1 . H.toMarkup + +-- | Converts a string in +-- to a 'Doc'. +markdown :: String -> Doc +markdown = html . Markdown.markdown Markdown.def . fromString + +-- | Render a document to a lazy 'B.ByteString'. +render :: Doc -> B.ByteString +render (Doc doc) = renderHtml html + where + dns = "https://cdnjs.cloudflare.com/ajax/libs/" + html = H.docTypeHtml $ do + H.head $ do + H.link ! A.rel "stylesheet" ! A.href (dns <> "c3/0.4.9/c3.min.css") + H.script ! A.charset "utf-8" ! A.src (dns <> "d3/3.5.3/d3.min.js") $ + mempty + H.script ! A.charset "utf-8" ! A.src (dns <> "c3/0.4.9/c3.min.js") $ + mempty + H.body $ + foldMap f (zip [(0::Int)..] $ toList doc) + f (_, (Html t)) = t + f (i, (Chart v)) = divTag <> scriptTag + where + name = "plot" <> show i + divTag = H.div ! A.id (fromString name) $ mempty + (Aeson.Object obj) = v + obj' = insert "bindto" (fromString $ "#" <> name) obj + json = H.unsafeLazyByteString $ Aeson.encode obj' + scriptTag = H.script ! A.type_ "text/javascript" $ + H.preEscapedToMarkup $ "c3.generate(" <> json <> ");" + +-- | If the file exists, it will be overwritten. +renderToFile :: FilePath -> Doc -> IO () +renderToFile p = B.writeFile p . render + +-- | /'linspace' x y n/ generates /n/ evenly spaced values from /x/ to /y/. +linspace :: Fractional a => a -> a -> Int -> [a] +linspace x y n = [x + (fromIntegral i)*d | i <- [0 .. n - 1]] + where d = (y - x) / (fromIntegral n - 1) diff --git a/text-and-plots.cabal b/text-and-plots.cabal new file mode 100644 --- /dev/null +++ b/text-and-plots.cabal @@ -0,0 +1,44 @@ +name: text-and-plots +version: 0.1.0.0 +synopsis: + EDSL to create HTML documents with plots based on the C3.js library. +description: + Haskell mini-language to create HTML documents with a mixture of markup and + plots based on the library. See the + for an + introduction. +homepage: https://github.com/andersjel/haskell-text-and-plots +license: MIT +license-file: LICENSE +author: Anders Jellinggaard +maintainer: anders.jel@gmail.com +copyright: (c) 2015 Anders Jellinggaard +category: Text +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: git + location: git://github.com/andersjel/haskell-text-and-plots.git + +source-repository this + type: git + location: git://github.com/andersjel/haskell-text-and-plots.git + tag: v0.1.0.0 + +library + exposed-modules: + Text.DocL + build-depends: + aeson >=0.8.0.0 && <0.9, + base >=4.7.0.0 && <4.8, + blaze-html >=0.7.0.0 && <0.8, + bytestring >=0.10.4.0 && <0.11, + containers >=0.5.5.1 && <0.6, + markdown >=0.1.7.1 && <0.2, + unordered-containers >=0.2.3.3 && <0.3 + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: + OverloadedStrings + GeneralizedNewtypeDeriving