Skip to content

Commit

Permalink
Add BackendBuild class.
Browse files Browse the repository at this point in the history
  • Loading branch information
cchalmers committed Jan 19, 2015
1 parent 589654a commit 2309bff
Show file tree
Hide file tree
Showing 2 changed files with 31 additions and 0 deletions.
1 change: 1 addition & 0 deletions diagrams-lib.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ Library
Diagrams.Attributes,
Diagrams.Attributes.Compile,
Diagrams.Backend.CmdLine,
Diagrams.Backend.Build,
Diagrams.BoundingBox,
Diagrams.Combinators,
Diagrams.Coordinates,
Expand Down
30 changes: 30 additions & 0 deletions src/Diagrams/Backend/Build.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
{-# LANGUAGE MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module : Diagrams.Builder.Class
-- Copyright : (c) 2014 diagrams-lib team (see LICENSE)
-- License : BSD-style (see LICENSE)
-- Maintainer : [email protected]
--
-- General class for building diagrams to files.
--
-----------------------------------------------------------------------------
module Diagrams.Backend.Build where

import Diagrams.Core
import Diagrams.Size
import Data.Monoid (Any)
import Linear.V2
import Control.Lens (Lens')

-- | Generic class for building diagrams whose output is a file with a
-- 2D size.
class Backend b v n => BackendBuild b v n where
-- | Lens onto the size of the output file.
outputSize :: Lens' (Options b v n) (SizeSpec V2 n)

-- | Build a diagram of the given format to the path using the
-- backend's options. The @Maybe String@ returns any errors.
saveDia :: FilePath -> Options b v n -> QDiagram b v n Any -> IO ()

0 comments on commit 2309bff

Please sign in to comment.