diagrams-html5 (empty) → 1.3
raw patch · 7 files changed
+684/−0 lines, 7 filesdep +NumInstancesdep +basedep +cmdargssetup-changed
Dependencies added: NumInstances, base, cmdargs, containers, data-default-class, diagrams-core, diagrams-lib, lens, mtl, optparse-applicative, split, statestack, static-canvas, text
Files
- CHANGELOG.md +5/−0
- LICENSE +37/−0
- README.md +67/−0
- Setup.hs +3/−0
- diagrams-html5.cabal +42/−0
- src/Diagrams/Backend/Html5.hs +436/−0
- src/Diagrams/Backend/Html5/CmdLine.hs +94/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Change Log++## [1.3](http://github.com/diagrams/diagrams-html5/tree/v1.3) (19 April 2015)++- initial release
+ LICENSE view
@@ -0,0 +1,37 @@+Copyright (c) 2014 diagrams-canvas team:+ + Daniel Bergey <bergey@alum.mit.edu>+ Christopher Chalmers <c.chalmers@me.com>+ Jeffrey Rosenbluth <jeffrey.rosenbluth@gmail.com>+ Ryan Yates <fryguybob@gmail.com>+ Brent Yorgey <byorgey@cis.upenn.edu>+ Andy Gill <andygill@ku.edu>++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 Ryan Yates 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,67 @@+diagrams-html5+===============++diagrams-html5 is an HTML5 Canvas backend for **diagrams** based on the static-canvas+https://github.com/jeffreyrosenbluth/static-canvas package.++**diagrams** is a powerful, flexible, declarative domain-specific language for +creating vector graphics, using the Haskell programming language.++[diagrams-lib]: http://hackage.haskell.org/package/diagrams%2Dlib++# Installation++```+cabal update && cabal install diagrams-html5+```++# Usage++A simple example that uses _diagrams-html5_ to draw a the Sierpinski triangle.++++```haskell+import Diagrams.Prelude+import Diagrams.Backend.Html5.CmdLine++sierpinski 1 = eqTriangle 1+sierpinski n = s+ ===+ (s ||| s) # centerX+ where s = sierpinski (n-1)++example :: Diagram B+example = sierpinski 7 # center # lw none # fc black++main = mainWith $ example # frame 0.1+```++Save this to file named `Sierpinski.hs` and compile this program:++```+ghc Sierpinski.hs+```++This will generate an executable which, when run creates an html file+containing the HTML5 Canvas code to generate the diagram.++```+$ ./Sierpinski -o sierpinski.html -w 400+```++You _must_ pass an output file name with a `.html` extension.++```+Usage: ./Sierpinksi [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT] [--loop] [-s|--src ARG] [-i|--interval INTERVAL]+ Command-line diagram generation.++Available options:+ -?,--help Show this help text+ -w,--width WIDTH Desired WIDTH of the output image+ -h,--height HEIGHT Desired HEIGHT of the output image+ -o,--output OUTPUT OUTPUT file+ -l,--loop Run in a self-recompiling loop+ -s,--src ARG Source file to watch+ -i,--interval INTERVAL When running in a loop, check for changes every INTERVAL seconds.+```
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ diagrams-html5.cabal view
@@ -0,0 +1,42 @@+Name: diagrams-html5+Version: 1.3+Synopsis: HTML5 canvas backend for diagrams drawing EDSL+Description: This package provides a modular backend for rendering+ diagrams created with the diagrams EDSL using an+ HTML5 canvas.+Homepage: http://projects.haskell.org/diagrams/+License: BSD3+License-file: LICENSE+Author: Jeffrey Rosenbluth+Maintainer: diagrams-discuss@googlegroups.com+Bug-reports: http://github.com/diagrams/diagrams-html5/issues+Stability: Experimental+Category: Graphics+Build-type: Simple+Extra-source-files: README.md, CHANGELOG.md+Tested-with: GHC == 7.8.4, GHC == 7.10.1+Cabal-version: >=1.10+Source-repository head+ type: git+ location: https://github.com/diagrams/diagrams-html5.git++Library+ Exposed-modules: Diagrams.Backend.Html5+ Diagrams.Backend.Html5.CmdLine+ Hs-source-dirs: src+ Build-depends: base >= 4.6 && < 4.9,+ mtl >= 2.0 && < 3.0,+ NumInstances >= 1.0 && < 1.5,+ diagrams-core >= 1.3 && < 1.4,+ diagrams-lib >= 1.3 && < 1.4,+ cmdargs >= 0.6 && < 0.11,+ static-canvas >= 0.2 && < 0.3,+ lens >= 4.0 && < 4.10,+ containers >= 0.3 && < 0.6,+ text >= 1.0 && < 1.3,+ data-default-class >= 0.0.1 && < 0.1,+ statestack >= 0.2 && <0.3,+ optparse-applicative >= 0.10 && < 0.12,+ split >= 0.2 && < 0.3++ Default-language: Haskell2010
+ src/Diagrams/Backend/Html5.hs view
@@ -0,0 +1,436 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++-------------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Html5+-- Copyright : (c) 2015 Jeffrey Rosenbluth+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- A full-featured rendering backend for diagrams using HTML5 Canvas.+-- Implemented using the static-canvas package.+--+-- To invoke the Html5 backend, you have three options.+--+-- * You can use the "Diagrams.Backend.Html5.CmdLine" module to create+-- standalone executables which will display the diagram in a browser+-- using a web service.+--+-- * You can use the 'renderHtml5' function provided by this module,+-- which gives you more programmatic control over when and+-- how images are displayed (making it east to, for example, write a+-- single program that displays multiple images, or one that diaplays+-- images dynamically based on user input, and so on).+--+-- * For the most flexiblity you can invoke the 'renderDia' method from+-- 'Diagrams.Core.Types.Backend' instance for @Html5@. In particular,+-- 'Diagrams.Core.Types.renderDia' has the generic type+--+-- > renderDia :: b -> Options b v -> QDiagram b v m -> Result b v+--+-- (omitting a few type class contraints). @b@ represents the+-- backend type, @v@ the vector space, and @m@ the type of monoidal+-- query annotations on the diagram. 'Options' and 'Result' are+-- associated data and type families, respectively, which yield the+-- type of option records and rendering results specific to any+-- particular backend. For @b ~ Html5@ and @v ~ R2@, we have+--+-- > data Options Html5 V2 Double = Html5Options+-- > { _size :: SizeSpec V2 -- ^^ The requested size+-- > }+--+-- @+-- data family Render Html5 V2 Double = C (RenderM ())+-- @+--+-- @+-- type family Result Html5 V2 Double = Html5 ()+-- @+--+-- So the type of 'renderDia' resolves to+--+-- @+-- renderDia :: Html5 -> Options Html5 V2 Double -> QDiagram Html5 V2 Double m ->+-- Html5()+-- @+--+-- which you could call like @renderDia Html5 (Html5Options (width 250))+-- myDiagram@+--+------------------------------------------------------------------------------++module Diagrams.Backend.Html5++ ( Html5(..) -- rendering token+ , B+ , Options(..) -- for rendering options specific to Html5+ , renderHtml5++ -- * Lenses+ , size+ , canvasId+ , standalone++ ) where++import Control.Lens hiding (transform, (#))+import Control.Monad.State (when)+import qualified Control.Monad.StateStack as SS+import Control.Monad.Trans (lift)++import Data.Default.Class+import qualified Data.Foldable as F+import Data.Maybe (catMaybes, isJust, fromJust, fromMaybe)+import Data.NumInstances ()+import qualified Data.Text as T+import Data.Text.Lazy.Builder (Builder, toLazyText)+import qualified Data.Text.Lazy.IO as L+import Data.Tree (Tree(Node))+import Data.Typeable (Typeable)++import Diagrams.Attributes+import Diagrams.Prelude hiding (fillTexture, moveTo, stroke, size)+import Diagrams.TwoD.Adjust (adjustDia2D)+import Diagrams.TwoD.Attributes (splitTextureFills)+import Diagrams.TwoD.Path (Clip (Clip))+import Diagrams.TwoD.Text++import Diagrams.Core.Compile+import Diagrams.Core.Transform (matrixHomRep)+import Diagrams.Core.Types (Annotation (..))++import qualified Graphics.Static as H++-- | This data declaration is simply used as a token to distinguish+-- this rendering engine.+data Html5 = Html5+ deriving (Eq, Ord, Read, Show, Typeable)++type B = Html5++type instance V Html5 = V2+type instance N Html5 = Double++data Html5State = Html5State { _accumStyle :: Style V2 Double+ , _csPos :: (Double, Double) }++makeLenses ''Html5State++instance Default Html5State where+ def = Html5State { _accumStyle = mempty+ , _csPos = (0,0) }++type RenderM a = SS.StateStackT Html5State H.CanvasFree a++liftC :: H.CanvasFree a -> RenderM a+liftC = lift++runRenderM :: RenderM a -> H.CanvasFree a+runRenderM = flip SS.evalStateStackT def++instance Monoid (Render Html5 V2 Double) where+ mempty = C $ return ()+ (C c1) `mappend` (C c2) = C (c1 >> c2)++instance Backend Html5 V2 Double where+ data Render Html5 V2 Double = C (RenderM ())+ type Result Html5 V2 Double = Builder+ data Options Html5 V2 Double = Html5Options+ { _html5Size :: SizeSpec V2 Double -- ^ the requested size+ , _standalone :: Bool+ , _canvasId :: String+ }++ renderRTree :: Html5 -> Options Html5 V2 Double -> RTree Html5 V2 Double Annotation+ -> Result Html5 V2 Double+ renderRTree _ opts rt = buildF (round w) (round h)+ . runRenderM+ . runC+ . toRender $ rt+ where+ V2 w h = specToSize 100 (opts^.size)+ buildF | opts^.standalone = H.buildDoc+ | otherwise = \w h -> H.buildScript' w h (opts^.canvasId.to T.pack)++ adjustDia c opts d = adjustDia2D size c opts (d # reflectY)++runC :: Render Html5 V2 Double -> RenderM ()+runC (C r) = r++toRender :: RTree Html5 V2 Double Annotation -> Render Html5 V2 Double+toRender = fromRTree+ . Node (RStyle (mempty # recommendFillColor transparent))+ . (:[])+ . splitTextureFills+ where+ fromRTree (Node (RPrim p) _) = render Html5 p+ fromRTree (Node (RStyle sty) rs) = C $ do+ save+ html5Style sty+ accumStyle %= (<> sty)+ runC $ F.foldMap fromRTree rs+ restore+ fromRTree (Node _ rs) = F.foldMap fromRTree rs++-- lenses --------------------------------------------------------------++-- | Output size.+size :: Lens' (Options Html5 V2 Double) (SizeSpec V2 Double)+size = lens _html5Size $ \o i -> o { _html5Size = i }++-- | \"id\" for the @<canvas>@ element (prepended to \"StaticCanvas\").+-- Only applies to non-'standalone' diagrams.+canvasId :: Lens' (Options Html5 V2 Double) String+canvasId = lens _canvasId $ \o i -> o { _canvasId = i }++-- | Should the output be a standalone html file. Otherwise the output+-- is a @<canvas>@ element followed by a @<script>@ calling the+-- canvas.+standalone :: Lens' (Options Html5 V2 Double) Bool+standalone = lens _standalone $ \o i -> o { _standalone = i }++move :: Double -> Double -> RenderM ()+move x y = do csPos .= (x, y)++save :: RenderM ()+save = SS.save >> liftC H.save++restore :: RenderM ()+restore = liftC H.restore >> SS.restore++newPath :: RenderM ()+newPath = liftC $ H.beginPath++closePath :: RenderM ()+closePath = liftC $ H.closePath++moveTo :: Double -> Double -> RenderM ()+moveTo x y = do+ liftC $ H.moveTo x y+ move x y++relLineTo :: Double -> Double -> RenderM ()+relLineTo x y = do+ (p, q) <- use csPos+ let x' = p + x+ y' = q + y+ liftC $ H.lineTo x' y'+ move x' y'++relCurveTo :: Double -> Double -> Double -> Double -> Double -> Double -> RenderM ()+relCurveTo ax ay bx by cx cy = do+ p <- use csPos+ let [(ax',ay'),(bx',by'),(cx',cy')] = map (p +) [(ax,ay),(bx,by),(cx,cy)]+ liftC $ H.bezierCurveTo ax' ay' bx' by' cx' cy'+ move cx' cy'++-- | Get an accumulated style attribute from the render monad state.+getStyleAttrib :: AttributeClass a => (a -> b) -> RenderM (Maybe b)+getStyleAttrib f = (fmap f . getAttr) <$> use accumStyle++-- | From the HTML5 canvas specification regarding line width:+--+-- "On setting, zero, negative, infinite, and NaN values must be+-- ignored, leaving the value unchanged; other values must change+-- the current value to the new value.+--+-- Hence we must implement a line width of zero by simply not+-- sending a stroke command.+stroke :: RenderM ()+stroke = do+ -- The default value of 0.5 is somewhat arbitary since lineWidth should never+ -- be 'Nothing'. 0.5 is choose since it is the lower bound of the+ -- default.+ w <- fromMaybe 0.5 <$> getStyleAttrib getLineWidth+ when (w > (0 :: Double)) (liftC H.stroke)++fill :: RenderM ()+fill = liftC $ H.fill++clip :: RenderM ()+clip = liftC $ H.clip++byteRange :: Double -> Int+byteRange d = floor (d * 255)++texture :: (H.Style -> H.CanvasFree ()) -> Texture Double -> Double -> RenderM ()+texture styleFn (SC (SomeColor c)) o = liftC . styleFn $ s+ where s = H.ColorStyle $ colorJS c o++texture styleFn (LG g) _ = liftC $ do+ grd <- H.createLinearGradient x0 y0 x1 y1+ mapM_ (addStop grd) stops+ styleFn grd+ where+ (x0, y0) = unp2 $ transform (g^.lGradTrans) (g^.lGradStart)+ (x1, y1) = unp2 $ transform (g^.lGradTrans) (g^.lGradEnd)+ stops = map (\s -> ( s^.stopFraction , colorJS (s^.stopColor) 1)) (g^.lGradStops)++texture styleFn (RG g) _ = liftC $ do+ grd <- H.createRadialGradient x0 y0 r0 x1 y1 r1+ mapM_ (addStop grd) stops+ styleFn grd+ where+ (r0, r1) = (s * g^.rGradRadius0, s * g^.rGradRadius1)+ (x0, y0) = unp2 $ transform (g^.rGradTrans) (g^.rGradCenter0)+ (x1, y1) = unp2 $ transform (g^.rGradTrans) (g^.rGradCenter1)+ stops = map (\st -> ( st^.stopFraction , colorJS (st^.stopColor) 1)) (g^.rGradStops)+ s = avgScale $ g^.rGradTrans++addStop :: H.Style -> (Double, H.Color) -> H.CanvasFree ()+addStop g (f, c) = H.addColorStop f c g++colorJS :: (Color c) => c -> Double -> H.Color+colorJS c o = H.RGBA (byteRange r) (byteRange g) (byteRange b) (o * realToFrac a)+ where+ (r,g,b,a) = colorToSRGBA . toAlphaColour $ c++html5Transform :: T2 Double -> RenderM ()+html5Transform tr = liftC $ H.transform ax ay bx by tx ty+ where+ [[ax, ay], [bx, by], [tx, ty]] = (map . map) realToFrac (matrixHomRep tr)++strokeTexture :: Texture Double -> Double -> RenderM ()+strokeTexture = texture H.strokeStyle++fillTexture :: Texture Double -> Double -> RenderM ()+fillTexture = texture H.fillStyle++fromLineCap :: LineCap -> H.LineCapStyle+fromLineCap LineCapRound = H.LineCapRound+fromLineCap LineCapSquare = H.LineCapSquare+fromLineCap _ = H.LineCapButt++fromLineJoin :: LineJoin -> H.LineJoinStyle+fromLineJoin LineJoinRound = H.LineJoinRound+fromLineJoin LineJoinBevel = H.LineJoinBevel+fromLineJoin _ = H.LineJoinMiter++showFontJS :: FontWeight -> FontSlant -> Double -> String -> T.Text+showFontJS wgt slant sz fnt = T.concat [a, " ", b, " ", c, " ", d]+ where+ a = case wgt of+ FontWeightNormal -> ""+ FontWeightBold -> "bold"+ b = case slant of+ FontSlantNormal -> ""+ FontSlantItalic -> "italic"+ FontSlantOblique -> "oblique"+ c = T.concat [T.pack $ show sz, "pt"]+ d = T.pack fnt++renderC :: (Renderable a Html5, V a ~ V2, N a ~ Double) => a -> RenderM ()+renderC a = case (render Html5 a) of C r -> r++html5Style :: Style v Double -> RenderM ()+html5Style s = sequence_+ . catMaybes $ [ handle clip'+ , handle lWidth+ , handle lCap+ , handle lJoin+ ]+ where handle :: (AttributeClass a) => (a -> RenderM ()) -> Maybe (RenderM ())+ handle f = f `fmap` getAttr s+ clip' = mapM_ (\p -> html5Path p >> clip) . op Clip+ lWidth = liftC . H.lineWidth . getLineWidth+ lCap = liftC . H.lineCap . fromLineCap . getLineCap+ lJoin = liftC . H.lineJoin . fromLineJoin . getLineJoin++instance Renderable (Segment Closed V2 Double) Html5 where+ render _ (Linear (OffsetClosed (V2 x y))) = C $ relLineTo x y+ render _ (Cubic (V2 x1 y1)+ (V2 x2 y2)+ (OffsetClosed (V2 x3 y3)))+ = C $ relCurveTo x1 y1 x2 y2 x3 y3++instance Renderable (Trail V2 Double) Html5 where+ render _ = withTrail renderLine renderLoop+ where+ renderLine ln = C $ do+ mapM_ renderC (lineSegments ln)+ renderLoop lp = C $ do+ case loopSegments lp of+ (segs, Linear _) -> mapM_ renderC segs+ _ -> mapM_ renderC (lineSegments . cutLoop $ lp)+ closePath++instance Renderable (Path V2 Double) Html5 where+ render _ p = C $ do+ html5Path p+ f <- getStyleAttrib getFillTexture+ s <- getStyleAttrib getLineTexture+ o <- fromMaybe 1 <$> getStyleAttrib getOpacity+ save+ when (isJust f) (fillTexture (fromJust f) (realToFrac o) >> fill)+ strokeTexture (fromMaybe (SC (SomeColor (black :: Colour Double))) s) (realToFrac o)+ stroke+ restore++-- Add a path to the Html5 context, without stroking or filling it.+html5Path :: Path V2 Double -> RenderM ()+html5Path (Path trs) = do+ newPath+ F.mapM_ renderTrail trs+ where+ renderTrail (viewLoc -> (unp2 -> p, tr)) = do+ uncurry moveTo p+ renderC tr++instance Renderable (Text Double) Html5 where+ render _ (Text tr al str) = C $ do+ tf <- fromMaybe "Calibri" <$> getStyleAttrib getFont+ sz <- fromMaybe 12 <$> getStyleAttrib getFontSize+ slant <- fromMaybe FontSlantNormal <$> getStyleAttrib getFontSlant+ fw <- fromMaybe FontWeightNormal <$> getStyleAttrib getFontWeight+ tx <- fromMaybe (SC (SomeColor (black :: Colour Double)))+ <$> getStyleAttrib getFillTexture+ o <- fromMaybe 1 <$> getStyleAttrib getOpacity+ let fSize = avgScale tr * sz+ fnt = showFontJS fw slant fSize tf+ vAlign = case al of+ BaselineText -> H.TextBaselineIdeographic+ BoxAlignedText _ h -> case h of+ h' | h' <= 0.25 -> H.TextBaselineBottom+ h' | h' >= 0.75 -> H.TextBaselineTop+ _ -> H.TextBaselineMiddle+ hAlign = case al of+ BaselineText -> H.TextAlignStart+ BoxAlignedText w _ -> case w of+ w' | w' <= 0.25 -> H.TextAlignStart+ w' | w' >= 0.75 -> H.TextAlignEnd+ _ -> H.TextAlignCenter+ save+ liftC $ H.textBaseline vAlign+ liftC $ H.textAlign hAlign+ liftC $ H.font fnt+ fillTexture tx (realToFrac o)+ html5Transform (tr <> reflectionY)+ liftC $ H.fillText (T.pack str) 0 0+ restore++instance Renderable (DImage Double External) Html5 where+ render _ (DImage path w h tr) = C $ do+ let ImageRef file = path+ save+ html5Transform (tr <> reflectionY)+ img <- liftC $ H.newImage (T.pack file)+ liftC $ H.drawImageSize img (fromIntegral (-w) / 2) (fromIntegral (-h) / 2)+ (fromIntegral w) (fromIntegral h)+ restore++renderHtml5 :: FilePath -> SizeSpec V2 Double -> QDiagram Html5 V2 Double Any -> IO ()+renderHtml5 outFile spec+ = L.writeFile outFile+ . toLazyText+ . renderDia Html5 (Html5Options spec True "")
+ src/Diagrams/Backend/Html5/CmdLine.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.Html5.CmdLine+-- Copyright : (c) 2015 Jeffrey Rosenbluth+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- Convenient creation of command-line-driven executables for+-- rendering diagrams using the Html5 backend.+--+--+-- * 'defaultMain' creates an executable which can render a single+-- diagram at various options.+--+-- * 'multiMain' is like 'defaultMain' but allows for a list of+-- diagrams from which the user can choose one to render.+--+-- * 'mainWith' is a generic form that does all of the above but with+-- a slightly scarier type. See "Diagrams.Backend.CmdLine". This+-- form can also take a function type that has a suitable final result+-- (any of arguments to the above types) and 'Parseable' arguments.+--+-- If you want to generate diagrams programmatically---/i.e./ if you+-- want to do anything more complex than what the below functions+-- provide---you have several options.+--+-- * Use a function with 'mainWith'. This may require making+-- 'Parseable' instances for custom argument types.+--+-- * Make a new 'Mainable' instance. This may require a newtype+-- wrapper on your diagram type to avoid the existing instances.+-- This gives you more control over argument parsing, intervening+-- steps, and diagram creation.+--+-- * Build option records and pass them along with a diagram to 'mainRender'+-- from "Diagrams.Backend.CmdLine".+--+-- For a tutorial on command-line diagram creation see+-- <http://projects.haskell.org/diagrams/doc/cmdline.html>.+--+-----------------------------------------------------------------------------++module Diagrams.Backend.Html5.CmdLine+ ( + -- * General form of @main@+ -- $mainWith+ mainWith++ -- * Supported froms of @main@+ , defaultMain+ , multiMain+ , Html5+ , B+ ) where++import Diagrams.Prelude hiding (width, height, option, (<>), value, output)+import Diagrams.Backend.CmdLine +import Diagrams.Backend.Html5++import Data.List.Split (splitOn)+import Control.Lens ((^.))++defaultMain :: QDiagram Html5 V2 Double Any -> IO ()+defaultMain = mainWith+ +instance Mainable (QDiagram Html5 V2 Double Any) where+ type MainOpts (QDiagram Html5 V2 Double Any) = DiagramOpts+ mainRender = html5Render++html5Render :: DiagramOpts -> QDiagram Html5 V2 Double Any -> IO ()+html5Render opts d =+ case splitOn "." (opts^.output) of+ [""] -> putStrLn "No output file given."+ ps | last ps `elem` ["html"] -> do+ let szSpec = fromIntegral <$> mkSizeSpec2D (opts^.width) (opts^.height)+ renderHtml5 (opts^.output) szSpec d+ | otherwise -> putStrLn $ "Unknown file type: " ++ last ps++multiMain :: [(String, QDiagram Html5 V2 Double Any)] -> IO ()+multiMain = mainWith++instance Mainable [(String, QDiagram Html5 V2 Double Any)] where+ type MainOpts [(String, QDiagram Html5 V2 Double Any)] = + (MainOpts (QDiagram Html5 V2 Double Any), DiagramMultiOpts)++ mainRender = defaultMultiMainRender