{-# LANGUAGE OverloadedStrings #-}

module Geometry.SvgParser (parse, SvgElement(..)) where



import           Data.Text (Text)
import qualified Data.Text as T

import           Geometry.Bezier
import           Geometry.Core
import qualified Geometry.SvgParser.PathParser   as PathParser
import qualified Geometry.SvgParser.SimpleShapes as SimpleShapes



data SvgElement
    = SvgLine Line
    | SvgCircle Circle
    | SvgEllipse Ellipse
    | SvgPath [[Either Line Bezier]] -- ^ List of poly-bezier-lines.
    deriving (Int -> SvgElement -> ShowS
[SvgElement] -> ShowS
SvgElement -> String
(Int -> SvgElement -> ShowS)
-> (SvgElement -> String)
-> ([SvgElement] -> ShowS)
-> Show SvgElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SvgElement -> ShowS
showsPrec :: Int -> SvgElement -> ShowS
$cshow :: SvgElement -> String
show :: SvgElement -> String
$cshowList :: [SvgElement] -> ShowS
showList :: [SvgElement] -> ShowS
Show)

instance HasBoundingBox SvgElement where
    boundingBox :: SvgElement -> BoundingBox
boundingBox (SvgLine Line
x) = Line -> BoundingBox
forall a. HasBoundingBox a => a -> BoundingBox
boundingBox Line
x
    boundingBox (SvgCircle Circle
x) = Circle -> BoundingBox
forall a. HasBoundingBox a => a -> BoundingBox
boundingBox Circle
x
    boundingBox (SvgEllipse Ellipse
x) = Ellipse -> BoundingBox
forall a. HasBoundingBox a => a -> BoundingBox
boundingBox Ellipse
x
    boundingBox (SvgPath [[Either Line Bezier]]
x) = [[Either Line Bezier]] -> BoundingBox
forall a. HasBoundingBox a => a -> BoundingBox
boundingBox [[Either Line Bezier]]
x

-- | Parse the input line-wise into various SVG elements.
--
-- * @<g>@ paths: @M413.654,295.115c0,0-1.283-13.865,12.717-19.615@
-- * Line elements: @LINE x1 y1 x2 y2@
-- * Circles: @CIRCLE cx cy r@
-- * Ellipses: @ELLIPSE cx cy rx ry@
--
-- This is not a full SVG parser, but in practice it’s much easier to edit an SVG
-- source file to extract all <g> element contents to a line rather than writing a
-- full-fledged SVG parser.
parse :: Text -> Either Text SvgElement
parse :: Text -> Either Text SvgElement
parse Text
input = case Text -> Either Text [[Either Line Bezier]]
PathParser.parse Text
input of
    Right [[Either Line Bezier]]
path -> SvgElement -> Either Text SvgElement
forall a b. b -> Either a b
Right ([[Either Line Bezier]] -> SvgElement
SvgPath [[Either Line Bezier]]
path)
    Left Text
pathErr -> case Text -> Either Text SimpleShape
SimpleShapes.parse Text
input of
        Right (SimpleShapes.SvgLine Line
line) -> SvgElement -> Either Text SvgElement
forall a b. b -> Either a b
Right (Line -> SvgElement
SvgLine Line
line)
        Right (SimpleShapes.SvgCircle Circle
circle) -> SvgElement -> Either Text SvgElement
forall a b. b -> Either a b
Right (Circle -> SvgElement
SvgCircle Circle
circle)
        Right (SimpleShapes.SvgEllipse Ellipse
ellipse) -> SvgElement -> Either Text SvgElement
forall a b. b -> Either a b
Right (Ellipse -> SvgElement
SvgEllipse Ellipse
ellipse)
        Left Text
shapeErr -> Text -> Either Text SvgElement
forall a b. a -> Either a b
Left (Text -> Text -> Text -> Text
errorMsg Text
input Text
pathErr Text
shapeErr)

errorMsg :: Text -> Text -> Text -> Text
errorMsg :: Text -> Text -> Text -> Text
errorMsg Text
input Text
pathErr Text
shapeErr = [Text] -> Text
T.unlines
    [ Text
"None of the parsers succeeded for input:"
    , Text
input
    , Text
"All the different parser errors were:"
    , Text
pathErr
    , Text
shapeErr
    ]