{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE AllowAmbiguousTypes          #-}
{-# LANGUAGE QuantifiedConstraints          #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Miso.Svg.Writer
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Render geometric objects to Svg files through miso
--
--------------------------------------------------------------------------------
module HGeometry.Miso.Svg.Writer
  ( withAts
  , Drawable(..)

  , dPoint
  , dLineSegment
  , dRectangle
  , dCircle
  , dDisk
  , dPolyLine
  , dSimplePolygon

  , SvgWriteAttributes(..)
  ) where

import           Control.Lens
import qualified Data.Foldable as F
import           HGeometry.Ball
import           HGeometry.Box
import           HGeometry.Ext
import           HGeometry.Foldable.Util
import           HGeometry.LineSegment
import           HGeometry.Miso.OrphanInstances ()
import           HGeometry.Point
import           HGeometry.PolyLine
import           HGeometry.Number.Radical
import           Prelude hiding (sqrt)
import           HGeometry.Polygon.Convex
import           HGeometry.Polygon.Simple
import           HGeometry.Vector
import qualified Ipe
import           Ipe.Attributes
import           Miso (Attribute, View, text)
import           Miso.String (MisoString, ToMisoString(..), ms)
import qualified Miso.String.Util as MisoString
import           Miso.Svg
import           Miso.Svg.Property
import           Miso.Html.Property (width_,height_) -- not sure if this is correct (namespace)!
import           Barbies

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


-- | Helper function to construct drawing functions. I..e it allows
-- you do pre-specify a bunch of attributes that should be drawn
-- (ats1) yet allow more attributes to be added by the user later.
withAts             ::  ([Attribute model action] -> View context props model action)
                    -> [Attribute model action] -> [Attribute model action]
                    -> View context props model action
withAts :: forall model action context props.
([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
withAts [Attribute model action] -> View context props model action
f [Attribute model action]
ats1 [Attribute model action]
ats2 = [Attribute model action] -> View context props model action
f ([Attribute model action]
ats1 [Attribute model action]
-> [Attribute model action] -> [Attribute model action]
forall a. Semigroup a => a -> a -> a
<> [Attribute model action]
ats2)

--------------------------------------------------------------------------------
-- * Default implementations for drawing geometric objects

-- -- | Default implementation for drawing geometric objects
class Drawable t where
  {-# MINIMAL draw | drawWith #-}
  -- | Draws the given object with the given attributes
  draw       :: t -> [Attribute model action] -> View context props model action
  draw t
x [Attribute model action]
ats = t
-> [Attribute model action]
-> [View context props model action]
-> View context props model action
forall t model action context props.
Drawable t =>
t
-> [Attribute model action]
-> [View context props model action]
-> View context props model action
forall model action context props.
t
-> [Attribute model action]
-> [View context props model action]
-> View context props model action
drawWith t
x [Attribute model action]
ats []

  -- | draw the given object, as well as the given "children"
  drawWith          :: t -> [Attribute model action]
                    -> [View context props model action]
                    -> View context props model action
  drawWith t
x [Attribute model action]
ats [View context props model action]
_b = t -> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
t -> [Attribute model action] -> View context props model action
draw t
x [Attribute model action]
ats

instance (Drawable l, Drawable r) => Drawable (Either l r) where
  draw :: forall model action context props.
Either l r
-> [Attribute model action] -> View context props model action
draw = (l -> [Attribute model action] -> View context props model action)
-> (r
    -> [Attribute model action] -> View context props model action)
-> Either l r
-> [Attribute model action]
-> View context props model action
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either l -> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
l -> [Attribute model action] -> View context props model action
draw r -> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
r -> [Attribute model action] -> View context props model action
draw

instance ToMisoString r => Drawable (Point 2 r) where
  draw :: forall model action context props.
Point 2 r
-> [Attribute model action] -> View context props model action
draw = Point 2 r
-> [Attribute model action] -> View context props model action
forall point r model action context props.
(Point_ point 2 r, ToMisoString r) =>
point
-> [Attribute model action] -> View context props model action
dPoint

instance (Point_ point 2 r, ToMisoString r, Num r) => Drawable (Rectangle point) where
  draw :: forall model action context props.
Rectangle point
-> [Attribute model action] -> View context props model action
draw = Rectangle point
-> [Attribute model action] -> View context props model action
forall rectangle point r model action context props.
(Rectangle_ rectangle point, Point_ point 2 r, ToMisoString r,
 Num r) =>
rectangle
-> [Attribute model action] -> View context props model action
dRectangle

instance ( Point_ point 2 r, EndPoint_ (endPoint point), IxValue (endPoint point) ~ point
         , ToMisoString r) => Drawable (LineSegment endPoint point) where
  draw :: forall model action context props.
LineSegment endPoint point
-> [Attribute model action] -> View context props model action
draw = LineSegment endPoint point
-> [Attribute model action] -> View context props model action
forall lineSegment point r model action context props.
(LineSegment_ lineSegment point, Point_ point 2 r,
 ToMisoString r) =>
lineSegment
-> [Attribute model action] -> View context props model action
dLineSegment

instance ( Point_ point 2 r, ToMisoString r
         , Traversable1 f
         , Ixed (f point), IxValue (f point) ~ point, Index (f point) ~ Int
         , HasFromFoldable1 f
         , TraversableWithIndex Int f
         ) => Drawable (PolyLineF f point) where
  draw :: forall model action context props.
PolyLineF f point
-> [Attribute model action] -> View context props model action
draw = PolyLineF f point
-> [Attribute model action] -> View context props model action
forall polyLine point r model action context props.
(PolyLine_ polyLine point, Point_ point 2 r, ToMisoString r) =>
polyLine
-> [Attribute model action] -> View context props model action
dPolyLine

instance ( Point_ point 2 r, VertexContainer f point, HasFromFoldable1 f
         , ToMisoString r) => Drawable (SimplePolygonF f point) where
 draw :: forall model action context props.
SimplePolygonF f point
-> [Attribute model action] -> View context props model action
draw = SimplePolygonF f point
-> [Attribute model action] -> View context props model action
forall simplePolygon point r model action context props.
(SimplePolygon_ simplePolygon point r, ToMisoString r) =>
simplePolygon
-> [Attribute model action] -> View context props model action
dSimplePolygon

instance ( Point_ point 2 r, VertexContainer f point, HasFromFoldable1 f
         , ToMisoString r) => Drawable (ConvexPolygonF f point) where
  draw :: forall model action context props.
ConvexPolygonF f point
-> [Attribute model action] -> View context props model action
draw = SimplePolygonF f point
-> [Attribute model action] -> View context props model action
forall simplePolygon point r model action context props.
(SimplePolygon_ simplePolygon point r, ToMisoString r) =>
simplePolygon
-> [Attribute model action] -> View context props model action
dSimplePolygon (SimplePolygonF f point
 -> [Attribute model action] -> View context props model action)
-> (ConvexPolygonF f point -> SimplePolygonF f point)
-> ConvexPolygonF f point
-> [Attribute model action]
-> View context props model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygonF f point -> SimplePolygonF f point
forall {k} (f :: k -> *) (point :: k).
ConvexPolygonF f point -> SimplePolygonF f point
toSimplePolygon

instance (Point_ point 2 r, Radical r, ToMisoString r) => Drawable (Circle point) where
  draw :: forall model action context props.
Circle point
-> [Attribute model action] -> View context props model action
draw = Circle point
-> [Attribute model action] -> View context props model action
forall point r model action context props.
(Point_ point 2 r, ToMisoString r, Radical r) =>
Circle point
-> [Attribute model action] -> View context props model action
dCircle

instance (Point_ point 2 r, ToMisoString r, Radical r) => Drawable (Disk point) where
  draw :: forall model action context props.
Disk point
-> [Attribute model action] -> View context props model action
draw = Disk point
-> [Attribute model action] -> View context props model action
forall disk point r model action context props.
(Disk_ disk point, ConstructableBall_ disk point, Point_ point 2 r,
 ToMisoString r, Radical r) =>
disk -> [Attribute model action] -> View context props model action
dDisk

-- instance ToMisoString r => Drawable (Viewport r) where
--   draw = error
--   drawWith vp ats content = withAts' svg_ [ height_ $ ms h <> "px"
--                                           , viewbox_ outerVB
--                                           ] ats
--                                           [ g_ [] -- do the transorm here
--                                                [ svg_ [ width_ "100%"
--                                                       , height "100%"
--                                                       , viewbox innerVB
--                                                       ]
--                                                       content
--                                                ]
--                                           ]
--     where
--       toVB = MisoString.unwords . map ms
--       outerVB = toVB [0, (-1) * h, w, h]
--             -- the role of the outer viewBox is to flip the coordinate
--             -- system s.t. the origin is in the bottom left rather
--             -- than the top-left
--       innerVB = toVB [lx, ly, vw, vh]




--------------------------------------------------------------------------------
-- * Functions to draw geometric objects

-- | Draw a point
dPoint   :: (Point_ point 2 r, ToMisoString r) => point
         -> [Attribute model action] -> View context props model action
dPoint :: forall point r model action context props.
(Point_ point 2 r, ToMisoString r) =>
point
-> [Attribute model action] -> View context props model action
dPoint point
p = ([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
forall model action context props.
([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
withAts [Attribute model action] -> View context props model action
forall model action context props.
[Attribute model action] -> View context props model action
ellipse_ [ MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
cx_ (r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> MisoString) -> r -> MisoString
forall a b. (a -> b) -> a -> b
$ point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord), MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
cy_ (r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> MisoString) -> r -> MisoString
forall a b. (a -> b) -> a -> b
$ point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
                            , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
rx_ MisoString
"5", MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
ry_ MisoString
"5"
                            ]

-- | Draw a rectangle
dRectangle   :: ( Rectangle_ rectangle point, Point_ point 2 r, ToMisoString r, Num r)
             => rectangle -> [Attribute model action] -> View context props model action
dRectangle :: forall rectangle point r model action context props.
(Rectangle_ rectangle point, Point_ point 2 r, ToMisoString r,
 Num r) =>
rectangle
-> [Attribute model action] -> View context props model action
dRectangle rectangle
b = let Point2 MisoString
x MisoString
y  = ASetter (Point 2 r) (Point 2 MisoString) r MisoString
-> (r -> MisoString) -> Point 2 r -> Point 2 MisoString
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Point 2 r) (Point 2 MisoString) r MisoString
(NumType (Point 2 r) -> Identity (NumType (Point 2 MisoString)))
-> Point 2 r -> Identity (Point 2 MisoString)
forall point point'.
HasCoordinates point point' =>
IndexedTraversal1 Int point point' (NumType point) (NumType point')
IndexedTraversal1
  Int
  (Point 2 r)
  (Point 2 MisoString)
  (NumType (Point 2 r))
  (NumType (Point 2 MisoString))
coordinates r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Point 2 r -> Point 2 MisoString)
-> Point 2 r -> Point 2 MisoString
forall a b. (a -> b) -> a -> b
$ rectangle
brectangle -> Getting (Point 2 r) rectangle (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> rectangle -> Const (Point 2 r) rectangle
forall box point. HasMinPoint box point => Lens' box point
Lens' rectangle point
minPoint((point -> Const (Point 2 r) point)
 -> rectangle -> Const (Point 2 r) rectangle)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) rectangle (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint
                   Vector2 MisoString
w MisoString
h = r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> MisoString) -> Vector 2 r -> Vector 2 MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> rectangle
brectangle
-> Getting (Vector 2 r) rectangle (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.(rectangle -> Vector 2 r)
-> Getting (Vector 2 r) rectangle (Vector 2 r)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to rectangle -> Vector 2 r
forall box (d :: Nat) point r.
(Box_ box point, Point_ point d r, Num r, Functor (Vector d)) =>
box -> Vector d r
size
               in ([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
forall model action context props.
([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
withAts [Attribute model action] -> View context props model action
forall model action context props.
[Attribute model action] -> View context props model action
rect_ [ MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
x_ MisoString
x, MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
y_ MisoString
y, MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
width_ MisoString
w, MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
height_ MisoString
h
                                 , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
strokeLinejoin_ MisoString
"round"
                                ]

-- | Draw a simple polygon
dSimplePolygon    :: (SimplePolygon_ simplePolygon point r, ToMisoString r)
                  => simplePolygon -> [Attribute model action] -> View context props model action
dSimplePolygon :: forall simplePolygon point r model action context props.
(SimplePolygon_ simplePolygon point r, ToMisoString r) =>
simplePolygon
-> [Attribute model action] -> View context props model action
dSimplePolygon simplePolygon
pg = ([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
forall model action context props.
([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
withAts [Attribute model action] -> View context props model action
forall model action context props.
[Attribute model action] -> View context props model action
polygon_ [ MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
points_ (MisoString -> Attribute model action)
-> MisoString -> Attribute model action
forall a b. (a -> b) -> a -> b
$ [point] -> MisoString
forall point r (f :: * -> *).
(Point_ point 2 r, ToMisoString r, Foldable f) =>
f point -> MisoString
toPointsString ([point] -> MisoString) -> [point] -> MisoString
forall a b. (a -> b) -> a -> b
$ simplePolygon
pgsimplePolygon
-> Getting (Endo [point]) simplePolygon point -> [point]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting (Endo [point]) simplePolygon point
(Vertex simplePolygon
 -> Const (Endo [point]) (Vertex simplePolygon))
-> simplePolygon -> Const (Endo [point]) simplePolygon
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx simplePolygon)
  simplePolygon
  simplePolygon
  (Vertex simplePolygon)
  (Vertex simplePolygon)
vertices
                                     , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
strokeLinejoin_ MisoString
"round"
                                     ]


  -- \case
  --   SimplePolygon vs   ->
  --   MultiPolygon vs hs -> withAts path_ [d_ s]
  --     where
  --       s = mconcat . map toSimplePolygonPathString $ vs : hs


-- toSimplePolygonPathString                    :: ToMisoString r => SimplePolygon p r -> MisoString
-- toSimplePolygonPathString (SimplePolygon vs) = mconcat [ "M", toOp p
--                                                        , mconcat $ map (\q -> "L" <> toOp q) ps
--                                                        , "Z"
--                                                        ]
  -- where
  --   p :| ps = F1.toNonEmpty vs
  --   toOp (Point2 x y :+ _) = ms x <> " " <> ms y <> " "


-- | Draw a polyline
dPolyLine    :: (PolyLine_ polyLine point, Point_ point 2 r, ToMisoString r)
             => polyLine -> [Attribute model action] -> View context props model action
dPolyLine :: forall polyLine point r model action context props.
(PolyLine_ polyLine point, Point_ point 2 r, ToMisoString r) =>
polyLine
-> [Attribute model action] -> View context props model action
dPolyLine polyLine
pl = ([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
forall model action context props.
([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
withAts [Attribute model action] -> View context props model action
forall model action context props.
[Attribute model action] -> View context props model action
polyline_ [ MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
points_ (MisoString -> Attribute model action)
-> ([point] -> MisoString) -> [point] -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [point] -> MisoString
forall point r (f :: * -> *).
(Point_ point 2 r, ToMisoString r, Foldable f) =>
f point -> MisoString
toPointsString ([point] -> Attribute model action)
-> [point] -> Attribute model action
forall a b. (a -> b) -> a -> b
$ polyLine
plpolyLine -> Getting (Endo [point]) polyLine point -> [point]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting (Endo [point]) polyLine point
(Vertex polyLine -> Const (Endo [point]) (Vertex polyLine))
-> polyLine -> Const (Endo [point]) polyLine
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx polyLine)
  polyLine
  polyLine
  (Vertex polyLine)
  (Vertex polyLine)
vertices
                                 , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
strokeLinejoin_ MisoString
"round"
                                 ]

-- | Draw a line segment
dLineSegment   :: ( LineSegment_ lineSegment point, Point_ point 2 r, ToMisoString r)
               => lineSegment -> [Attribute model action] -> View context props model action
dLineSegment :: forall lineSegment point r model action context props.
(LineSegment_ lineSegment point, Point_ point 2 r,
 ToMisoString r) =>
lineSegment
-> [Attribute model action] -> View context props model action
dLineSegment lineSegment
s = ([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
forall model action context props.
([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
withAts [Attribute model action] -> View context props model action
forall model action context props.
[Attribute model action] -> View context props model action
polyline_ [ MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
points_ (MisoString -> Attribute model action)
-> MisoString -> Attribute model action
forall a b. (a -> b) -> a -> b
$ [point] -> MisoString
forall point r (f :: * -> *).
(Point_ point 2 r, ToMisoString r, Foldable f) =>
f point -> MisoString
toPointsString [lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start, lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end] ]

-- | constructs a list of points to be used in the 'points' svg attribute.
toPointsString :: (Point_ point 2 r, ToMisoString r, Foldable f) => f point -> MisoString
toPointsString :: forall point r (f :: * -> *).
(Point_ point 2 r, ToMisoString r, Foldable f) =>
f point -> MisoString
toPointsString =
  [MisoString] -> MisoString
MisoString.unwords ([MisoString] -> MisoString)
-> (f point -> [MisoString]) -> f point -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (point -> MisoString) -> [point] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
map (\(Point2_ r
x r
y) -> [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat [r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms r
x, MisoString
",", r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms r
y]) ([point] -> [MisoString])
-> (f point -> [point]) -> f point -> [MisoString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f point -> [point]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList


-- | Draw a circle
dCircle              :: (Point_ point 2 r, ToMisoString r, Radical r)
                     => Circle point -> [Attribute model action]
                     -> View context props model action
dCircle :: forall point r model action context props.
(Point_ point 2 r, ToMisoString r, Radical r) =>
Circle point
-> [Attribute model action] -> View context props model action
dCircle (Circle point
c NumType point
r) = ([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
forall model action context props.
([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
withAts [Attribute model action] -> View context props model action
forall model action context props.
[Attribute model action] -> View context props model action
ellipse_ [ MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
rx_ (MisoString -> Attribute model action)
-> (r -> MisoString) -> r -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute model action) -> r -> Attribute model action
forall a b. (a -> b) -> a -> b
$ r -> r
forall r. Radical r => r -> r
sqrt r
NumType point
r
                                        , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
ry_ (MisoString -> Attribute model action)
-> (r -> MisoString) -> r -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute model action) -> r -> Attribute model action
forall a b. (a -> b) -> a -> b
$ r -> r
forall r. Radical r => r -> r
sqrt r
NumType point
r
                                        , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
cx_ (MisoString -> Attribute model action)
-> (r -> MisoString) -> r -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute model action) -> r -> Attribute model action
forall a b. (a -> b) -> a -> b
$ point
cpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord
                                        , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
cy_ (MisoString -> Attribute model action)
-> (r -> MisoString) -> r -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute model action) -> r -> Attribute model action
forall a b. (a -> b) -> a -> b
$ point
cpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord
                                        ]

-- | Draw a disk
dDisk             :: ( Disk_ disk point, ConstructableBall_ disk point
                     , Point_ point 2 r, ToMisoString r, Radical r)
                  => disk -> [Attribute model action] -> View context props model action
dDisk :: forall disk point r model action context props.
(Disk_ disk point, ConstructableBall_ disk point, Point_ point 2 r,
 ToMisoString r, Radical r) =>
disk -> [Attribute model action] -> View context props model action
dDisk (Disk_ point
c NumType disk
r) = Circle point
-> [Attribute model action] -> View context props model action
forall point r model action context props.
(Point_ point 2 r, ToMisoString r, Radical r) =>
Circle point
-> [Attribute model action] -> View context props model action
dCircle (point -> NumType point -> Circle point
forall point. point -> NumType point -> Circle point
Circle point
c NumType disk
NumType point
r)

-- instance (ToMisoString r, Drawable v, Drawable  => Drawable (PlanarSubdivision s v e f r)


-- dPlanarSubdivision        :: PlanarSubdivision s (Maybe (View context props model action))
--                                                  (Maybe (View context props model action))
--                                                  (Maybe (View context props model action)) r
--                           -> [Attribute model action] -> View context props model action
-- dPlanarSubdivision = dPlanarSubdivisionWith (^._2.vData) (^._2.extra) (^._2.extra)


-- -- | Draws only the values for which we have a Just attribute
-- dPlanarSubdivision' :: (ToMisoString r)
--                     => PlanarSubdivision s (Maybe (Ipe.IpeAttributes Ipe.IpeSymbol r))
--                                            (Maybe (Ipe.IpeAttributes Ipe.Path r))
--                                            (Maybe (Ipe.IpeAttributes Ipe.Path r)) r
--                     -> [Attribute model action]
--                     -> View context props model action
-- dPlanarSubdivision' = dPlanarSubdivisionWith fv fe ff
--   where
--     fv (_,v) = (\ats -> draw (v^.location) (svgWriteAttrs ats)) <$> v^.vData
--     fe (_,e) = (\ats -> draw (e^.core)     (svgWriteAttrs ats)) <$> e^.extra
--     ff (_,f) = (\ats -> draw (f^.core)     (svgWriteAttrs ats)) <$> f^.extra


-- type DrawF a action = a -> Maybe (View context props model action)

-- dPlanarSubdivisionWith                 :: DrawF (VertexId' s, VertexData r v)          action
--                                        -> DrawF (Dart s,      LineSegment 2 v r :+ e)  action
--                                        -> DrawF (FaceId' s,   SomePolygon v r :+ f)    action
--                                        -> PlanarSubdivision s v e f r
--                                        -> [Attribute model action]
--                                        -> View context props model action
-- dPlanarSubdivisionWith fv fe ff ps ats = g_ ats (fs <> es <> vs)
--     -- draw faces at the bottom, then edges, and finally the vertices
--   where
--     vs = mapMaybe fv . F.toList . vertices        $ ps
--     es = mapMaybe fe . F.toList . edgeSegments    $ ps
--     fs = mapMaybe ff . F.toList . rawFacePolygons $ ps

--------------------------------------------------------------------------------
-- * Functions to draw ipe objects

instance ToMisoString r => Drawable (Ipe.IpeObject r) where
  draw :: forall model action context props.
IpeObject r
-> [Attribute model action] -> View context props model action
draw = \case
    Ipe.IpeGroup IpeObject' Group r
g     -> (Group r :+ GroupAttributes r)
-> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
(Group r :+ GroupAttributes r)
-> [Attribute model action] -> View context props model action
draw Group r :+ GroupAttributes r
IpeObject' Group r
g
    Ipe.IpeImage IpeObject' Image r
i     -> (Image r :+ ImageAttributes r)
-> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
(Image r :+ ImageAttributes r)
-> [Attribute model action] -> View context props model action
draw Image r :+ ImageAttributes r
IpeObject' Image r
i
    Ipe.IpeTextLabel IpeObject' TextLabel r
t -> (TextLabel r :+ TextAttributes r)
-> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
(TextLabel r :+ TextAttributes r)
-> [Attribute model action] -> View context props model action
draw TextLabel r :+ TextAttributes r
IpeObject' TextLabel r
t
    Ipe.IpeMiniPage IpeObject' MiniPage r
m  -> (MiniPage r :+ TextAttributes r)
-> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
(MiniPage r :+ TextAttributes r)
-> [Attribute model action] -> View context props model action
draw MiniPage r :+ TextAttributes r
IpeObject' MiniPage r
m
    Ipe.IpeUse IpeObject' IpeSymbol r
u       -> (IpeSymbol r :+ SymbolAttributes r)
-> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
(IpeSymbol r :+ SymbolAttributes r)
-> [Attribute model action] -> View context props model action
draw IpeSymbol r :+ SymbolAttributes r
IpeObject' IpeSymbol r
u
    Ipe.IpePath IpeObject' Path r
p      -> (Path r :+ PathAttributes r)
-> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
(Path r :+ PathAttributes r)
-> [Attribute model action] -> View context props model action
draw Path r :+ PathAttributes r
IpeObject' Path r
p

instance ( Drawable g
         , ToMisoString r
         , forall action. SvgWriteAttributes (ats r) action
         ) => Drawable (g :+ ats r Maybe) where
  draw :: forall model action context props.
(g :+ ats r Maybe)
-> [Attribute model action] -> View context props model action
draw (g
i :+ ats r Maybe
iAts) [Attribute model action]
ats = g -> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
g -> [Attribute model action] -> View context props model action
draw g
i (forall (ats :: (* -> *) -> *) action model.
SvgWriteAttributes ats action =>
ats Maybe -> [Attribute model action]
svgWriteAttrs @(ats r) ats r Maybe
iAts [Attribute model action]
-> [Attribute model action] -> [Attribute model action]
forall a. Semigroup a => a -> a -> a
<> [Attribute model action]
ats)

instance ToMisoString r => Drawable (Ipe.Group r) where
  draw :: forall model action context props.
Group r
-> [Attribute model action] -> View context props model action
draw (Ipe.Group [IpeObject r]
os) [Attribute model action]
ats = [Attribute model action]
-> [View context props model action]
-> View context props model action
forall model action context props.
[Attribute model action]
-> [View context props model action]
-> View context props model action
g_ [Attribute model action]
ats ((IpeObject r -> View context props model action)
-> [IpeObject r] -> [View context props model action]
forall a b. (a -> b) -> [a] -> [b]
map ((IpeObject r
 -> [Attribute model action] -> View context props model action)
-> [Attribute model action]
-> IpeObject r
-> View context props model action
forall a b c. (a -> b -> c) -> b -> a -> c
flip IpeObject r
-> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
IpeObject r
-> [Attribute model action] -> View context props model action
draw []) [IpeObject r]
os)

instance ToMisoString r => Drawable (Ipe.Image r) where
  draw :: forall model action context props.
Image r
-> [Attribute model action] -> View context props model action
draw Image r
_ [Attribute model action]
ats = [Attribute model action]
-> [View context props model action]
-> View context props model action
forall model action context props.
[Attribute model action]
-> [View context props model action]
-> View context props model action
text_ [Attribute model action]
ats [MisoString -> View context props model action
forall context props model action.
MisoString -> View context props model action
text MisoString
"image"]
instance ToMisoString r => Drawable (Ipe.TextLabel r) where
  draw :: forall model action context props.
TextLabel r
-> [Attribute model action] -> View context props model action
draw (Ipe.Label MisoString
t Point 2 r
p) [Attribute model action]
ats = [Attribute model action]
-> [View context props model action]
-> View context props model action
forall model action context props.
[Attribute model action]
-> [View context props model action]
-> View context props model action
text_ ([ MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
transform_ (MisoString -> Attribute model action)
-> MisoString -> Attribute model action
forall a b. (a -> b) -> a -> b
$ Point 2 r -> MisoString
forall r. ToMisoString r => Point 2 r -> MisoString
moveTo Point 2 r
p ] [Attribute model action]
-> [Attribute model action] -> [Attribute model action]
forall a. Semigroup a => a -> a -> a
<> [Attribute model action]
ats) [MisoString -> View context props model action
forall context props model action.
MisoString -> View context props model action
text (MisoString -> View context props model action)
-> MisoString -> View context props model action
forall a b. (a -> b) -> a -> b
$ MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
t ]
instance ToMisoString r => Drawable (Ipe.MiniPage r) where
  draw :: forall model action context props.
MiniPage r
-> [Attribute model action] -> View context props model action
draw (Ipe.MiniPage MisoString
t Point 2 r
p r
w) [Attribute model action]
ats = [Attribute model action]
-> [View context props model action]
-> View context props model action
forall model action context props.
[Attribute model action]
-> [View context props model action]
-> View context props model action
text_ ([ MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
transform_ (MisoString -> Attribute model action)
-> MisoString -> Attribute model action
forall a b. (a -> b) -> a -> b
$ Point 2 r -> MisoString
forall r. ToMisoString r => Point 2 r -> MisoString
moveTo Point 2 r
p
                                         , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
width_     (MisoString -> Attribute model action)
-> MisoString -> Attribute model action
forall a b. (a -> b) -> a -> b
$ r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms r
w
                                         ] [Attribute model action]
-> [Attribute model action] -> [Attribute model action]
forall a. Semigroup a => a -> a -> a
<> [Attribute model action]
ats)
                                        [MisoString -> View context props model action
forall context props model action.
MisoString -> View context props model action
text (MisoString -> View context props model action)
-> MisoString -> View context props model action
forall a b. (a -> b) -> a -> b
$ MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
t]

-- | renders a translation matrix
moveTo :: ToMisoString r => Point 2 r -> MisoString
moveTo :: forall r. ToMisoString r => Point 2 r -> MisoString
moveTo (ASetter (Point 2 r) (Point 2 MisoString) r MisoString
-> (r -> MisoString) -> Point 2 r -> Point 2 MisoString
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Point 2 r) (Point 2 MisoString) r MisoString
(NumType (Point 2 r) -> Identity (NumType (Point 2 MisoString)))
-> Point 2 r -> Identity (Point 2 MisoString)
forall point point'.
HasCoordinates point point' =>
IndexedTraversal1 Int point point' (NumType point) (NumType point')
IndexedTraversal1
  Int
  (Point 2 r)
  (Point 2 MisoString)
  (NumType (Point 2 r))
  (NumType (Point 2 MisoString))
coordinates r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms -> Point2 MisoString
x MisoString
y) = MisoString
"translate(" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
x MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
" " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
y MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
")"

instance ToMisoString r => Drawable (Ipe.IpeSymbol r) where
  draw :: forall model action context props.
IpeSymbol r
-> [Attribute model action] -> View context props model action
draw (Ipe.Symbol Point 2 r
p MisoString
_ ) = ([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
forall model action context props.
([Attribute model action] -> View context props model action)
-> [Attribute model action]
-> [Attribute model action]
-> View context props model action
withAts [Attribute model action] -> View context props model action
forall model action context props.
[Attribute model action] -> View context props model action
ellipse_ [ MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
rx_ MisoString
r
                                            , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
ry_ MisoString
r
                                            , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
cx_ (MisoString -> Attribute model action)
-> (r -> MisoString) -> r -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute model action) -> r -> Attribute model action
forall a b. (a -> b) -> a -> b
$ Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (Point 2 r) r
xCoord
                                            , MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
cy_ (MisoString -> Attribute model action)
-> (r -> MisoString) -> r -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute model action) -> r -> Attribute model action
forall a b. (a -> b) -> a -> b
$ Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (Point 2 r) r
yCoord
                                            ]
    where
      r :: MisoString
r = MisoString
"5"

instance ToMisoString r => Drawable (Ipe.Path r) where
  draw :: forall model action context props.
Path r
-> [Attribute model action] -> View context props model action
draw (Ipe.Path Seq (PathSegment r)
s) [Attribute model action]
ats = [Attribute model action]
-> [View context props model action]
-> View context props model action
forall model action context props.
[Attribute model action]
-> [View context props model action]
-> View context props model action
g_ [] ((PathSegment r -> View context props model action)
-> [PathSegment r] -> [View context props model action]
forall a b. (a -> b) -> [a] -> [b]
map ((PathSegment r
 -> [Attribute model action] -> View context props model action)
-> [Attribute model action]
-> PathSegment r
-> View context props model action
forall a b c. (a -> b -> c) -> b -> a -> c
flip PathSegment r
-> [Attribute model action] -> View context props model action
forall t model action context props.
Drawable t =>
t -> [Attribute model action] -> View context props model action
forall model action context props.
PathSegment r
-> [Attribute model action] -> View context props model action
draw (MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
fill_ MisoString
"none"Attribute model action
-> [Attribute model action] -> [Attribute model action]
forall a. a -> [a] -> [a]
:[Attribute model action]
ats)) ([PathSegment r] -> [View context props model action])
-> (Seq (PathSegment r) -> [PathSegment r])
-> Seq (PathSegment r)
-> [View context props model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (PathSegment r) -> [PathSegment r]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (PathSegment r) -> [View context props model action])
-> Seq (PathSegment r) -> [View context props model action]
forall a b. (a -> b) -> a -> b
$ Seq (PathSegment r)
s)
  -- svg fills paths by default; don't do that unless specified otherwise

instance ToMisoString r => Drawable (Ipe.PathSegment r) where
  draw :: forall model action context props.
PathSegment r
-> [Attribute model action] -> View context props model action
draw = \case
    Ipe.PolyLineSegment PolyLine (Point 2 r)
pl -> PolyLine (Point 2 r)
-> [Attribute model action] -> View context props model action
forall polyLine point r model action context props.
(PolyLine_ polyLine point, Point_ point 2 r, ToMisoString r) =>
polyLine
-> [Attribute model action] -> View context props model action
dPolyLine PolyLine (Point 2 r)
pl
    Ipe.PolygonPath Orientation
_ SimplePolygon (Point 2 r)
pg   -> SimplePolygon (Point 2 r)
-> [Attribute model action] -> View context props model action
forall simplePolygon point r model action context props.
(SimplePolygon_ simplePolygon point r, ToMisoString r) =>
simplePolygon
-> [Attribute model action] -> View context props model action
dSimplePolygon SimplePolygon (Point 2 r)
pg -- TODO: maybe don't ignore the orientation
    PathSegment r
_                      -> String
-> [Attribute model action] -> View context props model action
forall a. HasCallStack => String -> a
error String
"toValue: not implemented yet"




--------------------------------------------------------------------------------
-- * Dealing with attributes



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


newtype SvgF action val = SvgF (forall model. val -> [Attribute model action])

-- | Helper newtype to represent 'forall model. Const [Attribute model action] val'
-- i.e. we hide the 'model' parameter.
newtype AttrList action val = AttrList (forall model. [Attribute model action])

class SvgWriteAttributes ats action where

  -- | The functions that specify how to write the values to attributes
  svgAttrFunctions :: ats (SvgF action)

  -- | The attribute values we are using if the attribute is set to Nothing.
  --
  -- This is particularly useful for e.g. fill. If there is no fill color set,
  -- we should add a 'fill='none'.
  svgAttrDefaults :: ats (AttrList action)
  default svgAttrDefaults :: ApplicativeB ats => ats (AttrList action)
  svgAttrDefaults = (forall a. AttrList action a) -> ats (AttrList action)
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
forall (f :: * -> *). (forall a. f a) -> ats f
bpure ((forall a. AttrList action a) -> ats (AttrList action))
-> (forall a. AttrList action a) -> ats (AttrList action)
forall a b. (a -> b) -> a -> b
$ (forall model. [Attribute model action]) -> AttrList action a
forall {k} action (val :: k).
(forall model. [Attribute model action]) -> AttrList action val
AttrList []

  -- | Write the actual attributes
  svgWriteAttrs :: ats Maybe -> [Attribute model action]

  default svgWriteAttrs :: (ApplicativeB ats, TraversableB ats)
                        => ats Maybe -> [Attribute model action]
  svgWriteAttrs = (forall a. AttrList action a -> [Attribute model action])
-> ats (AttrList action) -> [Attribute model action]
forall {k} (b :: (k -> *) -> *) m (f :: k -> *).
(TraversableB b, Monoid m) =>
(forall (a :: k). f a -> m) -> b f -> m
bfoldMap (\(AttrList forall model. [Attribute model action]
res) -> [Attribute model action]
forall model. [Attribute model action]
res)
                (ats (AttrList action) -> [Attribute model action])
-> (ats Maybe -> ats (AttrList action))
-> ats Maybe
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 AttrList action a -> SvgF action a -> Maybe a -> AttrList action a)
-> ats (AttrList action)
-> ats (SvgF action)
-> ats Maybe
-> ats (AttrList action)
forall {k} (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *) (i :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a -> i a)
-> b f -> b g -> b h -> b i
bzipWith3 AttrList action a -> SvgF action a -> Maybe a -> AttrList action a
forall a.
AttrList action a -> SvgF action a -> Maybe a -> AttrList action a
forall action a.
AttrList action a -> SvgF action a -> Maybe a -> AttrList action a
writeAttr ats (AttrList action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (AttrList action)
svgAttrDefaults ats (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions


writeAttr :: AttrList action a
          -> SvgF action a
          -> Maybe a
          -> AttrList action a
writeAttr :: forall action a.
AttrList action a -> SvgF action a -> Maybe a -> AttrList action a
writeAttr (AttrList forall model. [Attribute model action]
def') (SvgF forall model. a -> [Attribute model action]
attr) Maybe a
m = (forall model. [Attribute model action]) -> AttrList action a
forall {k} action (val :: k).
(forall model. [Attribute model action]) -> AttrList action val
AttrList ((forall model. [Attribute model action]) -> AttrList action a)
-> (forall model. [Attribute model action]) -> AttrList action a
forall a b. (a -> b) -> a -> b
$ [Attribute model action]
-> (a -> [Attribute model action])
-> Maybe a
-> [Attribute model action]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Attribute model action]
forall model. [Attribute model action]
def' a -> [Attribute model action]
forall model. a -> [Attribute model action]
attr Maybe a
m

singleton :: a -> [a]
singleton :: forall a. a -> [a]
singleton = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])


instance SvgWriteAttributes (CommonAttributes r) action where
  svgAttrFunctions :: CommonAttributes r (SvgF action)
svgAttrFunctions = (forall a. SvgF action a) -> CommonAttributes r (SvgF action)
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
forall (f :: * -> *). (forall a. f a) -> CommonAttributes r f
bpure ((forall model. a -> [Attribute model action]) -> SvgF action a
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ((forall model. a -> [Attribute model action]) -> SvgF action a)
-> (forall model. a -> [Attribute model action]) -> SvgF action a
forall a b. (a -> b) -> a -> b
$ [Attribute model action] -> a -> [Attribute model action]
forall a b. a -> b -> a
const [])

  -- svgWriteAttrs = bfoldMap getConst
  --               . bzipWith writeAttr svgAttrFunctions

-- writeAttr :: forall action model.
--              (forall a. SvgF action a -> Maybe a -> AttrList action a)
-- writeAttr = writeAttr' (Const [])

-- writeAttr' :: forall action model.
--               (forall a. AttrList action a -> SvgF action a
-- -> Maybe a
--                                            -> Const [Attribute model] a)
-- writeAttr' (Const def) (SvgF attr) m = Const $ maybe def attr m

instance ToMisoString r => SvgWriteAttributes (SymbolAttributesF r) action where
  svgAttrFunctions :: SymbolAttributesF r (SvgF action)
svgAttrFunctions = SymbolAttributes
    { _commonAttrs :: CommonAttributes r (SvgF action)
_commonAttrs = CommonAttributes r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions
    , _stroke :: SvgF action (IpeColor r)
_stroke      = (forall model. IpeColor r -> [Attribute model action])
-> SvgF action (IpeColor r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeColor r -> Attribute model action)
-> IpeColor r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
stroke_ (MisoString -> Attribute model action)
-> (IpeColor r -> MisoString)
-> IpeColor r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _fill :: SvgF action (IpeColor r)
_fill        = (forall model. IpeColor r -> [Attribute model action])
-> SvgF action (IpeColor r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeColor r -> Attribute model action)
-> IpeColor r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
fill_   (MisoString -> Attribute model action)
-> (IpeColor r -> MisoString)
-> IpeColor r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _pen :: SvgF action (IpePen r)
_pen         = (forall model. IpePen r -> [Attribute model action])
-> SvgF action (IpePen r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action] -> IpePen r -> [Attribute model action]
forall a b. a -> b -> a
const []           )
    , _symbolSize :: SvgF action (IpeSize r)
_symbolSize  = (forall model. IpeSize r -> [Attribute model action])
-> SvgF action (IpeSize r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action] -> IpeSize r -> [Attribute model action]
forall a b. a -> b -> a
const []           )
    }
  -- svgWriteAttrs = bfoldMap getConst
  --               . bzipWith writeAttr svgAttrFunctions

  svgAttrDefaults :: SymbolAttributesF r (AttrList action)
svgAttrDefaults = ((forall a. AttrList action a)
-> SymbolAttributesF r (AttrList action)
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
forall (f :: * -> *). (forall a. f a) -> SymbolAttributesF r f
bpure ((forall a. AttrList action a)
 -> SymbolAttributesF r (AttrList action))
-> (forall a. AttrList action a)
-> SymbolAttributesF r (AttrList action)
forall a b. (a -> b) -> a -> b
$ (forall model. [Attribute model action]) -> AttrList action a
forall {k} action (val :: k).
(forall model. [Attribute model action]) -> AttrList action val
AttrList [])SymbolAttributesF r (AttrList action)
-> (SymbolAttributesF r (AttrList action)
    -> SymbolAttributesF r (AttrList action))
-> SymbolAttributesF r (AttrList action)
forall a b. a -> (a -> b) -> b
&(AttrList action (IpeColor r)
 -> Identity (AttrList action (IpeColor r)))
-> SymbolAttributesF r (AttrList action)
-> Identity (SymbolAttributesF r (AttrList action))
forall s a. HasFill s a => Lens' s a
Lens'
  (SymbolAttributesF r (AttrList action))
  (AttrList action (IpeColor r))
fill ((AttrList action (IpeColor r)
  -> Identity (AttrList action (IpeColor r)))
 -> SymbolAttributesF r (AttrList action)
 -> Identity (SymbolAttributesF r (AttrList action)))
-> AttrList action (IpeColor r)
-> SymbolAttributesF r (AttrList action)
-> SymbolAttributesF r (AttrList action)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall model. [Attribute model action])
-> AttrList action (IpeColor r)
forall {k} action (val :: k).
(forall model. [Attribute model action]) -> AttrList action val
AttrList [MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
fill_ MisoString
"none"]


instance ToMisoString r => SvgWriteAttributes (PathAttributesF r) action where
  svgAttrFunctions :: PathAttributesF r (SvgF action)
svgAttrFunctions = PathAttributes
    { _commonAttrs :: CommonAttributes r (SvgF action)
_commonAttrs = CommonAttributes r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions
    , _stroke :: SvgF action (IpeColor r)
_stroke        = (forall model. IpeColor r -> [Attribute model action])
-> SvgF action (IpeColor r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeColor r -> Attribute model action)
-> IpeColor r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
stroke_ (MisoString -> Attribute model action)
-> (IpeColor r -> MisoString)
-> IpeColor r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _fill :: SvgF action (IpeColor r)
_fill          = (forall model. IpeColor r -> [Attribute model action])
-> SvgF action (IpeColor r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeColor r -> Attribute model action)
-> IpeColor r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
fill_ (MisoString -> Attribute model action)
-> (IpeColor r -> MisoString)
-> IpeColor r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _pen :: SvgF action (IpePen r)
_pen           = (forall model. IpePen r -> [Attribute model action])
-> SvgF action (IpePen r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpePen r -> Attribute model action)
-> IpePen r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
strokeWidth_ (MisoString -> Attribute model action)
-> (IpePen r -> MisoString) -> IpePen r -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpePen r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _dash :: SvgF action (IpeDash r)
_dash          = (forall model. IpeDash r -> [Attribute model action])
-> SvgF action (IpeDash r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action] -> IpeDash r -> [Attribute model action]
forall a b. a -> b -> a
const []                           )
    , _lineCap :: SvgF action Int
_lineCap       = (forall model. Int -> [Attribute model action]) -> SvgF action Int
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (Int -> Attribute model action)
-> Int
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
strokeLinecap_ (MisoString -> Attribute model action)
-> (Int -> MisoString) -> Int -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _lineJoin :: SvgF action LineJoin
_lineJoin      = (forall model. LineJoin -> [Attribute model action])
-> SvgF action LineJoin
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (LineJoin -> Attribute model action)
-> LineJoin
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
strokeLinejoin_ (MisoString -> Attribute model action)
-> (LineJoin -> MisoString) -> LineJoin -> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> MisoString
forall str. ToMisoString str => str -> MisoString
ms   )
    , _fillRule :: SvgF action FillType
_fillRule      = (forall model. FillType -> [Attribute model action])
-> SvgF action FillType
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action] -> FillType -> [Attribute model action]
forall a b. a -> b -> a
const []                           )
    , _arrow :: SvgF action (IpeArrow r)
_arrow         = (forall model. IpeArrow r -> [Attribute model action])
-> SvgF action (IpeArrow r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeArrow r -> Attribute model action)
-> IpeArrow r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
markerEnd_ (MisoString -> Attribute model action)
-> (IpeArrow r -> MisoString)
-> IpeArrow r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeArrow r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms )
    , _rArrow :: SvgF action (IpeArrow r)
_rArrow        = (forall model. IpeArrow r -> [Attribute model action])
-> SvgF action (IpeArrow r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeArrow r -> Attribute model action)
-> IpeArrow r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
markerStart_ (MisoString -> Attribute model action)
-> (IpeArrow r -> MisoString)
-> IpeArrow r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeArrow r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _strokeOpacity :: SvgF action (IpeValue r)
_strokeOpacity = (forall model. IpeValue r -> [Attribute model action])
-> SvgF action (IpeValue r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeValue r -> Attribute model action)
-> IpeValue r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
strokeOpacity_ (MisoString -> Attribute model action)
-> (IpeValue r -> MisoString)
-> IpeValue r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeValue r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _opacity :: SvgF action (IpeValue r)
_opacity       = (forall model. IpeValue r -> [Attribute model action])
-> SvgF action (IpeValue r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeValue r -> Attribute model action)
-> IpeValue r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
fillOpacity_ (MisoString -> Attribute model action)
-> (IpeValue r -> MisoString)
-> IpeValue r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeValue r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _tiling :: SvgF action MisoString
_tiling        = (forall model. MisoString -> [Attribute model action])
-> SvgF action MisoString
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action] -> MisoString -> [Attribute model action]
forall a b. a -> b -> a
const []                           )
    , _gradient :: SvgF action MisoString
_gradient      = (forall model. MisoString -> [Attribute model action])
-> SvgF action MisoString
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action] -> MisoString -> [Attribute model action]
forall a b. a -> b -> a
const []                           )
    }
  svgAttrDefaults :: PathAttributesF r (AttrList action)
svgAttrDefaults = ((forall a. AttrList action a)
-> PathAttributesF r (AttrList action)
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
forall (f :: * -> *). (forall a. f a) -> PathAttributesF r f
bpure ((forall a. AttrList action a)
 -> PathAttributesF r (AttrList action))
-> (forall a. AttrList action a)
-> PathAttributesF r (AttrList action)
forall a b. (a -> b) -> a -> b
$ (forall model. [Attribute model action]) -> AttrList action a
forall {k} action (val :: k).
(forall model. [Attribute model action]) -> AttrList action val
AttrList [])PathAttributesF r (AttrList action)
-> (PathAttributesF r (AttrList action)
    -> PathAttributesF r (AttrList action))
-> PathAttributesF r (AttrList action)
forall a b. a -> (a -> b) -> b
&(AttrList action (IpeColor r)
 -> Identity (AttrList action (IpeColor r)))
-> PathAttributesF r (AttrList action)
-> Identity (PathAttributesF r (AttrList action))
forall s a. HasFill s a => Lens' s a
Lens'
  (PathAttributesF r (AttrList action))
  (AttrList action (IpeColor r))
fill ((AttrList action (IpeColor r)
  -> Identity (AttrList action (IpeColor r)))
 -> PathAttributesF r (AttrList action)
 -> Identity (PathAttributesF r (AttrList action)))
-> AttrList action (IpeColor r)
-> PathAttributesF r (AttrList action)
-> PathAttributesF r (AttrList action)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall model. [Attribute model action])
-> AttrList action (IpeColor r)
forall {k} action (val :: k).
(forall model. [Attribute model action]) -> AttrList action val
AttrList [MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
fill_ MisoString
"none"]

  -- svgWriteAttrs = bfoldMap getConst
  --               . bzipWith3 writeAttr' defValues svgAttrFunctions
  --   where
  --     defValues :: PathAttributes (AttrList action)
  --     defValues = pure (Const []) & fill .~ Const [fill_ "none"]




instance SvgWriteAttributes (GroupAttributesF r) action where
  svgAttrFunctions :: GroupAttributesF r (SvgF action)
svgAttrFunctions = GroupAttributes
    { _commonAttrs :: CommonAttributes r (SvgF action)
_commonAttrs = CommonAttributes r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions
    , _clip :: SvgF action (Path r)
_clip        = (forall model. Path r -> [Attribute model action])
-> SvgF action (Path r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action] -> Path r -> [Attribute model action]
forall a b. a -> b -> a
const [])
    }


instance ToMisoString r => SvgWriteAttributes (TextAttributesF r) action where
  svgAttrFunctions :: TextAttributesF r (SvgF action)
svgAttrFunctions = TextAttributes
    { _commonAttrs :: CommonAttributes r (SvgF action)
_commonAttrs = CommonAttributes r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions
    , _stroke :: SvgF action (IpeColor r)
_stroke      = (forall model. IpeColor r -> [Attribute model action])
-> SvgF action (IpeColor r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeColor r -> Attribute model action)
-> IpeColor r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
stroke_ (MisoString -> Attribute model action)
-> (IpeColor r -> MisoString)
-> IpeColor r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _textSize :: SvgF action (IpeSize r)
_textSize    = (forall model. IpeSize r -> [Attribute model action])
-> SvgF action (IpeSize r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action] -> IpeSize r -> [Attribute model action]
forall a b. a -> b -> a
const [])
    , _opacity :: SvgF action (IpeValue r)
_opacity     = (forall model. IpeValue r -> [Attribute model action])
-> SvgF action (IpeValue r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF (Attribute model action -> [Attribute model action]
forall a. a -> [a]
singleton (Attribute model action -> [Attribute model action])
-> (IpeValue r -> Attribute model action)
-> IpeValue r
-> [Attribute model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute model action
forall model action. MisoString -> Attribute model action
strokeOpacity_ (MisoString -> Attribute model action)
-> (IpeValue r -> MisoString)
-> IpeValue r
-> Attribute model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeValue r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _textWidth :: SvgF action (TextSizeUnit r)
_textWidth   = (forall model. TextSizeUnit r -> [Attribute model action])
-> SvgF action (TextSizeUnit r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action]
-> TextSizeUnit r -> [Attribute model action]
forall a b. a -> b -> a
const [])
    , _textHeight :: SvgF action (TextSizeUnit r)
_textHeight  = (forall model. TextSizeUnit r -> [Attribute model action])
-> SvgF action (TextSizeUnit r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action]
-> TextSizeUnit r -> [Attribute model action]
forall a b. a -> b -> a
const [])
    , _depth :: SvgF action (TextSizeUnit r)
_depth       = (forall model. TextSizeUnit r -> [Attribute model action])
-> SvgF action (TextSizeUnit r)
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action]
-> TextSizeUnit r -> [Attribute model action]
forall a b. a -> b -> a
const [])
    , _hAlign :: SvgF action HorizontalAlignment
_hAlign      = (forall model. HorizontalAlignment -> [Attribute model action])
-> SvgF action HorizontalAlignment
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action]
-> HorizontalAlignment -> [Attribute model action]
forall a b. a -> b -> a
const [])
    , _vAlign :: SvgF action VerticalAlignment
_vAlign      = (forall model. VerticalAlignment -> [Attribute model action])
-> SvgF action VerticalAlignment
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action]
-> VerticalAlignment -> [Attribute model action]
forall a b. a -> b -> a
const [])
    , _style :: SvgF action MisoString
_style       = (forall model. MisoString -> [Attribute model action])
-> SvgF action MisoString
forall action val.
(forall model. val -> [Attribute model action]) -> SvgF action val
SvgF ([Attribute model action] -> MisoString -> [Attribute model action]
forall a b. a -> b -> a
const [])
    }