module Text.Blaze.Svg.Internal where

import           Control.Monad       (join)
import           Control.Monad.State
import           Data.Monoid         (mappend, mempty)

import           Text.Blaze

-- | Type to represent an SVG document fragment.
type Svg = Markup

toSvg :: ToMarkup a => a -> Svg
toSvg :: forall a. ToMarkup a => a -> Svg
toSvg = forall a. ToMarkup a => a -> Svg
toMarkup

-- | Type to accumulate an SVG path.
type Path = State AttributeValue ()

-- | Construct SVG path values using path instruction combinators.
-- See simple example below of how you can use @mkPath@ to
-- specify a path using the path instruction combinators
-- that are included as part of the same module.
--
-- More information available at: <http://www.w3.org/TR/SVG/paths.html>
--
-- > import Text.Blaze.Svg11 ((!), mkPath, l, m)
-- > import qualified Text.Blaze.Svg11 as S
-- > import qualified Text.Blaze.Svg11.Attributes as A
-- >
-- > svgDoc :: S.Svg
-- > svgDoc = S.docTypeSvg ! A.version "1.1" ! A.width "150" ! A.height "100" $ do
-- >  S.path ! A.d makeSimplePath
-- >
-- > makeSimplePath :: S.AttributeValue
-- > makeSimplePath =  mkPath do
-- >   l 2 3
-- >   m 4 5
mkPath :: Path -> AttributeValue
mkPath :: Path -> AttributeValue
mkPath Path
path = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> (a, s)
runState Path
path forall a. Monoid a => a
mempty

appendToPath :: [String] -> Path
appendToPath :: [String] -> Path
appendToPath  = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToValue a => a -> AttributeValue
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join

-- | Moveto
m :: Show a => a -> a -> Path
m :: forall a. Show a => a -> a -> Path
m a
x a
y = [String] -> Path
appendToPath
  [ String
"M "
  , forall a. Show a => a -> String
show a
x, String
",", forall a. Show a => a -> String
show a
y
  , String
" "
  ]

-- | Moveto (relative)
mr :: Show a => a -> a -> Path
mr :: forall a. Show a => a -> a -> Path
mr a
dx a
dy = [String] -> Path
appendToPath
  [ String
"m "
  , forall a. Show a => a -> String
show a
dx, String
",", forall a. Show a => a -> String
show a
dy
  , String
" "
  ]

-- | ClosePath
z :: Path
z :: Path
z = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Monoid a => a -> a -> a
`mappend` forall a. ToValue a => a -> AttributeValue
toValue String
"Z")

-- | Lineto
l :: Show a => a -> a -> Path
l :: forall a. Show a => a -> a -> Path
l a
x a
y = [String] -> Path
appendToPath
  [ String
"L "
  , forall a. Show a => a -> String
show a
x, String
",", forall a. Show a => a -> String
show a
y
  , String
" "
  ]

-- | Lineto (relative)
lr :: Show a => a -> a -> Path
lr :: forall a. Show a => a -> a -> Path
lr a
dx a
dy = [String] -> Path
appendToPath
  [ String
"l "
  , forall a. Show a => a -> String
show a
dx, String
",", forall a. Show a => a -> String
show a
dy
  , String
" "
  ]

-- | Horizontal lineto
h :: Show a => a -> Path
h :: forall a. Show a => a -> Path
h a
x = [String] -> Path
appendToPath
  [ String
"H "
  , forall a. Show a => a -> String
show a
x
  , String
" "
  ]

-- | Horizontal lineto (relative)
hr :: Show a => a -> Path
hr :: forall a. Show a => a -> Path
hr a
dx = [String] -> Path
appendToPath
  [ String
"h "
  , forall a. Show a => a -> String
show a
dx
  , String
" "
  ]


-- | Vertical lineto
v :: Show a => a -> Path
v :: forall a. Show a => a -> Path
v a
y = [String] -> Path
appendToPath
  [ String
"V "
  , forall a. Show a => a -> String
show a
y
  , String
" "
  ]

-- | Vertical lineto (relative)
vr :: Show a => a -> Path
vr :: forall a. Show a => a -> Path
vr a
dy = [String] -> Path
appendToPath
  [ String
"v "
  , forall a. Show a => a -> String
show a
dy
  , String
" "
  ]

-- | Cubic Bezier curve
c :: Show a => a -> a -> a -> a -> a -> a -> Path
c :: forall a. Show a => a -> a -> a -> a -> a -> a -> Path
c a
c1x a
c1y a
c2x a
c2y a
x a
y = [String] -> Path
appendToPath
  [ String
"C "
  , forall a. Show a => a -> String
show a
c1x, String
",", forall a. Show a => a -> String
show a
c1y
  , String
" "
  , forall a. Show a => a -> String
show a
c2x, String
",", forall a. Show a => a -> String
show a
c2y
  , String
" "
  , forall a. Show a => a -> String
show a
x, String
" ", forall a. Show a => a -> String
show a
y
  ]

-- | Cubic Bezier curve (relative)
cr :: Show a => a -> a -> a -> a -> a -> a -> Path
cr :: forall a. Show a => a -> a -> a -> a -> a -> a -> Path
cr a
dc1x a
dc1y a
dc2x a
dc2y a
dx a
dy = [String] -> Path
appendToPath
  [ String
"c "
  , forall a. Show a => a -> String
show a
dc1x, String
",", forall a. Show a => a -> String
show a
dc1y
  , String
" "
  , forall a. Show a => a -> String
show a
dc2x, String
",", forall a. Show a => a -> String
show a
dc2y
  , String
" "
  , forall a. Show a => a -> String
show a
dx, String
" ", forall a. Show a => a -> String
show a
dy
  ]

-- | Smooth Cubic Bezier curve
s :: Show a => a -> a -> a -> a -> Path
s :: forall a. Show a => a -> a -> a -> a -> Path
s a
c2x a
c2y a
x a
y = [String] -> Path
appendToPath
  [ String
"S "
  , forall a. Show a => a -> String
show a
c2x, String
",", forall a. Show a => a -> String
show a
c2y
  , String
" "
  , forall a. Show a => a -> String
show a
x, String
",", forall a. Show a => a -> String
show a
y
  , String
" "
  ]

-- | Smooth Cubic Bezier curve (relative)
sr :: Show a => a -> a -> a -> a -> Path
sr :: forall a. Show a => a -> a -> a -> a -> Path
sr a
dc2x a
dc2y a
dx a
dy = [String] -> Path
appendToPath
  [ String
"s "
  , forall a. Show a => a -> String
show a
dc2x, String
",", forall a. Show a => a -> String
show a
dc2y
  , String
" "
  , forall a. Show a => a -> String
show a
dx, String
",", forall a. Show a => a -> String
show a
dy
  , String
" "
  ]

-- | Quadratic Bezier curve
q :: Show a => a -> a -> a -> a -> Path
q :: forall a. Show a => a -> a -> a -> a -> Path
q a
cx a
cy a
x a
y = [String] -> Path
appendToPath
  [ String
"Q "
  , forall a. Show a => a -> String
show a
cx, String
",", forall a. Show a => a -> String
show a
cy
  , String
" "
  , forall a. Show a => a -> String
show a
x, String
",", forall a. Show a => a -> String
show a
y
  , String
" "
  ]

-- | Quadratic Bezier curve (relative)
qr :: Show a => a -> a -> a -> a  -> Path
qr :: forall a. Show a => a -> a -> a -> a -> Path
qr a
dcx a
dcy a
dx a
dy = [String] -> Path
appendToPath
  [ String
"q "
  , forall a. Show a => a -> String
show a
dcx, String
",", forall a. Show a => a -> String
show a
dcy
  , String
" "
  , forall a. Show a => a -> String
show a
dx, String
",", forall a. Show a => a -> String
show a
dy
  , String
" "
  ]

-- | Smooth Quadratic Bezier curve
t  :: Show a => a -> a -> Path
t :: forall a. Show a => a -> a -> Path
t a
x a
y = [String] -> Path
appendToPath
  [ String
"T "
  , String
" "
  , forall a. Show a => a -> String
show a
x, String
",", forall a. Show a => a -> String
show a
y
  , String
" "
  ]

-- | Smooth Quadratic Bezier curve (relative)
tr :: Show a => a -> a -> Path
tr :: forall a. Show a => a -> a -> Path
tr a
x a
y = [String] -> Path
appendToPath
  [ String
"t "
  , String
" "
  , forall a. Show a => a -> String
show a
x, String
",", forall a. Show a => a -> String
show a
y
  , String
" "
  ]

-- | Elliptical Arc (absolute).
--
--   Note that this function is an alias for the function
--   'Text.Blaze.Svg.Internal.a', defined in
--   "Text.Blaze.Svg.Internal". 'aa' is exported from "Text.Blaze.Svg"
--   instead of 'a' due to naming conflicts with 'Text.Blaze.SVG11.a'
--   from "Text.Blaze.SVG11".
aa
  :: Show a
  => a -- ^ Radius in the x-direction
  -> a -- ^ Radius in the y-direction
  -> a -- ^ The rotation of the arc's x-axis compared to the normal x-axis
  -> Bool -- ^ Draw the smaller or bigger arc satisfying the start point
  -> Bool -- ^ To mirror or not
  -> a -- ^ The x-coordinate of the end point
  -> a -- ^ The y-coordinate of the end point
  -> Path
aa :: forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa = forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
a

-- | Elliptical Arc (absolute). This is the internal definition for absolute
--   arcs. It is not exported but instead exported as 'aa' due to naming
--   conflicts with 'Text.Blaze.SVG11.a'.
a
  :: Show a
  => a -- ^ Radius in the x-direction
  -> a -- ^ Radius in the y-direction
  -> a -- ^ The rotation of the arc's x-axis compared to the normal x-axis
  -> Bool -- ^ True to draw the larger of the two arcs satisfying constraints.
  -> Bool -- ^ To mirror or not
  -> a -- ^ The x-coordinate of the end point
  -> a -- ^ The y-coordinate of the end point
  -> Path
a :: forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
a a
rx a
ry a
xAxisRotation Bool
largeArcFlag Bool
sweepFlag a
x a
y = [String] -> Path
appendToPath
  [ String
"A "
  , forall a. Show a => a -> String
show a
rx, String
",", forall a. Show a => a -> String
show a
ry, String
" "
  , forall a. Show a => a -> String
show a
xAxisRotation, String
" "
  , if Bool
largeArcFlag then String
"1" else String
"0", String
",", if Bool
sweepFlag then String
"1" else String
"0", String
" "
  , forall a. Show a => a -> String
show a
x, String
",", forall a. Show a => a -> String
show a
y, String
" "
  ]

-- | Elliptical Arc (relative)
ar
  :: Show a
  => a -- ^ Radius in the x-direction
  -> a -- ^ Radius in the y-direction
  -> a -- ^ The rotation of the arc's x-axis compared to the normal x-axis
  -> Bool -- ^ True to draw the larger of the two arcs satisfying constraints.
  -> Bool -- ^ To mirror or not
  -> a -- ^ The x-coordinate of the end point
  -> a -- ^ The y-coordinate of the end point
  -> Path
ar :: forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
ar a
rx a
ry a
xAxisRotation Bool
largeArcFlag Bool
sweepFlag a
x a
y = [String] -> Path
appendToPath
  [ String
"a "
  , forall a. Show a => a -> String
show a
rx, String
",", forall a. Show a => a -> String
show a
ry, String
" "
  , forall a. Show a => a -> String
show a
xAxisRotation, String
" "
  , if Bool
largeArcFlag then String
"1" else String
"0", String
",", if Bool
sweepFlag then String
"1" else String
"0", String
" "
  , forall a. Show a => a -> String
show a
x, String
",", forall a. Show a => a -> String
show a
y, String
" "
  ]

-- | Specifies a translation by @x@ and @y@
translate :: Show a => a -> a -> AttributeValue
translate :: forall a. Show a => a -> a -> AttributeValue
translate a
x a
y = forall a. ToValue a => a -> AttributeValue
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$
  [ String
"translate("
  , forall a. Show a => a -> String
show a
x, String
" ", forall a. Show a => a -> String
show a
y
  , String
")"
  ]

-- | Specifies a scale operation by @x@ and @y@
scale :: Show a => a -> a -> AttributeValue
scale :: forall a. Show a => a -> a -> AttributeValue
scale a
x a
y = forall a. ToValue a => a -> AttributeValue
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$
  [ String
"scale("
  , forall a. Show a => a -> String
show a
x, String
" ", forall a. Show a => a -> String
show a
y
  , String
")"
  ]

-- | Specifies a rotation by @rotate-angle@ degrees
rotate :: Show a => a -> AttributeValue
rotate :: forall a. Show a => a -> AttributeValue
rotate a
rotateAngle = forall a. ToValue a => a -> AttributeValue
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$
  [ String
"rotate("
  , forall a. Show a => a -> String
show a
rotateAngle
  , String
")"
  ]

-- | Specifies a rotation by @rotate-angle@ degrees about the given time @rx,ry@
rotateAround :: Show a => a -> a -> a -> AttributeValue
rotateAround :: forall a. Show a => a -> a -> a -> AttributeValue
rotateAround a
rotateAngle a
rx a
ry = forall a. ToValue a => a -> AttributeValue
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$
  [ String
"rotate("
  , forall a. Show a => a -> String
show a
rotateAngle, String
","
  , forall a. Show a => a -> String
show a
rx, String
",", forall a. Show a => a -> String
show a
ry
  , String
")"
  ]

-- | Skew tansformation along x-axis
skewX :: Show a => a -> AttributeValue
skewX :: forall a. Show a => a -> AttributeValue
skewX a
skewAngle = forall a. ToValue a => a -> AttributeValue
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$
  [ String
"skewX("
  , forall a. Show a => a -> String
show a
skewAngle
  , String
")"
  ]

-- | Skew tansformation along y-axis
skewY :: Show a => a -> AttributeValue
skewY :: forall a. Show a => a -> AttributeValue
skewY a
skewAngle = forall a. ToValue a => a -> AttributeValue
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$
  [ String
"skewY("
  , forall a. Show a => a -> String
show a
skewAngle
  , String
")"
  ]

-- | Specifies a transform in the form of a transformation matrix
matrix :: Show a => a -> a -> a -> a -> a -> a -> AttributeValue
matrix :: forall a. Show a => a -> a -> a -> a -> a -> a -> AttributeValue
matrix a
a_ a
b a
c_ a
d a
e a
f =  forall a. ToValue a => a -> AttributeValue
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$
  [  String
"matrix("
  ,  forall a. Show a => a -> String
show a
a_, String
","
  ,  forall a. Show a => a -> String
show a
b, String
","
  ,  forall a. Show a => a -> String
show a
c_, String
","
  ,  forall a. Show a => a -> String
show a
d, String
","
  ,  forall a. Show a => a -> String
show a
e, String
","
  ,  forall a. Show a => a -> String
show a
f
  , String
")"
  ]