{-# LANGUAGE OverloadedStrings #-}
module Graphics.SvgTree.PathParser
  ( transformParser
  , command
  , pathParser
  , viewBoxParser
  , pointData
  , gradientCommand
  , serializePoints
  , serializeCommand
  , serializeGradientCommand
  , serializeCommands
  , serializeViewBox
  ) where

import           Control.Applicative        ((<|>))
import           Data.Attoparsec.Combinator (option, sepBy, sepBy1)
import           Data.Attoparsec.Text       (Parser, char, digit, many1,
                                             parseOnly, scientific, skipSpace,
                                             string)
import           Data.Functor
import           Data.List
import           Data.Scientific            (toRealFloat)
import qualified Data.Text                  as T
import           Graphics.SvgTree.Misc
import           Graphics.SvgTree.Types
import           Linear                     hiding (angle, point)
import           Text.Printf                (printf)

num :: Parser Double
num :: Parser Double
num = Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double) -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipSpace Parser () -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Double
plusMinus Parser Double -> Parser () -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace)
  where doubleNumber :: Parser Double
        doubleNumber :: Parser Double
doubleNumber = Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat (Scientific -> Double) -> Parser Text Scientific -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Scientific
scientific Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
shorthand

        plusMinus :: Parser Double
plusMinus = Double -> Double
forall a. Num a => a -> a
negate (Double -> Double)
-> Parser Text Text -> Parser Text (Double -> Double)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"-" Parser Text (Double -> Double) -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
doubleNumber
                 Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
string Text
"+" Parser Text Text -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Double
doubleNumber
                 Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
doubleNumber

        shorthand :: Parser Double
shorthand = [Char] -> Double
process' ([Char] -> Double) -> Parser Text [Char] -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text Text
string Text
"." Parser Text Text -> Parser Text [Char] -> Parser Text [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text Char
digit)
        process' :: [Char] -> Double
process' = ([Char] -> Double)
-> (Double -> Double) -> Either [Char] Double -> Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Double -> [Char] -> Double
forall a b. a -> b -> a
const Double
0) Double -> Double
forall a. a -> a
id (Either [Char] Double -> Double)
-> ([Char] -> Either [Char] Double) -> [Char] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Double -> Text -> Either [Char] Double
forall a. Parser a -> Text -> Either [Char] a
parseOnly Parser Double
doubleNumber (Text -> Either [Char] Double)
-> ([Char] -> Text) -> [Char] -> Either [Char] Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> ([Char] -> [Char]) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) [Char]
"0."

flag :: Parser Bool
flag :: Parser Bool
flag = (Char -> Bool) -> Parser Text Char -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'0') Parser Text Char
digit

viewBoxParser :: Parser (Double, Double, Double, Double)
viewBoxParser :: Parser (Double, Double, Double, Double)
viewBoxParser = (,,,)
       (Double
 -> Double -> Double -> Double -> (Double, Double, Double, Double))
-> Parser Double
-> Parser
     Text
     (Double -> Double -> Double -> (Double, Double, Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
iParse Parser
  Text
  (Double -> Double -> Double -> (Double, Double, Double, Double))
-> Parser Double
-> Parser
     Text (Double -> Double -> (Double, Double, Double, Double))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
iParse Parser Text (Double -> Double -> (Double, Double, Double, Double))
-> Parser Double
-> Parser Text (Double -> (Double, Double, Double, Double))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
iParse Parser Text (Double -> (Double, Double, Double, Double))
-> Parser Double -> Parser (Double, Double, Double, Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
iParse
  where
    iParse :: Parser Double
iParse = Parser Double
num Parser Double -> Parser () -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace

serializeViewBox :: (Double, Double, Double, Double) -> String
serializeViewBox :: (Double, Double, Double, Double) -> [Char]
serializeViewBox (Double
a, Double
b, Double
c, Double
d) = [Char] -> [Char] -> [Char] -> [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s %s %s %s" (Double -> [Char]
ppD Double
a) (Double -> [Char]
ppD Double
b) (Double -> [Char]
ppD Double
c) (Double -> [Char]
ppD Double
d)

commaWsp :: Parser ()
commaWsp :: Parser ()
commaWsp = Parser ()
skipSpace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Text -> Parser Text Text
string Text
"," Parser Text Text -> () -> Parser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace

point :: Parser RPoint
point :: Parser RPoint
point = Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 (Double -> Double -> RPoint)
-> Parser Double -> Parser Text (Double -> RPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
num Parser Text (Double -> RPoint)
-> Parser () -> Parser Text (Double -> RPoint)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp Parser Text (Double -> RPoint) -> Parser Double -> Parser RPoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
num

pointData :: Parser [RPoint]
pointData :: Parser [RPoint]
pointData = Parser RPoint
point Parser RPoint -> Parser () -> Parser [RPoint]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Parser ()
commaWsp

pathParser :: Parser [PathCommand]
pathParser :: Parser [PathCommand]
pathParser = Parser ()
skipSpace Parser () -> Parser [PathCommand] -> Parser [PathCommand]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text PathCommand -> Parser [PathCommand]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text PathCommand
command

command :: Parser PathCommand
command :: Parser Text PathCommand
command =  (Origin -> [RPoint] -> PathCommand
MoveTo Origin
OriginAbsolute ([RPoint] -> PathCommand)
-> Parser Text Text -> Parser Text ([RPoint] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"M" Parser Text ([RPoint] -> PathCommand)
-> Parser [RPoint] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RPoint]
pointList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [RPoint] -> PathCommand
MoveTo Origin
OriginRelative ([RPoint] -> PathCommand)
-> Parser Text Text -> Parser Text ([RPoint] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"m" Parser Text ([RPoint] -> PathCommand)
-> Parser [RPoint] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RPoint]
pointList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [RPoint] -> PathCommand
LineTo Origin
OriginAbsolute ([RPoint] -> PathCommand)
-> Parser Text Text -> Parser Text ([RPoint] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"L" Parser Text ([RPoint] -> PathCommand)
-> Parser [RPoint] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RPoint]
pointList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [RPoint] -> PathCommand
LineTo Origin
OriginRelative ([RPoint] -> PathCommand)
-> Parser Text Text -> Parser Text ([RPoint] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"l" Parser Text ([RPoint] -> PathCommand)
-> Parser [RPoint] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RPoint]
pointList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [Double] -> PathCommand
HorizontalTo Origin
OriginAbsolute ([Double] -> PathCommand)
-> Parser Text Text -> Parser Text ([Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"H" Parser Text ([Double] -> PathCommand)
-> Parser Text [Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [Double]
coordList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [Double] -> PathCommand
HorizontalTo Origin
OriginRelative ([Double] -> PathCommand)
-> Parser Text Text -> Parser Text ([Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"h" Parser Text ([Double] -> PathCommand)
-> Parser Text [Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [Double]
coordList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [Double] -> PathCommand
VerticalTo Origin
OriginAbsolute ([Double] -> PathCommand)
-> Parser Text Text -> Parser Text ([Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"V" Parser Text ([Double] -> PathCommand)
-> Parser Text [Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [Double]
coordList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [Double] -> PathCommand
VerticalTo Origin
OriginRelative ([Double] -> PathCommand)
-> Parser Text Text -> Parser Text ([Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"v" Parser Text ([Double] -> PathCommand)
-> Parser Text [Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [Double]
coordList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [(RPoint, RPoint, RPoint)] -> PathCommand
CurveTo Origin
OriginAbsolute ([(RPoint, RPoint, RPoint)] -> PathCommand)
-> Parser Text Text
-> Parser Text ([(RPoint, RPoint, RPoint)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"C" Parser Text ([(RPoint, RPoint, RPoint)] -> PathCommand)
-> Parser Text [(RPoint, RPoint, RPoint)]
-> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (RPoint, RPoint, RPoint)
-> Parser Text [(RPoint, RPoint, RPoint)]
forall a. Parser Text a -> Parser Text [a]
manyComma Parser Text (RPoint, RPoint, RPoint)
curveToArgs)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [(RPoint, RPoint, RPoint)] -> PathCommand
CurveTo Origin
OriginRelative ([(RPoint, RPoint, RPoint)] -> PathCommand)
-> Parser Text Text
-> Parser Text ([(RPoint, RPoint, RPoint)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"c" Parser Text ([(RPoint, RPoint, RPoint)] -> PathCommand)
-> Parser Text [(RPoint, RPoint, RPoint)]
-> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (RPoint, RPoint, RPoint)
-> Parser Text [(RPoint, RPoint, RPoint)]
forall a. Parser Text a -> Parser Text [a]
manyComma Parser Text (RPoint, RPoint, RPoint)
curveToArgs)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [(RPoint, RPoint)] -> PathCommand
SmoothCurveTo Origin
OriginAbsolute ([(RPoint, RPoint)] -> PathCommand)
-> Parser Text Text
-> Parser Text ([(RPoint, RPoint)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"S" Parser Text ([(RPoint, RPoint)] -> PathCommand)
-> Parser Text [(RPoint, RPoint)] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [(RPoint, RPoint)]
pointPairList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [(RPoint, RPoint)] -> PathCommand
SmoothCurveTo Origin
OriginRelative ([(RPoint, RPoint)] -> PathCommand)
-> Parser Text Text
-> Parser Text ([(RPoint, RPoint)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"s" Parser Text ([(RPoint, RPoint)] -> PathCommand)
-> Parser Text [(RPoint, RPoint)] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [(RPoint, RPoint)]
pointPairList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [(RPoint, RPoint)] -> PathCommand
QuadraticBezier Origin
OriginAbsolute ([(RPoint, RPoint)] -> PathCommand)
-> Parser Text Text
-> Parser Text ([(RPoint, RPoint)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"Q" Parser Text ([(RPoint, RPoint)] -> PathCommand)
-> Parser Text [(RPoint, RPoint)] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [(RPoint, RPoint)]
pointPairList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [(RPoint, RPoint)] -> PathCommand
QuadraticBezier Origin
OriginRelative ([(RPoint, RPoint)] -> PathCommand)
-> Parser Text Text
-> Parser Text ([(RPoint, RPoint)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"q" Parser Text ([(RPoint, RPoint)] -> PathCommand)
-> Parser Text [(RPoint, RPoint)] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [(RPoint, RPoint)]
pointPairList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [RPoint] -> PathCommand
SmoothQuadraticBezierCurveTo Origin
OriginAbsolute ([RPoint] -> PathCommand)
-> Parser Text Text -> Parser Text ([RPoint] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"T" Parser Text ([RPoint] -> PathCommand)
-> Parser [RPoint] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RPoint]
pointList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> [RPoint] -> PathCommand
SmoothQuadraticBezierCurveTo Origin
OriginRelative ([RPoint] -> PathCommand)
-> Parser Text Text -> Parser Text ([RPoint] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"t" Parser Text ([RPoint] -> PathCommand)
-> Parser [RPoint] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RPoint]
pointList)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin
-> [(Double, Double, Double, Bool, Bool, RPoint)] -> PathCommand
EllipticalArc Origin
OriginAbsolute ([(Double, Double, Double, Bool, Bool, RPoint)] -> PathCommand)
-> Parser Text Text
-> Parser
     Text
     ([(Double, Double, Double, Bool, Bool, RPoint)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"A" Parser
  Text
  ([(Double, Double, Double, Bool, Bool, RPoint)] -> PathCommand)
-> Parser Text [(Double, Double, Double, Bool, Bool, RPoint)]
-> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (Double, Double, Double, Bool, Bool, RPoint)
-> Parser Text [(Double, Double, Double, Bool, Bool, RPoint)]
forall a. Parser Text a -> Parser Text [a]
manyComma Parser Text (Double, Double, Double, Bool, Bool, RPoint)
ellipticalArgs)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin
-> [(Double, Double, Double, Bool, Bool, RPoint)] -> PathCommand
EllipticalArc Origin
OriginRelative ([(Double, Double, Double, Bool, Bool, RPoint)] -> PathCommand)
-> Parser Text Text
-> Parser
     Text
     ([(Double, Double, Double, Bool, Bool, RPoint)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"a" Parser
  Text
  ([(Double, Double, Double, Bool, Bool, RPoint)] -> PathCommand)
-> Parser Text [(Double, Double, Double, Bool, Bool, RPoint)]
-> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (Double, Double, Double, Bool, Bool, RPoint)
-> Parser Text [(Double, Double, Double, Bool, Bool, RPoint)]
forall a. Parser Text a -> Parser Text [a]
manyComma Parser Text (Double, Double, Double, Bool, Bool, RPoint)
ellipticalArgs)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PathCommand
EndPath PathCommand -> Parser Text Text -> Parser Text PathCommand
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"Z" Parser Text PathCommand -> Parser () -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
       Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PathCommand
EndPath PathCommand -> Parser Text Text -> Parser Text PathCommand
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"z" Parser Text PathCommand -> Parser () -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
    where pointList :: Parser [RPoint]
pointList = Parser RPoint
point Parser RPoint -> Parser () -> Parser [RPoint]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
commaWsp
          pointPair :: Parser Text (RPoint, RPoint)
pointPair = (,) (RPoint -> RPoint -> (RPoint, RPoint))
-> Parser RPoint -> Parser Text (RPoint -> (RPoint, RPoint))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RPoint
point Parser Text (RPoint -> (RPoint, RPoint))
-> Parser () -> Parser Text (RPoint -> (RPoint, RPoint))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp Parser Text (RPoint -> (RPoint, RPoint))
-> Parser RPoint -> Parser Text (RPoint, RPoint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RPoint
point
          pointPairList :: Parser Text [(RPoint, RPoint)]
pointPairList = Parser Text (RPoint, RPoint)
pointPair Parser Text (RPoint, RPoint)
-> Parser () -> Parser Text [(RPoint, RPoint)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
commaWsp
          coordList :: Parser Text [Double]
coordList = Parser Double
num Parser Double -> Parser () -> Parser Text [Double]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
commaWsp
          curveToArgs :: Parser Text (RPoint, RPoint, RPoint)
curveToArgs = (,,) (RPoint -> RPoint -> RPoint -> (RPoint, RPoint, RPoint))
-> Parser RPoint
-> Parser Text (RPoint -> RPoint -> (RPoint, RPoint, RPoint))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser RPoint
point Parser RPoint -> Parser () -> Parser RPoint
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
                             Parser Text (RPoint -> RPoint -> (RPoint, RPoint, RPoint))
-> Parser RPoint
-> Parser Text (RPoint -> (RPoint, RPoint, RPoint))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser RPoint
point Parser RPoint -> Parser () -> Parser RPoint
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
                             Parser Text (RPoint -> (RPoint, RPoint, RPoint))
-> Parser RPoint -> Parser Text (RPoint, RPoint, RPoint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RPoint
point
          manyComma :: Parser Text a -> Parser Text [a]
manyComma Parser Text a
a = Parser Text a
a Parser Text a -> Parser () -> Parser Text [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
commaWsp

          numComma :: Parser Double
numComma = Parser Double
num Parser Double -> Parser () -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp
          flagComma :: Parser Bool
flagComma = Parser Bool
flag Parser Bool -> Parser () -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp
          ellipticalArgs :: Parser Text (Double, Double, Double, Bool, Bool, RPoint)
ellipticalArgs = (,,,,,) (Double
 -> Double
 -> Double
 -> Bool
 -> Bool
 -> RPoint
 -> (Double, Double, Double, Bool, Bool, RPoint))
-> Parser Double
-> Parser
     Text
     (Double
      -> Double
      -> Bool
      -> Bool
      -> RPoint
      -> (Double, Double, Double, Bool, Bool, RPoint))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
numComma
                                   Parser
  Text
  (Double
   -> Double
   -> Bool
   -> Bool
   -> RPoint
   -> (Double, Double, Double, Bool, Bool, RPoint))
-> Parser Double
-> Parser
     Text
     (Double
      -> Bool
      -> Bool
      -> RPoint
      -> (Double, Double, Double, Bool, Bool, RPoint))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
numComma
                                   Parser
  Text
  (Double
   -> Bool
   -> Bool
   -> RPoint
   -> (Double, Double, Double, Bool, Bool, RPoint))
-> Parser Double
-> Parser
     Text
     (Bool
      -> Bool -> RPoint -> (Double, Double, Double, Bool, Bool, RPoint))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
numComma
                                   Parser
  Text
  (Bool
   -> Bool -> RPoint -> (Double, Double, Double, Bool, Bool, RPoint))
-> Parser Bool
-> Parser
     Text
     (Bool -> RPoint -> (Double, Double, Double, Bool, Bool, RPoint))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
flagComma
                                   Parser
  Text
  (Bool -> RPoint -> (Double, Double, Double, Bool, Bool, RPoint))
-> Parser Bool
-> Parser
     Text (RPoint -> (Double, Double, Double, Bool, Bool, RPoint))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
flagComma
                                   Parser
  Text (RPoint -> (Double, Double, Double, Bool, Bool, RPoint))
-> Parser RPoint
-> Parser Text (Double, Double, Double, Bool, Bool, RPoint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RPoint
point

unwordsS :: [ShowS] -> ShowS
unwordsS :: [[Char] -> [Char]] -> [Char] -> [Char]
unwordsS = (([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [[Char] -> [Char]] -> [Char] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [Char] -> [Char]
forall a. a -> a
id ([[Char] -> [Char]] -> [Char] -> [Char])
-> ([[Char] -> [Char]] -> [[Char] -> [Char]])
-> [[Char] -> [Char]]
-> [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char] -> [Char]] -> [[Char] -> [Char]]
forall a. a -> [a] -> [a]
intersperse (Char -> [Char] -> [Char]
showChar Char
' ')

serializePoint :: RPoint -> ShowS
serializePoint :: RPoint -> [Char] -> [Char]
serializePoint (V2 Double
x Double
y) = [Char] -> [Char] -> [Char]
showString (Double -> [Char]
ppD Double
x) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char] -> [Char]
showChar Char
',' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString (Double -> [Char]
ppD Double
y)

serializePoints :: [RPoint] -> ShowS
serializePoints :: [RPoint] -> [Char] -> [Char]
serializePoints = [[Char] -> [Char]] -> [Char] -> [Char]
unwordsS ([[Char] -> [Char]] -> [Char] -> [Char])
-> ([RPoint] -> [[Char] -> [Char]]) -> [RPoint] -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RPoint -> [Char] -> [Char]) -> [RPoint] -> [[Char] -> [Char]]
forall a b. (a -> b) -> [a] -> [b]
map RPoint -> [Char] -> [Char]
serializePoint

serializeCoords :: [Coord] -> ShowS
serializeCoords :: [Double] -> [Char] -> [Char]
serializeCoords = [[Char] -> [Char]] -> [Char] -> [Char]
unwordsS ([[Char] -> [Char]] -> [Char] -> [Char])
-> ([Double] -> [[Char] -> [Char]]) -> [Double] -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> [Char] -> [Char]) -> [Double] -> [[Char] -> [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char] -> [Char]
showString ([Char] -> [Char] -> [Char])
-> (Double -> [Char]) -> Double -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Char]
ppD)

serializePointPair :: (RPoint, RPoint) -> ShowS
serializePointPair :: (RPoint, RPoint) -> [Char] -> [Char]
serializePointPair (RPoint
a, RPoint
b) = RPoint -> [Char] -> [Char]
serializePoint RPoint
a ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char] -> [Char]
showChar Char
' ' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPoint -> [Char] -> [Char]
serializePoint RPoint
b

serializePointPairs :: [(RPoint, RPoint)] -> ShowS
serializePointPairs :: [(RPoint, RPoint)] -> [Char] -> [Char]
serializePointPairs = [[Char] -> [Char]] -> [Char] -> [Char]
unwordsS ([[Char] -> [Char]] -> [Char] -> [Char])
-> ([(RPoint, RPoint)] -> [[Char] -> [Char]])
-> [(RPoint, RPoint)]
-> [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RPoint, RPoint) -> [Char] -> [Char])
-> [(RPoint, RPoint)] -> [[Char] -> [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RPoint, RPoint) -> [Char] -> [Char]
serializePointPair

serializePointTriplet :: (RPoint, RPoint, RPoint) -> ShowS
serializePointTriplet :: (RPoint, RPoint, RPoint) -> [Char] -> [Char]
serializePointTriplet (RPoint
a, RPoint
b, RPoint
c) =
    RPoint -> [Char] -> [Char]
serializePoint RPoint
a ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char] -> [Char]
showChar Char
' ' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPoint -> [Char] -> [Char]
serializePoint RPoint
b ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char] -> [Char]
showChar Char
' ' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPoint -> [Char] -> [Char]
serializePoint RPoint
c

serializePointTriplets :: [(RPoint, RPoint, RPoint)] -> ShowS
serializePointTriplets :: [(RPoint, RPoint, RPoint)] -> [Char] -> [Char]
serializePointTriplets = [[Char] -> [Char]] -> [Char] -> [Char]
unwordsS ([[Char] -> [Char]] -> [Char] -> [Char])
-> ([(RPoint, RPoint, RPoint)] -> [[Char] -> [Char]])
-> [(RPoint, RPoint, RPoint)]
-> [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RPoint, RPoint, RPoint) -> [Char] -> [Char])
-> [(RPoint, RPoint, RPoint)] -> [[Char] -> [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RPoint, RPoint, RPoint) -> [Char] -> [Char]
serializePointTriplet

serializeCommands :: [PathCommand] -> ShowS
serializeCommands :: [PathCommand] -> [Char] -> [Char]
serializeCommands = [[Char] -> [Char]] -> [Char] -> [Char]
unwordsS ([[Char] -> [Char]] -> [Char] -> [Char])
-> ([PathCommand] -> [[Char] -> [Char]])
-> [PathCommand]
-> [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathCommand -> [Char] -> [Char])
-> [PathCommand] -> [[Char] -> [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathCommand -> [Char] -> [Char]
serializeCommand

serializeCommand :: PathCommand -> ShowS
serializeCommand :: PathCommand -> [Char] -> [Char]
serializeCommand PathCommand
p = case PathCommand
p of
  MoveTo Origin
OriginAbsolute [RPoint]
points -> Char -> [Char] -> [Char]
showChar Char
'M' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RPoint] -> [Char] -> [Char]
serializePoints [RPoint]
points
  MoveTo Origin
OriginRelative [RPoint]
points -> Char -> [Char] -> [Char]
showChar Char
'm' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RPoint] -> [Char] -> [Char]
serializePoints [RPoint]
points
  LineTo Origin
OriginAbsolute [RPoint]
points -> Char -> [Char] -> [Char]
showChar Char
'L' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RPoint] -> [Char] -> [Char]
serializePoints [RPoint]
points
  LineTo Origin
OriginRelative [RPoint]
points -> Char -> [Char] -> [Char]
showChar Char
'l' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RPoint] -> [Char] -> [Char]
serializePoints [RPoint]
points

  HorizontalTo Origin
OriginRelative [Double]
coords -> Char -> [Char] -> [Char]
showChar Char
'h' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Char] -> [Char]
serializeCoords [Double]
coords
  HorizontalTo Origin
OriginAbsolute [Double]
coords -> Char -> [Char] -> [Char]
showChar Char
'H' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Char] -> [Char]
serializeCoords [Double]
coords
  VerticalTo Origin
OriginAbsolute [Double]
coords   -> Char -> [Char] -> [Char]
showChar Char
'V' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Char] -> [Char]
serializeCoords [Double]
coords
  VerticalTo Origin
OriginRelative [Double]
coords   -> Char -> [Char] -> [Char]
showChar Char
'v' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Char] -> [Char]
serializeCoords [Double]
coords

  CurveTo Origin
OriginAbsolute [(RPoint, RPoint, RPoint)]
triplets -> Char -> [Char] -> [Char]
showChar Char
'C' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RPoint, RPoint, RPoint)] -> [Char] -> [Char]
serializePointTriplets [(RPoint, RPoint, RPoint)]
triplets
  CurveTo Origin
OriginRelative [(RPoint, RPoint, RPoint)]
triplets -> Char -> [Char] -> [Char]
showChar Char
'c' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RPoint, RPoint, RPoint)] -> [Char] -> [Char]
serializePointTriplets [(RPoint, RPoint, RPoint)]
triplets
  SmoothCurveTo Origin
OriginAbsolute [(RPoint, RPoint)]
pointPairs -> Char -> [Char] -> [Char]
showChar Char
'S' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RPoint, RPoint)] -> [Char] -> [Char]
serializePointPairs [(RPoint, RPoint)]
pointPairs
  SmoothCurveTo Origin
OriginRelative [(RPoint, RPoint)]
pointPairs -> Char -> [Char] -> [Char]
showChar Char
's' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RPoint, RPoint)] -> [Char] -> [Char]
serializePointPairs [(RPoint, RPoint)]
pointPairs
  QuadraticBezier Origin
OriginAbsolute [(RPoint, RPoint)]
pointPairs -> Char -> [Char] -> [Char]
showChar Char
'Q' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RPoint, RPoint)] -> [Char] -> [Char]
serializePointPairs [(RPoint, RPoint)]
pointPairs
  QuadraticBezier Origin
OriginRelative [(RPoint, RPoint)]
pointPairs -> Char -> [Char] -> [Char]
showChar Char
'q' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RPoint, RPoint)] -> [Char] -> [Char]
serializePointPairs [(RPoint, RPoint)]
pointPairs
  SmoothQuadraticBezierCurveTo Origin
OriginAbsolute [RPoint]
points -> Char -> [Char] -> [Char]
showChar Char
'T' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RPoint] -> [Char] -> [Char]
serializePoints [RPoint]
points
  SmoothQuadraticBezierCurveTo Origin
OriginRelative [RPoint]
points -> Char -> [Char] -> [Char]
showChar Char
't' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RPoint] -> [Char] -> [Char]
serializePoints [RPoint]
points
  EllipticalArc Origin
OriginAbsolute [(Double, Double, Double, Bool, Bool, RPoint)]
args -> Char -> [Char] -> [Char]
showChar Char
'A' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Double, Double, Double, Bool, Bool, RPoint)] -> [Char] -> [Char]
serializeArgs [(Double, Double, Double, Bool, Bool, RPoint)]
args
  EllipticalArc Origin
OriginRelative [(Double, Double, Double, Bool, Bool, RPoint)]
args -> Char -> [Char] -> [Char]
showChar Char
'a' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Double, Double, Double, Bool, Bool, RPoint)] -> [Char] -> [Char]
serializeArgs [(Double, Double, Double, Bool, Bool, RPoint)]
args
  PathCommand
EndPath -> Char -> [Char] -> [Char]
showChar Char
'Z'
  where
    serializeArg :: (Double, Double, Double, a, a, RPoint) -> [Char] -> [Char]
serializeArg (Double
a, Double
b, Double
c, a
d, a
e, V2 Double
x Double
y) =
        [Char] -> [Char] -> [Char]
showString ([Char] -> [Char] -> [Char]) -> [Char] -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
        [Char]
-> [Char]
-> [Char]
-> [Char]
-> Int
-> Int
-> [Char]
-> [Char]
-> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s %s %s %d %d %s,%s"
          (Double -> [Char]
ppD Double
a) (Double -> [Char]
ppD Double
b) (Double -> [Char]
ppD Double
c) (a -> Int
forall a. Enum a => a -> Int
fromEnum a
d) (a -> Int
forall a. Enum a => a -> Int
fromEnum a
e) (Double -> [Char]
ppD Double
x) (Double -> [Char]
ppD Double
y)
    serializeArgs :: [(Double, Double, Double, Bool, Bool, RPoint)] -> [Char] -> [Char]
serializeArgs = [[Char] -> [Char]] -> [Char] -> [Char]
unwordsS ([[Char] -> [Char]] -> [Char] -> [Char])
-> ([(Double, Double, Double, Bool, Bool, RPoint)]
    -> [[Char] -> [Char]])
-> [(Double, Double, Double, Bool, Bool, RPoint)]
-> [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Double, Double, Bool, Bool, RPoint) -> [Char] -> [Char])
-> [(Double, Double, Double, Bool, Bool, RPoint)]
-> [[Char] -> [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Double, Double, Bool, Bool, RPoint) -> [Char] -> [Char]
forall a a.
(Enum a, Enum a) =>
(Double, Double, Double, a, a, RPoint) -> [Char] -> [Char]
serializeArg



transformParser :: Parser Transformation
transformParser :: Parser Transformation
transformParser = Parser Transformation
matrixParser
               Parser Transformation
-> Parser Transformation -> Parser Transformation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Transformation
translationParser
               Parser Transformation
-> Parser Transformation -> Parser Transformation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Transformation
scaleParser
               Parser Transformation
-> Parser Transformation -> Parser Transformation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Transformation
rotateParser
               Parser Transformation
-> Parser Transformation -> Parser Transformation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Transformation
skewYParser
               Parser Transformation
-> Parser Transformation -> Parser Transformation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Transformation
skewXParser

functionParser :: T.Text -> Parser [Double]
functionParser :: Text -> Parser Text [Double]
functionParser Text
funcName =
    Text -> Parser Text Text
string Text
funcName Parser Text Text -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace
                    Parser () -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
char Char
'(' Parser Text Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace
                    Parser () -> Parser Text [Double] -> Parser Text [Double]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Double
num Parser Double -> Parser () -> Parser Text [Double]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
commaWsp
                    Parser Text [Double] -> Parser () -> Parser Text [Double]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Text [Double] -> Parser Text Char -> Parser Text [Double]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
')' Parser Text [Double] -> Parser () -> Parser Text [Double]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace

translationParser :: Parser Transformation
translationParser :: Parser Transformation
translationParser = do
  [Double]
args <- Text -> Parser Text [Double]
functionParser Text
"translate"
  Transformation -> Parser Transformation
forall (m :: * -> *) a. Monad m => a -> m a
return (Transformation -> Parser Transformation)
-> Transformation -> Parser Transformation
forall a b. (a -> b) -> a -> b
$ case [Double]
args of
    [Double
x]    -> Double -> Double -> Transformation
Translate Double
x Double
0
    [Double
x, Double
y] -> Double -> Double -> Transformation
Translate Double
x Double
y
    [Double]
_      -> Transformation
TransformUnknown

skewXParser :: Parser Transformation
skewXParser :: Parser Transformation
skewXParser = do
  [Double]
args <- Text -> Parser Text [Double]
functionParser Text
"skewX"
  Transformation -> Parser Transformation
forall (m :: * -> *) a. Monad m => a -> m a
return (Transformation -> Parser Transformation)
-> Transformation -> Parser Transformation
forall a b. (a -> b) -> a -> b
$ case [Double]
args of
    [Double
x] -> Double -> Transformation
SkewX Double
x
    [Double]
_   -> Transformation
TransformUnknown

skewYParser :: Parser Transformation
skewYParser :: Parser Transformation
skewYParser = do
  [Double]
args <- Text -> Parser Text [Double]
functionParser Text
"skewY"
  Transformation -> Parser Transformation
forall (m :: * -> *) a. Monad m => a -> m a
return (Transformation -> Parser Transformation)
-> Transformation -> Parser Transformation
forall a b. (a -> b) -> a -> b
$ case [Double]
args of
    [Double
x] -> Double -> Transformation
SkewY Double
x
    [Double]
_   -> Transformation
TransformUnknown


scaleParser :: Parser Transformation
scaleParser :: Parser Transformation
scaleParser = do
  [Double]
args <- Text -> Parser Text [Double]
functionParser Text
"scale"
  Transformation -> Parser Transformation
forall (m :: * -> *) a. Monad m => a -> m a
return (Transformation -> Parser Transformation)
-> Transformation -> Parser Transformation
forall a b. (a -> b) -> a -> b
$ case [Double]
args of
    [Double
x]    -> Double -> Maybe Double -> Transformation
Scale Double
x Maybe Double
forall a. Maybe a
Nothing
    [Double
x, Double
y] -> Double -> Maybe Double -> Transformation
Scale Double
x (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
y)
    [Double]
_      -> Transformation
TransformUnknown

matrixParser :: Parser Transformation
matrixParser :: Parser Transformation
matrixParser = do
  [Double]
args <- Text -> Parser Text [Double]
functionParser Text
"matrix"
  Transformation -> Parser Transformation
forall (m :: * -> *) a. Monad m => a -> m a
return (Transformation -> Parser Transformation)
-> Transformation -> Parser Transformation
forall a b. (a -> b) -> a -> b
$ case [Double]
args of
    [Double
a, Double
b, Double
c, Double
d, Double
e, Double
f] ->
        Double
-> Double -> Double -> Double -> Double -> Double -> Transformation
TransformMatrix Double
a Double
b Double
c Double
d Double
e Double
f
    [Double]
_ -> Transformation
TransformUnknown

rotateParser :: Parser Transformation
rotateParser :: Parser Transformation
rotateParser = do
  [Double]
args <- Text -> Parser Text [Double]
functionParser Text
"rotate"
  Transformation -> Parser Transformation
forall (m :: * -> *) a. Monad m => a -> m a
return (Transformation -> Parser Transformation)
-> Transformation -> Parser Transformation
forall a b. (a -> b) -> a -> b
$ case [Double]
args of
    [Double
angle]       -> Double -> Maybe (Double, Double) -> Transformation
Rotate Double
angle Maybe (Double, Double)
forall a. Maybe a
Nothing
    [Double
angle, Double
x, Double
y] -> Double -> Maybe (Double, Double) -> Transformation
Rotate Double
angle (Maybe (Double, Double) -> Transformation)
-> Maybe (Double, Double) -> Transformation
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Double
x, Double
y)
    [Double]
_             -> Transformation
TransformUnknown
{-
rotate(<rotate-angle> [<cx> <cy>]), which specifies a rotation by <rotate-angle> degrees about a given point.

If optional parameters <cx> and <cy> are not supplied, the rotation is about the origin of the current user coordinate system. The operation corresponds to the matrix [cos(a) sin(a) -sin(a) cos(a) 0 0].

If optional parameters <cx> and <cy> are supplied, the rotation is about the point (cx, cy). The operation represents the equivalent of the following specification: translate(<cx>, <cy>) rotate(<rotate-angle>) translate(-<cx>, -<cy>).

skewX(<skew-angle>), which specifies a skew transformation along the x-axis.

skewY(<skew-angle>), which specifies a skew transformation along the y-axis.
    -}
gradientCommand :: Parser GradientPathCommand
gradientCommand :: Parser GradientPathCommand
gradientCommand =
        (Origin -> Maybe RPoint -> GradientPathCommand
GLine Origin
OriginAbsolute (Maybe RPoint -> GradientPathCommand)
-> Parser Text (Maybe RPoint) -> Parser GradientPathCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text Text
string Text
"L" Parser Text Text
-> Parser Text (Maybe RPoint) -> Parser Text (Maybe RPoint)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Maybe RPoint)
mayPoint))
    Parser GradientPathCommand
-> Parser GradientPathCommand -> Parser GradientPathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Origin -> Maybe RPoint -> GradientPathCommand
GLine Origin
OriginRelative (Maybe RPoint -> GradientPathCommand)
-> Parser Text (Maybe RPoint) -> Parser GradientPathCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text Text
string Text
"l" Parser Text Text
-> Parser Text (Maybe RPoint) -> Parser Text (Maybe RPoint)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Maybe RPoint)
mayPoint))
    Parser GradientPathCommand
-> Parser GradientPathCommand -> Parser GradientPathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text Text
string Text
"C" Parser Text Text
-> Parser GradientPathCommand -> Parser GradientPathCommand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Origin -> Parser GradientPathCommand
curveToArgs Origin
OriginAbsolute)
    Parser GradientPathCommand
-> Parser GradientPathCommand -> Parser GradientPathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text Text
string Text
"c" Parser Text Text
-> Parser GradientPathCommand -> Parser GradientPathCommand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Origin -> Parser GradientPathCommand
curveToArgs Origin
OriginRelative)
    Parser GradientPathCommand
-> Parser GradientPathCommand -> Parser GradientPathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GradientPathCommand
GClose GradientPathCommand
-> Parser Text Text -> Parser GradientPathCommand
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"Z")
  where
    mayPoint :: Parser Text (Maybe RPoint)
mayPoint = Maybe RPoint
-> Parser Text (Maybe RPoint) -> Parser Text (Maybe RPoint)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe RPoint
forall a. Maybe a
Nothing (Parser Text (Maybe RPoint) -> Parser Text (Maybe RPoint))
-> Parser Text (Maybe RPoint) -> Parser Text (Maybe RPoint)
forall a b. (a -> b) -> a -> b
$ RPoint -> Maybe RPoint
forall a. a -> Maybe a
Just (RPoint -> Maybe RPoint)
-> Parser RPoint -> Parser Text (Maybe RPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RPoint
point
    curveToArgs :: Origin -> Parser GradientPathCommand
curveToArgs Origin
o =
        Origin -> RPoint -> RPoint -> Maybe RPoint -> GradientPathCommand
GCurve Origin
o (RPoint -> RPoint -> Maybe RPoint -> GradientPathCommand)
-> Parser RPoint
-> Parser Text (RPoint -> Maybe RPoint -> GradientPathCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser RPoint
point Parser RPoint -> Parser () -> Parser RPoint
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
                 Parser Text (RPoint -> Maybe RPoint -> GradientPathCommand)
-> Parser RPoint
-> Parser Text (Maybe RPoint -> GradientPathCommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser RPoint
point Parser RPoint -> Parser () -> Parser RPoint
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
                 Parser Text (Maybe RPoint -> GradientPathCommand)
-> Parser Text (Maybe RPoint) -> Parser GradientPathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (Maybe RPoint)
mayPoint

serializeGradientCommand :: GradientPathCommand -> ShowS
serializeGradientCommand :: GradientPathCommand -> [Char] -> [Char]
serializeGradientCommand GradientPathCommand
p = case GradientPathCommand
p of
  GLine Origin
OriginAbsolute Maybe RPoint
points -> Char -> [Char] -> [Char]
showChar Char
'L' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe RPoint -> [Char] -> [Char]
smp Maybe RPoint
points
  GLine Origin
OriginRelative Maybe RPoint
points -> Char -> [Char] -> [Char]
showChar Char
'l' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe RPoint -> [Char] -> [Char]
smp Maybe RPoint
points
  GradientPathCommand
GClose                      -> Char -> [Char] -> [Char]
showChar Char
'Z'

  GCurve Origin
OriginAbsolute RPoint
a RPoint
b Maybe RPoint
c -> Char -> [Char] -> [Char]
showChar Char
'C' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPoint -> [Char] -> [Char]
sp RPoint
a ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPoint -> [Char] -> [Char]
sp RPoint
b ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe RPoint -> [Char] -> [Char]
smp Maybe RPoint
c
  GCurve Origin
OriginRelative RPoint
a RPoint
b Maybe RPoint
c -> Char -> [Char] -> [Char]
showChar Char
'c' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPoint -> [Char] -> [Char]
sp RPoint
a ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPoint -> [Char] -> [Char]
sp RPoint
b ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe RPoint -> [Char] -> [Char]
smp Maybe RPoint
c
  where
    sp :: RPoint -> [Char] -> [Char]
sp = RPoint -> [Char] -> [Char]
serializePoint
    smp :: Maybe RPoint -> [Char] -> [Char]
smp Maybe RPoint
Nothing   = [Char] -> [Char]
forall a. a -> a
id
    smp (Just RPoint
pp) = RPoint -> [Char] -> [Char]
serializePoint RPoint
pp