{-# LANGUAGE ConstraintKinds, DeriveDataTypeable, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GADTs,
             MultiParamTypeClasses, NoMonomorphismRestriction, OverloadedStrings, TypeFamilies, UndecidableInstances #-}

-------------------------------------------------------------------
-- |
-- Module     : Diagrams.SVG.ReadSVG
-- Copyright  : (c) 2015 Tillmann Vogt <tillk.vogt@googlemail.com>
-- License    :  BSD-style (see LICENSE)
-- Maintainer :  diagrams-discuss@googlegroups.com
--
-- Maintainer : diagrams-discuss@googlegroups.com
-- Stability  : stable
-- Portability: portable

-------------------------------------------------------------------

module Diagrams.SVG.ReadSVG
    (
    -- * Main functions
      readSVGFile
    , preserveAspectRatio
    , nodes
    , insertRefs
    , PreserveAR(..)
    , AlignSVG(..)
    , Place(..)
    , MeetOrSlice(..)
    , InputConstraints(..)
    -- * Parsing of basic structure tags
    , parseSVG
    , parseG
    , parseDefs
    , parseSymbol
    , parseUse
    , parseSwitch
    , parseDesc
    , parseTitle
--    , parseMetaData
    -- * Parsing of basic shape tags
    , parseRect
    , parseCircle
    , parseEllipse
    , parseLine
    , parsePolyLine
    , parsePolygon
    , parsePath
    -- * Parsing of Gradient tags
    , parseLinearGradient
    , parseRadialGradient
    , parseSet
    , parseStop
    -- * Parsing of other tags
    , parseClipPath
    , parsePattern
    , parseFilter
    , parseImage
    , parseText
    -- * Parsing data uri in <image>
    , dataUriToImage
    ) where

import           Codec.Picture
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Resource
import           Control.Monad.Trans.Class
import           Data.Either.Combinators
import qualified Data.Attoparsec.Text as AT
import qualified Data.Attoparsec.ByteString as ABS
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as Base64
import           Data.Conduit
import qualified Data.Conduit.List as CL
import qualified Data.Colour
import qualified Data.Conduit.List as C
import qualified Data.HashMap.Strict as H
import           Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Text as T
import           Data.Text(Text(..))
import           Data.Text.Encoding
import           Data.Typeable (Typeable)
import           Data.XML.Types
import           Diagrams.Attributes
import           Diagrams.Prelude
import           Diagrams.TwoD.Ellipse
import           Diagrams.TwoD.Path (isInsideEvenOdd)
import           Diagrams.TwoD.Size
import           Diagrams.TwoD.Types
import qualified Diagrams.TwoD.Text as TT
import           Diagrams.SVG.Arguments
import           Diagrams.SVG.Attributes
import           Diagrams.SVG.Fonts.ReadFont
import           Diagrams.SVG.Path (commands, commandsToPaths, PathCommand(..))
import           Diagrams.SVG.Tree
import           Filesystem.Path (FilePath(..), extension)
import           Filesystem.Path.CurrentOS (encodeString)
import           Prelude hiding (FilePath)
import           Text.XML.Stream.Parse hiding (parseText)
import           Text.CSS.Parse (parseBlocks)

import           Debug.Trace
--------------------------------------------------------------------------------------
-- | Main library function
-- 
-- @
-- \{-\# LANGUAGE OverloadedStrings \#-\}
--
-- module Main where
-- import Diagrams.SVG.ReadSVG
-- import Diagrams.Prelude
-- import Diagrams.Backend.SVG.CmdLine
-- import System.Environment
-- import Filesystem.Path.CurrentOS
-- import Diagrams.SVG.Attributes (PreserveAR(..), AlignSVG(..), Place(..), MeetOrSlice(..))
--
-- main = do
--    diagramFromSVG <- readSVGFile \"svgs/web.svg\"
--    mainWith $ diagramFromSVG
-- @
--
readSVGFile :: (V b ~ V2, N b ~ n, RealFloat n, Renderable (Path V2 n) b, Renderable (DImage n Embedded) b, -- TODO upper example
                Typeable b, Typeable n, Show n, Read n, n ~ Place, Renderable (TT.Text n) b) 
             => Filesystem.Path.FilePath -> IO (Either String (Diagram b))
readSVGFile :: FilePath -> IO (Either String (Diagram b))
readSVGFile FilePath
fp = if (FilePath -> Maybe Text
extension FilePath
fp) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
/= (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"svg") then Either String (QDiagram b V2 Place Any)
-> IO (Either String (QDiagram b V2 Place Any))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (QDiagram b V2 Place Any)
 -> IO (Either String (QDiagram b V2 Place Any)))
-> Either String (QDiagram b V2 Place Any)
-> IO (Either String (QDiagram b V2 Place Any))
forall a b. (a -> b) -> a -> b
$ String -> Either String (QDiagram b V2 Place Any)
forall a b. a -> Either a b
Left String
"Not a svg file" else -- TODO All exceptions into left values
  ResourceT IO (Either String (Diagram b))
-> IO (Either String (Diagram b))
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Either String (Diagram b))
 -> IO (Either String (Diagram b)))
-> ResourceT IO (Either String (Diagram b))
-> IO (Either String (Diagram b))
forall a b. (a -> b) -> a -> b
$ do Tag b Place
tree <- ParseSettings -> String -> ConduitT () Event (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
ParseSettings -> String -> ConduitT i Event m ()
parseFile ParseSettings
forall a. Default a => a
def (FilePath -> String
encodeString FilePath
fp) ConduitT () Event (ResourceT IO) ()
-> Sink Event (ResourceT IO) (Tag b Place)
-> ResourceT IO (Tag b Place)
forall (m :: * -> *) a b.
Monad m =>
Source m a -> Sink a m b -> m b
$$ String
-> ConduitT Event Void (ResourceT IO) (Maybe (Tag b Place))
-> Sink Event (ResourceT IO) (Tag b Place)
forall (m :: * -> *) a.
MonadThrow m =>
String -> m (Maybe a) -> m a
force String
"error in parseSVG" ConduitT Event Void (ResourceT IO) (Maybe (Tag b Place))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Renderable (Text n) b,
 Read n) =>
Sink Event m (Maybe (Tag b n))
parseSVG
                    Either String (Diagram b)
-> ResourceT IO (Either String (Diagram b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Diagram b -> Either String (Diagram b)
forall a b. b -> Either a b
Right (Tag b Place -> Diagram b
forall n b.
(RealFloat n, V b ~ V2, n ~ N b, Typeable n, Read n, n ~ Place) =>
Tag b n -> Diagram b
diagram Tag b Place
tree))

diagram :: (RealFloat n, V b ~ V2, n ~ N b, Typeable n, Read n, n ~ Place) => Tag b n -> Diagram b
diagram :: Tag b n -> Diagram b
diagram Tag b n
tr = ((HashMaps b n, ViewBox n) -> Tag b n -> Diagram b
forall b n.
(V b ~ V2, N b ~ n, RealFloat n, Place ~ n) =>
(HashMaps b n, ViewBox n) -> Tag b n -> Diagram b
insertRefs ((HashMap Text (Tag b n)
nmap,HashMap Text Attrs
cssmap,GradientsMap n
expandedGradMap),(n
0,n
0,n
100,n
100)) Tag b n
tr) QDiagram b V2 Place Any
-> (QDiagram b V2 Place Any -> QDiagram b V2 Place Any)
-> QDiagram b V2 Place Any
forall a b. a -> (a -> b) -> b
# Place -> QDiagram b V2 Place Any -> QDiagram b V2 Place Any
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY (-Place
1) QDiagram b V2 Place Any
-> (QDiagram b V2 Place Any -> QDiagram b V2 Place Any)
-> QDiagram b V2 Place Any
forall a b. a -> (a -> b) -> b
# QDiagram b V2 Place Any -> QDiagram b V2 Place Any
forall c.
(HasStyle c, Typeable (N c), Floating (N c), Ord (N c),
 V c ~ V2) =>
c -> c
initialStyles
  where
    (Nodelist b n
ns,CSSlist
css,Gradlist n
grad,Fontlist b n
fonts) = Maybe (ViewBox n)
-> (Nodelist b n, CSSlist, Gradlist n, Fontlist b n)
-> Tag b n
-> (Nodelist b n, CSSlist, Gradlist n, Fontlist b n)
forall n b.
Maybe (ViewBox n)
-> (Nodelist b n, CSSlist, Gradlist n, Fontlist b n)
-> Tag b n
-> (Nodelist b n, CSSlist, Gradlist n, Fontlist b n)
nodes Maybe (ViewBox n)
forall a. Maybe a
Nothing ([],[],[], []) Tag b n
tr
    nmap :: HashMap Text (Tag b n)
nmap    = Nodelist b n -> HashMap Text (Tag b n)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList Nodelist b n
ns -- needed because of the use-tag and clipPath
    cssmap :: HashMap Text Attrs
cssmap  = CSSlist -> HashMap Text Attrs
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList CSSlist
css -- CSS inside the <defs> tag
    gradmap :: GradientsMap n
gradmap = Gradlist n -> GradientsMap n
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList Gradlist n
grad
    expandedGradMap :: GradientsMap n
expandedGradMap = GradientsMap n -> GradientsMap n
forall n. GradientsMap n -> GradientsMap n
expandGradMap GradientsMap n
gradmap


-- | Read font data from font file, and compute its outline map.
--
{-
loadFont :: (Read n, RealFloat n) => FilePath -> IO (Either String (PreparedFont n))
loadFont filename = if (extension fp) /= (Just "svg") then return $ Left "Not a svg file" else -- TODO All exceptions into left values
  runResourceT $ runEitherT $ do
    tree <- lift (parseFile def fp $$ force "error in parseSVG" parseSVG)
    let fontData = font tree
    case fontData of Left s -> return (Left s)
                     Right s -> do let (font, errs) = prepareFont fontData
                                   sequence_ [ putStrLn ("error parsing character '" ++ ch ++ "': " ++ err)
                                             | (ch, err) <- Map.toList errs
                                             ]
                                   return font

font tr = fonts
  where (ns,css,grad,fonts) = nodes Nothing ([],[],[], []) tr
-}
-------------------------------------------------------------------------------------
-- Basic SVG structure

tagName :: Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
name = NameMatcher Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' ((Name -> Bool) -> NameMatcher Name
Text.XML.Stream.Parse.matching (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name))

class (V b ~ V2, N b ~ n, RealFloat n, Renderable (Path V2 n) b, Typeable n, Typeable b, Show n,
       Renderable (DImage n Embedded) b) => InputConstraints b n

instance (V b ~ V2, N b ~ n, RealFloat n, Renderable (Path V2 n) b, Typeable n, Typeable b, Show n,
          Renderable (DImage n Embedded) b) => InputConstraints b n

-- | Parse \<svg\>, see <http://www.w3.org/TR/SVG/struct.html#SVGElement>
parseSVG :: (MonadThrow m, InputConstraints b n, Renderable (TT.Text n) b, Read n) 
          => Sink Event m (Maybe (Tag b n))
parseSVG :: Sink Event m (Maybe (Tag b n))
parseSVG = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, NameSpaces, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, NameSpaces, Maybe Text)
    -> ConduitT Event Void m (Tag b n))
-> Sink Event m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}svg" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, NameSpaces, Maybe Text)
svgAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, NameSpaces, Maybe Text)
  -> ConduitT Event Void m (Tag b n))
 -> Sink Event m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, NameSpaces, Maybe Text)
    -> ConduitT Event Void m (Tag b n))
-> Sink Event m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
vb,Maybe Text
ar,Maybe Text
zp,Maybe Text
ver,Maybe Text
baseprof,Maybe Text
cScripT,Maybe Text
cStyleT,NameSpaces
xmlns,Maybe Text
xml) ->
   do [Tag b n]
gs <- Sink Event m (Maybe (Tag b n)) -> ConduitT Event Void m [Tag b n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many Sink Event m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n, Read n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
gContent
      let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++ -- parse the style attribute (style="stop-color:#000000;stop-opacity:0.8")
                     (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++ -- presentation attributes: stop-color="#000000" stop-opacity="0.8"
                     ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"svg" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
      let pw :: Place
pw = if (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
w) then Text -> Place
forall n. RealFloat n => Text -> n
parseDouble (Text -> Place) -> Text -> Place
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
w else Place
0
      let ph :: Place
ph = if (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
h) then Text -> Place
forall n. RealFloat n => Text -> n
parseDouble (Text -> Place) -> Text -> Place
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
h else Place
0
      Tag b n -> ConduitT Event Void m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event Void m (Tag b n))
-> Tag b n -> ConduitT Event Void m (Tag b n)
forall a b. (a -> b) -> a -> b
$ -- Debug.Trace.trace ("@" ++ show vb ++ show (parseViewBox vb w h)) (
               Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n))
    -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
forall b n.
Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
True (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca)
                            (Place
pw,Place
ph)
                            (Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
forall n.
RealFloat n =>
Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
parseViewBox Maybe Text
vb Maybe Text
w Maybe Text
h)
                            (Maybe Text -> Maybe PreserveAR
parsePreserveAR Maybe Text
ar)
                            (((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st)
                            ([Tag b n] -> [Tag b n]
forall a. [a] -> [a]
reverse [Tag b n]
gs)

svgContent :: (MonadThrow m, InputConstraints b n, Renderable (TT.Text n) b, Read n) 
            => Consumer Event m (Maybe (Tag b n))
svgContent :: Consumer Event m (Maybe (Tag b n))
svgContent = [ConduitT Event o m (Maybe (Tag b n))]
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose -- the likely most common are checked first
     [ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Renderable (Text n) b,
 Read n) =>
Consumer Event m (Maybe (Tag b n))
parseG, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n) =>
Consumer Event m (Maybe (Tag b n))
parsePath, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseCircle, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseRect, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseEllipse, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseLine, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parsePolyLine, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parsePolygon,
      ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Renderable (Text n) b,
 Read n) =>
Consumer Event m (Maybe (Tag b n))
parseDefs, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Renderable (Text n) b,
 Read n) =>
Consumer Event m (Maybe (Tag b n))
parseSymbol, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Typeable n) =>
Consumer Event m (Maybe (Tag b n))
parseUse, -- structural elements
      ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n, Read n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
parseClipPath, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parsePattern, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n,
 Renderable (DImage (N b) Embedded) b, Typeable b, Typeable n) =>
Consumer Event m (Maybe (Tag b n))
parseImage, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Read n, RealFloat n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
parseText, -- parseSwitch, parseSodipodi,
      ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Renderable (Text n) b,
 Read n) =>
Consumer Event m (Maybe (Tag b n))
skipArbitraryTag] -- should always be last!
      -- parseDesc, parseMetaData, parseTitle] -- descriptive Elements

---------------------------------------------------------------------------
-- | Parse \<g\>, see <http://www.w3.org/TR/SVG/struct.html#GElement>
parseG :: (MonadThrow m, InputConstraints b n, Renderable (TT.Text n) b, Read n) 
        => Consumer Event m (Maybe (Tag b n))
parseG :: Consumer Event m (Maybe (Tag b n))
parseG = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}g" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
gAttrs
   (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr) ->
   do [Tag b n]
insideGs <- ConduitT Event o m (Maybe (Tag b n))
-> ConduitT Event o m [Tag b n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n, Read n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
gContent
      let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"g" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n))
    -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
forall b n.
Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
True (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca)
                            (Place
0, Place
0)
                            Maybe (ViewBox n)
forall a. Maybe a
Nothing
                            Maybe PreserveAR
forall a. Maybe a
Nothing
                            (\(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps -> (((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps) (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Transform (N (QDiagram b V2 n Any))]
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a.
(RealFloat (N a), Transformable a, V a ~ V2) =>
[Transform (N a)] -> a -> a
applyTr (Maybe Text -> [Transform n]
forall n. RealFloat n => Maybe Text -> [Transform n]
parseTr Maybe Text
tr)) )
                            ([Tag b n] -> [Tag b n]
forall a. [a] -> [a]
reverse [Tag b n]
insideGs)

gContent :: (MonadThrow m, InputConstraints b n, Show n, Read n, Renderable (TT.Text n) b) 
          => Consumer Event m (Maybe (Tag b n))
gContent :: Consumer Event m (Maybe (Tag b n))
gContent = [ConduitT Event o m (Maybe (Tag b n))]
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose -- the likely most common are checked first
     [ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n) =>
Consumer Event m (Maybe (Tag b n))
parsePath, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Renderable (Text n) b,
 Read n) =>
Consumer Event m (Maybe (Tag b n))
parseG, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseRect, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseCircle, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseEllipse, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseLine, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parsePolyLine, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parsePolygon,
      ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Typeable n) =>
Consumer Event m (Maybe (Tag b n))
parseUse, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Renderable (Text n) b,
 Read n) =>
Consumer Event m (Maybe (Tag b n))
parseSymbol, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) n b.
(MonadThrow m, RealFloat n) =>
Consumer Event m (Maybe (Tag b n))
parseStyle, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Renderable (Text n) b,
 Read n) =>
Consumer Event m (Maybe (Tag b n))
parseDefs, -- structural elements
      ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n, Read n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
parseClipPath, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n) =>
Consumer Event m (Maybe (Tag b n))
parseLinearGradient, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n) =>
Consumer Event m (Maybe (Tag b n))
parseRadialGradient, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n,
 Renderable (DImage (N b) Embedded) b, Typeable b, Typeable n) =>
Consumer Event m (Maybe (Tag b n))
parseImage, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Read n, RealFloat n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
parseText, -- parseFont,
      ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Renderable (Text n) b,
 Read n) =>
Consumer Event m (Maybe (Tag b n))
skipArbitraryTag] -- -- should always be last!
--      parseFilter, parsePattern, parseSwitch, parsePerspective,
--      parseDesc, parseMetaData, parseTitle, parsePathEffect] -- descriptive Elements

---------------------------------------------------------------------------
-- | Parse \<defs\>, see <http://www.w3.org/TR/SVG/struct.html#DefsElement>
parseDefs :: (MonadThrow m, InputConstraints b n, Renderable (TT.Text n) b, Read n) 
           => Consumer Event m (Maybe (Tag b n))
parseDefs :: Consumer Event m (Maybe (Tag b n))
parseDefs = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}defs" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
gAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr) ->
   do [Tag b n]
insideDefs <- ConduitT Event o m (Maybe (Tag b n))
-> ConduitT Event o m [Tag b n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n, Read n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
gContent
      let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA PresentationAttributes
pa (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"defs" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n))
    -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
forall b n.
Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
False (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca)
                             (Place
0, Place
0)
                             Maybe (ViewBox n)
forall a. Maybe a
Nothing
                             Maybe PreserveAR
forall a. Maybe a
Nothing
                             ( ([Transform (N (QDiagram b V2 n Any -> QDiagram b V2 n Any))]
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a.
(RealFloat (N a), Transformable a, V a ~ V2) =>
[Transform (N a)] -> a -> a
applyTr (Maybe Text -> [Transform n]
forall n. RealFloat n => Maybe Text -> [Transform n]
parseTr Maybe Text
tr)) ((QDiagram b V2 n Any -> QDiagram b V2 n Any)
 -> QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n))
    -> QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st) )
                             ([Tag b n] -> [Tag b n]
forall a. [a] -> [a]
reverse [Tag b n]
insideDefs)

---------------------------------------------------------------------------
-- | Parse \<defs\>, see <http://www.w3.org/TR/SVG/struct.html#DefsElement>
-- e.g.
--  <style type="text/css">
--   <![CDATA[
--    .fil0 {fill:#FEFEFE}
--    .fil1 {fill:#3A73B8}
--   ]]>
--  </style>
parseStyle :: (MonadThrow m, RealFloat n) => Consumer Event m (Maybe (Tag b n))
parseStyle :: Consumer Event m (Maybe (Tag b n))
parseStyle = Name
-> AttrParser (CoreAttributes, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}style" AttrParser (CoreAttributes, Maybe Text, Maybe Text, Maybe Text)
sAttrs (((CoreAttributes, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,Maybe Text
type_,Maybe Text
media,Maybe Text
title) ->
   do Text
insideStyle <- ConduitT Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
      let blocks :: Either String CSSlist
blocks = Text -> Either String CSSlist
parseBlocks Text
insideStyle -- parseBlocks :: Text -> Either String [CssBlock]
      let cssBlocks :: CSSlist
cssBlocks = case Either String CSSlist
blocks of
                   Left String
err -> []
                   Right CSSlist
st -> CSSlist
st
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ CSSlist -> Tag b n
forall b n. CSSlist -> Tag b n
StyleTag CSSlist
cssBlocks -- type CssBlock = (Text, [(Text, Text)]) = (selector, [(attribute, value)])

-----------------------------------------------------------------------------------
-- | Parse \<symbol\>, see <http://www.w3.org/TR/SVG/struct.html#SymbolElement>
parseSymbol :: (MonadThrow m, InputConstraints b n, Renderable (TT.Text n) b, Read n) 
             => Consumer Event m (Maybe (Tag b n))
parseSymbol :: Consumer Event m (Maybe (Tag b n))
parseSymbol = Name
-> AttrParser
     (CoreAttributes, GraphicalEventAttributes, PresentationAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, GraphicalEventAttributes,
     PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}symbol" AttrParser
  (CoreAttributes, GraphicalEventAttributes, PresentationAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
symbolAttrs (((CoreAttributes, GraphicalEventAttributes,
   PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, GraphicalEventAttributes,
     PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
viewbox) ->
   do [Tag b n]
insideSym <- ConduitT Event o m (Maybe (Tag b n))
-> ConduitT Event o m [Tag b n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n, Read n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
gContent
      let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"symbol" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n))
    -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
forall b n.
Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
False (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca)
                             (Place
0, Place
0)
                             (Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
forall n.
RealFloat n =>
Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
parseViewBox Maybe Text
viewbox Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing)
                             (Maybe Text -> Maybe PreserveAR
parsePreserveAR Maybe Text
ar)
                             (((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st)
                             ([Tag b n] -> [Tag b n]
forall a. [a] -> [a]
reverse [Tag b n]
insideSym)

-----------------------------------------------------------------------------------
-- | Parse \<use\>, see <http://www.w3.org/TR/SVG/struct.html#UseElement>
parseUse :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Typeable n) => Consumer Event m (Maybe (Tag b n))
parseUse :: Consumer Event m (Maybe (Tag b n))
parseUse = Name
-> AttrParser
     (CoreAttributes, ConditionalProcessingAttributes,
      GraphicalEventAttributes, PresentationAttributes, XlinkAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, ConditionalProcessingAttributes,
     GraphicalEventAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}use" AttrParser
  (CoreAttributes, ConditionalProcessingAttributes,
   GraphicalEventAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
useAttrs
   (((CoreAttributes, ConditionalProcessingAttributes,
   GraphicalEventAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, ConditionalProcessingAttributes,
     GraphicalEventAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ \(CoreAttributes
ca,ConditionalProcessingAttributes
cpa,GraphicalEventAttributes
gea,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h) ->
   do -- insideUse <- many useContent
      let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"use" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
      let path :: (n, n, n, n) -> Path V2 n
path (n
minx,n
miny,n
vbW,n
vbH) = n -> n -> Path V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
vbW) n
0 Maybe Text
w)  ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
vbH) n
0 Maybe Text
h)
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Maybe Text
-> ((n, n, n, n) -> Path V2 n)
-> (((HashMap Text (Tag b n), HashMap Text Attrs,
      HashMap Text (Gr n)),
     (n, n, n, n))
    -> Diagram b -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b -> Diagram b)
-> Tag b n
Reference (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca)
                         (Maybe Text -> Maybe Text
Diagrams.SVG.Attributes.fragment (Maybe Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ XlinkAttributes -> Maybe Text
xlinkHref XlinkAttributes
xlink)
                         (n, n, n, n) -> Path V2 n
path
                         (Maybe Text
-> Maybe Text
-> Maybe Text
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n))
    -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n)),
    (N (QDiagram b V2 n Any), N (QDiagram b V2 n Any),
     N (QDiagram b V2 n Any), N (QDiagram b V2 n Any)))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall c t.
(Transformable c, RealFloat (N c), HasStyle c, Typeable (N c),
 V c ~ V2) =>
Maybe Text
-> Maybe Text
-> Maybe Text
-> (t -> [SVGStyle (N c) Place])
-> (t, (N c, N c, N c, N c))
-> c
-> c
f Maybe Text
tr Maybe Text
x Maybe Text
y (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st) -- f gets supplied with the missing maps an viewbox when evaluating the Tag-tree
  where -- f :: Maybe Text -> Maybe Text -> Maybe Text -> (HashMaps b n -> [SVGStyle n a]) 
        -- -> (HashMaps b n, (n,n,n,n)) -> Diagram b -> Diagram b
        f :: Maybe Text
-> Maybe Text
-> Maybe Text
-> (t -> [SVGStyle (N c) Place])
-> (t, (N c, N c, N c, N c))
-> c
-> c
f Maybe Text
tr Maybe Text
x Maybe Text
y t -> [SVGStyle (N c) Place]
st (t
maps,(N c
minx,N c
miny,N c
vbW,N c
vbH)) = (Vn c -> c -> c
forall t. Transformable t => Vn t -> t -> t
translate ((N c, N c) -> V2 (N c)
forall n. (n, n) -> V2 n
r2 ((N c, N c) -> N c -> Maybe Text -> N c
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (N c
vbW, N c
minx) N c
0 Maybe Text
x, 
                                                                 (N c, N c) -> N c -> Maybe Text -> N c
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (N c
vbH, N c
miny) N c
0 Maybe Text
y))) (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                 ([Transform (N c)] -> c -> c
forall a.
(RealFloat (N a), Transformable a, V a ~ V2) =>
[Transform (N a)] -> a -> a
applyTr (Maybe Text -> [Transform (N c)]
forall n. RealFloat n => Maybe Text -> [Transform n]
parseTr Maybe Text
tr)) (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((t -> [SVGStyle (N c) Place]) -> t -> c -> c
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG t -> [SVGStyle (N c) Place]
st t
maps)

useContent :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n) => Consumer Event m (Maybe (Tag b n))
useContent :: Consumer Event m (Maybe (Tag b n))
useContent = [ConduitT Event o m (Maybe (Tag b n))]
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseDesc,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseTitle] -- descriptive elements

--------------------------------------------------------------------------------------
-- | Parse \<switch\>, see <http://www.w3.org/TR/SVG/struct.html#SwitchElement>
parseSwitch :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n) => Consumer Event m (Maybe (Tag b n))
parseSwitch :: Consumer Event m (Maybe (Tag b n))
parseSwitch = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}switch" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
switchAttrs
   (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr) ->
   do -- insideSwitch <- many switchContent
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- switchContent :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n) => Consumer Event m (Maybe (Tag b n))
switchContent :: ConduitT Event o m (Maybe (Tag b (N b)))
switchContent = [ConduitT Event o m (Maybe (Tag b (N b)))]
-> ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n) =>
Consumer Event m (Maybe (Tag b n))
parsePath, ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseRect, ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseCircle, ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseEllipse, ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseLine, ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parsePolyLine, ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parsePolygon]

-----------------------------------------------------------------------------------
-- | Parse \<rect\>,  see <http://www.w3.org/TR/SVG11/shapes.html#RectElement>
parseRect :: (MonadThrow m, InputConstraints b n) => Consumer Event m (Maybe (Tag b n))
parseRect :: Consumer Event m (Maybe (Tag b n))
parseRect = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}rect" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
rectAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
tr,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
rx,Maybe Text
ry) -> do
    let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"rect" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
    let rRect :: N p -> N p -> N p -> N p -> p
rRect N p
pw N p
ph N p
prx N p
pry | N p
prx N p -> N p -> Bool
forall a. Eq a => a -> a -> Bool
== N p
0 Bool -> Bool -> Bool
&& N p
pry N p -> N p -> Bool
forall a. Eq a => a -> a -> Bool
== N p
0 = N p -> N p -> p
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect N p
pw N p
ph
                            | Bool
otherwise = N p -> N p -> N p -> p
forall n t.
(InSpace V2 n t, TrailLike t, RealFloat n) =>
n -> n -> n -> t
roundedRect N p
pw N p
ph (if N p
prx N p -> N p -> Bool
forall a. Eq a => a -> a -> Bool
== N p
0 then N p
pry else N p
prx)
    let path :: (n, n, n, n) -> Path V2 n
path (n
minx,n
miny,n
vbW,n
vbH) = (N (Path V2 n)
-> N (Path V2 n) -> N (Path V2 n) -> N (Path V2 n) -> Path V2 n
forall p.
(TrailLike p, RealFloat (N p), V p ~ V2) =>
N p -> N p -> N p -> N p -> p
rRect ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
vbW) n
0 Maybe Text
w)  ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
vbH) n
0 Maybe Text
h)
                                          ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
vbW) n
0 Maybe Text
rx) ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
vbH) n
0 Maybe Text
ry))
                                   # alignBL
                                   # applyTr (parseTr tr)
                                   # translate (r2 (p (minx,vbW) 0 x, p (miny,vbH) 0 y))
    let f :: ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> QDiagram b V2 n Any
f ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps,(n, n, n, n)
viewbox) = (n, n, n, n) -> Path V2 n
path (n, n, n, n)
viewbox Path V2 n
-> (Path V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Path V2 n -> QDiagram b V2 n Any
forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps
    Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> ((n, n, n, n) -> Path V2 n)
-> (((HashMap Text (Tag b n), HashMap Text Attrs,
      HashMap Text (Gr n)),
     (n, n, n, n))
    -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) (n, n, n, n) -> Path V2 n
path ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> Diagram b
((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> QDiagram b V2 n Any
f

---------------------------------------------------------------------------------------------------
-- | Parse \<circle\>,  see <http://www.w3.org/TR/SVG11/shapes.html#CircleElement>
parseCircle :: (MonadThrow m, InputConstraints b n) => Consumer Event m (Maybe (Tag b n))
parseCircle :: Consumer Event m (Maybe (Tag b n))
parseCircle = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}circle" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
circleAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
r,Maybe Text
cx,Maybe Text
cy) -> do
    let -- st :: (RealFloat n, RealFloat a, Read a) => (HashMaps b n, ViewBox n) -> [SVGStyle n a]
        st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"circle" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
    let path :: (n, n, n, n) -> Path V2 n
path (n
minx,n
miny,n
w,n
h) = n -> Path V2 n
forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) n
0 Maybe Text
r) -- TODO: radius of a circle in percentages (relative to x?)
                               # applyTr (parseTr tr)
                               # translate (r2 (p (minx,w) 0 cx, p (miny,h) 0 cy))
    let f :: ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> QDiagram b V2 n Any
f ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps,(n, n, n, n)
viewbox) = (n, n, n, n) -> Path V2 n
path (n, n, n, n)
viewbox Path V2 n
-> (Path V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Path V2 n -> QDiagram b V2 n Any
forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps
    Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> ((n, n, n, n) -> Path V2 n)
-> (((HashMap Text (Tag b n), HashMap Text Attrs,
      HashMap Text (Gr n)),
     (n, n, n, n))
    -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) (n, n, n, n) -> Path V2 n
path ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> Diagram b
((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> QDiagram b V2 n Any
f

---------------------------------------------------------------------------------------------------
-- | Parse \<ellipse\>,  see <http://www.w3.org/TR/SVG11/shapes.html#EllipseElement>
parseEllipse :: (MonadThrow m, InputConstraints b n) => Consumer Event m (Maybe (Tag b n))
parseEllipse :: Consumer Event m (Maybe (Tag b n))
parseEllipse = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}ellipse" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
ellipseAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
rx,Maybe Text
ry,Maybe Text
cx,Maybe Text
cy) -> do
    let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"ellipse" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
    let path :: (n, n, n, n) -> Path V2 n
path (n
minx,n
miny,n
w,n
h) = ((n -> n -> Path V2 n
forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> n -> t
ellipseXY ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) n
0 Maybe Text
rx) ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
h) n
0 Maybe Text
ry) ))
                               # applyTr (parseTr tr)
                               # translate (r2 (p (minx,w) 0 cx, p (miny,h) 0 cy))
    let f :: ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> QDiagram b V2 n Any
f ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps,(n, n, n, n)
viewbox) = (n, n, n, n) -> Path V2 n
path (n, n, n, n)
viewbox Path V2 n
-> (Path V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Path V2 n -> QDiagram b V2 n Any
forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps
    Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> ((n, n, n, n) -> Path V2 n)
-> (((HashMap Text (Tag b n), HashMap Text Attrs,
      HashMap Text (Gr n)),
     (n, n, n, n))
    -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) (n, n, n, n) -> Path V2 n
path ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> Diagram b
((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> QDiagram b V2 n Any
f

---------------------------------------------------------------------------------------------------
-- | Parse \<line\>,  see <http://www.w3.org/TR/SVG11/shapes.html#LineElement>
parseLine :: (MonadThrow m, InputConstraints b n) => Consumer Event m (Maybe (Tag b n))
parseLine :: Consumer Event m (Maybe (Tag b n))
parseLine = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}line" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
lineAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
x1,Maybe Text
y1,Maybe Text
x2,Maybe Text
y2) -> do
    let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"line" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
    let path :: (n, n, n, n) -> Path V2 n
path (n
minx,n
miny,n
w,n
h) = ([Segment Closed (V (Path V2 n)) (N (Path V2 n))] -> Path V2 n
forall t. TrailLike t => [Segment Closed (V t) (N t)] -> t
fromSegments [ V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) n
0 Maybe Text
x2) n -> n -> n
forall a. Num a => a -> a -> a
- ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) n
0 Maybe Text
x1), 
                                                             ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
h) n
0 Maybe Text
y2) n -> n -> n
forall a. Num a => a -> a -> a
- ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
h) n
0 Maybe Text
y1))) ])
                               # applyTr (parseTr tr)
                               # translate (r2 (p (minx,w) 0 x1, p (miny,h) 0 y1))
    let f :: ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> QDiagram b V2 n Any
f ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps,(n, n, n, n)
viewbox) = (n, n, n, n) -> Path V2 n
path (n, n, n, n)
viewbox Path V2 n
-> (Path V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Path V2 n -> QDiagram b V2 n Any
forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke
                                        # applyStyleSVG st maps
    Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> ((n, n, n, n) -> Path V2 n)
-> (((HashMap Text (Tag b n), HashMap Text Attrs,
      HashMap Text (Gr n)),
     (n, n, n, n))
    -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) (n, n, n, n) -> Path V2 n
path ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> Diagram b
((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 (n, n, n, n))
-> QDiagram b V2 n Any
f

---------------------------------------------------------------------------------------------------
-- | Parse \<polyline\>,  see <http://www.w3.org/TR/SVG11/shapes.html#PolylineElement>
parsePolyLine :: (MonadThrow m, InputConstraints b n) => Consumer Event m (Maybe (Tag b n))
parsePolyLine :: Consumer Event m (Maybe (Tag b n))
parsePolyLine = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}polyline" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
polygonAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
points) -> do
    let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"polyline" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
    let ps :: [(n, n)]
ps = Text -> [(n, n)]
forall n. RealFloat n => Text -> [(n, n)]
parsePoints (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
points)
    let path :: ViewBox n -> Path V2 n
path ViewBox n
viewbox = [Point (V (Path V2 n)) (N (Path V2 n))] -> Path V2 n
forall t. TrailLike t => [Point (V t) (N t)] -> t
fromVertices (((n, n) -> P2 n) -> [(n, n)] -> [P2 n]
forall a b. (a -> b) -> [a] -> [b]
map (n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 [(n, n)]
ps) Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# Vn (Path V2 n) -> Path V2 n -> Path V2 n
forall t. Transformable t => Vn t -> t -> t
translate ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 ([(n, n)] -> (n, n)
forall a. [a] -> a
head [(n, n)]
ps))
                                                # applyTr (parseTr tr)

    let f :: ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 ViewBox n)
-> QDiagram b V2 n Any
f ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps,ViewBox n
viewbox) = [Point (V (Trail' Line V2 n)) (N (Trail' Line V2 n))]
-> Trail' Line V2 n
forall t. TrailLike t => [Point (V t) (N t)] -> t
fromVertices (((n, n) -> P2 n) -> [(n, n)] -> [P2 n]
forall a b. (a -> b) -> [a] -> [b]
map (n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 [(n, n)]
ps) Trail' Line V2 n
-> (Trail' Line V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Trail' Line V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine
                                                    # translate (r2 (head ps))
                                                    # applyTr (parseTr tr)
                                                    # applyStyleSVG st maps
    Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> (((HashMap Text (Tag b n), HashMap Text Attrs,
      HashMap Text (Gr n)),
     ViewBox n)
    -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
path ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 ViewBox n)
-> Diagram b
((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 ViewBox n)
-> QDiagram b V2 n Any
f

--------------------------------------------------------------------------------------------------
-- | Parse \<polygon\>,  see <http://www.w3.org/TR/SVG11/shapes.html#PolygonElement>
parsePolygon :: (MonadThrow m, InputConstraints b n) => Consumer Event m (Maybe (Tag b n))
parsePolygon :: Consumer Event m (Maybe (Tag b n))
parsePolygon = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}polygon" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
polygonAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
points) -> do
    let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"polygon" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
    let ps :: [(n, n)]
ps = Text -> [(n, n)]
forall n. RealFloat n => Text -> [(n, n)]
parsePoints (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
points)
    let path :: ViewBox n -> Path V2 n
path ViewBox n
viewbox = [Point (V (Path V2 n)) (N (Path V2 n))] -> Path V2 n
forall t. TrailLike t => [Point (V t) (N t)] -> t
fromVertices (((n, n) -> P2 n) -> [(n, n)] -> [P2 n]
forall a b. (a -> b) -> [a] -> [b]
map (n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 [(n, n)]
ps) Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# Vn (Path V2 n) -> Path V2 n -> Path V2 n
forall t. Transformable t => Vn t -> t -> t
translate ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 ([(n, n)] -> (n, n)
forall a. [a] -> a
head [(n, n)]
ps))
                                                # applyTr (parseTr tr)
    let f :: ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 ViewBox n)
-> QDiagram b V2 n Any
f ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps,ViewBox n
viewbox) = [Point (V (Trail' Line V2 n)) (N (Trail' Line V2 n))]
-> Trail' Line V2 n
forall t. TrailLike t => [Point (V t) (N t)] -> t
fromVertices (((n, n) -> P2 n) -> [(n, n)] -> [P2 n]
forall a b. (a -> b) -> [a] -> [b]
map (n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 [(n, n)]
ps) Trail' Line V2 n
-> (Trail' Line V2 n -> Trail' Loop V2 n) -> Trail' Loop V2 n
forall a b. a -> (a -> b) -> b
# Trail' Line V2 n -> Trail' Loop V2 n
forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine
                                                    # strokeLoop
                                                    # translate (r2 (head ps))
                                                    # applyTr (parseTr tr)
                                                    # applyStyleSVG st maps
    Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> (((HashMap Text (Tag b n), HashMap Text Attrs,
      HashMap Text (Gr n)),
     ViewBox n)
    -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
path ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 ViewBox n)
-> Diagram b
((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 ViewBox n)
-> QDiagram b V2 n Any
f

--------------------------------------------------------------------------------------------------
-- | Parse \<path\>,  see <http://www.w3.org/TR/SVG11/paths.html#PathElement>
parsePath :: (MonadThrow m, InputConstraints b n, Show n) => Consumer Event m (Maybe (Tag b n))
parsePath :: Consumer Event m (Maybe (Tag b n))
parsePath = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}path" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
pathAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
d,Maybe Text
pathLength) -> do
    let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"path" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
    let path :: ViewBox n -> Path V2 n
path ViewBox n
viewbox = ([Path V2 n] -> Path V2 n
forall a. Monoid a => [a] -> a
mconcat ([Path V2 n] -> Path V2 n) -> [Path V2 n] -> Path V2 n
forall a b. (a -> b) -> a -> b
$ [PathCommand n] -> [Path V2 n]
forall n. (RealFloat n, Show n) => [PathCommand n] -> [Path V2 n]
commandsToPaths ([PathCommand n] -> [Path V2 n]) -> [PathCommand n] -> [Path V2 n]
forall a b. (a -> b) -> a -> b
$ Maybe Text -> [PathCommand n]
forall n. (RealFloat n, Show n) => Maybe Text -> [PathCommand n]
commands Maybe Text
d) Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# [Transform (N (Path V2 n))] -> Path V2 n -> Path V2 n
forall a.
(RealFloat (N a), Transformable a, V a ~ V2) =>
[Transform (N a)] -> a -> a
applyTr (Maybe Text -> [Transform n]
forall n. RealFloat n => Maybe Text -> [Transform n]
parseTr Maybe Text
tr)
    let f :: ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 ViewBox n)
-> QDiagram b V2 n Any
f ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps,ViewBox n
viewbox) = ViewBox n -> Path V2 n
path ViewBox n
viewbox Path V2 n
-> (Path V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Path V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Path V2 n -> QDiagram b V2 n Any
strokePath
                                        # applyStyleSVG st maps
    Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> (((HashMap Text (Tag b n), HashMap Text Attrs,
      HashMap Text (Gr n)),
     ViewBox n)
    -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
path ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 ViewBox n)
-> Diagram b
((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n)),
 ViewBox n)
-> QDiagram b V2 n Any
f

-------------------------------------------------------------------------------------------------
-- | Parse \<clipPath\>, see <http://www.w3.org/TR/SVG/masking.html#ClipPathElement>
parseClipPath :: (MonadThrow m, InputConstraints b n, Show n, Read n, Renderable (TT.Text n) b) 
               => Consumer Event m (Maybe (Tag b n))
parseClipPath :: Consumer Event m (Maybe (Tag b n))
parseClipPath = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}clipPath" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
clipPathAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
viewbox) -> do
    [Tag b n]
insideClipPath <- ConduitT Event o m (Maybe (Tag b n))
-> ConduitT Event o m [Tag b n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n, Read n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
clipPathContent
    let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                   ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"clipPath" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
    Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n))
    -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
forall b n.
Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
False (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca)
                     (Place
0, Place
0)
                     (Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
forall n.
RealFloat n =>
Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
parseViewBox Maybe Text
viewbox Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing)
                     (Maybe Text -> Maybe PreserveAR
parsePreserveAR Maybe Text
ar)
                     (((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st)
                     ([Tag b n] -> [Tag b n]
forall a. [a] -> [a]
reverse [Tag b n]
insideClipPath)

clipPathContent :: (MonadThrow m, InputConstraints b n, Show n, Read n, Renderable (TT.Text n) b) 
                 => Consumer Event m (Maybe (Tag b n))
clipPathContent :: Consumer Event m (Maybe (Tag b n))
clipPathContent = [ConduitT Event o m (Maybe (Tag b n))]
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseRect, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseCircle, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseEllipse, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parseLine, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parsePolyLine, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n) =>
Consumer Event m (Maybe (Tag b n))
parsePath,
                          ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n) =>
Consumer Event m (Maybe (Tag b n))
parsePolygon, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Read n, RealFloat n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
parseText, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Typeable n) =>
Consumer Event m (Maybe (Tag b n))
parseUse]

--------------------------------------------------------------------------------------
-- | Parse \<image\>, see <http://www.w3.org/TR/SVG/struct.html#ImageElement>
-- <image width="28" xlink:href="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABwAAAADCAYAAACAjW/aAAAABmJLR0QA/wD/AP+gvaeTAAAAB3RJTUUH2AkMDx4ErQ9V0AAAAClJREFUGJVjYMACGhoa/jMwMPyH0kQDYvQxYpNsaGjAyibCQrL00dSHACypIHXUNrh3AAAAAElFTkSuQmCC" height="3"/>
parseImage :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Renderable (DImage (N b) Embedded) b,
              Typeable b, Typeable n) => Consumer Event m (Maybe (Tag b n))
parseImage :: Consumer Event m (Maybe (Tag b n))
parseImage = Name
-> AttrParser
     (CoreAttributes, ConditionalProcessingAttributes,
      GraphicalEventAttributes, XlinkAttributes, PresentationAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, ConditionalProcessingAttributes,
     GraphicalEventAttributes, XlinkAttributes, PresentationAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}image" AttrParser
  (CoreAttributes, ConditionalProcessingAttributes,
   GraphicalEventAttributes, XlinkAttributes, PresentationAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
imageAttrs (((CoreAttributes, ConditionalProcessingAttributes,
   GraphicalEventAttributes, XlinkAttributes, PresentationAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, ConditionalProcessingAttributes,
     GraphicalEventAttributes, XlinkAttributes, PresentationAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(CoreAttributes
ca,ConditionalProcessingAttributes
cpa,GraphicalEventAttributes
gea,XlinkAttributes
xlink,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
ar,Maybe Text
tr,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h) ->
  do Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (\(HashMaps b n
_,(n
minx,n
miny,n
vbW,n
vbH)) -> (Maybe Text -> n -> n -> Diagram b
forall b n.
(Metric (V b), Ord n, RealFloat n, N b ~ n, V2 ~ V b,
 Renderable (DImage n Embedded) b, Typeable b, Typeable n) =>
Maybe Text -> n -> n -> Diagram b
dataUriToImage (XlinkAttributes -> Maybe Text
xlinkHref XlinkAttributes
xlink) ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
vbW) n
0 Maybe Text
w) ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
vbH) n
0 Maybe Text
h))
                                           # alignBL
                                           # applyTr (parseTr tr)
                                           # translate (r2 (p (minx,vbW) 0 x, p (miny,vbH) 0 y)))
-- TODO aspect ratio

data ImageType = JPG | PNG | SVG

---------------------------------------------------------------------------------------------------
-- | Convert base64 encoded data in <image> to a Diagram b with JuicyPixels
--   input: "data:image/png;base64,..."
dataUriToImage :: (Metric (V b), Ord n, RealFloat n, N b ~ n, V2 ~ V b, Renderable (DImage n Embedded) b,
                  Typeable b, Typeable n) => Maybe Text -> n -> n -> Diagram b
dataUriToImage :: Maybe Text -> n -> n -> Diagram b
dataUriToImage Maybe Text
_           n
0 n
h = Diagram b
forall a. Monoid a => a
mempty
dataUriToImage Maybe Text
_           n
w n
0 = Diagram b
forall a. Monoid a => a
mempty
dataUriToImage Maybe Text
Nothing     n
w n
h = Diagram b
forall a. Monoid a => a
mempty
dataUriToImage (Just Text
text) n
w n
h = (String -> QDiagram b V2 n Any)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> Either String (QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (QDiagram b V2 n Any -> String -> QDiagram b V2 n Any
forall a b. a -> b -> a
const QDiagram b V2 n Any
forall a. Monoid a => a
mempty) QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. a -> a
id (Either String (QDiagram b V2 n Any) -> QDiagram b V2 n Any)
-> Either String (QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Parser (QDiagram b V2 n Any)
-> ByteString -> Either String (QDiagram b V2 n Any)
forall a. Parser a -> ByteString -> Either String a
ABS.parseOnly Parser (QDiagram b V2 n Any)
dataUri (Text -> ByteString
encodeUtf8 Text
text)
  where
    jpg :: Parser ByteString ImageType
jpg = do { ByteString -> Parser ByteString
ABS.string ByteString
"jpg"; ImageType -> Parser ByteString ImageType
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
JPG } -- ABS = Data.Attoparsec.ByteString
    png :: Parser ByteString ImageType
png = do { ByteString -> Parser ByteString
ABS.string ByteString
"png"; ImageType -> Parser ByteString ImageType
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
PNG }
    svg :: Parser ByteString ImageType
svg = do { ByteString -> Parser ByteString
ABS.string ByteString
"svg"; ImageType -> Parser ByteString ImageType
forall (m :: * -> *) a. Monad m => a -> m a
return ImageType
SVG }

    dataUri :: Parser (QDiagram b V2 n Any)
dataUri = do
      ByteString -> Parser ByteString
ABS.string ByteString
"data:image/"
      ImageType
imageType <- [Parser ByteString ImageType] -> Parser ByteString ImageType
forall (f :: * -> *) a. Alternative f => [f a] -> f a
ABS.choice [Parser ByteString ImageType
jpg, Parser ByteString ImageType
png, Parser ByteString ImageType
svg]
      ByteString -> Parser ByteString
ABS.string ByteString
";base64," -- assuming currently that this is always used
      [Word8]
base64data <- Parser ByteString Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
ABS.many1 Parser ByteString Word8
ABS.anyWord8
      QDiagram b V2 n Any -> Parser (QDiagram b V2 n Any)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram b V2 n Any -> Parser (QDiagram b V2 n Any))
-> QDiagram b V2 n Any -> Parser (QDiagram b V2 n Any)
forall a b. (a -> b) -> a -> b
$ case ImageType -> ByteString -> Either String DynamicImage
im ImageType
imageType ([Word8] -> ByteString
B.pack [Word8]
base64data) of
                 Right DynamicImage
img -> DImage n Embedded -> QDiagram b V2 n Any
forall n a b.
(TypeableFloat n, Typeable a, Renderable (DImage n a) b) =>
DImage n a -> QDiagram b V2 n Any
image (ImageData Embedded
-> Int -> Int -> Transformation V2 n -> DImage n Embedded
forall b a.
ImageData b -> Int -> Int -> Transformation V2 a -> DImage a b
DImage (DynamicImage -> ImageData Embedded
ImageRaster DynamicImage
img) (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round n
w) (n -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round n
h) Transformation V2 n
forall a. Monoid a => a
mempty)
                 Left String
x -> QDiagram b V2 n Any
forall a. Monoid a => a
mempty

im :: ImageType -> B.ByteString -> Either String DynamicImage
im :: ImageType -> ByteString -> Either String DynamicImage
im ImageType
imageType ByteString
base64data = case ByteString -> Either String ByteString
Base64.decode ByteString
base64data of
   Left String
_ -> String -> Either String DynamicImage
forall a b. a -> Either a b
Left String
"diagrams-input: Error decoding data uri in <image>-tag"
   Right ByteString
b64 -> case ImageType
imageType of
         ImageType
JPG -> ByteString -> Either String DynamicImage
decodeJpeg ByteString
b64 -- decodeJpeg :: ByteString -> Either String DynamicImage
         ImageType
PNG -> ByteString -> Either String DynamicImage
decodePng ByteString
b64
         --  SVG -> preserveAspectRatio w h oldWidth oldHeight ar (readSVGBytes base64data) -- something like that
         ImageType
_ -> String -> Either String DynamicImage
forall a b. a -> Either a b
Left String
"diagrams-input: format not supported in <image>-tag"

-------------------------------------------------------------------------------------------------
-- | Parse \<text\>, see <http://www.w3.org/TR/SVG/text.html#TextElement>
parseText :: (MonadThrow m, InputConstraints b n, Read n, RealFloat n, Renderable (TT.Text n) b)
            => Consumer Event m (Maybe (Tag b n))
parseText :: Consumer Event m (Maybe (Tag b n))
parseText = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}text" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
textAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
la,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rot,Maybe Text
textlen) ->
    do let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                      (PresentationAttributes
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                      ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"text" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
       [Tag b n]
insideText <- ConduitT Event o m (Maybe (Tag b n))
-> ConduitT Event o m [Tag b n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ((ConditionalProcessingAttributes, CoreAttributes,
 GraphicalEventAttributes, PresentationAttributes, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b o.
(MonadThrow m, RealFloat (N b), Typeable (N b), Typeable b,
 Show (N b), Read (N b), Renderable (Path V2 (N b)) b,
 Renderable (DImage (N b) Embedded) b, Renderable (Text (N b)) b,
 V b ~ V2) =>
(ConditionalProcessingAttributes, CoreAttributes,
 GraphicalEventAttributes, PresentationAttributes, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ConduitT Event o m (Maybe (Tag b (N b)))
tContent (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
la,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rot,Maybe Text
textlen))
       Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n))
    -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
forall b n.
Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
True (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca)
                             (Place
0, Place
0)
                             Maybe (ViewBox n)
forall a. Maybe a
Nothing
                             Maybe PreserveAR
forall a. Maybe a
Nothing
                             (\(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps -> ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps)
                             [Tag b n]
insideText

tContent :: (ConditionalProcessingAttributes, CoreAttributes,
 GraphicalEventAttributes, PresentationAttributes, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ConduitT Event o m (Maybe (Tag b (N b)))
tContent (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
la,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rot,Maybe Text
textlen)
         = [ConduitT Event o m (Maybe (Tag b (N b)))]
-> ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose
           [ (ConditionalProcessingAttributes, CoreAttributes,
 GraphicalEventAttributes, PresentationAttributes, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b n o.
(MonadThrow m, InputConstraints b n, RealFloat n, Read n,
 Renderable (Text n) b) =>
(ConditionalProcessingAttributes, CoreAttributes,
 GraphicalEventAttributes, PresentationAttributes, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ConduitM Event o m (Maybe (Tag b n))
parseTSpan  (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
la,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rot,Maybe Text
textlen),
             (ConditionalProcessingAttributes, CoreAttributes,
 GraphicalEventAttributes, PresentationAttributes, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ConduitT Event o m (Maybe (Tag b (N b)))
forall (m :: * -> *) b n o.
(MonadThrow m, InputConstraints b n, RealFloat n, Read n,
 Renderable (Text n) b) =>
(ConditionalProcessingAttributes, CoreAttributes,
 GraphicalEventAttributes, PresentationAttributes, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ConduitM Event o m (Maybe (Tag b n))
textContent (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
la,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rot,Maybe Text
textlen) ]


{-
-- text related data of pa (presentation attribute)

alignmentBaseline baselineShift dominantBaseline fontFamily
fntSize fontSizeAdjust fontStretch fontStyle fontVariant fontWeight
glyphOrientationHorizontal glyphOrientationVertical kerning letterSpacing
textAnchor textDecoration textRendering wordSpacing writingMode
-}

-- | Parse a string between the text tags:  \<text\>Hello\</text\>
textContent :: (MonadThrow m, InputConstraints b n, RealFloat n, Read n, Renderable (TT.Text n) b) =>
               (ConditionalProcessingAttributes,
                CoreAttributes,
                GraphicalEventAttributes,
                PresentationAttributes,
                Maybe Text,
                Maybe Text,
                Maybe Text,
                Maybe Text,
                Maybe Text,
                Maybe Text,
                Maybe Text,
                Maybe Text,
                Maybe Text,
                Maybe Text,
                Maybe Text) -> ConduitM Event o m (Maybe (Tag b n))
textContent :: (ConditionalProcessingAttributes, CoreAttributes,
 GraphicalEventAttributes, PresentationAttributes, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ConduitM Event o m (Maybe (Tag b n))
textContent (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
la,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rot,Maybe Text
textlen) =
  do Maybe Text
t <- ConduitT Event o m (Maybe Text)
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe Text)
contentMaybe
     let st :: (Read a, RealFloat a, RealFloat n) => (HashMaps b n, ViewBox n) -> [(SVGStyle n a)]
         st :: (HashMaps b n, ViewBox n) -> [SVGStyle n a]
st (HashMaps b n
hmaps,ViewBox n
_) = (Maybe Text -> HashMaps b n -> [SVGStyle n a]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style HashMaps b n
hmaps) [SVGStyle n a] -> [SVGStyle n a] -> [SVGStyle n a]
forall a. [a] -> [a] -> [a]
++
                        (PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  HashMaps b n
hmaps)

     let f :: (V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable n, Renderable (TT.Text n) b)
           => (HashMaps b n, ViewBox n) -> Diagram b
         f :: (HashMaps b n, ViewBox n) -> Diagram b
f (HashMaps b n
maps,(n
minx,n
miny,n
w,n
h)) = PresentationAttributes -> String -> QDiagram b V2 n Any
forall b n.
(V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable n,
 Renderable (Text n) b) =>
PresentationAttributes -> String -> QDiagram b V2 n Any
anchorText PresentationAttributes
pa (String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Text -> String
T.unpack Maybe Text
t)
                                    -- fontWeight
                                    # scaleY (-1)
                                    # translate (r2 (p (minx,w) 0 x, p (miny,h) 0 y))
                                    # (applyTr (parseTr tr))
                                    # applyStyleSVG st (maps,(minx,miny,w,h))
                                    # maybe id (fontSize . local . read . T.unpack) (fntSize pa)
                                    # maybe id (font . T.unpack) (fontFamily pa)

     Maybe (Tag b n) -> ConduitM Event o m (Maybe (Tag b n))
forall (m :: * -> *) a. Monad m => a -> m a
return (if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
t then Tag b n -> Maybe (Tag b n)
forall a. a -> Maybe a
Just (Tag b n -> Maybe (Tag b n)) -> Tag b n -> Maybe (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall b n.
(V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable n,
 Renderable (Text n) b) =>
(HashMaps b n, ViewBox n) -> Diagram b
f
                         else Maybe (Tag b n)
forall a. Maybe a
Nothing)


{-<tspan
         sodipodi:role="line"
         id="tspan2173"
         x="1551.4218"
         y="1056.9836" /> -}

-------------------------------------------------------------------------------------------------
-- | Parse \<tspan\>, see <https://www.w3.org/TR/SVG/text.html#TSpanElement>
parseTSpan :: (MonadThrow m, InputConstraints b n, RealFloat n, Read n, Renderable (TT.Text n) b) =>
              (ConditionalProcessingAttributes,
               CoreAttributes,
               GraphicalEventAttributes,
               PresentationAttributes,
               Maybe Text,
               Maybe Text,
               Maybe Text,
               Maybe Text,
               Maybe Text,
               Maybe Text,
               Maybe Text,
               Maybe Text,
               Maybe Text,
               Maybe Text,
               Maybe Text) -> ConduitM Event o m (Maybe (Tag b n))
parseTSpan :: (ConditionalProcessingAttributes, CoreAttributes,
 GraphicalEventAttributes, PresentationAttributes, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
 Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ConduitM Event o m (Maybe (Tag b n))
parseTSpan (ConditionalProcessingAttributes
cpa,CoreAttributes
ca,GraphicalEventAttributes
gea,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
tr,Maybe Text
la,Maybe Text
x,Maybe Text
y,Maybe Text
dx,Maybe Text
dy,Maybe Text
rot,Maybe Text
textlen) = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      GraphicalEventAttributes, PresentationAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitM Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}tspan" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
tspanAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   GraphicalEventAttributes, PresentationAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitM Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     GraphicalEventAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitM Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa1,CoreAttributes
ca1,GraphicalEventAttributes
gea1,PresentationAttributes
pa1,Maybe Text
class1,Maybe Text
style1,Maybe Text
ext1,Maybe Text
x1,Maybe Text
y1,Maybe Text
dx1,Maybe Text
dy1,Maybe Text
rot1,Maybe Text
textlen1,Maybe Text
lAdjust1,Maybe Text
role) ->
    do Maybe Text
t <- ConduitT Event o m (Maybe Text)
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe Text)
contentMaybe
       let st :: (Read a, RealFloat a, RealFloat n) => (HashMaps b n, ViewBox n) -> [(SVGStyle n a)]
           st :: (HashMaps b n, ViewBox n) -> [SVGStyle n a]
st (HashMaps b n
hmaps,ViewBox n
_) = (Maybe Text -> HashMaps b n -> [SVGStyle n a]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style HashMaps b n
hmaps) [SVGStyle n a] -> [SVGStyle n a] -> [SVGStyle n a]
forall a. [a] -> [a] -> [a]
++
                          (Maybe Text -> HashMaps b n -> [SVGStyle n a]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style1 HashMaps b n
hmaps) [SVGStyle n a] -> [SVGStyle n a] -> [SVGStyle n a]
forall a. [a] -> [a] -> [a]
++
                          (PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa  HashMaps b n
hmaps) [SVGStyle n a] -> [SVGStyle n a] -> [SVGStyle n a]
forall a. [a] -> [a] -> [a]
++
                          (PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA  PresentationAttributes
pa1  HashMaps b n
hmaps) [SVGStyle n a] -> [SVGStyle n a] -> [SVGStyle n a]
forall a. [a] -> [a] -> [a]
++
                          (HashMaps b n -> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap HashMaps b n
hmaps Text
"tspan" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)

       let f :: (V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable n, Renderable (TT.Text n) b)
             => (HashMaps b n, ViewBox n) -> Diagram b
           f :: (HashMaps b n, ViewBox n) -> Diagram b
f (HashMaps b n
maps,(n
minx,n
miny,n
w,n
h)) = PresentationAttributes -> String -> QDiagram b V2 n Any
forall b n.
(V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable n,
 Renderable (Text n) b) =>
PresentationAttributes -> String -> QDiagram b V2 n Any
anchorText PresentationAttributes
pa (String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Text -> String
T.unpack Maybe Text
t)
                             # maybe id (fontSize . local . read . T.unpack) (pref (fntSize pa1) (fntSize pa))
                             # maybe id (font . T.unpack) (pref (fontFamily pa1) (fontFamily pa))
                             -- fontWeight
                             # scaleY (-1)
                             # translate (r2 (p (minx,w) 0 (pref x1 x), p (miny,h) 0 (pref y1 y)))
                             # (applyTr (parseTr tr))
                             # applyStyleSVG st (maps,(minx,miny,w,h))
       Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall b n.
(V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable n,
 Renderable (Text n) b) =>
(HashMaps b n, ViewBox n) -> Diagram b
f


anchorText :: (V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable n, Renderable (TT.Text n) b)
           => PresentationAttributes -> String -> QDiagram b V2 n Any
anchorText :: PresentationAttributes -> String -> QDiagram b V2 n Any
anchorText PresentationAttributes
pa String
txt = case PresentationAttributes -> String
anchor PresentationAttributes
pa of 
    String
"start"   -> String -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
String -> QDiagram b V2 n Any
baselineText String
txt
    String
"middle"  -> String -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
String -> QDiagram b V2 n Any
text String
txt
    String
"end"     -> n -> n -> String -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
n -> n -> String -> QDiagram b V2 n Any
alignedText n
1 n
0 String
txt -- TODO is this correct?
    String
"inherit" -> String -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
String -> QDiagram b V2 n Any
text String
txt -- TODO
  where
    anchor :: PresentationAttributes -> String
anchor PresentationAttributes
pa = String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"start" Text -> String
T.unpack (PresentationAttributes -> Maybe Text
textAnchor PresentationAttributes
pa) -- see <https://www.w3.org/TR/SVG/text.html#TextAnchorProperty>


pref :: Maybe a -> Maybe a -> Maybe a
pref :: Maybe a -> Maybe a -> Maybe a
pref (Just a
x) Maybe a
b       = a -> Maybe a
forall a. a -> Maybe a
Just a
x
pref Maybe a
Nothing (Just a
y) = a -> Maybe a
forall a. a -> Maybe a
Just a
y
pref Maybe a
Nothing Maybe a
Nothing  = Maybe a
forall a. Maybe a
Nothing


--------------------------------------------------------------------------------------
-- Gradients
-------------------------------------------------------------------------------------

-- | Parse \<linearGradient\>, see <http://www.w3.org/TR/SVG/pservers.html#LinearGradientElement>
-- example: <linearGradient id="SVGID_2_" gradientUnits="userSpaceOnUse" x1="68.2461" y1="197.6797"
--           x2="52.6936" y2="237.5337" gradientTransform="matrix(1 0 0 -1 -22.5352 286.4424)">
parseLinearGradient :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n) => Consumer Event m (Maybe (Tag b n))
parseLinearGradient :: Consumer Event m (Maybe (Tag b n))
parseLinearGradient = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, XlinkAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}linearGradient" AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
linearGradAttrs (((CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x1,Maybe Text
y1,Maybe Text
x2,Maybe Text
y2,Maybe Text
gradientUnits,Maybe Text
gradientTransform,Maybe Text
spreadMethod) -> -- TODO gradientUnits
  do [Tag Any n]
gs <- ConduitT Event o m (Maybe (Tag Any n))
-> ConduitT Event o m [Tag Any n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe (Tag Any n))
forall (m :: * -> *) n o b.
(MonadThrow m, RealFloat n) =>
ConduitT Event o m (Maybe (Tag b n))
gradientContent
     let stops :: [HashMap Text Attrs -> [GradientStop n]]
stops = (Tag Any n -> HashMap Text Attrs -> [GradientStop n])
-> [Tag Any n] -> [HashMap Text Attrs -> [GradientStop n]]
forall a b. (a -> b) -> [a] -> [b]
map Tag Any n -> HashMap Text Attrs -> [GradientStop n]
forall n b.
RealFloat n =>
Tag b n -> HashMap Text Attrs -> [GradientStop n]
getTexture ([Tag Any n] -> [HashMap Text Attrs -> [GradientStop n]])
-> [Tag Any n] -> [HashMap Text Attrs -> [GradientStop n]]
forall a b. (a -> b) -> a -> b
$ [[Tag Any n]] -> [Tag Any n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Tag Any n]] -> [Tag Any n]) -> [[Tag Any n]] -> [Tag Any n]
forall a b. (a -> b) -> a -> b
$ (Tag Any n -> [Tag Any n]) -> [Tag Any n] -> [[Tag Any n]]
forall a b. (a -> b) -> [a] -> [b]
map Tag Any n -> [Tag Any n]
forall b n. Tag b n -> [Tag b n]
extractStops [Tag Any n]
gs

     -- because of href we have to replace Nothing-attributes by attributes of referenced gradients
     -- see <http://www.w3.org/TR/SVG/pservers.html#RadialGradientElementHrefAttribute>
     let attributes :: GradientAttributes
attributes = PresentationAttributes
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> GradientAttributes
GA PresentationAttributes
pa Maybe Text
class_ Maybe Text
style Maybe Text
x1 Maybe Text
y1 Maybe Text
x2 Maybe Text
y2 Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
gradientUnits Maybe Text
gradientTransform Maybe Text
spreadMethod

     -- stops are lists of functions and everyone of these gets passed the same cssmap
     -- and puts them into a Grad constructor
     let f :: HashMap Text Attrs
-> GradientAttributes
-> (n, n, n, n)
-> [HashMap Text Attrs -> [GradientStop n]]
-> Texture n
f HashMap Text Attrs
css GradientAttributes
attributes (n
minx,n
miny,n
w,n
h) [HashMap Text Attrs -> [GradientStop n]]
stops =
           ASetter
  (Texture n) (Texture n) (Transformation V2 n) (Transformation V2 n)
-> (Transformation V2 n -> Transformation V2 n)
-> Texture n
-> Texture n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((LGradient n -> Identity (LGradient n))
-> Texture n -> Identity (Texture n)
forall n. Prism' (Texture n) (LGradient n)
_LG ((LGradient n -> Identity (LGradient n))
 -> Texture n -> Identity (Texture n))
-> ((Transformation V2 n -> Identity (Transformation V2 n))
    -> LGradient n -> Identity (LGradient n))
-> ASetter
     (Texture n) (Texture n) (Transformation V2 n) (Transformation V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transformation V2 n -> Identity (Transformation V2 n))
-> LGradient n -> Identity (LGradient n)
forall n. Lens' (LGradient n) (Transformation V2 n)
lGradTrans) ([Transform (N (Transformation V2 n))]
-> Transformation V2 n -> Transformation V2 n
forall a.
(RealFloat (N a), Transformable a, V a ~ V2) =>
[Transform (N a)] -> a -> a
applyTr (Maybe Text -> [Transform n]
forall n. RealFloat n => Maybe Text -> [Transform n]
parseTr Maybe Text
gradientTransform))
           ([GradientStop n]
-> Point V2 n -> Point V2 n -> SpreadMethod -> Texture n
forall n.
Num n =>
[GradientStop n]
-> Point V2 n -> Point V2 n -> SpreadMethod -> Texture n
mkLinearGradient ([[GradientStop n]] -> [GradientStop n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (((HashMap Text Attrs -> [GradientStop n]) -> [GradientStop n])
-> [HashMap Text Attrs -> [GradientStop n]] -> [[GradientStop n]]
forall a b. (a -> b) -> [a] -> [b]
map ((HashMap Text Attrs -> [GradientStop n])
-> HashMap Text Attrs -> [GradientStop n]
forall a b. (a -> b) -> a -> b
$ HashMap Text Attrs
css) [HashMap Text Attrs -> [GradientStop n]]
stops)) -- (minx,miny,w,h) is the viewbox
                             (((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) n
0 Maybe Text
x1) PrevDim (Point V2 n) -> FinalCoord (Point V2 n) -> Point V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
h) n
0 Maybe Text
y1))
                             (((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) n
0 Maybe Text
x2) PrevDim (Point V2 n) -> FinalCoord (Point V2 n) -> Point V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
h) n
0 Maybe Text
y2))
                             (Maybe Text -> SpreadMethod
parseSpread Maybe Text
spreadMethod))
     Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Gr n -> Tag b n
forall b n. Maybe Text -> Gr n -> Tag b n
Grad (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) (Maybe Text
-> GradientAttributes
-> Maybe (n, n, n, n)
-> [HashMap Text Attrs -> [GradientStop n]]
-> (HashMap Text Attrs
    -> GradientAttributes
    -> (n, n, n, n)
    -> [HashMap Text Attrs -> [GradientStop n]]
    -> Texture n)
-> Gr n
forall n.
Maybe Text
-> GradientAttributes
-> Maybe (ViewBox n)
-> [HashMap Text Attrs -> [GradientStop n]]
-> (HashMap Text Attrs
    -> GradientAttributes
    -> ViewBox n
    -> [HashMap Text Attrs -> [GradientStop n]]
    -> Texture n)
-> Gr n
Gr (Maybe Text -> Maybe Text
Diagrams.SVG.Attributes.fragment (Maybe Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ XlinkAttributes -> Maybe Text
xlinkHref XlinkAttributes
xlink) GradientAttributes
attributes Maybe (n, n, n, n)
forall a. Maybe a
Nothing [HashMap Text Attrs -> [GradientStop n]]
stops HashMap Text Attrs
-> GradientAttributes
-> (n, n, n, n)
-> [HashMap Text Attrs -> [GradientStop n]]
-> Texture n
f)

gradientContent :: ConduitT Event o m (Maybe (Tag b n))
gradientContent = [ConduitT Event o m (Maybe (Tag b n))]
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) n o b.
(MonadThrow m, RealFloat n) =>
ConduitT Event o m (Maybe (Tag b n))
parseStop, ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) n o b.
(MonadThrow m, RealFloat n) =>
ConduitT Event o m (Maybe (Tag b n))
parseMidPointStop] -- parseSet,
   --   parseDesc, parseMetaData, parseTitle] -- descriptive Elements (rarely used here, so tested at the end)

-- | Parse \<radialGradient\>, see <http://www.w3.org/TR/SVG/pservers.html#RadialGradientElement>
parseRadialGradient :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n) => Consumer Event m (Maybe (Tag b n))
parseRadialGradient :: Consumer Event m (Maybe (Tag b n))
parseRadialGradient = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, XlinkAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text)
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}radialGradient" AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
radialGradAttrs (((CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ -- TODO gradientUnits
  \(CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
cx,Maybe Text
cy,Maybe Text
r,Maybe Text
fx,Maybe Text
fy,Maybe Text
gradientUnits,Maybe Text
gradientTransform,Maybe Text
spreadMethod) -> 
  do [Tag Any n]
gs <- ConduitT Event o m (Maybe (Tag Any n))
-> ConduitT Event o m [Tag Any n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe (Tag Any n))
forall (m :: * -> *) n o b.
(MonadThrow m, RealFloat n) =>
ConduitT Event o m (Maybe (Tag b n))
gradientContent
     let stops :: [HashMap Text Attrs -> [GradientStop n]]
stops = (Tag Any n -> HashMap Text Attrs -> [GradientStop n])
-> [Tag Any n] -> [HashMap Text Attrs -> [GradientStop n]]
forall a b. (a -> b) -> [a] -> [b]
map Tag Any n -> HashMap Text Attrs -> [GradientStop n]
forall n b.
RealFloat n =>
Tag b n -> HashMap Text Attrs -> [GradientStop n]
getTexture ([Tag Any n] -> [HashMap Text Attrs -> [GradientStop n]])
-> [Tag Any n] -> [HashMap Text Attrs -> [GradientStop n]]
forall a b. (a -> b) -> a -> b
$ [[Tag Any n]] -> [Tag Any n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Tag Any n]] -> [Tag Any n]) -> [[Tag Any n]] -> [Tag Any n]
forall a b. (a -> b) -> a -> b
$ (Tag Any n -> [Tag Any n]) -> [Tag Any n] -> [[Tag Any n]]
forall a b. (a -> b) -> [a] -> [b]
map Tag Any n -> [Tag Any n]
forall b n. Tag b n -> [Tag b n]
extractStops [Tag Any n]
gs

     -- because of href we have to replace Nothing-attributes by attributes of referenced gradients
     -- see <http://www.w3.org/TR/SVG/pservers.html#RadialGradientElementHrefAttribute>
     let attributes :: GradientAttributes
attributes = PresentationAttributes
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> GradientAttributes
GA PresentationAttributes
pa Maybe Text
class_ Maybe Text
style Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
cx Maybe Text
cy Maybe Text
r Maybe Text
fx Maybe Text
fy Maybe Text
gradientUnits Maybe Text
gradientTransform Maybe Text
spreadMethod

     let f :: HashMap Text Attrs
-> GradientAttributes
-> (n, n, n, n)
-> [HashMap Text Attrs -> [GradientStop n]]
-> Texture n
f HashMap Text Attrs
css GradientAttributes
attributes (n
minx,n
miny,n
w,n
h) [HashMap Text Attrs -> [GradientStop n]]
stops =
            ASetter
  (Texture n) (Texture n) (Transformation V2 n) (Transformation V2 n)
-> (Transformation V2 n -> Transformation V2 n)
-> Texture n
-> Texture n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((RGradient n -> Identity (RGradient n))
-> Texture n -> Identity (Texture n)
forall n. Prism' (Texture n) (RGradient n)
_RG ((RGradient n -> Identity (RGradient n))
 -> Texture n -> Identity (Texture n))
-> ((Transformation V2 n -> Identity (Transformation V2 n))
    -> RGradient n -> Identity (RGradient n))
-> ASetter
     (Texture n) (Texture n) (Transformation V2 n) (Transformation V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transformation V2 n -> Identity (Transformation V2 n))
-> RGradient n -> Identity (RGradient n)
forall n. Lens' (RGradient n) (Transformation V2 n)
rGradTrans) ([Transform (N (Transformation V2 n))]
-> Transformation V2 n -> Transformation V2 n
forall a.
(RealFloat (N a), Transformable a, V a ~ V2) =>
[Transform (N a)] -> a -> a
applyTr (Maybe Text -> [Transform n]
forall n. RealFloat n => Maybe Text -> [Transform n]
parseTr Maybe Text
gradientTransform))
            ([GradientStop n]
-> Point V2 n -> n -> Point V2 n -> n -> SpreadMethod -> Texture n
forall n.
Num n =>
[GradientStop n]
-> Point V2 n -> n -> Point V2 n -> n -> SpreadMethod -> Texture n
mkRadialGradient ([[GradientStop n]] -> [GradientStop n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (((HashMap Text Attrs -> [GradientStop n]) -> [GradientStop n])
-> [HashMap Text Attrs -> [GradientStop n]] -> [[GradientStop n]]
forall a b. (a -> b) -> [a] -> [b]
map ((HashMap Text Attrs -> [GradientStop n])
-> HashMap Text Attrs -> [GradientStop n]
forall a b. (a -> b) -> a -> b
$ HashMap Text Attrs
css) [HashMap Text Attrs -> [GradientStop n]]
stops))
                              (((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) n
0 Maybe Text
cx) Maybe Text
fx) PrevDim (Point V2 n) -> FinalCoord (Point V2 n) -> Point V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& -- focal point fx is set to cx if fx does not exist
                              ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
h) ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
h) n
0 Maybe Text
cy) Maybe Text
fy))
                              n
0
                              (((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) n
0             Maybe Text
cx) PrevDim (Point V2 n) -> FinalCoord (Point V2 n) -> Point V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& 
                              ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
miny,n
h) n
0             Maybe Text
cy))
                              ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
w) (n
0.5n -> n -> n
forall a. Num a => a -> a -> a
*(n
wn -> n -> n
forall a. Num a => a -> a -> a
-n
minx)) Maybe Text
r) --TODO radius percentage relative to x or y?
                              (Maybe Text -> SpreadMethod
parseSpread Maybe Text
spreadMethod))
     Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Gr n -> Tag b n
forall b n. Maybe Text -> Gr n -> Tag b n
Grad (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) (Maybe Text
-> GradientAttributes
-> Maybe (n, n, n, n)
-> [HashMap Text Attrs -> [GradientStop n]]
-> (HashMap Text Attrs
    -> GradientAttributes
    -> (n, n, n, n)
    -> [HashMap Text Attrs -> [GradientStop n]]
    -> Texture n)
-> Gr n
forall n.
Maybe Text
-> GradientAttributes
-> Maybe (ViewBox n)
-> [HashMap Text Attrs -> [GradientStop n]]
-> (HashMap Text Attrs
    -> GradientAttributes
    -> ViewBox n
    -> [HashMap Text Attrs -> [GradientStop n]]
    -> Texture n)
-> Gr n
Gr (Maybe Text -> Maybe Text
Diagrams.SVG.Attributes.fragment (Maybe Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ XlinkAttributes -> Maybe Text
xlinkHref XlinkAttributes
xlink) GradientAttributes
attributes Maybe (n, n, n, n)
forall a. Maybe a
Nothing [HashMap Text Attrs -> [GradientStop n]]
stops HashMap Text Attrs
-> GradientAttributes
-> (n, n, n, n)
-> [HashMap Text Attrs -> [GradientStop n]]
-> Texture n
f)

extractStops :: Tag b n -> [Tag b n]
extractStops (SubTree Bool
b Maybe Text
id1 (Place, Place)
wh Maybe (ViewBox n)
viewBox Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
children) = [[Tag b n]] -> [Tag b n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Tag b n -> [Tag b n]) -> [Tag b n] -> [[Tag b n]]
forall a b. (a -> b) -> [a] -> [b]
map Tag b n -> [Tag b n]
extractStops [Tag b n]
children)
extractStops (Stop HashMaps b n -> [GradientStop n]
stops) = [(HashMaps b n -> [GradientStop n]) -> Tag b n
forall b n. (HashMaps b n -> [GradientStop n]) -> Tag b n
Stop HashMaps b n -> [GradientStop n]
stops]
extractStops Tag b n
_ = []

getTexture :: (RealFloat n) => Tag b n -> (CSSMap -> [GradientStop n])
getTexture :: Tag b n -> HashMap Text Attrs -> [GradientStop n]
getTexture (Stop HashMaps b n -> [GradientStop n]
stops) = HashMaps b n -> [GradientStop n]
stops (HashMaps b n -> [GradientStop n])
-> (HashMap Text Attrs -> HashMaps b n)
-> HashMap Text Attrs
-> [GradientStop n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\HashMap Text Attrs
css -> (HashMap Text (Tag b n)
forall k v. HashMap k v
H.empty, HashMap Text Attrs
css, HashMap Text (Gr n)
forall k v. HashMap k v
H.empty))

-- | Parse \<set\>, see <http://www.w3.org/TR/SVG/animate.html#SetElement>
parseSet :: ConduitT Event o m (Maybe (Tag b n))
parseSet = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, XlinkAttributes)
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}set" AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes)
setAttrs (((CoreAttributes, PresentationAttributes, XlinkAttributes)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink) ->
   do Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty -- "set" ignored so far

-- | Parse \<stop\>, see <http://www.w3.org/TR/SVG/pservers.html#StopElement>
--  e.g. <stop  offset="0.4664" style="stop-color:#000000;stop-opacity:0.8"/>
parseStop :: ConduitT Event o m (Maybe (Tag b n))
parseStop = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, XlinkAttributes,
      Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}stop" AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text)
stopAttrs (((CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
offset) ->
   do let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag Any n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag Any n), HashMap Text Attrs, HashMap Text (Gr n))
forall k v k v k v. (HashMap k v, HashMap k v, HashMap k v)
empty3) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     (PresentationAttributes
-> (HashMap Text (Tag Any n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA PresentationAttributes
pa (HashMap Text (Tag Any n), HashMap Text Attrs, HashMap Text (Gr n))
forall k v k v k v. (HashMap k v, HashMap k v, HashMap k v)
empty3) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"stop" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [GradientStop n])
-> Tag b n
forall b n. (HashMaps b n -> [GradientStop n]) -> Tag b n
Stop (\(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps -> [(Colour Place, n, Place)] -> [GradientStop n]
forall d. [(Colour Place, d, Place)] -> [GradientStop d]
mkStops [n -> [SVGStyle n Place] -> (Colour Place, n, Place)
forall b n. b -> [SVGStyle n Place] -> (Colour Place, b, Place)
getStopTriple ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
0,n
1) n
0 Maybe Text
offset) ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps)])

parseMidPointStop :: ConduitT Event o m (Maybe (Tag b n))
parseMidPointStop = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, XlinkAttributes,
      Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}midPointStop" AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text)
stopAttrs (((CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
offset) ->
   do let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = (Maybe Text
-> (HashMap Text (Tag Any n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag Any n), HashMap Text Attrs, HashMap Text (Gr n))
forall k v k v k v. (HashMap k v, HashMap k v, HashMap k v)
empty3) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     (PresentationAttributes
-> (HashMap Text (Tag Any n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA PresentationAttributes
pa (HashMap Text (Tag Any n), HashMap Text Attrs, HashMap Text (Gr n))
forall k v k v k v. (HashMap k v, HashMap k v, HashMap k v)
empty3) [SVGStyle n Place] -> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. [a] -> [a] -> [a]
++
                     ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps Text
"midPointStop" (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
class_)
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [GradientStop n])
-> Tag b n
forall b n. (HashMaps b n -> [GradientStop n]) -> Tag b n
Stop (\(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps -> [(Colour Place, n, Place)] -> [GradientStop n]
forall d. [(Colour Place, d, Place)] -> [GradientStop d]
mkStops [n -> [SVGStyle n Place] -> (Colour Place, n, Place)
forall b n. b -> [SVGStyle n Place] -> (Colour Place, b, Place)
getStopTriple ((n, n) -> n -> Maybe Text -> n
forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
0,n
1) n
0 Maybe Text
offset) ((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps)])

empty3 :: (HashMap k v, HashMap k v, HashMap k v)
empty3 = (HashMap k v
forall k v. HashMap k v
H.empty,HashMap k v
forall k v. HashMap k v
H.empty,HashMap k v
forall k v. HashMap k v
H.empty)

getStopTriple :: b -> [SVGStyle n Place] -> (Colour Place, b, Place)
getStopTriple b
offset [SVGStyle n Place]
styles = ([SVGStyle n Place] -> Colour Place
forall n. [SVGStyle n Place] -> Colour Place
col [SVGStyle n Place]
colors, b
offset, [SVGStyle n Place] -> Place
forall n a. [SVGStyle n a] -> Place
opacity [SVGStyle n Place]
opacities)
  where col :: [SVGStyle n Place] -> Colour Place
col ((Fill AlphaColour Place
c):[SVGStyle n Place]
_) = AlphaColour Place -> Colour Place
forall c. Color c => AlphaColour Place -> c
fromAlphaColour AlphaColour Place
c
        col [SVGStyle n Place]
_ = Colour Place
forall a. (Ord a, Floating a) => Colour a
white
        opacity :: [SVGStyle n a] -> Place
opacity ((FillOpacity Place
x):[SVGStyle n a]
_) = Place
x
        opacity [SVGStyle n a]
_ =  Place
1
        colors :: [SVGStyle n Place]
colors = (SVGStyle n Place -> Bool)
-> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter SVGStyle n Place -> Bool
forall n a. SVGStyle n a -> Bool
isFill [SVGStyle n Place]
styles
        opacities :: [SVGStyle n Place]
opacities = (SVGStyle n Place -> Bool)
-> [SVGStyle n Place] -> [SVGStyle n Place]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter SVGStyle n Place -> Bool
forall n a. SVGStyle n a -> Bool
isOpacity [SVGStyle n Place]
styles

isFill :: SVGStyle n a -> Bool
isFill (Fill AlphaColour a
_) = Bool
True
isFill SVGStyle n a
_        = Bool
False

isOpacity :: SVGStyle n a -> Bool
isOpacity (FillOpacity Place
_) = Bool
True
isOpacity SVGStyle n a
_           = Bool
False

----------------------------------------------------------------------------------------------------
-- Fonts
----------------------------------------------------------------------------------------------------

parseFont :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Renderable (DImage (N b) Embedded) b, Renderable (Path V2 n) b,
              Typeable b, Typeable n, Show n, Read n, Renderable (TT.Text n) b) => Consumer Event m (Maybe (Tag b n))
parseFont :: Consumer Event m (Maybe (Tag b n))
parseFont = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}font" AttrParser
  (CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
fontAttrs (((CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
hOriginX,Maybe Text
hOriginY,Maybe Text
hAdvX,Maybe Text
vOriginX,Maybe Text
vOriginY,Maybe Text
vAdvY) ->
  do [FontContent b n]
gs <- ConduitT Event o m (Maybe (FontContent b n))
-> ConduitT Event o m [FontContent b n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Read n, Show n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (FontContent b n))
fontContent
     Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ FontData b n -> Tag b n
forall b n. FontData b n -> Tag b n
FontTag (FontData b n -> Tag b n) -> FontData b n -> Tag b n
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Maybe Text
-> Maybe Text
-> n
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> FontFace n
-> Glyph b n
-> SvgGlyphs n
-> KernMaps n
-> FontData b n
forall b n.
Maybe Text
-> Maybe Text
-> Maybe Text
-> n
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> FontFace n
-> Glyph b n
-> SvgGlyphs n
-> KernMaps n
-> FontData b n
FontData (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Maybe Text
hOriginX Maybe Text
hOriginY (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
hAdvX) Maybe Text
vOriginX Maybe Text
vOriginY Maybe Text
vAdvY 
                                 ([FontContent b n] -> FontFace n
forall b n. [FontContent b n] -> FontFace n
fontf [FontContent b n]
gs) ([FontContent b n] -> Glyph b n
forall b n. [FontContent b n] -> Glyph b n
missingGlyph [FontContent b n]
gs) ([FontContent b n] -> SvgGlyphs n
forall b b.
[FontContent b b] -> HashMap Text (Maybe Text, b, Maybe Text)
glyphs [FontContent b n]
gs) ([Kern n] -> KernMaps n
forall n. [Kern n] -> KernMaps n
kernMap ([FontContent b n] -> [Kern n]
forall b n. [FontContent b n] -> [Kern n]
kerns [FontContent b n]
gs))
  where fontf :: [FontContent b n] -> FontFace n
fontf [FontContent b n]
gs        = (\(FF FontFace n
f) -> FontFace n
f) (FontContent b n -> FontFace n) -> FontContent b n -> FontFace n
forall a b. (a -> b) -> a -> b
$ [FontContent b n] -> FontContent b n
forall a. [a] -> a
head ([FontContent b n] -> FontContent b n)
-> [FontContent b n] -> FontContent b n
forall a b. (a -> b) -> a -> b
$ (FontContent b n -> Bool) -> [FontContent b n] -> [FontContent b n]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter FontContent b n -> Bool
forall b n. FontContent b n -> Bool
isFontFace [FontContent b n]
gs
        missingGlyph :: [FontContent b n] -> Glyph b n
missingGlyph [FontContent b n]
gs = (\(GG Glyph b n
g) -> Glyph b n
g) (FontContent b n -> Glyph b n) -> FontContent b n -> Glyph b n
forall a b. (a -> b) -> a -> b
$ [FontContent b n] -> FontContent b n
forall a. [a] -> a
head ([FontContent b n] -> FontContent b n)
-> [FontContent b n] -> FontContent b n
forall a b. (a -> b) -> a -> b
$ (FontContent b n -> Bool) -> [FontContent b n] -> [FontContent b n]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter FontContent b n -> Bool
forall b n. FontContent b n -> Bool
isMissingGlyph [FontContent b n]
gs
        glyphs :: [FontContent b b] -> HashMap Text (Maybe Text, b, Maybe Text)
glyphs [FontContent b b]
gs       = [(Text, (Maybe Text, b, Maybe Text))]
-> HashMap Text (Maybe Text, b, Maybe Text)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, (Maybe Text, b, Maybe Text))]
 -> HashMap Text (Maybe Text, b, Maybe Text))
-> [(Text, (Maybe Text, b, Maybe Text))]
-> HashMap Text (Maybe Text, b, Maybe Text)
forall a b. (a -> b) -> a -> b
$ (FontContent b b -> (Text, (Maybe Text, b, Maybe Text)))
-> [FontContent b b] -> [(Text, (Maybe Text, b, Maybe Text))]
forall a b. (a -> b) -> [a] -> [b]
map FontContent b b -> (Text, (Maybe Text, b, Maybe Text))
forall b b. FontContent b b -> (Text, (Maybe Text, b, Maybe Text))
toSvgGlyph     ((FontContent b b -> Bool) -> [FontContent b b] -> [FontContent b b]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter FontContent b b -> Bool
forall b n. FontContent b n -> Bool
isGlyph [FontContent b b]
gs)
        kerns :: [FontContent b n] -> [Kern n]
kerns [FontContent b n]
gs = (FontContent b n -> Kern n) -> [FontContent b n] -> [Kern n]
forall a b. (a -> b) -> [a] -> [b]
map (\(KK Kern n
k) -> Kern n
k) ((FontContent b n -> Bool) -> [FontContent b n] -> [FontContent b n]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter FontContent b n -> Bool
forall b n. FontContent b n -> Bool
isKern [FontContent b n]
gs)

        isGlyph :: FontContent b n -> Bool
isGlyph (GG (Glyph Maybe Text
glyphId Tag b n
g Maybe Text
d n
_ n
_ n
_ n
_ Maybe Text
unicode Maybe Text
glyphName Maybe Text
o Maybe Text
a Maybe Text
l)) = Bool -> Bool
not (Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
T.null Maybe Text
unicode) Bool -> Bool -> Bool
||
                                                                           Bool -> Bool
not (Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
T.null Maybe Text
glyphName)
        isGlyph FontContent b n
_        = Bool
False
        isMissingGlyph :: FontContent b n -> Bool
isMissingGlyph (GG (Glyph Maybe Text
glyphId Tag b n
g Maybe Text
d n
_ n
_ n
_ n
_ Maybe Text
unicode Maybe Text
glyphName Maybe Text
o Maybe Text
a Maybe Text
l)) = (Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
T.null Maybe Text
unicode) Bool -> Bool -> Bool
&&
                                                                                  (Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
T.null Maybe Text
glyphName)
        isMissingGlyph FontContent b n
_  = Bool
False
        isKern :: FontContent b n -> Bool
isKern (KK Kern n
k)     = Bool
True
        isKern FontContent b n
_          = Bool
False
        isFontFace :: FontContent b n -> Bool
isFontFace (FF FontFace n
f) = Bool
True
        isFontFace FontContent b n
_      = Bool
False
        toSvgGlyph :: FontContent b b -> (Text, (Maybe Text, b, Maybe Text))
toSvgGlyph (GG (Glyph Maybe Text
glyphId Tag b b
g Maybe Text
d b
horizAdvX b
_ b
_ b
_ (Just Text
unicode) Maybe Text
glyphName Maybe Text
o Maybe Text
a Maybe Text
l)) = (Text
unicode,(Maybe Text
glyphName,b
horizAdvX,Maybe Text
d))

fontContent :: (MonadThrow m, InputConstraints b n, Read n, Show n, Renderable (TT.Text n) b) 
             => Consumer Event m (Maybe (FontContent b n))
fontContent :: Consumer Event m (Maybe (FontContent b n))
fontContent = [ConduitT Event o m (Maybe (FontContent b n))]
-> ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose -- the likely most common are checked first
     [ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Read n,
 Renderable (DImage (N b) Embedded) b, Renderable (Path V2 n) b,
 Show n, Typeable b, Typeable n, Renderable (Text n) b) =>
Consumer Event m (Maybe (FontContent b n))
parseGlyph, ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable b,
 Typeable n) =>
Consumer Event m (Maybe (FontContent b n))
parseHKern, ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, Read n, RealFloat n,
 Renderable (DImage (N b) Embedded) b, Typeable b, Typeable n) =>
Consumer Event m (Maybe (FontContent b n))
parseFontFace, ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Read n,
 Renderable (DImage (N b) Embedded) b, Typeable b, Typeable n) =>
Consumer Event m (Maybe (FontContent b n))
parseMissingGlyph, ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable b,
 Typeable n) =>
Consumer Event m (Maybe (FontContent b n))
parseVKern]


parseFontFace :: (MonadThrow m, V b ~ V2, N b ~ n, Read n, RealFloat n, Renderable (DImage (N b) Embedded) b,
              Typeable b, Typeable n) => Consumer Event m (Maybe (FontContent b n))
parseFontFace :: Consumer Event m (Maybe (FontContent b n))
parseFontFace = Name
-> AttrParser
     (CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}font-face" AttrParser
  (CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
fontFaceAttrs (((CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (FontContent b n))
 -> ConduitT Event o m (Maybe (FontContent b n)))
-> ((CoreAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall a b. (a -> b) -> a -> b
$
  \(CoreAttributes
ca,Maybe Text
fontFamily,Maybe Text
fontStyle,Maybe Text
fontVariant,Maybe Text
fontWeight,Maybe Text
fontStretch,Maybe Text
fontSize,Maybe Text
unicodeRange,Maybe Text
unitsPerEm,Maybe Text
panose1,
    Maybe Text
stemv,Maybe Text
stemh,Maybe Text
slope,Maybe Text
capHeight,Maybe Text
xHeight,Maybe Text
accentHeight,Maybe Text
ascent,Maybe Text
descent,Maybe Text
widths,Maybe Text
bbox,Maybe Text
ideographic,Maybe Text
alphabetic,Maybe Text
mathematical,
    Maybe Text
hanging,Maybe Text
vIdeographic,Maybe Text
vAlphabetic,Maybe Text
vMathematical,Maybe Text
vHanging,Maybe Text
underlinePosition,Maybe Text
underlineThickness,Maybe Text
strikethroughPosition,
    Maybe Text
strikethroughThickness,Maybe Text
overlinePosition,Maybe Text
overlineThickness) ->
  do FontContent b n -> ConduitT Event o m (FontContent b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FontContent b n -> ConduitT Event o m (FontContent b n))
-> FontContent b n -> ConduitT Event o m (FontContent b n)
forall a b. (a -> b) -> a -> b
$ FontFace n -> FontContent b n
forall b n. FontFace n -> FontContent b n
FF (FontFace n -> FontContent b n) -> FontFace n -> FontContent b n
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [n]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> FontFace n
forall n.
Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [n]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> FontFace n
FontFace Maybe Text
fontFamily Maybe Text
fontStyle Maybe Text
fontVariant Maybe Text
fontWeight Maybe Text
fontStretch Maybe Text
fontSize Maybe Text
unicodeRange Maybe Text
unitsPerEm Maybe Text
panose1
                            Maybe Text
stemv Maybe Text
stemh Maybe Text
slope Maybe Text
capHeight Maybe Text
xHeight Maybe Text
accentHeight Maybe Text
ascent Maybe Text
descent Maybe Text
widths (Maybe Text -> [n]
forall n. (Read n, RealFloat n) => Maybe Text -> [n]
parseBBox Maybe Text
bbox) Maybe Text
ideographic
                            Maybe Text
alphabetic Maybe Text
mathematical Maybe Text
hanging Maybe Text
vIdeographic Maybe Text
vAlphabetic  Maybe Text
vMathematical Maybe Text
vHanging Maybe Text
underlinePosition 
                            Maybe Text
underlineThickness Maybe Text
strikethroughPosition Maybe Text
strikethroughThickness Maybe Text
overlinePosition Maybe Text
overlineThickness


parseMissingGlyph :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Read n, Renderable (DImage (N b) Embedded) b,
              Typeable b, Typeable n) => Consumer Event m (Maybe (FontContent b n))
parseMissingGlyph :: Consumer Event m (Maybe (FontContent b n))
parseMissingGlyph = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}missing-glyph" AttrParser
  (CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
missingGlyphAttrs (((CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (FontContent b n))
 -> ConduitT Event o m (Maybe (FontContent b n)))
-> ((CoreAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall a b. (a -> b) -> a -> b
$
  \(CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
d,Maybe Text
horizAdvX,Maybe Text
vertOriginX,Maybe Text
vertOriginY,Maybe Text
vertAdvY) ->
  do FontContent b n -> ConduitT Event o m (FontContent b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FontContent b n -> ConduitT Event o m (FontContent b n))
-> FontContent b n -> ConduitT Event o m (FontContent b n)
forall a b. (a -> b) -> a -> b
$ Glyph b n -> FontContent b n
forall b n. Glyph b n -> FontContent b n
GG (Glyph b n -> FontContent b n) -> Glyph b n -> FontContent b n
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Tag b n
-> Maybe Text
-> n
-> n
-> n
-> n
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Glyph b n
forall b n.
Maybe Text
-> Tag b n
-> Maybe Text
-> n
-> n
-> n
-> n
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Glyph b n
Glyph (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) (Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty) Maybe Text
forall a. Maybe a
Nothing
                         (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
horizAdvX) (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
vertOriginX) (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
vertOriginY) (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
vertAdvY)
                         Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing


parseGlyph :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Read n, Renderable (DImage (N b) Embedded) b,
              Renderable (Path V2 n) b, Show n, Typeable b, Typeable n, Renderable (TT.Text n) b) 
           => Consumer Event m (Maybe (FontContent b n))
parseGlyph :: Consumer Event m (Maybe (FontContent b n))
parseGlyph = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}glyph" AttrParser
  (CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
glyphAttrs (((CoreAttributes, PresentationAttributes, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (FontContent b n))
 -> ConduitT Event o m (Maybe (FontContent b n)))
-> ((CoreAttributes, PresentationAttributes, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall a b. (a -> b) -> a -> b
$
  \(CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
d,Maybe Text
horizAdvX,Maybe Text
vertOriginX,Maybe Text
vertOriginY,Maybe Text
vertAdvY,Maybe Text
unicode,Maybe Text
glyphName,Maybe Text
orientation,Maybe Text
arabicForm,Maybe Text
lang) ->
  do [Tag b n]
gs <- ConduitT Event o m (Maybe (Tag b n))
-> ConduitT Event o m [Tag b n]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, InputConstraints b n, Show n, Read n,
 Renderable (Text n) b) =>
Consumer Event m (Maybe (Tag b n))
gContent
     let st :: (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps = Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n Place]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
style (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
hmaps
     let sub :: Tag b n
sub = Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> ((HashMap Text (Tag b n), HashMap Text Attrs,
     HashMap Text (Gr n))
    -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
forall b n.
Bool
-> Maybe Text
-> (Place, Place)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
True (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) (Place
0,Place
0) Maybe (ViewBox n)
forall a. Maybe a
Nothing Maybe PreserveAR
forall a. Maybe a
Nothing (\(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps -> (((HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
 -> [SVGStyle (N (QDiagram b V2 n Any)) Place])
-> (HashMap Text (Tag b n), HashMap Text Attrs,
    HashMap Text (Gr n))
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a t.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
(t -> [SVGStyle (N a) Place]) -> t -> a -> a
applyStyleSVG (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle n Place]
(HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
-> [SVGStyle (N (QDiagram b V2 n Any)) Place]
st (HashMap Text (Tag b n), HashMap Text Attrs, HashMap Text (Gr n))
maps)) ([Tag b n] -> [Tag b n]
forall a. [a] -> [a]
reverse [Tag b n]
gs)
     FontContent b n -> ConduitT Event o m (FontContent b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FontContent b n -> ConduitT Event o m (FontContent b n))
-> FontContent b n -> ConduitT Event o m (FontContent b n)
forall a b. (a -> b) -> a -> b
$ Glyph b n -> FontContent b n
forall b n. Glyph b n -> FontContent b n
GG (Glyph b n -> FontContent b n) -> Glyph b n -> FontContent b n
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Tag b n
-> Maybe Text
-> n
-> n
-> n
-> n
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Glyph b n
forall b n.
Maybe Text
-> Tag b n
-> Maybe Text
-> n
-> n
-> n
-> n
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Glyph b n
Glyph (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) Tag b n
sub Maybe Text
d (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
horizAdvX) (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
vertOriginX) (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
vertOriginY) (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
vertAdvY)
                         Maybe Text
unicode Maybe Text
glyphName Maybe Text
orientation Maybe Text
arabicForm Maybe Text
lang

getN :: Maybe Text -> b
getN = b -> (Text -> b) -> Maybe Text -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
0 (String -> b
forall a. Read a => String -> a
read (String -> b) -> (Text -> String) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

parseHKern :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable b, Typeable n) => Consumer Event m (Maybe (FontContent b n))
parseHKern :: Consumer Event m (Maybe (FontContent b n))
parseHKern = Name
-> AttrParser
     (CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text)
-> ((CoreAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}hkern" AttrParser
  (CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
kernAttrs (((CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
  -> ConduitT Event o m (FontContent b n))
 -> ConduitT Event o m (Maybe (FontContent b n)))
-> ((CoreAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall a b. (a -> b) -> a -> b
$
  \(CoreAttributes
ca,Maybe Text
u1,Maybe Text
g1,Maybe Text
u2,Maybe Text
g2,Maybe Text
k) ->
  do FontContent b n -> ConduitT Event o m (FontContent b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FontContent b n -> ConduitT Event o m (FontContent b n))
-> FontContent b n -> ConduitT Event o m (FontContent b n)
forall a b. (a -> b) -> a -> b
$ Kern n -> FontContent b n
forall b n. Kern n -> FontContent b n
KK (Kern n -> FontContent b n) -> Kern n -> FontContent b n
forall a b. (a -> b) -> a -> b
$ KernDir -> [Text] -> [Text] -> [Text] -> [Text] -> n -> Kern n
forall n.
KernDir -> [Text] -> [Text] -> [Text] -> [Text] -> n -> Kern n
Kern KernDir
HKern (Maybe Text -> [Text]
charList Maybe Text
u1) (Maybe Text -> [Text]
charList Maybe Text
g1) (Maybe Text -> [Text]
charList Maybe Text
u2) (Maybe Text -> [Text]
charList Maybe Text
g2) (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
k)

parseVKern :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n, Read n, Typeable b, Typeable n) => Consumer Event m (Maybe (FontContent b n))
parseVKern :: Consumer Event m (Maybe (FontContent b n))
parseVKern = Name
-> AttrParser
     (CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text)
-> ((CoreAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}vkern" AttrParser
  (CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
kernAttrs (((CoreAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
  -> ConduitT Event o m (FontContent b n))
 -> ConduitT Event o m (Maybe (FontContent b n)))
-> ((CoreAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (FontContent b n))
-> ConduitT Event o m (Maybe (FontContent b n))
forall a b. (a -> b) -> a -> b
$
  \(CoreAttributes
ca,Maybe Text
u1,Maybe Text
g1,Maybe Text
u2,Maybe Text
g2,Maybe Text
k) ->
  do FontContent b n -> ConduitT Event o m (FontContent b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (FontContent b n -> ConduitT Event o m (FontContent b n))
-> FontContent b n -> ConduitT Event o m (FontContent b n)
forall a b. (a -> b) -> a -> b
$ Kern n -> FontContent b n
forall b n. Kern n -> FontContent b n
KK (Kern n -> FontContent b n) -> Kern n -> FontContent b n
forall a b. (a -> b) -> a -> b
$ KernDir -> [Text] -> [Text] -> [Text] -> [Text] -> n -> Kern n
forall n.
KernDir -> [Text] -> [Text] -> [Text] -> [Text] -> n -> Kern n
Kern KernDir
VKern (Maybe Text -> [Text]
charList Maybe Text
u1) (Maybe Text -> [Text]
charList Maybe Text
g1) (Maybe Text -> [Text]
charList Maybe Text
u2) (Maybe Text -> [Text]
charList Maybe Text
g2) (Maybe Text -> n
forall b. (Num b, Read b) => Maybe Text -> b
getN Maybe Text
k)

charList :: Maybe Text -> [Text]
charList :: Maybe Text -> [Text]
charList Maybe Text
str = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> Text -> [Text]
T.splitOn Text
",") Maybe Text
str

----------------------------------------------------------------------------------------
-- descriptive elements
------------------------------------------------------o	----------------------------------
-- | Parse \<desc\>, see <http://www.w3.org/TR/SVG/struct.html#DescriptionAndTitleElements>
-- parseDesc :: (MonadThrow m, Metric (V b), RealFloat (N b)) => Consumer Event m (Maybe (Tag b n))
parseDesc :: ConduitT Event o m (Maybe (Tag b n))
parseDesc = Name
-> AttrParser (CoreAttributes, Maybe Text, Maybe Text)
-> ((CoreAttributes, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}desc" AttrParser (CoreAttributes, Maybe Text, Maybe Text)
descAttrs
   (((CoreAttributes, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ \(CoreAttributes
ca,Maybe Text
class_,Maybe Text
style) ->
   do Text
desc <- ConduitT Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<title\>, see <http://www.w3.org/TR/SVG/struct.html#DescriptionAndTitleElements>
parseTitle :: ConduitT Event o m (Maybe (Tag b n))
parseTitle = Name
-> AttrParser (CoreAttributes, Maybe Text, Maybe Text)
-> ((CoreAttributes, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}title" AttrParser (CoreAttributes, Maybe Text, Maybe Text)
descAttrs
   (((CoreAttributes, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ \(CoreAttributes
ca,Maybe Text
class_,Maybe Text
style) ->
   do Text
title <- ConduitT Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

skipArbitraryTag :: (MonadThrow m, InputConstraints b n, Renderable (TT.Text n) b, Read n) => Consumer Event m (Maybe (Tag b n))
skipArbitraryTag :: Consumer Event m (Maybe (Tag b n))
skipArbitraryTag = do Maybe ()
t <- ConduitT Event o m (Maybe ())
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreAnyTreeContent
                      if Maybe () -> Bool
forall a. Maybe a -> Bool
isJust Maybe ()
t then Maybe (Tag b n) -> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> Maybe (Tag b n)
forall a. a -> Maybe a
Just (Tag b n -> Maybe (Tag b n)) -> Tag b n -> Maybe (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"") ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty)
                                  else Maybe (Tag b n) -> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Tag b n)
forall a. Maybe a
Nothing

-- | Parse \<meta\>, see <http://www.w3.org/TR/SVG/struct.html#DescriptionAndTitleElements>
--
-- @
-- An example what metadata contains:
--
--  \<metadata
--     id=\"metadata22\"\>
--    \<rdf:RDF\>
--      \<cc:Work
--         rdf:about=\"\"\>
--        \<dc:format\>image\/svg+xml\<\/dc:format\>
--        \<dc:type
--           rdf:resource=\"http:\/\/purl.org\/dc\/dcmitype\/StillImage\" \/\>
--      \</cc:Work\>
--    \</rdf:RDF\>
--  \</metadata\>
-- @
--
{-  Maybe we implement it one day

parseMetaData :: (MonadThrow m, V b ~ V2, N b ~ n, RealFloat n) => Consumer Event m (Maybe (Tag b n))
parseMetaData = tagName "{http://www.w3.org/2000/svg}metadata" ignoreAttrs
   $ \_ ->
   do -- meta <- many metaContent
      return $ Leaf Nothing mempty mempty

-- metaContent :: (MonadThrow m, Metric (V b), RealFloat (N b)) => Consumer Event m (Maybe (Tag b n))
metaContent = choose [parseRDF] -- extend if needed

-- parseRDF :: (MonadThrow m, Metric (V b), RealFloat (N b)) => Consumer Event m (Maybe (Tag b n))
parseRDF = tagName "{http://www.w3.org/1999/02/22-rdf-syntax-ns#}RDF" ignoreAttrs
          $ \_ ->
          do -- c <- parseWork
             return $ Leaf Nothing mempty mempty

-- parseWork :: (MonadThrow m, Metric (V b), RealFloat (N b)) => Consumer Event m (Maybe (Tag b n))
parseWork = tagName "{http://creativecommons.org/ns#}Work" ignoreAttrs
   $ \_ ->
   do -- c <- many workContent
      return $ Leaf Nothing mempty mempty

workContent = choose [parseFormat, parseType, parseRDFTitle, parseDate, parseCreator,
                      parsePublisher, parseSource, parseLanguage, parseSubject, parseDescription]

parseCreator = tagName "{http://purl.org/dc/elements/1.1/}creator" ignoreAttrs
   $ \_ -> do { c <- parseAgent ; return $ Leaf Nothing mempty mempty }

parseAgent = tagName "{http://creativecommons.org/ns#}Agent" ignoreAttrs
   $ \_ -> do { c <- parseAgentTitle ; return $ Leaf Nothing mempty mempty }

parsePublisher = tagName "{http://purl.org/dc/elements/1.1/}publisher" ignoreAttrs
   $ \_ -> do { c <- parseAgent ; return $ Leaf Nothing mempty mempty }

parseSubject = tagName "{http://purl.org/dc/elements/1.1/}subject" ignoreAttrs
   $ \_ -> do { c <- parseBag ; return $ Leaf Nothing mempty mempty }

-- parseBag :: (MonadThrow m, Metric (V b), Ord (N b), Floating (N b)) => Consumer Event m (Maybe (Tag b n))
parseBag = tagName "{http://www.w3.org/1999/02/22-rdf-syntax-ns#}Bag" ignoreAttrs
   $ \_ -> do { c <- parseList ; return $ Leaf Nothing mempty mempty }

parseFormat = tagName "{http://purl.org/dc/elements/1.1/}format" ignoreAttrs
   $ \_ -> do { c <- content ; return $ Leaf Nothing mempty mempty }

parseType = tagName "{http://purl.org/dc/elements/1.1/}type" ignoreAttrs
   $ \_ -> do { c <- content ; return $ Leaf Nothing mempty mempty }

parseRDFTitle = tagName "{http://purl.org/dc/elements/1.1/}title" ignoreAttrs
   $ \_ -> do { c <- content ; return $ Leaf Nothing mempty mempty }

parseDate = tagName "{http://purl.org/dc/elements/1.1/}date" ignoreAttrs
   $ \_ -> do { c <- content ; return $ Leaf Nothing mempty mempty }

parseAgentTitle = tagName "{http://purl.org/dc/elements/1.1/}title" ignoreAttrs
   $ \_ -> do { c <- content ; return $ Leaf Nothing mempty mempty }

parseSource = tagName "{http://purl.org/dc/elements/1.1/}source" ignoreAttrs
   $ \_ -> do { c <- content ; return $ Leaf Nothing mempty mempty }

parseLanguage = tagName "{http://purl.org/dc/elements/1.1/}language" ignoreAttrs
   $ \_ -> do { c <- content ; return $ Leaf Nothing mempty mempty }

parseList = tagName "{http://www.w3.org/1999/02/22-rdf-syntax-ns#}li" ignoreAttrs
   $ \_ -> do { c <- content ; return $ Leaf Nothing mempty mempty }

parseDescription = tagName "{http://purl.org/dc/elements/1.1/}description" ignoreAttrs
   $ \_ -> do { c <- content ; return $ Leaf Nothing mempty mempty }
-}
------------------------------------
-- inkscape / sodipodi tags
------------------------------------
parseSodipodi :: ConduitT Event o m (Maybe (Tag b n))
parseSodipodi = Name
-> AttrParser
     (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd}namedview" AttrParser
  (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
namedViewAttrs
   (((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ \(Maybe Text
pc,Maybe Text
bc,Maybe Text
bo,Maybe Text
ot,Maybe Text
gt,Maybe Text
gut,Maybe Text
po,Maybe Text
ps,Maybe Text
ww,Maybe Text
wh,Maybe Text
id1,Maybe Text
sg,Maybe Text
zoom,Maybe Text
cx,Maybe Text
cy,Maybe Text
wx,Maybe Text
wy,Maybe Text
wm,Maybe Text
cl) ->
   do -- c <- parseGrid
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"") ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

--    <inkscape:grid
--       type="xygrid"
--       id="grid5177" />
parseGrid :: ConduitT Event o m (Maybe (Tag b n))
parseGrid = Name
-> AttrParser ()
-> (() -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.inkscape.org/namespaces/inkscape}grid" AttrParser ()
ignoreAttrs
   ((() -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> (() -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ \()
_ ->
   do Text
c <- ConduitT Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
      Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf Maybe Text
forall a. Maybe a
Nothing ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

{-   <inkscape:perspective
       sodipodi:type="inkscape:persp3d"
       inkscape:vp_x="0 : 212.5 : 1"
       inkscape:vp_y="0 : 1000 : 0"
       inkscape:vp_z="428.75 : 212.5 : 1"
       inkscape:persp3d-origin="214.375 : 141.66667 : 1"
       id="perspective5175" />
-}

parsePerspective :: ConduitT Event o m (Maybe (Tag b n))
parsePerspective = Name
-> AttrParser
     (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text)
-> ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.inkscape.org/namespaces/inkscape}perspective" AttrParser
  (Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
perspectiveAttrs
   (((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ \(Maybe Text
typ,Maybe Text
vp_x,Maybe Text
vp_y,Maybe Text
vp_z,Maybe Text
persp3d_origin,Maybe Text
id_) ->
     Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"") ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

parsePathEffect :: ConduitT Event o m (Maybe (Tag b n))
parsePathEffect = Name
-> AttrParser ()
-> (() -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.inkscape.org/namespaces/inkscape}path-effect" AttrParser ()
ignoreAttrs
   ((() -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> (() -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$ \()
_ -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf Maybe Text
forall a. Maybe a
Nothing ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty
--------------------------------------------------------------------------------------
-- sceletons

-- | Parse \<pattern\>, see <http://www.w3.org/TR/SVG/pservers.html#PatternElement>
parsePattern :: (MonadThrow m, InputConstraints b n) => Consumer Event m (Maybe (Tag b n))
parsePattern :: Consumer Event m (Maybe (Tag b n))
parsePattern = Name
-> AttrParser
     (ConditionalProcessingAttributes, CoreAttributes,
      PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((ConditionalProcessingAttributes, CoreAttributes,
     PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}pattern" AttrParser
  (ConditionalProcessingAttributes, CoreAttributes,
   PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
patternAttrs (((ConditionalProcessingAttributes, CoreAttributes,
   PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((ConditionalProcessingAttributes, CoreAttributes,
     PresentationAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(ConditionalProcessingAttributes
cpa,CoreAttributes
ca,PresentationAttributes
pa,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
view,Maybe Text
ar,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
pUnits,Maybe Text
pCUnits,Maybe Text
pTrans) ->
  do Text
c <- ConduitT Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content -- insidePattern <- many patternContent
     Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"") ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

patternContent :: (MonadThrow m, InputConstraints b n) => Consumer Event m (Maybe (Tag b n))
patternContent :: Consumer Event m (Maybe (Tag b n))
patternContent = [ConduitT Event o m (Maybe (Tag b n))]
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b n.
(MonadThrow m, V b ~ V2, N b ~ n, RealFloat n,
 Renderable (DImage (N b) Embedded) b, Typeable b, Typeable n) =>
Consumer Event m (Maybe (Tag b n))
parseImage]

-- | Parse \<filter\>, see <http://www.w3.org/TR/SVG/filters.html#FilterElement>
parseFilter :: ConduitT Event o m (Maybe (Tag b n))
parseFilter = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, XlinkAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}filter" AttrParser
  (CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
filterAttrs (((CoreAttributes, PresentationAttributes, XlinkAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes, XlinkAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
  \(CoreAttributes
ca,PresentationAttributes
pa,XlinkAttributes
xlink,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
x,Maybe Text
y,Maybe Text
w,Maybe Text
h,Maybe Text
filterRes,Maybe Text
filterUnits,Maybe Text
primUnits) ->
  do -- insideFilter <- many filterContent
     Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

filterContent :: ConduitT Event o m (Maybe (Tag b n))
filterContent = [ConduitT Event o m (Maybe (Tag b n))]
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeGaussianBlur,
  ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeBlend,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeColorMatrix,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeComponentTransfer,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeComposite,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeConvolveMatrix, -- filter primitive elments
  ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeDiffuseLighting,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeDisplacementMap,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeFlood,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeImage,
  ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeMerge,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeMorphology,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeOffset,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeSpecularLighting,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeTile,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseFeTurbulence,
  ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseDesc,ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o n.
(MonadThrow m, Metric (V b), Floating (N b), Ord (N b)) =>
ConduitT Event o m (Maybe (Tag b n))
parseTitle]

--------------------------------------------------------------------------------------
-- filter primitives (currently only sceletons)
--------------------------------------------------------------------------------------

-- | Parse \<feBlend\>, see <http://www.w3.org/TR/SVG/filters.html#feBlendElement>
parseFeBlend :: ConduitT Event o m (Maybe (Tag b n))
parseFeBlend = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feBlend" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feBlendAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
mode) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feColorMatrix\>, see <http://www.w3.org/TR/SVG/filters.html#feColorMatrixElement>
parseFeColorMatrix :: ConduitT Event o m (Maybe (Tag b n))
parseFeColorMatrix = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feColorMatrix" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feColorMatrixAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
type1,Maybe Text
values) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feComponentTransfer\>, see <http://www.w3.org/TR/SVG/filters.html#feComponentTransferElement>
parseFeComponentTransfer :: ConduitT Event o m (Maybe (Tag b n))
parseFeComponentTransfer = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feComponentTransfer" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text)
feComponentTransferAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feComposite\>, see <http://www.w3.org/TR/SVG/filters.html#feCompositeElement>
parseFeComposite :: ConduitT Event o m (Maybe (Tag b n))
parseFeComposite = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feComposite" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feCompositeAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
operator,Maybe Text
k1,Maybe Text
k2,Maybe Text
k3,Maybe Text
k4) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feConvolveMatrix\>, see <http://www.w3.org/TR/SVG/filters.html#feConvolveMatrixElement>
parseFeConvolveMatrix :: ConduitT Event o m (Maybe (Tag b n))
parseFeConvolveMatrix = Name
-> AttrParser
     (CoreAttributes, Maybe Text, FilterPrimitiveAttributes, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, Maybe Text, FilterPrimitiveAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feConvolveMatrix" AttrParser
  (CoreAttributes, Maybe Text, FilterPrimitiveAttributes, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feConvolveMatrixAttrs (((CoreAttributes, Maybe Text, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, Maybe Text, FilterPrimitiveAttributes,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,Maybe Text
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
order,Maybe Text
km,Maybe Text
d,Maybe Text
bias,Maybe Text
tx,Maybe Text
ty,Maybe Text
em,Maybe Text
ku,Maybe Text
par) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feDiffuseLighting\>, see <http://www.w3.org/TR/SVG/filters.html#feDiffuseLightingElement>
parseFeDiffuseLighting :: ConduitT Event o m (Maybe (Tag b n))
parseFeDiffuseLighting = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feDiffuseLighting" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
feDiffuseLightingAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
surfaceScale,Maybe Text
diffuseConstant,Maybe Text
kuLength) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feDisplacementMap\>, see <http://www.w3.org/TR/SVG/filters.html#feDisplacementMapElement>
parseFeDisplacementMap :: ConduitT Event o m (Maybe (Tag b n))
parseFeDisplacementMap = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feDisplacementMap" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
feDisplacementMapAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
sc,Maybe Text
xChan,Maybe Text
yChan) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feFlood\>, see <http://www.w3.org/TR/SVG/filters.html#feFloodElement>
parseFeFlood :: ConduitT Event o m (Maybe (Tag b n))
parseFeFlood = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feFlood" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text)
feFloodAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feGaussianBlur\>, see <http://www.w3.org/TR/SVG/filters.html#feGaussianBlurElement>
parseFeGaussianBlur :: ConduitT Event o m (Maybe (Tag b n))
parseFeGaussianBlur = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feGaussianBlur" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feGaussianBlurAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
stdDeviation) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feImage\>, see <http://www.w3.org/TR/SVG/filters.html#feImageElement>
parseFeImage :: ConduitT Event o m (Maybe (Tag b n))
parseFeImage = Name
-> AttrParser
     (CoreAttributes, Maybe Text, FilterPrimitiveAttributes,
      XlinkAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, Maybe Text, FilterPrimitiveAttributes,
     XlinkAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feImage" AttrParser
  (CoreAttributes, Maybe Text, FilterPrimitiveAttributes,
   XlinkAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feImageAttrs (((CoreAttributes, Maybe Text, FilterPrimitiveAttributes,
   XlinkAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, Maybe Text, FilterPrimitiveAttributes,
     XlinkAttributes, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,Maybe Text
pa,FilterPrimitiveAttributes
fpa,XlinkAttributes
xlibk,Maybe Text
class_,Maybe Text
style,Maybe Text
ext,Maybe Text
par) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feMerge\>, see <http://www.w3.org/TR/SVG/filters.html#feMergeElement>
parseFeMerge :: ConduitT Event o m (Maybe (Tag b n))
parseFeMerge = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feMerge" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text)
feMergeAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feMorphology\>, see <http://www.w3.org/TR/SVG/filters.html#feMorphologyElement>
parseFeMorphology :: ConduitT Event o m (Maybe (Tag b n))
parseFeMorphology = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feMorphology" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feMorphologyAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
operator,Maybe Text
radius) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feOffset\>, see <http://www.w3.org/TR/SVG/filters.html#feOffsetElement>
parseFeOffset :: ConduitT Event o m (Maybe (Tag b n))
parseFeOffset = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feOffset" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feOffsetAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
dx,Maybe Text
dy) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feSpecularLighting\>, see <http://www.w3.org/TR/SVG/filters.html#feSpecularLightingElement>
parseFeSpecularLighting :: ConduitT Event o m (Maybe (Tag b n))
parseFeSpecularLighting = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
      Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feSpecularLighting" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
feSpecularLightingAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
surfaceScale,Maybe Text
sc,Maybe Text
se,Maybe Text
ku) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feTile\>, see <http://www.w3.org/TR/SVG/filters.html#feTileElement>
parseFeTile :: ConduitT Event o m (Maybe (Tag b n))
parseFeTile = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feTile" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text)
feTileAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

-- | Parse \<feTurbulence\>, see <http://www.w3.org/TR/SVG/filters.html#feTurbulenceElement>
parseFeTurbulence :: ConduitT Event o m (Maybe (Tag b n))
parseFeTurbulence = Name
-> AttrParser
     (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
      Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall (m :: * -> *) b o c.
MonadThrow m =>
Name
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tagName Name
"{http://www.w3.org/2000/svg}feTurbulence" AttrParser
  (CoreAttributes, PresentationAttributes, FilterPrimitiveAttributes,
   Maybe Text, Maybe Text, Maybe Text, Maybe Text, Maybe Text)
feTurbulenceAttrs (((CoreAttributes, PresentationAttributes,
   FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
   Maybe Text, Maybe Text)
  -> ConduitT Event o m (Tag b n))
 -> ConduitT Event o m (Maybe (Tag b n)))
-> ((CoreAttributes, PresentationAttributes,
     FilterPrimitiveAttributes, Maybe Text, Maybe Text, Maybe Text,
     Maybe Text, Maybe Text)
    -> ConduitT Event o m (Tag b n))
-> ConduitT Event o m (Maybe (Tag b n))
forall a b. (a -> b) -> a -> b
$
   \(CoreAttributes
ca,PresentationAttributes
pa,FilterPrimitiveAttributes
fpa,Maybe Text
class_,Maybe Text
style,Maybe Text
in1,Maybe Text
in2,Maybe Text
mode) -> Tag b n -> ConduitT Event o m (Tag b n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag b n -> ConduitT Event o m (Tag b n))
-> Tag b n -> ConduitT Event o m (Tag b n)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf (CoreAttributes -> Maybe Text
id1 CoreAttributes
ca) ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty

------------------------------------------------------------------------------------

animationElements :: [a]
animationElements = []