{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, TypeFamilies, FlexibleContexts #-}
module Diagrams.SVG.Attributes
(
initialStyles
, CoreAttributes(..)
, ConditionalProcessingAttributes(..)
, DocumentEventAttributes(..)
, GraphicalEventAttributes(..)
, XlinkAttributes(..)
, FilterPrimitiveAttributes(..)
, NameSpaces(..)
, separatedBy
, parseOne
, parseOne'
, compose
, parseDouble
, parseToDouble
, parsePoints
, parseTempl
, parseIRI
, applyTr
, parseTr
, applyStyleSVG
, parseStyles
, parseLengths
, parseViewBox
, parsePA
, cssStylesFromMap
, fragment
, p
, parseSpread
, parsePreserveAR
, PreserveAR(..)
, AlignSVG(..)
, Place(..)
, MeetOrSlice(..)
, SVGStyle(..)
, PresentationAttributes(..)
)
where
import Data.Attoparsec.Combinator
import Data.Attoparsec.Text
import qualified Data.Attoparsec.Text as AT
import Data.Char (isAlpha, isHexDigit, digitToInt)
import Data.Colour
import Data.Colour.Names (readColourName)
import Data.Colour.SRGB
import Data.Colour.RGBSpace.HSL (hsl)
import qualified Data.HashMap.Strict as H
import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, maybeToList, catMaybes)
import qualified Data.Text as T
import Data.Text(Text(..), pack, unpack, empty, cons, snoc, append)
import Data.Typeable
import Data.Word (Word8)
import Diagrams.Prelude hiding (fillOpacity, strokeOpacity)
import Diagrams.SVG.Path
import Diagrams.SVG.Tree
import Text.CSS.Parse
import Diagrams.Core.Transform
import Data.Digits
data CoreAttributes =
CA { CoreAttributes -> Maybe Text
id1 :: Maybe Text
, CoreAttributes -> Maybe Text
xmlbase :: Maybe Text
, CoreAttributes -> Maybe Text
xmllang :: Maybe Text
, CoreAttributes -> Maybe Text
xmlspace :: Maybe Text
}
data ConditionalProcessingAttributes =
CPA { ConditionalProcessingAttributes -> Maybe Text
requiredFeatures :: Maybe Text
, ConditionalProcessingAttributes -> Maybe Text
requiredExtensions :: Maybe Text
, ConditionalProcessingAttributes -> Maybe Text
systemLanguage :: Maybe Text
}
data DocumentEventAttributes =
DEA { DocumentEventAttributes -> Maybe Text
onunload :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onabort :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onerror :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onresize :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onscroll :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onzoom :: Maybe Text
}
data GraphicalEventAttributes =
GEA { GraphicalEventAttributes -> Maybe Text
onfocusin :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onfocusout :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onactivate :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onclick :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmousedown :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmouseup :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmouseover :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmousemove :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmouseout :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onload :: Maybe Text
}
data XlinkAttributes =
XLA { XlinkAttributes -> Maybe Text
xlinkHref :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkShow :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkActuate :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkType :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkRole :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkArcrole :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkTitle :: Maybe Text
}
data FilterPrimitiveAttributes =
FPA { FilterPrimitiveAttributes -> Maybe Text
x :: Maybe Text
, FilterPrimitiveAttributes -> Maybe Text
y :: Maybe Text
, FilterPrimitiveAttributes -> Maybe Text
width :: Maybe Text
, FilterPrimitiveAttributes -> Maybe Text
height :: Maybe Text
, FilterPrimitiveAttributes -> Maybe Text
result :: Maybe Text
}
data NameSpaces =
NSP { NameSpaces -> Maybe Text
xlink :: Maybe Text
, NameSpaces -> Maybe Text
dc :: Maybe Text
, NameSpaces -> Maybe Text
cc :: Maybe Text
, NameSpaces -> Maybe Text
rdf :: Maybe Text
, NameSpaces -> Maybe Text
svg :: Maybe Text
, NameSpaces -> Maybe Text
sodipodi :: Maybe Text
, NameSpaces -> Maybe Text
inkscape :: Maybe Text
} deriving Int -> NameSpaces -> ShowS
[NameSpaces] -> ShowS
NameSpaces -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameSpaces] -> ShowS
$cshowList :: [NameSpaces] -> ShowS
show :: NameSpaces -> String
$cshow :: NameSpaces -> String
showsPrec :: Int -> NameSpaces -> ShowS
$cshowsPrec :: Int -> NameSpaces -> ShowS
Show
separatedBy :: Parser Text a -> Text -> Parser Text [a]
separatedBy Parser Text a
parse Text
sep = do [a]
ls <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [forall {b}. Parser Text b -> Text -> Parser Text b
parseOne Parser Text a
parse Text
sep, forall {b}. Parser Text b -> Parser Text b
parseOne' Parser Text a
parse])
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
ls
parseOne :: Parser Text b -> Text -> Parser Text b
parseOne Parser Text b
parse Text
sep = do Parser ()
AT.skipSpace
b
s <- Parser Text b
parse
Text -> Parser Text
AT.string Text
sep
forall (m :: * -> *) a. Monad m => a -> m a
return b
s
parseOne' :: Parser Text b -> Parser Text b
parseOne' Parser Text b
parse = do Parser ()
AT.skipSpace
b
s <- Parser Text b
parse
forall (m :: * -> *) a. Monad m => a -> m a
return b
s
compose :: [a -> a] -> a -> a
compose :: forall a. [a -> a] -> a -> a
compose [a -> a]
fs a
v = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) forall a. a -> a
id [a -> a]
fs forall a b. (a -> b) -> a -> b
$ a
v
parseDouble :: RealFloat n => Text -> n
parseDouble :: forall n. RealFloat n => Text -> n
parseDouble Text
l = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const n
0) (forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) (forall a. Parser a -> Text -> Either String a
AT.parseOnly Parser Text Double
myDouble Text
l)
parseToDouble :: RealFloat n => Maybe Text -> Maybe n
parseToDouble :: forall n. RealFloat n => Maybe Text -> Maybe n
parseToDouble Maybe Text
l | forall a. Maybe a -> Bool
isJust Maybe Text
l = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) (forall a. Parser a -> Text -> Either String a
AT.parseOnly Parser Text Double
myDouble (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
l))
| Bool
otherwise = forall a. Maybe a
Nothing
pp :: String -> c
pp = forall n. RealFloat n => Text -> n
parseDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
myDouble :: Parser Text Double
myDouble = forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {b}. Fractional b => Parser Text b
dotDouble, Parser Text Double
double]
dotDouble :: Parser Text b
dotDouble =
do Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'.'
Integer
frac <- forall a. Integral a => Parser a
AT.decimal
let denominator :: b
denominator = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^(forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall n. Integral n => n -> n -> [n]
digits Integer
10 Integer
frac))
forall (m :: * -> *) a. Monad m => a -> m a
return ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frac) forall a. Fractional a => a -> a -> a
/ b
denominator)
parsePoints :: RealFloat n => Text -> [(n, n)]
parsePoints :: forall n. RealFloat n => Text -> [(n, n)]
parsePoints Text
t = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) forall a. a -> a
id (forall a. Parser a -> Text -> Either String a
AT.parseOnly (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall n. RealFloat n => Parser (n, n)
parsePoint) Text
t)
parsePoint :: RealFloat n => Parser (n, n)
parsePoint :: forall n. RealFloat n => Parser (n, n)
parsePoint =
do Parser ()
AT.skipSpace
Double
a <- Parser Text Double
double
Char -> Parser Char
AT.char Char
','
Double
b <- Parser Text Double
double
forall (m :: * -> *) a. Monad m => a -> m a
return ( (forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) Double
a, (forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) Double
b)
parseUntil :: Char -> Parser Text String
parseUntil Char
c = forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
AT.manyTill Parser Char
AT.anyChar (Char -> Parser Char
AT.char Char
c)
data Tup n = TS1 Text | TS2 Text Text | TS3 Text Text Text
| T1 n | T2 n n | T3 n n n
deriving Int -> Tup n -> ShowS
forall n. Show n => Int -> Tup n -> ShowS
forall n. Show n => [Tup n] -> ShowS
forall n. Show n => Tup n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tup n] -> ShowS
$cshowList :: forall n. Show n => [Tup n] -> ShowS
show :: Tup n -> String
$cshow :: forall n. Show n => Tup n -> String
showsPrec :: Int -> Tup n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Tup n -> ShowS
Show
parse1 :: Parser Text (Tup n)
parse1 =
do Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'('
Text
a <- (Char -> Bool) -> Parser Text
AT.takeTill (forall a. Eq a => a -> a -> Bool
== Char
')')
Char -> Parser Char
AT.char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Text -> Tup n
TS1 Text
a)
parse2 :: Parser Text (Tup n)
parse2 =
do Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'('
Text
a <- (Char -> Bool) -> Parser Text
AT.takeTill (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' ')
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Char -> Parser Char
AT.char Char
',', Char -> Parser Char
AT.char Char
' ']
Parser ()
AT.skipSpace
Text
b <- (Char -> Bool) -> Parser Text
AT.takeTill (forall a. Eq a => a -> a -> Bool
== Char
')')
Char -> Parser Char
AT.char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Text -> Text -> Tup n
TS2 Text
a Text
b)
parse3 :: Parser Text (Tup n)
parse3 =
do Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'('
Text
a <- (Char -> Bool) -> Parser Text
AT.takeTill (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' ')
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Char -> Parser Char
AT.char Char
',', Char -> Parser Char
AT.char Char
' ']
Text
b <- (Char -> Bool) -> Parser Text
AT.takeTill (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' ')
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Char -> Parser Char
AT.char Char
',', Char -> Parser Char
AT.char Char
' ']
Text
c <- (Char -> Bool) -> Parser Text
AT.takeTill (forall a. Eq a => a -> a -> Bool
== Char
')')
Char -> Parser Char
AT.char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. Text -> Text -> Text -> Tup n
TS3 Text
a Text
b Text
c)
data Transform n = Tr (Tup n)
| Matrix n n n n n n
| Rotate (Tup n)
| Scale (Tup n)
| SkewX (Tup n)
| SkewY (Tup n) deriving Int -> Transform n -> ShowS
forall n. Show n => Int -> Transform n -> ShowS
forall n. Show n => [Transform n] -> ShowS
forall n. Show n => Transform n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transform n] -> ShowS
$cshowList :: forall n. Show n => [Transform n] -> ShowS
show :: Transform n -> String
$cshow :: forall n. Show n => Transform n -> String
showsPrec :: Int -> Transform n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Transform n -> ShowS
Show
parseTr :: RealFloat n => Maybe Text -> [Transform n]
parseTr :: forall n. RealFloat n => Maybe Text -> [Transform n]
parseTr = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
( forall a. Parser a -> Text -> Either String a
AT.parseOnly (forall (f :: * -> *) a. Alternative f => f a -> f [a]
AT.many1 forall {n}. RealFloat n => Parser Text (Maybe (Transform n))
parseTransform)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a. a -> Maybe a -> a
fromMaybe Text
empty)
parseTransform :: Parser Text (Maybe (Transform n))
parseTransform = forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {n}. RealFloat n => Parser Text (Maybe (Transform n))
matr, forall {n}. RealFloat n => Parser Text (Maybe (Transform n))
trans, forall {n}. RealFloat n => Parser Text (Maybe (Transform n))
scle, forall {n}. RealFloat n => Parser Text (Maybe (Transform n))
rot, forall {n}. RealFloat n => Parser Text (Maybe (Transform n))
skewX, forall {n}. RealFloat n => Parser Text (Maybe (Transform n))
skewY]
applyTr :: [Transform (N a)] -> a -> a
applyTr [Transform (N a)]
trs = forall a. [a -> a] -> a -> a
compose (forall a b. (a -> b) -> [a] -> [b]
map forall {t}.
(V t ~ V2, Transformable t, RealFloat (N t), Additive (V t),
R2 (V t)) =>
Transform (N t) -> t -> t
getTransformations [Transform (N a)]
trs)
getTransformations :: Transform (N t) -> t -> t
getTransformations (Tr (T1 N t
x)) = forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX N t
x
getTransformations (Tr (T2 N t
x N t
y)) = (forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX N t
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY N t
y)
getTransformations (Matrix N t
a N t
b N t
c N t
d N t
e N t
f)
= (forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX N t
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY N t
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy N t
angle) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX N t
scX) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY N t
scY)
where (N t
angle, N t
scX, N t
scY, N t
x, N t
y) = forall {e}. RealFloat e => Transform e -> (e, e, e, e, e)
matrixDecompose (forall n. n -> n -> n -> n -> n -> n -> Transform n
Matrix N t
a N t
b N t
c N t
d N t
e N t
f)
getTransformations (Rotate (T1 N t
angle)) = forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy N t
angle
getTransformations (Rotate (T3 N t
angle N t
x N t
y)) = forall a. a -> a
id
getTransformations (Scale (T1 N t
x)) = forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX N t
x
getTransformations (Scale (T2 N t
x N t
y)) = (forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX N t
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY N t
y)
getTransformations (SkewX (T1 N t
x)) = forall a. a -> a
id
getTransformations (SkewY (T1 N t
y)) = forall a. a -> a
id
matrixDecompose :: Transform e -> (e, e, e, e, e)
matrixDecompose (Matrix e
m11 e
m12 e
m21 e
m22 e
m31 e
m32) = (e
rotation, e
scX, e
scY, e
transX, e
transY)
where
rotation :: e
rotation = (forall a. RealFloat a => a -> a -> a
atan2 e
m12 e
m22) forall a. Fractional a => a -> a -> a
/ (e
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)
scX :: e
scX | e
m11 forall a. Ord a => a -> a -> Bool
>= e
0 = forall a. Floating a => a -> a
sqrt (e
m11forall a. Num a => a -> a -> a
*e
m11 forall a. Num a => a -> a -> a
+ e
m21forall a. Num a => a -> a -> a
*e
m21)
| Bool
otherwise = - forall a. Floating a => a -> a
sqrt (e
m11forall a. Num a => a -> a -> a
*e
m11 forall a. Num a => a -> a -> a
+ e
m21forall a. Num a => a -> a -> a
*e
m21)
scY :: e
scY | e
m22 forall a. Ord a => a -> a -> Bool
>= e
0 = forall a. Floating a => a -> a
sqrt (e
m12forall a. Num a => a -> a -> a
*e
m12 forall a. Num a => a -> a -> a
+ e
m22forall a. Num a => a -> a -> a
*e
m22)
| Bool
otherwise = - forall a. Floating a => a -> a
sqrt (e
m12forall a. Num a => a -> a -> a
*e
m12 forall a. Num a => a -> a -> a
+ e
m22forall a. Num a => a -> a -> a
*e
m22)
(e
transX, e
transY) = (e
m31, e
m32)
matr :: Parser Text (Maybe (Transform n))
matr =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"matrix"
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'('
String
a <- Char -> Parser Text String
parseUntil Char
','
String
b <- Char -> Parser Text String
parseUntil Char
','
String
c <- Char -> Parser Text String
parseUntil Char
','
String
d <- Char -> Parser Text String
parseUntil Char
','
String
e <- Char -> Parser Text String
parseUntil Char
','
String
f <- Char -> Parser Text String
parseUntil Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. n -> n -> n -> n -> n -> n -> Transform n
Matrix (forall {c}. RealFloat c => String -> c
pp String
a) (forall {c}. RealFloat c => String -> c
pp String
b) (forall {c}. RealFloat c => String -> c
pp String
c) (forall {c}. RealFloat c => String -> c
pp String
d) (forall {c}. RealFloat c => String -> c
pp String
e) (forall {c}. RealFloat c => String -> c
pp String
f) )
evalTup :: Tup n -> Tup n
evalTup (TS1 Text
x) = forall n. n -> Tup n
T1 (forall n. RealFloat n => Text -> n
parseDouble Text
x)
evalTup (TS2 Text
x Text
y) = forall n. n -> n -> Tup n
T2 (forall n. RealFloat n => Text -> n
parseDouble Text
x) (forall n. RealFloat n => Text -> n
parseDouble Text
y)
evalTup (TS3 Text
x Text
y Text
z) = forall n. n -> n -> n -> Tup n
T3 (forall n. RealFloat n => Text -> n
parseDouble Text
x) (forall n. RealFloat n => Text -> n
parseDouble Text
y) (forall n. RealFloat n => Text -> n
parseDouble Text
z)
trans :: Parser Text (Maybe (Transform n))
trans =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"translate"
Tup Any
tup <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {n}. Parser Text (Tup n)
parse2, forall {n}. Parser Text (Tup n)
parse1]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Tup n -> Transform n
Tr (forall {n} {n}. RealFloat n => Tup n -> Tup n
evalTup Tup Any
tup))
scle :: Parser Text (Maybe (Transform n))
scle =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"scale"
Tup Any
tup <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {n}. Parser Text (Tup n)
parse2, forall {n}. Parser Text (Tup n)
parse1]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Tup n -> Transform n
Scale (forall {n} {n}. RealFloat n => Tup n -> Tup n
evalTup Tup Any
tup))
rot :: Parser Text (Maybe (Transform n))
rot =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"rotate"
Tup Any
tup <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {n}. Parser Text (Tup n)
parse1, forall {n}. Parser Text (Tup n)
parse3]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Tup n -> Transform n
Rotate (forall {n} {n}. RealFloat n => Tup n -> Tup n
evalTup Tup Any
tup))
skewX :: Parser Text (Maybe (Transform n))
skewX =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"skewX"
Tup Any
angle <- forall {n}. Parser Text (Tup n)
parse1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Tup n -> Transform n
SkewX (forall {n} {n}. RealFloat n => Tup n -> Tup n
evalTup Tup Any
angle))
skewY :: Parser Text (Maybe (Transform n))
skewY =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"skewY"
Tup Any
angle <- forall {n}. Parser Text (Tup n)
parse1
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Tup n -> Transform n
SkewY (forall {n} {n}. RealFloat n => Tup n -> Tup n
evalTup Tup Any
angle))
parsePA :: (RealFloat n, RealFloat a, Read a) => PresentationAttributes -> HashMaps b n -> [(SVGStyle n a)]
parsePA :: forall n a b.
(RealFloat n, RealFloat a, Read a) =>
PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA PresentationAttributes
pa (NodesMap b n
nodes,CSSMap
css,GradientsMap n
grad) = [SVGStyle n a]
l
where l :: [SVGStyle n a]
l = forall a. [Maybe a] -> [a]
catMaybes
[(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl (forall {a} {n}.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillVal CSSMap
css GradientsMap n
grad)) (PresentationAttributes -> Maybe Text
fill PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Parser Text (SVGStyle n a)
styleFillRuleVal) (PresentationAttributes -> Maybe Text
fillRuleSVG PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Parser Text (SVGStyle n a)
styleFillOpacityVal) (PresentationAttributes -> Maybe Text
fillOpacity PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Parser Text (SVGStyle n a)
styleOpacityVal) (PresentationAttributes -> Maybe Text
Diagrams.SVG.Tree.opacity PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Parser Text (SVGStyle n a)
styleStrokeOpacityVal) (PresentationAttributes -> Maybe Text
strokeOpacity PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl (forall {a} {n}.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeVal CSSMap
css GradientsMap n
grad)) (PresentationAttributes -> Maybe Text
strokeSVG PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleStrokeWidthVal) (PresentationAttributes -> Maybe Text
strokeWidth PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Parser Text (SVGStyle n a)
styleStrokeLineCapVal) (PresentationAttributes -> Maybe Text
strokeLinecap PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Parser Text (SVGStyle n a)
styleStrokeLineJoinVal) (PresentationAttributes -> Maybe Text
strokeLinejoin PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleStrokeMiterLimitVal) (PresentationAttributes -> Maybe Text
strokeMiterlimit PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Parser Text (SVGStyle n a)
styleFontFamily) (PresentationAttributes -> Maybe Text
fontFamily PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleFontSize) (PresentationAttributes -> Maybe Text
fntSize PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl (forall {n} {b} {a}.
RealFloat n =>
HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPathVal NodesMap b n
nodes)) (PresentationAttributes -> Maybe Text
clipPath PresentationAttributes
pa),
(forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleStrokeDashArrayVal) (PresentationAttributes -> Maybe Text
strokeDasharray PresentationAttributes
pa) ]
data SVGStyle n a = Fill (AlphaColour a) | FillTex (Texture n) | FillOpacity Double | FillRule FR | Opacity Double
| Stroke (AlphaColour a) | StrokeTex (Texture n) | StrokeWidth (LenPercent n) | StrokeLineCap LineCap
| StrokeLineJoin LineJoin | StrokeMiterLimit n | StrokeDasharray [LenPercent n] | StrokeOpacity Double
| FontFamily String | FontStyle FStyle | FontVariant FVariant | FontWeight FWeight | FontStretch FStretch
| FontSize (LenPercent n)
| ClipPath (Path V2 n)
| EmptyStyle
data Unit = EM | EX | PX | IN | CM | MM | PT | PC deriving Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show
data FR = Even_Odd | Nonzero | Inherit deriving Int -> FR -> ShowS
[FR] -> ShowS
FR -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FR] -> ShowS
$cshowList :: [FR] -> ShowS
show :: FR -> String
$cshow :: FR -> String
showsPrec :: Int -> FR -> ShowS
$cshowsPrec :: Int -> FR -> ShowS
Show
data LenPercent n = Len n | Percent n
instance Show (SVGStyle n a) where
show :: SVGStyle n a -> String
show (Fill AlphaColour a
c) = String
"Fill"
show (FillTex Texture n
t) = String
"Filltex"
show (FillRule FR
r) = String
"FillRule"
show (FillOpacity Double
d) = String
"FillOpacity"
show (FontFamily String
f) = String
"FontFamily"
show (FontStyle FStyle
f) = String
"FontStyle"
show (FontVariant FVariant
f) = String
"FontVariant"
show (FontWeight FWeight
f) = String
"FontWeight"
show (FontStretch FStretch
f) = String
"FontStretch"
show (FontSize LenPercent n
f) = String
"FontSize"
show (Diagrams.SVG.Attributes.Opacity Double
d) = String
"Opacity"
show (StrokeOpacity Double
o) = String
"StrokeOpacity"
show (Stroke AlphaColour a
s) = String
"Stroke"
show (StrokeTex Texture n
s) = String
"StrokeTex"
show (StrokeWidth LenPercent n
w) = String
"StrokeWidth"
show (StrokeLineCap LineCap
l) = String
"StrokeLineCap"
show (StrokeLineJoin LineJoin
l) = String
"StrokeLineJoin"
show (StrokeMiterLimit n
l) = String
"StrokeMiterLimit"
show (StrokeDasharray [LenPercent n]
l) = String
"StrokeDasharray"
show (ClipPath Path V2 n
path) = String
"ClipPath"
show (SVGStyle n a
EmptyStyle) = String
""
instance Show (LenPercent n) where
show :: LenPercent n -> String
show (Len n
x) = String
""
show (Percent n
x) = String
""
parseStyles :: Maybe Text
-> (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
text (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
hmaps = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$
forall a. Parser a -> Text -> Either String a
AT.parseOnly (forall {a}. Parser Text a -> Text -> Parser Text [a]
separatedBy (forall {n} {a} {b}.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> Parser Text (SVGStyle n a)
parseStyleAttr (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
hmaps) Text
";") (forall a. a -> Maybe a -> a
fromMaybe Text
empty Maybe Text
text)
parseStyleAttr :: (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> Parser Text (SVGStyle n a)
parseStyleAttr (HashMap Text (Tag b n)
ns,CSSMap
css,HashMap Text (Gr n)
grad) =
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {n} {a}. Parser Text (SVGStyle n a)
styleFillRule, forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleStrokeWidth, forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleStrokeDashArray, forall {a} {n}.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFill CSSMap
css HashMap Text (Gr n)
grad, forall {a} {n}.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStroke CSSMap
css HashMap Text (Gr n)
grad, forall {a} {n}.
(Floating a, RealFrac a) =>
Parser Text (SVGStyle n a)
styleStopColor,
forall {n} {a}. Parser Text (SVGStyle n a)
styleStopOpacity, forall {n} {a}. Parser Text (SVGStyle n a)
styleFillOpacity, forall {n} {a}. Parser Text (SVGStyle n a)
styleStrokeOpacity, forall {n} {a}. Parser Text (SVGStyle n a)
styleOpacity,
forall {n} {a}. Parser Text (SVGStyle n a)
styleFontFamily, forall {n} {a}. Parser Text (SVGStyle n a)
styleFontStyle, forall {n} {a}. Parser Text (SVGStyle n a)
styleFontVariant, forall {n} {a}. Parser Text (SVGStyle n a)
styleFontWeight, forall {n} {a}. Parser Text (SVGStyle n a)
styleFontStretch, forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleFontSize,
forall {n} {a}. Parser Text (SVGStyle n a)
styleStrokeLineCap, forall {n} {a}. Parser Text (SVGStyle n a)
styleStrokeLineJoin, forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleStrokeMiterLimit, forall {n} {b} {a}.
RealFloat n =>
HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPath HashMap Text (Tag b n)
ns, forall {n} {a}. Parser Text (SVGStyle n a)
skipOne]
skipOne :: Parser Text (SVGStyle n a)
skipOne = do String
str <- forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
AT.manyTill Parser Char
AT.anyChar (Char -> Parser Char
AT.char Char
';')
forall (m :: * -> *) a. Monad m => a -> m a
return forall n a. SVGStyle n a
EmptyStyle
cssStylesFromMap :: (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n)
ns,CSSMap
css,HashMap Text (Gr n)
grad) Text
tagName Maybe Text
id_ Maybe Text
class_ = forall {n} {a} {b}.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles ( forall a. a -> Maybe a
Just ( [Text] -> Text
T.concat ( forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
f [(Text, Text)]
attributes ) ) ) (HashMap Text (Tag b n)
ns,CSSMap
css,HashMap Text (Gr n)
grad)
where f :: (Text, Text) -> Text
f (Text
attr, Text
val) = (Text
attr Text -> Char -> Text
`Data.Text.snoc` Char
':') Text -> Text -> Text
`append` (Text
val Text -> Char -> Text
`Data.Text.snoc` Char
';')
styleFromClass :: Text -> [Maybe [(Text, Text)]]
styleFromClass Text
cl = [forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (Char
'.' Char -> Text -> Text
`Data.Text.cons` Text
cl) CSSMap
css] forall a. [a] -> [a] -> [a]
++ [forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (Text
tagName Text -> Text -> Text
`append` (Char
'.' Char -> Text -> Text
`Data.Text.cons` Text
cl)) CSSMap
css]
attributes :: [(Text, Text)]
attributes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
( [forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"*" CSSMap
css] forall a. [a] -> [a] -> [a]
++
(if forall a. Maybe a -> Bool
isJust Maybe Text
id_ then [forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (Char
'#' Char -> Text -> Text
`Data.Text.cons` (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
id_)) CSSMap
css] else []) forall a. [a] -> [a] -> [a]
++
(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map Text -> [Maybe [(Text, Text)]]
styleFromClass (if forall a. Maybe a -> Bool
isJust Maybe Text
class_ then Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
class_ else [])))
)
parseTempl :: Parser a -> Maybe Text -> Maybe a
parseTempl :: forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser a
p = (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a. Parser a -> Text -> Either String a
AT.parseOnly Parser a
p)forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a. a -> Maybe a -> a
fromMaybe Text
empty)
p :: RealFloat n => (n,n) -> n -> Maybe Text -> n
p :: forall n. RealFloat n => (n, n) -> n -> Maybe Text -> n
p (n
minx,n
maxx) n
def Maybe Text
x = LenPercent n -> n
unL forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall n. n -> LenPercent n
Len n
def) forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {n}. Fractional n => Parser Text (LenPercent n)
styleLength Maybe Text
x
where unL :: LenPercent n -> n
unL (Len n
x) = n
x
unL (Percent n
x) = n
xforall a. Fractional a => a -> a -> a
/n
100 forall a. Num a => a -> a -> a
* (n
maxxforall a. Num a => a -> a -> a
-n
minx)
parseIRI :: Parser Text (Text, Text)
parseIRI = do forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ Parser Text (Text, Text)
funcIRI, Parser Text (Text, Text)
absoluteOrRelativeIRI ]
funcIRI :: Parser Text (Text, Text)
funcIRI =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"url("
String
absrel <- Char -> Parser Text String
parseUntil Char
'#'
String
frag <- Char -> Parser Text String
parseUntil Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
absrel, String -> Text
T.pack String
frag)
absoluteOrRelativeIRI :: Parser Text (Text, Text)
absoluteOrRelativeIRI =
do Parser ()
AT.skipSpace
String
absrel <- Char -> Parser Text String
parseUntil Char
'#'
Text
frag <- Parser Text
takeText
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
absrel, Text
frag)
fragment :: Maybe Text -> Maybe Text
fragment Maybe Text
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser Text (Text, Text)
parseIRI Maybe Text
x)
initialStyles :: c -> c
initialStyles = forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwL N c
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc forall a. Num a => Colour a
black forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyle a => LineCap -> a -> a
lineCap LineCap
LineCapButt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyle a => LineJoin -> a -> a
lineJoin LineJoin
LineJoinMiter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyle a => Double -> a -> a
lineMiterLimit Double
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
AlphaColour Double -> a -> a
lcA forall a. Num a => AlphaColour a
transparent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize forall n. OrderedField n => Measure n
medium
applyStyleSVG :: (t -> [SVGStyle (N a) Double]) -> t -> a -> a
applyStyleSVG t -> [SVGStyle (N a) Double]
stylesFromMap t
hmap = forall a. [a -> a] -> a -> a
compose (forall a b. (a -> b) -> [a] -> [b]
map forall {a}.
(V a ~ V2, HasStyle a, Typeable (N a), RealFloat (N a)) =>
SVGStyle (N a) Double -> a -> a
getStyles (t -> [SVGStyle (N a) Double]
stylesFromMap t
hmap))
getStyles :: SVGStyle (N a) Double -> a -> a
getStyles (Fill AlphaColour Double
c) = forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
AlphaColour Double -> a -> a
fcA AlphaColour Double
c
getStyles (FillTex Texture (N a)
x) = forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
fillTexture Texture (N a)
x
getStyles (FillRule FR
Even_Odd) = forall a. HasStyle a => FillRule -> a -> a
fillRule FillRule
EvenOdd
getStyles (FillRule FR
Nonzero) = forall a. a -> a
id
getStyles (FillRule FR
Inherit) = forall a. a -> a
id
getStyles (FillOpacity Double
x) = forall a. HasStyle a => Double -> a -> a
Diagrams.Prelude.opacity Double
x
getStyles (FontFamily String
str) = forall a. HasStyle a => String -> a -> a
font String
str
getStyles (FontStyle FStyle
s) = forall a. a -> a
id
getStyles (FontVariant FVariant
s) = forall a. a -> a
id
getStyles (FontWeight FWeight
s) = forall a. a -> a
id
getStyles (FontStretch FStretch
s) = forall a. a -> a
id
getStyles (FontSize (Len N a
len)) = forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize (forall n. Num n => n -> Measure n
local N a
len)
getStyles (Diagrams.SVG.Attributes.Opacity Double
x) = forall a. HasStyle a => Double -> a -> a
Diagrams.Prelude.opacity Double
x
getStyles (StrokeOpacity Double
x) | Double
x forall a. Eq a => a -> a -> Bool
== Double
0 = forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwL N a
0
| Bool
otherwise = forall a. HasStyle a => Double -> a -> a
Diagrams.Prelude.opacity Double
x
getStyles (Stroke AlphaColour Double
x) = forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
AlphaColour Double -> a -> a
lcA AlphaColour Double
x
getStyles (StrokeTex Texture (N a)
x) = forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
lineTexture Texture (N a)
x
getStyles (StrokeWidth (Len N a
x)) = forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwL forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational N a
x
getStyles (StrokeWidth (Percent N a
x)) = forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwG N a
x
getStyles (StrokeLineCap LineCap
x) = forall a. HasStyle a => LineCap -> a -> a
lineCap LineCap
x
getStyles (StrokeLineJoin LineJoin
x) = forall a. HasStyle a => LineJoin -> a -> a
lineJoin LineJoin
x
getStyles (StrokeMiterLimit N a
x) = forall a. a -> a
id
getStyles (StrokeDasharray [LenPercent (N a)]
array) = forall a n.
(N a ~ n, HasStyle a, Typeable n, Num n) =>
[n] -> n -> a -> a
dashingL (forall a b. (a -> b) -> [a] -> [b]
map forall {n}. LenPercent n -> n
dash [LenPercent (N a)]
array) N a
0
where dash :: LenPercent n -> n
dash (Len n
x) = n
x
dash (Percent n
x) = n
x
getStyles (ClipPath Path V2 (N a)
path) = forall a n.
(HasStyle a, V a ~ V2, N a ~ n, TypeableFloat n) =>
Path V2 n -> a -> a
clipBy Path V2 (N a)
path
getStyles SVGStyle (N a) Double
_ = forall a. a -> a
id
styleFill :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFill CSSMap
css HashMap Text (Gr n)
hmap =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"fill:"
Parser ()
AT.skipSpace
forall {a} {n}.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillVal CSSMap
css HashMap Text (Gr n)
hmap
styleFillVal :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillVal CSSMap
css HashMap Text (Gr n)
gradients = forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ forall {a} {n}.
(Floating a, RealFrac a) =>
Parser Text (SVGStyle n a)
styleFillColourVal, forall {n} {a}.
Num n =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillTexURL CSSMap
css HashMap Text (Gr n)
gradients ]
styleFillColourVal :: Parser Text (SVGStyle n a)
styleFillColourVal =
do AlphaColour a
c <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {a}. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorRRGGBB, forall {a}. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorRGB, forall {a}. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorString, forall {a}. (Floating a, Ord a) => Parser Text (AlphaColour a)
colorRGBPercent, forall {a}. (RealFrac a, Floating a) => Parser Text (AlphaColour a)
colorHSLPercent, forall {a}. Num a => Parser Text (AlphaColour a)
colorNone, forall {a}. (Floating a, Ord a) => Parser Text (AlphaColour a)
colorRGBWord]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. AlphaColour a -> SVGStyle n a
Fill AlphaColour a
c)
styleFillTexURL :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillTexURL CSSMap
css HashMap Text (Gr n)
gradients =
do (Text
absrel,Text
frag) <- Parser Text (Text, Text)
parseIRI
let t :: Maybe (Gr n)
t = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
frag HashMap Text (Gr n)
gradients
if forall a. Maybe a -> Bool
isJust Maybe (Gr n)
t then forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. Texture n -> SVGStyle n a
FillTex (Gr n -> Texture n
getTexture (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
t)))
else forall (m :: * -> *) a. Monad m => a -> m a
return forall n a. SVGStyle n a
EmptyStyle
where getTexture :: Gr n -> Texture n
getTexture (Gr Maybe Text
refId GradientAttributes
ga Maybe (ViewBox n)
vb [CSSMap -> [GradientStop n]]
stops CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f) = CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f CSSMap
css GradientAttributes
ga (forall a. a -> Maybe a -> a
fromMaybe (n
0,n
0,n
0,n
0) Maybe (ViewBox n)
vb) [CSSMap -> [GradientStop n]]
stops
styleFillRule :: Parser Text (SVGStyle n a)
styleFillRule =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"fill-rule:"
Parser ()
AT.skipSpace
forall {n} {a}. Parser Text (SVGStyle n a)
styleFillRuleVal
styleFillRuleVal :: Parser Text (SVGStyle n a)
styleFillRuleVal =
do forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ (do{ Text -> Parser Text
AT.string Text
"evenodd"; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n a. FR -> SVGStyle n a
FillRule FR
Even_Odd }),
(do{ Text -> Parser Text
AT.string Text
"nonzero"; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n a. FR -> SVGStyle n a
FillRule FR
Nonzero }),
(do{ Text -> Parser Text
AT.string Text
"inherit"; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n a. FR -> SVGStyle n a
FillRule FR
Inherit })
]
styleFillOpacity :: Parser Text (SVGStyle n a)
styleFillOpacity =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"fill-opacity:"
Parser ()
AT.skipSpace
forall {n} {a}. Parser Text (SVGStyle n a)
styleFillOpacityVal
styleFillOpacityVal :: Parser Text (SVGStyle n a)
styleFillOpacityVal =
do Double
o <- Parser Text Double
myDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. Double -> SVGStyle n a
FillOpacity forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
o)
styleOpacity :: Parser Text (SVGStyle n a)
styleOpacity =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"opacity:"
Parser ()
AT.skipSpace
forall {n} {a}. Parser Text (SVGStyle n a)
styleOpacityVal
styleOpacityVal :: Parser Text (SVGStyle n a)
styleOpacityVal =
do Double
o <- Parser Text Double
myDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. Double -> SVGStyle n a
Diagrams.SVG.Attributes.Opacity forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
o)
styleStroke :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStroke CSSMap
css HashMap Text (Gr n)
hmap =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke:"
Parser ()
AT.skipSpace
forall {a} {n}.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeVal CSSMap
css HashMap Text (Gr n)
hmap
styleStrokeVal :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeVal CSSMap
css HashMap Text (Gr n)
gradients = forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ forall {a} {n}.
(Floating a, RealFrac a) =>
Parser Text (SVGStyle n a)
styleStrokeColourVal, forall {n} {a}.
Num n =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeTexURL CSSMap
css HashMap Text (Gr n)
gradients ]
styleStrokeColourVal :: Parser Text (SVGStyle n a)
styleStrokeColourVal =
do AlphaColour a
c <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {a}. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorRRGGBB, forall {a}. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorRGB, forall {a}. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorString, forall {a}. (Floating a, Ord a) => Parser Text (AlphaColour a)
colorRGBPercent, forall {a}. (RealFrac a, Floating a) => Parser Text (AlphaColour a)
colorHSLPercent, forall {a}. Num a => Parser Text (AlphaColour a)
colorNone, forall {a}. (Floating a, Ord a) => Parser Text (AlphaColour a)
colorRGBWord]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. AlphaColour a -> SVGStyle n a
Stroke AlphaColour a
c)
styleStrokeTexURL :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeTexURL CSSMap
css HashMap Text (Gr n)
gradients =
do (Text
absrel,Text
frag) <- Parser Text (Text, Text)
parseIRI
let t :: Maybe (Gr n)
t = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
frag HashMap Text (Gr n)
gradients
if forall a. Maybe a -> Bool
isJust Maybe (Gr n)
t then forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. Texture n -> SVGStyle n a
StrokeTex (Gr n -> Texture n
getTexture (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
t)))
else forall (m :: * -> *) a. Monad m => a -> m a
return forall n a. SVGStyle n a
EmptyStyle
where getTexture :: Gr n -> Texture n
getTexture (Gr Maybe Text
refId GradientAttributes
ga Maybe (ViewBox n)
vb [CSSMap -> [GradientStop n]]
stops CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f) = CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f CSSMap
css GradientAttributes
ga (forall a. a -> Maybe a -> a
fromMaybe (n
0,n
0,n
0,n
0) Maybe (ViewBox n)
vb) [CSSMap -> [GradientStop n]]
stops
styleStrokeWidth :: Parser Text (SVGStyle n a)
styleStrokeWidth =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-width:"
forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleStrokeWidthVal
styleStrokeWidthVal :: Parser Text (SVGStyle n a)
styleStrokeWidthVal =
do LenPercent n
len <- forall {n}. Fractional n => Parser Text (LenPercent n)
styleLength
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. LenPercent n -> SVGStyle n a
StrokeWidth LenPercent n
len)
styleFontFamily :: Parser Text (SVGStyle n a)
styleFontFamily =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-family:"
String
str <- forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
AT.manyTill Parser Char
AT.anyChar Parser Char
theEnd
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. String -> SVGStyle n a
FontFamily String
str)
theEnd :: Parser Char
theEnd = do forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Char -> Parser Char
AT.char Char
';', do { forall t. Chunk t => Parser t ()
endOfInput; forall (m :: * -> *) a. Monad m => a -> m a
return Char
' '}]
data FStyle = NormalStyle | Italic | Oblique | FSInherit
styleFontStyle :: Parser Text (SVGStyle n a)
styleFontStyle =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-style:"
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Text -> Parser Text
string Text
"normal"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStyle -> SVGStyle n a
FontStyle FStyle
NormalStyle)}
, do { Text -> Parser Text
string Text
"italic"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStyle -> SVGStyle n a
FontStyle FStyle
Italic)}
, do { Text -> Parser Text
string Text
"oblique"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStyle -> SVGStyle n a
FontStyle FStyle
Oblique)}
, do { Text -> Parser Text
string Text
"inherit"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStyle -> SVGStyle n a
FontStyle FStyle
FSInherit)}
]
data FVariant = NormalVariant | SmallCaps | VInherit
styleFontVariant :: Parser Text (SVGStyle n a)
styleFontVariant =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-variant:"
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Text -> Parser Text
string Text
"normal"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FVariant -> SVGStyle n a
FontVariant FVariant
NormalVariant)}
, do { Text -> Parser Text
string Text
"small-caps"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FVariant -> SVGStyle n a
FontVariant FVariant
SmallCaps)}
, do { Text -> Parser Text
string Text
"inherit"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FVariant -> SVGStyle n a
FontVariant FVariant
VInherit)}
]
data FWeight = NormalWeight | Bold | Bolder | Lighter
| N100 | N200 | N300 | N400 | N500 | N600 | N700 | N800 | N900
| FWInherit
styleFontWeight :: Parser Text (SVGStyle n a)
styleFontWeight =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-weight:"
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Text -> Parser Text
string Text
"normal"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
NormalWeight)}
, do { Text -> Parser Text
string Text
"bold"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
Bold)}
, do { Text -> Parser Text
string Text
"bolder"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
Bolder)}
, do { Text -> Parser Text
string Text
"lighter"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
Lighter)}
, do { Text -> Parser Text
string Text
"100"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N100)}
, do { Text -> Parser Text
string Text
"200"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N200)}
, do { Text -> Parser Text
string Text
"300"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N300)}
, do { Text -> Parser Text
string Text
"400"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N400)}
, do { Text -> Parser Text
string Text
"500"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N500)}
, do { Text -> Parser Text
string Text
"600"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N600)}
, do { Text -> Parser Text
string Text
"700"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N700)}
, do { Text -> Parser Text
string Text
"800"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N800)}
, do { Text -> Parser Text
string Text
"900"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N900)}
, do { Text -> Parser Text
string Text
"inherit"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
FWInherit)}
]
data FStretch = NormalStretch | Wider | Narrower | UltraCondensed | | Condensed
| SemiCondensed | SemiExpanded | Expanded | ExtraExpanded | UltraExpanded | SInherit
styleFontStretch :: Parser Text (SVGStyle n a)
styleFontStretch =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-stretch:"
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Text -> Parser Text
string Text
"normal"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
NormalStretch)}
, do { Text -> Parser Text
string Text
"wider"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
Wider)}
, do { Text -> Parser Text
string Text
"narrower"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
Narrower)}
, do { Text -> Parser Text
string Text
"ultra-condensed"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
UltraCondensed)}
, do { Text -> Parser Text
string Text
"extra-condensed"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
ExtraCondensed)}
, do { Text -> Parser Text
string Text
"condensed"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
Condensed)}
, do { Text -> Parser Text
string Text
"semi-condensed"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
SemiCondensed)}
, do { Text -> Parser Text
string Text
"semi-expanded"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
SemiExpanded)}
, do { Text -> Parser Text
string Text
"expanded"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
Expanded)}
, do { Text -> Parser Text
string Text
"extra-expanded"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
ExtraExpanded)}
, do { Text -> Parser Text
string Text
"ultra-expanded"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
UltraExpanded)}
, do { Text -> Parser Text
string Text
"inherit"; forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
SInherit)}
]
styleFontSize :: Parser Text (SVGStyle n a)
styleFontSize =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-size:"
LenPercent n
len <- forall {n}. Fractional n => Parser Text (LenPercent n)
styleLength
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. LenPercent n -> SVGStyle n a
FontSize LenPercent n
len)
styleLength :: Parser Text (LenPercent n)
styleLength =
do Parser ()
AT.skipSpace
Double
d <- Parser Text Double
myDouble
Parser ()
AT.skipSpace
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ forall {n}. Fractional n => n -> Parser Text (LenPercent n)
styleLengthWithUnit (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
d),
forall {n}. n -> Parser Text (LenPercent n)
lengthPercent (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
d), forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. n -> LenPercent n
Len (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
d)) ]
styleLengthWithUnit :: n -> Parser Text (LenPercent n)
styleLengthWithUnit n
d =
do Unit
u <- Parser Text Unit
styleUnit
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. n -> LenPercent n
Len (n
d forall a. Num a => a -> a -> a
* (forall {a}. Fractional a => Unit -> a
unitFactor Unit
u)))
lengthPercent :: n -> Parser Text (LenPercent n)
lengthPercent n
d =
do Text -> Parser Text
AT.string Text
"%"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. n -> LenPercent n
Percent n
d)
styleUnit :: Parser Text Unit
styleUnit = do forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text Unit
styleEM,Parser Text Unit
styleEX,Parser Text Unit
stylePX,Parser Text Unit
styleIN,Parser Text Unit
styleCM,Parser Text Unit
styleMM,Parser Text Unit
stylePT,Parser Text Unit
stylePC]
styleEM :: Parser Text Unit
styleEM = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"em", Text -> Parser Text
AT.string Text
"EM"]; forall (m :: * -> *) a. Monad m => a -> m a
return Unit
EM }
styleEX :: Parser Text Unit
styleEX = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"ex", Text -> Parser Text
AT.string Text
"EX"]; forall (m :: * -> *) a. Monad m => a -> m a
return Unit
EX }
stylePX :: Parser Text Unit
stylePX = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"px", Text -> Parser Text
AT.string Text
"PX"]; forall (m :: * -> *) a. Monad m => a -> m a
return Unit
PX }
styleIN :: Parser Text Unit
styleIN = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"in", Text -> Parser Text
AT.string Text
"IN"]; forall (m :: * -> *) a. Monad m => a -> m a
return Unit
IN }
styleCM :: Parser Text Unit
styleCM = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"cm", Text -> Parser Text
AT.string Text
"CM"]; forall (m :: * -> *) a. Monad m => a -> m a
return Unit
CM }
styleMM :: Parser Text Unit
styleMM = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"mm", Text -> Parser Text
AT.string Text
"MM"]; forall (m :: * -> *) a. Monad m => a -> m a
return Unit
MM }
stylePT :: Parser Text Unit
stylePT = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"pt", Text -> Parser Text
AT.string Text
"PT"]; forall (m :: * -> *) a. Monad m => a -> m a
return Unit
PT }
stylePC :: Parser Text Unit
stylePC = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"pc", Text -> Parser Text
AT.string Text
"PC"]; forall (m :: * -> *) a. Monad m => a -> m a
return Unit
PC }
unitFactor :: Unit -> a
unitFactor Unit
EM = a
1
unitFactor Unit
EX = a
1
unitFactor Unit
PX = a
1
unitFactor Unit
IN = a
90
unitFactor Unit
CM = a
35.43307
unitFactor Unit
MM = a
3.543307
unitFactor Unit
PT = a
1.25
unitFactor Unit
PC = a
15
styleStrokeLineCap :: Parser Text (SVGStyle n a)
styleStrokeLineCap =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-linecap:"
Parser ()
AT.skipSpace
forall {n} {a}. Parser Text (SVGStyle n a)
styleStrokeLineCapVal
styleStrokeLineCapVal :: Parser Text (SVGStyle n a)
styleStrokeLineCapVal =
do LineCap
lc <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text LineCap
butt,Parser Text LineCap
round0,Parser Text LineCap
square0]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. LineCap -> SVGStyle n a
StrokeLineCap LineCap
lc)
butt :: Parser Text LineCap
butt = do { Text -> Parser Text
AT.string Text
"butt"; forall (m :: * -> *) a. Monad m => a -> m a
return LineCap
LineCapButt }
round0 :: Parser Text LineCap
round0 = do { Text -> Parser Text
AT.string Text
"round"; forall (m :: * -> *) a. Monad m => a -> m a
return LineCap
LineCapRound }
square0 :: Parser Text LineCap
square0 = do { Text -> Parser Text
AT.string Text
"square"; forall (m :: * -> *) a. Monad m => a -> m a
return LineCap
LineCapSquare }
styleStrokeLineJoin :: Parser Text (SVGStyle n a)
styleStrokeLineJoin =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-linejoin:"
Parser ()
AT.skipSpace
forall {n} {a}. Parser Text (SVGStyle n a)
styleStrokeLineJoinVal
styleStrokeLineJoinVal :: Parser Text (SVGStyle n a)
styleStrokeLineJoinVal =
do LineJoin
lj <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text LineJoin
miter,Parser Text LineJoin
round1,Parser Text LineJoin
bevel]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. LineJoin -> SVGStyle n a
StrokeLineJoin LineJoin
lj)
miter :: Parser Text LineJoin
miter = do { Text -> Parser Text
AT.string Text
"miter"; forall (m :: * -> *) a. Monad m => a -> m a
return LineJoin
LineJoinMiter }
round1 :: Parser Text LineJoin
round1 = do { Text -> Parser Text
AT.string Text
"round"; forall (m :: * -> *) a. Monad m => a -> m a
return LineJoin
LineJoinRound }
bevel :: Parser Text LineJoin
bevel = do { Text -> Parser Text
AT.string Text
"bevel"; forall (m :: * -> *) a. Monad m => a -> m a
return LineJoin
LineJoinBevel }
styleClipPath :: HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPath HashMap Text (Tag b n)
hmap =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"clip-path:"
Parser ()
AT.skipSpace
forall {n} {b} {a}.
RealFloat n =>
HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPathVal HashMap Text (Tag b n)
hmap
styleClipPathVal :: HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPathVal HashMap Text (Tag b n)
hmap =
do (Text
absrel,Text
frag) <- Parser Text (Text, Text)
parseIRI
let t :: Maybe (Tag b n)
t = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
frag HashMap Text (Tag b n)
hmap
if forall a. Maybe a -> Bool
isJust Maybe (Tag b n)
t then forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. Path V2 n -> SVGStyle n a
ClipPath forall a b. (a -> b) -> a -> b
$ forall n b.
RealFloat n =>
HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
evalPath HashMap Text (Tag b n)
hmap forall a. Maybe a
Nothing (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Tag b n)
t))
else forall (m :: * -> *) a. Monad m => a -> m a
return forall n a. SVGStyle n a
EmptyStyle
evalPath :: RealFloat n => H.HashMap Text (Tag b n) -> Maybe (ViewBox n) -> (Tag b n) -> Path V2 n
evalPath :: forall n b.
RealFloat n =>
HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
evalPath HashMap Text (Tag b n)
hmap (Just ViewBox n
viewBox) (Leaf Maybe Text
id1 ViewBox n -> Path V2 n
path (HashMaps b n, ViewBox n) -> Diagram b
diagram) = ViewBox n -> Path V2 n
path ViewBox n
viewBox
evalPath HashMap Text (Tag b n)
hmap Maybe (ViewBox n)
Nothing (Leaf Maybe Text
id1 ViewBox n -> Path V2 n
path (HashMaps b n, ViewBox n) -> Diagram b
diagram) = ViewBox n -> Path V2 n
path (n
0,n
0,n
1,n
1)
evalPath HashMap Text (Tag b n)
hmap Maybe (ViewBox n)
_ (SubTree Bool
_ Maybe Text
id1 (Double, Double)
_ (Just ViewBox n
viewBox) Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
children) = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall n b.
RealFloat n =>
HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
evalPath HashMap Text (Tag b n)
hmap (forall a. a -> Maybe a
Just ViewBox n
viewBox)) [Tag b n]
children)
evalPath HashMap Text (Tag b n)
hmap (Just ViewBox n
viewBox) (SubTree Bool
_ Maybe Text
id1 (Double, Double)
_ Maybe (ViewBox n)
Nothing Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
children) = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall n b.
RealFloat n =>
HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
evalPath HashMap Text (Tag b n)
hmap (forall a. a -> Maybe a
Just ViewBox n
viewBox)) [Tag b n]
children)
evalPath HashMap Text (Tag b n)
hmap Maybe (ViewBox n)
_ Tag b n
_ = forall a. Monoid a => a
mempty
lookUp :: HashMap k (Tag b n) -> k -> Tag b n
lookUp HashMap k (Tag b n)
hmap k
i | forall a. Maybe a -> Bool
isJust Maybe (Tag b n)
l = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Tag b n)
l
| Bool
otherwise = forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf forall a. Maybe a
Nothing forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
where l :: Maybe (Tag b n)
l = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup k
i HashMap k (Tag b n)
hmap
styleStrokeMiterLimit :: Parser Text (SVGStyle n a)
styleStrokeMiterLimit =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-miterlimit:"
Parser ()
AT.skipSpace
forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleStrokeMiterLimitVal
styleStrokeMiterLimitVal :: Parser Text (SVGStyle n a)
styleStrokeMiterLimitVal =
do Double
l <- Parser Text Double
myDouble
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n a. n -> SVGStyle n a
StrokeMiterLimit forall a b. (a -> b) -> a -> b
$ (forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) Double
l
styleStrokeDashArray :: Parser Text (SVGStyle n a)
styleStrokeDashArray =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-dasharray:"
forall {n} {a}. Fractional n => Parser Text (SVGStyle n a)
styleStrokeDashArrayVal
styleStrokeDashArrayVal :: Parser Text (SVGStyle n a)
styleStrokeDashArrayVal =
do [LenPercent n]
len <- forall {n}. Fractional n => Parser Text [LenPercent n]
parseLengths
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n a. [LenPercent n] -> SVGStyle n a
StrokeDasharray [LenPercent n]
len)
parseLengths :: Parser Text [LenPercent n]
parseLengths = forall {a}. Parser Text a -> Text -> Parser Text [a]
separatedBy forall {n}. Fractional n => Parser Text (LenPercent n)
styleLength Text
","
styleStrokeOpacity :: Parser Text (SVGStyle n a)
styleStrokeOpacity =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-opacity:"
Parser ()
AT.skipSpace
forall {n} {a}. Parser Text (SVGStyle n a)
styleStrokeOpacityVal
styleStrokeOpacityVal :: Parser Text (SVGStyle n a)
styleStrokeOpacityVal =
do Double
l <- Parser Text Double
myDouble
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n a. Double -> SVGStyle n a
StrokeOpacity forall a b. (a -> b) -> a -> b
$ (forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) Double
l
styleStopColor :: Parser Text (SVGStyle n a)
styleStopColor =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stop-color:"
Parser ()
AT.skipSpace
forall {a} {n}.
(Floating a, RealFrac a) =>
Parser Text (SVGStyle n a)
styleFillColourVal
styleStopOpacity :: Parser Text (SVGStyle n a)
styleStopOpacity =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stop-opacity:"
Parser ()
AT.skipSpace
forall {n} {a}. Parser Text (SVGStyle n a)
styleFillOpacityVal
colorString :: Parser Text (AlphaColour a)
colorString =
do Text
a <- (Char -> Bool) -> Parser Text
Data.Attoparsec.Text.takeWhile Char -> Bool
isAlpha
Colour a
c <- forall (m :: * -> *) a.
(MonadFail m, Monad m, Ord a, Floating a) =>
String -> m (Colour a)
readColourName (Text -> String
unpack Text
a)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => Colour a -> AlphaColour a
opaque Colour a
c)
colorRGB :: Parser Text (AlphaColour a)
colorRGB =
do Char -> Parser Char
AT.char Char
'#'
Char
h0 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h1 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h2 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque ( forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h0) forall a. Num a => a -> a -> a
* Int
16))
(forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h1) forall a. Num a => a -> a -> a
* Int
16))
(forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h2) forall a. Num a => a -> a -> a
* Int
16)) )
colorRRGGBB :: Parser Text (AlphaColour a)
colorRRGGBB =
do Char -> Parser Char
AT.char Char
'#'
Char
h0 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h1 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h2 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h3 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h4 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h5 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque ( forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h0) forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ (Char -> Int
digitToInt Char
h1)) )
(forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h2) forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ (Char -> Int
digitToInt Char
h3)) )
(forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h4) forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ (Char -> Int
digitToInt Char
h5)) ) )
colorRGBWord :: Parser Text (AlphaColour a)
colorRGBWord =
do Text -> Parser Text
AT.string Text
"rgb("
Parser ()
AT.skipSpace
Integer
r <- forall a. Integral a => Parser a
decimal
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
g <- forall a. Integral a => Parser a
decimal
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
b <- forall a. Integral a => Parser a
decimal
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r)forall a. Fractional a => a -> a -> a
/a
255) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
g)forall a. Fractional a => a -> a -> a
/a
255) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)forall a. Fractional a => a -> a -> a
/a
255))
colorRGBPercent :: Parser Text (AlphaColour a)
colorRGBPercent =
do Text -> Parser Text
AT.string Text
"rgb("
Parser ()
AT.skipSpace
Integer
r <- forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
g <- forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
b <- forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r)forall a. Fractional a => a -> a -> a
/a
100) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
g)forall a. Fractional a => a -> a -> a
/a
100) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)forall a. Fractional a => a -> a -> a
/a
100))
colorHSLPercent :: Parser Text (AlphaColour a)
colorHSLPercent =
do Text -> Parser Text
AT.string Text
"hsl("
Parser ()
AT.skipSpace
Integer
h <- forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
s <- forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
l <- forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
')'
let c :: RGB a
c = forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsl (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
l)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque (forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB (forall a. RGB a -> a
channelRed RGB a
c) (forall a. RGB a -> a
channelGreen RGB a
c) (forall a. RGB a -> a
channelBlue RGB a
c))
colorNone :: Parser Text (AlphaColour a)
colorNone =
do Text -> Parser Text
AT.string Text
"none"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Num a => AlphaColour a
transparent
parseSpread :: Maybe Text -> SpreadMethod
parseSpread :: Maybe Text -> SpreadMethod
parseSpread Maybe Text
spr | forall a. Maybe a -> Bool
isJust Maybe SpreadMethod
parsedSpread = forall a. HasCallStack => Maybe a -> a
fromJust Maybe SpreadMethod
parsedSpread
| Bool
otherwise = SpreadMethod
GradPad
where parsedSpread :: Maybe SpreadMethod
parsedSpread = forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser Text SpreadMethod
gradSpread Maybe Text
spr
gradSpread :: Parser Text SpreadMethod
gradSpread = forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text SpreadMethod
gradPad, Parser Text SpreadMethod
gradReflect, Parser Text SpreadMethod
gradRepeat ]
gradPad :: Parser Text SpreadMethod
gradPad = do Text -> Parser Text
AT.string Text
"pad"
forall (m :: * -> *) a. Monad m => a -> m a
return SpreadMethod
GradPad
gradReflect :: Parser Text SpreadMethod
gradReflect = do Text -> Parser Text
AT.string Text
"reflect"
forall (m :: * -> *) a. Monad m => a -> m a
return SpreadMethod
GradReflect
gradRepeat :: Parser Text SpreadMethod
gradRepeat = do Text -> Parser Text
AT.string Text
"repeat"
forall (m :: * -> *) a. Monad m => a -> m a
return SpreadMethod
GradRepeat
parseViewBox :: RealFloat n => Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
parseViewBox :: forall n.
RealFloat n =>
Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
parseViewBox Maybe Text
vb Maybe Text
w Maybe Text
h | forall a. Maybe a -> Bool
isJust Maybe (n, n, n, n)
parsedVB = Maybe (n, n, n, n)
parsedVB
| n
pw forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
|| n
ph forall a. Eq a => a -> a -> Bool
== n
0 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (n
0,n
0,n
pw, n
ph)
where parsedVB :: Maybe (n, n, n, n)
parsedVB = forall a. Parser a -> Maybe Text -> Maybe a
parseTempl forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
viewBox Maybe Text
vb
pw :: n
pw | forall a. Maybe a -> Bool
isJust Maybe Text
w = forall n. RealFloat n => Text -> n
parseDouble forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
w
| Bool
otherwise = n
0
ph :: n
ph | forall a. Maybe a -> Bool
isJust Maybe Text
h = forall n. RealFloat n => Text -> n
parseDouble forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
h
| Bool
otherwise = n
0
viewBox :: Parser Text (a, b, c, d)
viewBox =
do Parser ()
AT.skipSpace
Double
minx <- Parser Text Double
myDouble
Parser ()
AT.skipSpace
Double
miny <- Parser Text Double
myDouble
Parser ()
AT.skipSpace
Double
width <- Parser Text Double
myDouble
Parser ()
AT.skipSpace
Double
height <- Parser Text Double
myDouble
Parser ()
AT.skipSpace
forall (m :: * -> *) a. Monad m => a -> m a
return ((forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) Double
minx,
(forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) Double
miny,
(forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) Double
width,
(forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational) Double
height)
parsePreserveAR :: Maybe Text -> Maybe PreserveAR
parsePreserveAR Maybe Text
x = forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser Text PreserveAR
preserveAR Maybe Text
x
preserveAR :: Parser Text PreserveAR
preserveAR =
do Parser ()
AT.skipSpace
AlignSVG
align <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text AlignSVG
alignXMinYMin,Parser Text AlignSVG
alignXMidYMin,Parser Text AlignSVG
alignXMaxYMin,Parser Text AlignSVG
alignXMinYMid,Parser Text AlignSVG
alignXMidYMid,
Parser Text AlignSVG
alignXMaxYMid,Parser Text AlignSVG
alignXMinYMax,Parser Text AlignSVG
alignXMidYMax,Parser Text AlignSVG
alignXMaxYMax]
Parser ()
AT.skipSpace
MeetOrSlice
meetOrSlice <- forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text MeetOrSlice
meet, Parser Text MeetOrSlice
slice]
forall (m :: * -> *) a. Monad m => a -> m a
return (AlignSVG -> MeetOrSlice -> PreserveAR
PAR AlignSVG
align MeetOrSlice
meetOrSlice)
meet :: Parser Text MeetOrSlice
meet =
do Text -> Parser Text
AT.string Text
"meet"
forall (m :: * -> *) a. Monad m => a -> m a
return MeetOrSlice
Meet
slice :: Parser Text MeetOrSlice
slice =
do Text -> Parser Text
AT.string Text
"slice"
forall (m :: * -> *) a. Monad m => a -> m a
return MeetOrSlice
Slice
alignXMinYMin :: Parser Text AlignSVG
alignXMinYMin =
do Text -> Parser Text
AT.string Text
"xMinYMin"
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0 Double
0)
alignXMidYMin :: Parser Text AlignSVG
alignXMidYMin =
do Text -> Parser Text
AT.string Text
"xMidYMin"
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0.5 Double
0)
alignXMaxYMin :: Parser Text AlignSVG
alignXMaxYMin =
do Text -> Parser Text
AT.string Text
"xMaxYMin"
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
1 Double
0)
alignXMinYMid :: Parser Text AlignSVG
alignXMinYMid =
do Text -> Parser Text
AT.string Text
"xMinYMid"
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0 Double
0.5)
alignXMidYMid :: Parser Text AlignSVG
alignXMidYMid =
do Text -> Parser Text
AT.string Text
"xMidYMid"
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0.5 Double
0.5)
alignXMaxYMid :: Parser Text AlignSVG
alignXMaxYMid =
do Text -> Parser Text
AT.string Text
"xMaxYMid"
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
1 Double
0.5)
alignXMinYMax :: Parser Text AlignSVG
alignXMinYMax =
do Text -> Parser Text
AT.string Text
"xMinYMax"
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0 Double
1)
alignXMidYMax :: Parser Text AlignSVG
alignXMidYMax =
do Text -> Parser Text
AT.string Text
"xMidYMax"
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0.5 Double
1)
alignXMaxYMax :: Parser Text AlignSVG
alignXMaxYMax =
do Text -> Parser Text
AT.string Text
"xMaxYMax"
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
1 Double
1)