{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Ipe.FromIpe
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Functions that help reading geometric values from ipe images.
--
--------------------------------------------------------------------------------
module Ipe.FromIpe(
  -- * Individual readers
    _asPoint
  , _asLineSegment
  , _asClosedLineSegment
  , _asRectangle
  , _asTriangle

  , _asPolyLine
  , _asSimplePolygon
  , _asConvexPolygon
  -- , _asSomePolygon, _asSimplePolygon, _asMultiPolygon

  -- * Dealing with Attributes
  , _withAttrs

  -- * Default readers
  , HasDefaultFromIpe(..)

  -- * Reading all elements of a particular type
  , readAll, readAllFrom
  ) where

import           Control.Lens hiding (Simple)
import           Data.Kind (Type)
import qualified Data.Sequence as Seq
import           HGeometry.Ball
import           HGeometry.Box
import qualified HGeometry.Box as Box
import           HGeometry.Ellipse (Ellipse, _EllipseCircle)
import           HGeometry.Ext
import           HGeometry.LineSegment
import           HGeometry.Number.Radical
import           HGeometry.Point
import qualified HGeometry.PolyLine as PolyLine
import           HGeometry.Polygon.Class
import           HGeometry.Polygon.Convex
import           HGeometry.Polygon.Simple
import           HGeometry.Properties
import           HGeometry.Triangle
import           Ipe.Path
import           Ipe.Reader
import           Ipe.Types
import           System.OsPath


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

-- import qualified Data.List.NonEmpty as NonEmpty
-- import Ipe.Attributes
-- import Ipe.Color(IpeColor(..))
--------------------------------------------------------------------------------
-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Ipe.Attributes
-- >>> import Ipe.Color(IpeColor(..))
-- >>> import qualified Data.List.NonEmpty as NonEmpty
-- >>> :{
-- let testPath :: Path Int
--     testPath = Path . fromSingleton  . PolyLineSegment
--              . PolyLine.polyLineFromPoints . NonEmpty.fromList
--              $ [ origin, Point2 10 10, Point2 200 100 ]
--     testPathAttrs :: IpeAttributes Path Int
--     testPathAttrs = attr SStroke (IpeColor "red")
--     testObject :: IpeObject Int
--     testObject = IpePath (testPath :+ testPathAttrs)
-- :}

-- testPath :: Path Int
-- testPath = Path . fromSingleton  . PolyLineSegment
--              . PolyLine.polyLineFromPoints . NonEmpty.fromList
--              $ [ origin, Point2 10 10, Point2 200 100 ]
-- testPathAttrs :: IpeAttributes Path Int
-- testPathAttrs = attr SStroke (IpeColor "red")
-- testObject :: IpeObject Int
-- testObject = IpePath (testPath :+ testPathAttrs)



-- | Extracts the point from a Symbol. When creating a symbol this
-- creates a disk that supports a stroke color.
_asPoint :: Prism' (IpeSymbol r) (Point 2 r)
_asPoint :: forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Point 2 r) (f (Point 2 r)) -> p (IpeSymbol r) (f (IpeSymbol r))
_asPoint = (Point 2 r -> IpeSymbol r)
-> (IpeSymbol r -> Maybe (Point 2 r))
-> Prism (IpeSymbol r) (IpeSymbol r) (Point 2 r) (Point 2 r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((Point 2 r -> Text -> IpeSymbol r)
-> Text -> Point 2 r -> IpeSymbol r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point 2 r -> Text -> IpeSymbol r
forall r. Point 2 r -> Text -> IpeSymbol r
Symbol Text
"mark/disk(sx)") (Point 2 r -> Maybe (Point 2 r)
forall a. a -> Maybe a
Just (Point 2 r -> Maybe (Point 2 r))
-> (IpeSymbol r -> Point 2 r) -> IpeSymbol r -> Maybe (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Point 2 r) (IpeSymbol r) (Point 2 r)
-> IpeSymbol r -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) (IpeSymbol r) (Point 2 r)
forall r r' (f :: * -> *).
Functor f =>
(Point 2 r -> f (Point 2 r')) -> IpeSymbol r -> f (IpeSymbol r')
symbolPoint)

-- | Try to convert a path into a line segment, fails if the path is not a line
-- segment or a polyline with more than two points.
--
--
_asLineSegment :: Prism' (Path r) (LineSegment AnEndPoint (Point 2 r))
_asLineSegment :: forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (LineSegment AnEndPoint (Point 2 r))
  (f (LineSegment AnEndPoint (Point 2 r)))
-> p (Path r) (f (Path r))
_asLineSegment = p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
-> p (Path r) (f (Path r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
-> p (Path r) (f (Path r))
_asPolyLine(p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
 -> p (Path r) (f (Path r)))
-> (p (LineSegment AnEndPoint (Point 2 r))
      (f (LineSegment AnEndPoint (Point 2 r)))
    -> p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r))))
-> p (LineSegment AnEndPoint (Point 2 r))
     (f (LineSegment AnEndPoint (Point 2 r)))
-> p (Path r) (f (Path r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p (LineSegment AnEndPoint (Point 2 r))
  (f (LineSegment AnEndPoint (Point 2 r)))
-> p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
forall lineSegment point polyLine.
(ConstructableLineSegment_ lineSegment point,
 ConstructablePolyLine_ polyLine point) =>
Prism' polyLine lineSegment
Prism' (PolyLine (Point 2 r)) (LineSegment AnEndPoint (Point 2 r))
PolyLine._PolyLineLineSegment

-- | Try to convert a path into a line segment, fails if the path is not a line
-- segment or a polyline with more than two points.
--
--
_asClosedLineSegment :: Prism' (Path r) (ClosedLineSegment (Point 2 r))
_asClosedLineSegment :: forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ClosedLineSegment (Point 2 r))
  (f (ClosedLineSegment (Point 2 r)))
-> p (Path r) (f (Path r))
_asClosedLineSegment = p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
-> p (Path r) (f (Path r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
-> p (Path r) (f (Path r))
_asPolyLine(p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
 -> p (Path r) (f (Path r)))
-> (p (ClosedLineSegment (Point 2 r))
      (f (ClosedLineSegment (Point 2 r)))
    -> p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r))))
-> p (ClosedLineSegment (Point 2 r))
     (f (ClosedLineSegment (Point 2 r)))
-> p (Path r) (f (Path r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p (ClosedLineSegment (Point 2 r))
  (f (ClosedLineSegment (Point 2 r)))
-> p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
forall lineSegment point polyLine.
(ConstructableLineSegment_ lineSegment point,
 ConstructablePolyLine_ polyLine point) =>
Prism' polyLine lineSegment
Prism' (PolyLine (Point 2 r)) (ClosedLineSegment (Point 2 r))
PolyLine._PolyLineLineSegment

-- | Convert to a polyline. Ignores all non-polyline parts
--
-- >>> testPath ^? _asPolyLine
-- Just (PolyLine [Point2 0 0,Point2 10 10,Point2 200 100])
_asPolyLine :: Prism' (Path r) (PolyLine.PolyLine (Point 2 r))
_asPolyLine :: forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
-> p (Path r) (f (Path r))
_asPolyLine = (PolyLine (Point 2 r) -> Path r)
-> (Path r -> Maybe (PolyLine (Point 2 r)))
-> Prism
     (Path r) (Path r) (PolyLine (Point 2 r)) (PolyLine (Point 2 r))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' PolyLine (Point 2 r) -> Path r
forall {r}. PolyLine (Point 2 r) -> Path r
poly2path Path r -> Maybe (PolyLine (Point 2 r))
path2poly
  where
    poly2path :: PolyLine (Point 2 r) -> Path r
poly2path = Seq (PathSegment r) -> Path r
forall r. Seq (PathSegment r) -> Path r
Path (Seq (PathSegment r) -> Path r)
-> (PolyLine (Point 2 r) -> Seq (PathSegment r))
-> PolyLine (Point 2 r)
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment r -> Seq (PathSegment r)
forall a. a -> Seq a
fromSingleton  (PathSegment r -> Seq (PathSegment r))
-> (PolyLine (Point 2 r) -> PathSegment r)
-> PolyLine (Point 2 r)
-> Seq (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyLine (Point 2 r) -> PathSegment r
forall r. PolyLine (Point 2 r) -> PathSegment r
PolyLineSegment
    path2poly :: Path r -> Maybe (PolyLine (Point 2 r))
path2poly = Getting
  (First (PolyLine (Point 2 r))) (Path r) (PolyLine (Point 2 r))
-> Path r -> Maybe (PolyLine (Point 2 r))
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Seq (PathSegment r)
 -> Const (First (PolyLine (Point 2 r))) (Seq (PathSegment r)))
-> Path r -> Const (First (PolyLine (Point 2 r))) (Path r)
forall r r' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Seq (PathSegment r)) (f (Seq (PathSegment r')))
-> p (Path r) (f (Path r'))
pathSegments((Seq (PathSegment r)
  -> Const (First (PolyLine (Point 2 r))) (Seq (PathSegment r)))
 -> Path r -> Const (First (PolyLine (Point 2 r))) (Path r))
-> ((PolyLine (Point 2 r)
     -> Const (First (PolyLine (Point 2 r))) (PolyLine (Point 2 r)))
    -> Seq (PathSegment r)
    -> Const (First (PolyLine (Point 2 r))) (Seq (PathSegment r)))
-> Getting
     (First (PolyLine (Point 2 r))) (Path r) (PolyLine (Point 2 r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathSegment r
 -> Const (First (PolyLine (Point 2 r))) (PathSegment r))
-> Seq (PathSegment r)
-> Const (First (PolyLine (Point 2 r))) (Seq (PathSegment r))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse((PathSegment r
  -> Const (First (PolyLine (Point 2 r))) (PathSegment r))
 -> Seq (PathSegment r)
 -> Const (First (PolyLine (Point 2 r))) (Seq (PathSegment r)))
-> ((PolyLine (Point 2 r)
     -> Const (First (PolyLine (Point 2 r))) (PolyLine (Point 2 r)))
    -> PathSegment r
    -> Const (First (PolyLine (Point 2 r))) (PathSegment r))
-> (PolyLine (Point 2 r)
    -> Const (First (PolyLine (Point 2 r))) (PolyLine (Point 2 r)))
-> Seq (PathSegment r)
-> Const (First (PolyLine (Point 2 r))) (Seq (PathSegment r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PolyLine (Point 2 r)
 -> Const (First (PolyLine (Point 2 r))) (PolyLine (Point 2 r)))
-> PathSegment r
-> Const (First (PolyLine (Point 2 r))) (PathSegment r)
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
-> p (PathSegment r) (f (PathSegment r))
_PolyLineSegment)
    -- TODO: Check that the path actually is a polyline, rather
    -- than ignoring everything that does not fit

-- | Convert to a simple polygon
_asSimplePolygon :: Prism' (Path r) (SimplePolygon (Point 2 r))
_asSimplePolygon :: forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (Path r) (f (Path r))
_asSimplePolygon = (SimplePolygon (Point 2 r) -> Path r)
-> (Path r -> Maybe (SimplePolygon (Point 2 r)))
-> Prism
     (Path r)
     (Path r)
     (SimplePolygon (Point 2 r))
     (SimplePolygon (Point 2 r))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' SimplePolygon (Point 2 r) -> Path r
forall r. SimplePolygon (Point 2 r) -> Path r
polygonToPath Path r -> Maybe (SimplePolygon (Point 2 r))
forall r. Path r -> Maybe (SimplePolygon (Point 2 r))
pathToPolygon

-- | Convert to a convex polygon
_asConvexPolygon :: (Num r, Ord r) => Prism' (Path r) (ConvexPolygon (Point 2 r))
_asConvexPolygon :: forall r.
(Num r, Ord r) =>
Prism' (Path r) (ConvexPolygon (Point 2 r))
_asConvexPolygon = p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (Path r) (f (Path r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (Path r) (f (Path r))
_asSimplePolygon(p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
 -> p (Path r) (f (Path r)))
-> (p (ConvexPolygon (Point 2 r)) (f (ConvexPolygon (Point 2 r)))
    -> p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r))))
-> p (ConvexPolygon (Point 2 r)) (f (ConvexPolygon (Point 2 r)))
-> p (Path r) (f (Path r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p (ConvexPolygon (Point 2 r)) (f (ConvexPolygon (Point 2 r)))
-> p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
forall (f :: * -> *) point r.
(Num r, Ord r, Point_ point 2 r, VertexContainer f point) =>
Prism' (SimplePolygonF f point) (ConvexPolygonF f point)
Prism' (SimplePolygon (Point 2 r)) (ConvexPolygon (Point 2 r))
_ConvexPolygon

-- | Tries to convert a path into a rectangle.
_asRectangle :: forall r. (Num r, Ord r) => Prism' (Path r) (Rectangle (Point 2 r))
_asRectangle :: forall r. (Num r, Ord r) => Prism' (Path r) (Rectangle (Point 2 r))
_asRectangle = (Rectangle (Point 2 r) -> Path r)
-> (Path r -> Maybe (Rectangle (Point 2 r)))
-> Prism
     (Path r) (Path r) (Rectangle (Point 2 r)) (Rectangle (Point 2 r))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Rectangle (Point 2 r) -> Path r
Rectangle (Point 2 r) -> Path (NumType (Rectangle (Point 2 r)))
forall {rectangle}.
(Dimension rectangle ~ 2,
 Box_ rectangle (PointF (Vector 2 (NumType rectangle))),
 Num (NumType rectangle)) =>
rectangle -> Path (NumType rectangle)
rectToPath Path r -> Maybe (Rectangle (Point 2 r))
pathToRect
  where
    rectToPath :: rectangle -> Path (NumType rectangle)
rectToPath (rectangle -> Corners (PointF (Vector 2 (NumType rectangle)))
forall r rectangle point.
(Num r, Rectangle_ rectangle point, Point_ point 2 r) =>
rectangle -> Corners point
Box.corners -> Corners PointF (Vector 2 (NumType rectangle))
a PointF (Vector 2 (NumType rectangle))
b PointF (Vector 2 (NumType rectangle))
c PointF (Vector 2 (NumType rectangle))
d) =
      AReview
  (Path (NumType rectangle))
  (SimplePolygon (PointF (Vector 2 (NumType rectangle))))
-> SimplePolygon (PointF (Vector 2 (NumType rectangle)))
-> Path (NumType rectangle)
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview
  (Path (NumType rectangle))
  (SimplePolygon (PointF (Vector 2 (NumType rectangle))))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (Path r) (f (Path r))
_asSimplePolygon (SimplePolygon (PointF (Vector 2 (NumType rectangle)))
 -> Path (NumType rectangle))
-> ([PointF (Vector 2 (NumType rectangle))]
    -> SimplePolygon (PointF (Vector 2 (NumType rectangle))))
-> [PointF (Vector 2 (NumType rectangle))]
-> Path (NumType rectangle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PointF (Vector 2 (NumType rectangle))]
-> SimplePolygon (PointF (Vector 2 (NumType rectangle)))
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable f =>
f (PointF (Vector 2 (NumType rectangle)))
-> SimplePolygon (PointF (Vector 2 (NumType rectangle)))
uncheckedFromCCWPoints ([PointF (Vector 2 (NumType rectangle))]
 -> Path (NumType rectangle))
-> [PointF (Vector 2 (NumType rectangle))]
-> Path (NumType rectangle)
forall a b. (a -> b) -> a -> b
$ [PointF (Vector 2 (NumType rectangle))
a,PointF (Vector 2 (NumType rectangle))
b,PointF (Vector 2 (NumType rectangle))
c,PointF (Vector 2 (NumType rectangle))
d]
    pathToRect :: Path r -> Maybe (Rectangle (Point 2 r))
pathToRect Path r
p = Path r
pPath r
-> Getting
     (First (SimplePolygon (Point 2 r)))
     (Path r)
     (SimplePolygon (Point 2 r))
-> Maybe (SimplePolygon (Point 2 r))
forall s a. s -> Getting (First a) s a -> Maybe a
^?Getting
  (First (SimplePolygon (Point 2 r)))
  (Path r)
  (SimplePolygon (Point 2 r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (Path r) (f (Path r))
_asSimplePolygon Maybe (SimplePolygon (Point 2 r))
-> (SimplePolygon (Point 2 r) -> Maybe (Rectangle (Point 2 r)))
-> Maybe (Rectangle (Point 2 r))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SimplePolygon (Point 2 r) -> Maybe (Rectangle (Point 2 r))
asRect

    asRect    :: SimplePolygon (Point 2  r) -> Maybe (Rectangle (Point 2 r))
    asRect :: SimplePolygon (Point 2 r) -> Maybe (Rectangle (Point 2 r))
asRect SimplePolygon (Point 2 r)
pg = case SimplePolygon (Point 2 r)
pgSimplePolygon (Point 2 r)
-> Getting
     (Endo [Point 2 r]) (SimplePolygon (Point 2 r)) (Point 2 r)
-> [Point 2 r]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(Vertex (SimplePolygon (Point 2 r))
 -> Const (Endo [Point 2 r]) (Vertex (SimplePolygon (Point 2 r))))
-> SimplePolygon (Point 2 r)
-> Const (Endo [Point 2 r]) (SimplePolygon (Point 2 r))
Getting (Endo [Point 2 r]) (SimplePolygon (Point 2 r)) (Point 2 r)
forall polygon.
HasOuterBoundary polygon =>
IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
IndexedTraversal1'
  (VertexIx (SimplePolygon (Point 2 r)))
  (SimplePolygon (Point 2 r))
  (Vertex (SimplePolygon (Point 2 r)))
outerBoundary of
        [Point 2 r
a,Point 2 r
b,Point 2 r
c,Point 2 r
d]
          | Point 2 r -> Point 2 r -> Bool
forall {s} {s}.
(NumType s ~ NumType s,
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Eq (NumType s), Point_ s (Dimension s) (NumType s),
 Point_ s (Dimension s) (NumType s)) =>
s -> s -> Bool
isH Point 2 r
a Point 2 r
b Bool -> Bool -> Bool
&& Point 2 r -> Point 2 r -> Bool
forall {s} {s}.
(NumType s ~ NumType s,
 Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Eq (NumType s), Point_ s (Dimension s) (NumType s),
 Point_ s (Dimension s) (NumType s)) =>
s -> s -> Bool
isV Point 2 r
b Point 2 r
c Bool -> Bool -> Bool
&& Point 2 r -> Point 2 r -> Bool
forall {s} {s}.
(NumType s ~ NumType s,
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Eq (NumType s), Point_ s (Dimension s) (NumType s),
 Point_ s (Dimension s) (NumType s)) =>
s -> s -> Bool
isH Point 2 r
c Point 2 r
d Bool -> Bool -> Bool
&& Point 2 r -> Point 2 r -> Bool
forall {s} {s}.
(NumType s ~ NumType s,
 Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Eq (NumType s), Point_ s (Dimension s) (NumType s),
 Point_ s (Dimension s) (NumType s)) =>
s -> s -> Bool
isV Point 2 r
d Point 2 r
a ->
              if Point 2 r
aPoint 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 r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< Point 2 r
bPoint 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 then Rectangle (Point 2 r) -> Maybe (Rectangle (Point 2 r))
forall a. a -> Maybe a
Just (Point 2 r -> Point 2 r -> Rectangle (Point 2 r)
forall point. (Dimension point ~ 2) => point -> point -> Box point
Rectangle Point 2 r
a Point 2 r
c)
                                       else Rectangle (Point 2 r) -> Maybe (Rectangle (Point 2 r))
forall a. a -> Maybe a
Just (Point 2 r -> Point 2 r -> Rectangle (Point 2 r)
forall point. (Dimension point ~ 2) => point -> point -> Box point
Rectangle Point 2 r
c Point 2 r
a)
          | Point 2 r -> Point 2 r -> Bool
forall {s} {s}.
(NumType s ~ NumType s,
 Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Eq (NumType s), Point_ s (Dimension s) (NumType s),
 Point_ s (Dimension s) (NumType s)) =>
s -> s -> Bool
isV Point 2 r
a Point 2 r
b Bool -> Bool -> Bool
&& Point 2 r -> Point 2 r -> Bool
forall {s} {s}.
(NumType s ~ NumType s,
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Eq (NumType s), Point_ s (Dimension s) (NumType s),
 Point_ s (Dimension s) (NumType s)) =>
s -> s -> Bool
isH Point 2 r
b Point 2 r
c Bool -> Bool -> Bool
&& Point 2 r -> Point 2 r -> Bool
forall {s} {s}.
(NumType s ~ NumType s,
 Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Eq (NumType s), Point_ s (Dimension s) (NumType s),
 Point_ s (Dimension s) (NumType s)) =>
s -> s -> Bool
isV Point 2 r
c Point 2 r
d Bool -> Bool -> Bool
&& Point 2 r -> Point 2 r -> Bool
forall {s} {s}.
(NumType s ~ NumType s,
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Eq (NumType s), Point_ s (Dimension s) (NumType s),
 Point_ s (Dimension s) (NumType s)) =>
s -> s -> Bool
isH Point 2 r
d Point 2 r
a ->
              if Point 2 r
aPoint 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 r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< Point 2 r
bPoint 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 then Rectangle (Point 2 r) -> Maybe (Rectangle (Point 2 r))
forall a. a -> Maybe a
Just (Point 2 r -> Point 2 r -> Rectangle (Point 2 r)
forall point. (Dimension point ~ 2) => point -> point -> Box point
Rectangle Point 2 r
d Point 2 r
b)
                                       else Rectangle (Point 2 r) -> Maybe (Rectangle (Point 2 r))
forall a. a -> Maybe a
Just (Point 2 r -> Point 2 r -> Rectangle (Point 2 r)
forall point. (Dimension point ~ 2) => point -> point -> Box point
Rectangle Point 2 r
b Point 2 r
d)
        [Point 2 r]
_                                            -> Maybe (Rectangle (Point 2 r))
forall a. Maybe a
Nothing

    isH :: s -> s -> Bool
isH s
p s
q = s
ps -> Getting (NumType s) s (NumType s) -> NumType s
forall s a. s -> Getting a s a -> a
^.Getting (NumType s) s (NumType s)
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int s (NumType s)
yCoord NumType s -> NumType s -> Bool
forall a. Eq a => a -> a -> Bool
== s
qs -> Getting (NumType s) s (NumType s) -> NumType s
forall s a. s -> Getting a s a -> a
^.Getting (NumType s) s (NumType s)
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int s (NumType s)
yCoord -- edge pq is horizontal
    isV :: s -> s -> Bool
isV s
p s
q = s
ps -> Getting (NumType s) s (NumType s) -> NumType s
forall s a. s -> Getting a s a -> a
^.Getting (NumType s) s (NumType s)
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int s (NumType s)
xCoord NumType s -> NumType s -> Bool
forall a. Eq a => a -> a -> Bool
== s
qs -> Getting (NumType s) s (NumType s) -> NumType s
forall s a. s -> Getting a s a -> a
^.Getting (NumType s) s (NumType s)
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int s (NumType s)
xCoord -- edge pq is vertical




-- | Convert to a triangle
_asTriangle :: Prism' (Path r) (Triangle (Point 2 r))
_asTriangle :: forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Triangle (Point 2 r)) (f (Triangle (Point 2 r)))
-> p (Path r) (f (Path r))
_asTriangle = (Triangle (Point 2 r) -> Path r)
-> (Path r -> Maybe (Triangle (Point 2 r)))
-> Prism
     (Path r) (Path r) (Triangle (Point 2 r)) (Triangle (Point 2 r))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Triangle (Point 2 r) -> Path r
forall {s}. Triangle (PointF (Vector 2 s)) -> Path s
triToPath Path r -> Maybe (Triangle (Point 2 r))
forall {r'}. Path r' -> Maybe (Triangle (PointF (Vector 2 r')))
path2tri
  where
    triToPath :: Triangle (PointF (Vector 2 s)) -> Path s
triToPath (Triangle PointF (Vector 2 s)
p PointF (Vector 2 s)
q PointF (Vector 2 s)
r) = SimplePolygon (PointF (Vector 2 s)) -> Path s
forall r. SimplePolygon (Point 2 r) -> Path r
polygonToPath (SimplePolygon (PointF (Vector 2 s)) -> Path s)
-> SimplePolygon (PointF (Vector 2 s)) -> Path s
forall a b. (a -> b) -> a -> b
$ [PointF (Vector 2 s)] -> SimplePolygon (PointF (Vector 2 s))
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable f =>
f (PointF (Vector 2 s)) -> SimplePolygon (PointF (Vector 2 s))
uncheckedFromCCWPoints [PointF (Vector 2 s)
p,PointF (Vector 2 s)
q,PointF (Vector 2 s)
r]
    path2tri :: Path r' -> Maybe (Triangle (PointF (Vector 2 r')))
path2tri Path r'
p = case Path r'
pPath r'
-> Getting
     (Endo [SimplePolygon (PointF (Vector 2 r'))])
     (Path r')
     (SimplePolygon (PointF (Vector 2 r')))
-> [SimplePolygon (PointF (Vector 2 r'))]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(Seq (PathSegment r')
 -> Const
      (Endo [SimplePolygon (PointF (Vector 2 r'))])
      (Seq (PathSegment r')))
-> Path r'
-> Const (Endo [SimplePolygon (PointF (Vector 2 r'))]) (Path r')
forall r r' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Seq (PathSegment r)) (f (Seq (PathSegment r')))
-> p (Path r) (f (Path r'))
pathSegments((Seq (PathSegment r')
  -> Const
       (Endo [SimplePolygon (PointF (Vector 2 r'))])
       (Seq (PathSegment r')))
 -> Path r'
 -> Const (Endo [SimplePolygon (PointF (Vector 2 r'))]) (Path r'))
-> ((SimplePolygon (PointF (Vector 2 r'))
     -> Const
          (Endo [SimplePolygon (PointF (Vector 2 r'))])
          (SimplePolygon (PointF (Vector 2 r'))))
    -> Seq (PathSegment r')
    -> Const
         (Endo [SimplePolygon (PointF (Vector 2 r'))])
         (Seq (PathSegment r')))
-> Getting
     (Endo [SimplePolygon (PointF (Vector 2 r'))])
     (Path r')
     (SimplePolygon (PointF (Vector 2 r')))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathSegment r'
 -> Const
      (Endo [SimplePolygon (PointF (Vector 2 r'))]) (PathSegment r'))
-> Seq (PathSegment r')
-> Const
     (Endo [SimplePolygon (PointF (Vector 2 r'))])
     (Seq (PathSegment r'))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse((PathSegment r'
  -> Const
       (Endo [SimplePolygon (PointF (Vector 2 r'))]) (PathSegment r'))
 -> Seq (PathSegment r')
 -> Const
      (Endo [SimplePolygon (PointF (Vector 2 r'))])
      (Seq (PathSegment r')))
-> ((SimplePolygon (PointF (Vector 2 r'))
     -> Const
          (Endo [SimplePolygon (PointF (Vector 2 r'))])
          (SimplePolygon (PointF (Vector 2 r'))))
    -> PathSegment r'
    -> Const
         (Endo [SimplePolygon (PointF (Vector 2 r'))]) (PathSegment r'))
-> (SimplePolygon (PointF (Vector 2 r'))
    -> Const
         (Endo [SimplePolygon (PointF (Vector 2 r'))])
         (SimplePolygon (PointF (Vector 2 r'))))
-> Seq (PathSegment r')
-> Const
     (Endo [SimplePolygon (PointF (Vector 2 r'))])
     (Seq (PathSegment r'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimplePolygon (PointF (Vector 2 r'))
 -> Const
      (Endo [SimplePolygon (PointF (Vector 2 r'))])
      (SimplePolygon (PointF (Vector 2 r'))))
-> PathSegment r'
-> Const
     (Endo [SimplePolygon (PointF (Vector 2 r'))]) (PathSegment r')
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (PathSegment r) (f (PathSegment r))
_PolygonPath of
                    []   -> Maybe (Triangle (PointF (Vector 2 r')))
forall a. Maybe a
Nothing
                    [SimplePolygon (PointF (Vector 2 r'))
pg] -> case SimplePolygon (PointF (Vector 2 r'))
pgSimplePolygon (PointF (Vector 2 r'))
-> Getting
     (Endo [PointF (Vector 2 r')])
     (SimplePolygon (PointF (Vector 2 r')))
     (PointF (Vector 2 r'))
-> [PointF (Vector 2 r')]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(Vertex (SimplePolygon (PointF (Vector 2 r')))
 -> Const
      (Endo [PointF (Vector 2 r')])
      (Vertex (SimplePolygon (PointF (Vector 2 r')))))
-> SimplePolygon (PointF (Vector 2 r'))
-> Const
     (Endo [PointF (Vector 2 r')])
     (SimplePolygon (PointF (Vector 2 r')))
Getting
  (Endo [PointF (Vector 2 r')])
  (SimplePolygon (PointF (Vector 2 r')))
  (PointF (Vector 2 r'))
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (SimplePolygon (PointF (Vector 2 r'))))
  (SimplePolygon (PointF (Vector 2 r')))
  (SimplePolygon (PointF (Vector 2 r')))
  (Vertex (SimplePolygon (PointF (Vector 2 r'))))
  (Vertex (SimplePolygon (PointF (Vector 2 r'))))
vertices of
                              [PointF (Vector 2 r')
a,PointF (Vector 2 r')
b,PointF (Vector 2 r')
c] -> Triangle (PointF (Vector 2 r'))
-> Maybe (Triangle (PointF (Vector 2 r')))
forall a. a -> Maybe a
Just (Triangle (PointF (Vector 2 r'))
 -> Maybe (Triangle (PointF (Vector 2 r'))))
-> Triangle (PointF (Vector 2 r'))
-> Maybe (Triangle (PointF (Vector 2 r')))
forall a b. (a -> b) -> a -> b
$ PointF (Vector 2 r')
-> PointF (Vector 2 r')
-> PointF (Vector 2 r')
-> Triangle (PointF (Vector 2 r'))
forall point. point -> point -> point -> Triangle point
Triangle PointF (Vector 2 r')
a PointF (Vector 2 r')
b PointF (Vector 2 r')
c
                              [PointF (Vector 2 r')]
_       -> Maybe (Triangle (PointF (Vector 2 r')))
forall a. Maybe a
Nothing
                    [SimplePolygon (PointF (Vector 2 r'))]
_    -> Maybe (Triangle (PointF (Vector 2 r')))
forall a. Maybe a
Nothing


  -- an ellipse is an affine transformation of the unit disk


-- (Disk origin 1) (Vector2 1 1)

_asEllipse :: Prism' (Path r) (Ellipse r)
_asEllipse :: forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Ellipse r) (f (Ellipse r)) -> p (Path r) (f (Path r))
_asEllipse = (Ellipse r -> Path r)
-> (Path r -> Maybe (Ellipse r))
-> Prism (Path r) (Path r) (Ellipse r) (Ellipse r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Ellipse r -> Path r
forall {r}. Ellipse r -> Path r
toPath Path r -> Maybe (Ellipse r)
forall {r'}. Path r' -> Maybe (Ellipse r')
toEllipse
  where
    toPath :: Ellipse r -> Path r
toPath      = Seq (PathSegment r) -> Path r
forall r. Seq (PathSegment r) -> Path r
Path (Seq (PathSegment r) -> Path r)
-> (Ellipse r -> Seq (PathSegment r)) -> Ellipse r -> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment r -> Seq (PathSegment r)
forall a. a -> Seq a
fromSingleton  (PathSegment r -> Seq (PathSegment r))
-> (Ellipse r -> PathSegment r) -> Ellipse r -> Seq (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ellipse r -> PathSegment r
forall r. Ellipse r -> PathSegment r
EllipseSegment
    toEllipse :: Path r' -> Maybe (Ellipse r')
toEllipse Path r'
p = case Path r'
pPath r'
-> Getting (Endo [Ellipse r']) (Path r') (Ellipse r')
-> [Ellipse r']
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(Seq (PathSegment r')
 -> Const (Endo [Ellipse r']) (Seq (PathSegment r')))
-> Path r' -> Const (Endo [Ellipse r']) (Path r')
forall r r' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Seq (PathSegment r)) (f (Seq (PathSegment r')))
-> p (Path r) (f (Path r'))
pathSegments((Seq (PathSegment r')
  -> Const (Endo [Ellipse r']) (Seq (PathSegment r')))
 -> Path r' -> Const (Endo [Ellipse r']) (Path r'))
-> ((Ellipse r' -> Const (Endo [Ellipse r']) (Ellipse r'))
    -> Seq (PathSegment r')
    -> Const (Endo [Ellipse r']) (Seq (PathSegment r')))
-> Getting (Endo [Ellipse r']) (Path r') (Ellipse r')
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathSegment r' -> Const (Endo [Ellipse r']) (PathSegment r'))
-> Seq (PathSegment r')
-> Const (Endo [Ellipse r']) (Seq (PathSegment r'))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse((PathSegment r' -> Const (Endo [Ellipse r']) (PathSegment r'))
 -> Seq (PathSegment r')
 -> Const (Endo [Ellipse r']) (Seq (PathSegment r')))
-> ((Ellipse r' -> Const (Endo [Ellipse r']) (Ellipse r'))
    -> PathSegment r' -> Const (Endo [Ellipse r']) (PathSegment r'))
-> (Ellipse r' -> Const (Endo [Ellipse r']) (Ellipse r'))
-> Seq (PathSegment r')
-> Const (Endo [Ellipse r']) (Seq (PathSegment r'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Ellipse r' -> Const (Endo [Ellipse r']) (Ellipse r'))
-> PathSegment r' -> Const (Endo [Ellipse r']) (PathSegment r')
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Ellipse r) (f (Ellipse r))
-> p (PathSegment r) (f (PathSegment r))
_EllipseSegment of
                    [Ellipse r'
e] -> Ellipse r' -> Maybe (Ellipse r')
forall a. a -> Maybe a
Just Ellipse r'
e
                    [Ellipse r']
_   -> Maybe (Ellipse r')
forall a. Maybe a
Nothing

_asCircle :: (Radical r, Eq r) => Prism' (Path r) (Circle (Point 2 r))
_asCircle :: forall r. (Radical r, Eq r) => Prism' (Path r) (Circle (Point 2 r))
_asCircle = p (Ellipse r) (f (Ellipse r)) -> p (Path r) (f (Path r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Ellipse r) (f (Ellipse r)) -> p (Path r) (f (Path r))
_asEllipse(p (Ellipse r) (f (Ellipse r)) -> p (Path r) (f (Path r)))
-> (p (Circle (Point 2 r)) (f (Circle (Point 2 r)))
    -> p (Ellipse r) (f (Ellipse r)))
-> p (Circle (Point 2 r)) (f (Circle (Point 2 r)))
-> p (Path r) (f (Path r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p (Circle (Point 2 r)) (f (Circle (Point 2 r)))
-> p (Ellipse r) (f (Ellipse r))
forall r.
(Radical r, Eq r) =>
Prism' (Ellipse r) (Circle (Point 2 r))
Prism' (Ellipse r) (Circle (Point 2 r))
_EllipseCircle
-- FIXME: For reading we should not need the Radical constraint!

_asDisk :: (Radical r, Eq r) => Prism' (Path r) (Disk (Point 2 r))
_asDisk :: forall r. (Radical r, Eq r) => Prism' (Path r) (Disk (Point 2 r))
_asDisk = p (Circle (Point 2 r)) (f (Circle (Point 2 r)))
-> p (Path r) (f (Path r))
forall r. (Radical r, Eq r) => Prism' (Path r) (Circle (Point 2 r))
Prism' (Path r) (Circle (Point 2 r))
_asCircle(p (Circle (Point 2 r)) (f (Circle (Point 2 r)))
 -> p (Path r) (f (Path r)))
-> (p (Disk (Point 2 r)) (f (Disk (Point 2 r)))
    -> p (Circle (Point 2 r)) (f (Circle (Point 2 r))))
-> p (Disk (Point 2 r)) (f (Disk (Point 2 r)))
-> p (Path r) (f (Path r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AnIso
  (Disk (Point 2 r))
  (Disk (Point 2 r))
  (Circle (Point 2 r))
  (Circle (Point 2 r))
-> Iso
     (Circle (Point 2 r))
     (Circle (Point 2 r))
     (Disk (Point 2 r))
     (Disk (Point 2 r))
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso
  (Disk (Point 2 r))
  (Disk (Point 2 r))
  (Circle (Point 2 r))
  (Circle (Point 2 r))
forall point point' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Circle point) (f (Circle point'))
-> p (Disk point) (f (Disk point'))
_DiskCircle


-- -- | Convert to a multipolygon
-- _asMultiPolygon :: Prism' (Path r) (MultiPolygon () r)
-- _asMultiPolygon = _asSomePolygon._Right

-- _asPolygon :: Prism' (Path r) (forall t. Polygon t () r)
-- _asPolygon = prism' polygonToPath (fmap (either id id) . pathToPolygon)

-- _asSomePolygon :: Prism' (Path r) (SomePolygon () r)
-- _asSomePolygon = prism' embed pathToPolygon
--   where
--     embed     = either polygonToPath polygonToPath


polygonToPath :: SimplePolygon (Point 2 r) -> Path r
polygonToPath :: forall r. SimplePolygon (Point 2 r) -> Path r
polygonToPath = Seq (PathSegment r) -> Path r
forall r. Seq (PathSegment r) -> Path r
Path (Seq (PathSegment r) -> Path r)
-> (SimplePolygon (Point 2 r) -> Seq (PathSegment r))
-> SimplePolygon (Point 2 r)
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment r -> Seq (PathSegment r)
forall a. a -> Seq a
fromSingleton (PathSegment r -> Seq (PathSegment r))
-> (SimplePolygon (Point 2 r) -> PathSegment r)
-> SimplePolygon (Point 2 r)
-> Seq (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimplePolygon (Point 2 r) -> PathSegment r
forall r. SimplePolygon (Point 2 r) -> PathSegment r
PolygonPath


-- polygonToPath (MultiPolygon vs hs) = Path . LSeq.fromNonEmpty . fmap PolygonPath
--                                    $ vs :| hs

pathToPolygon   :: Path r -> Maybe (SimplePolygon (Point 2 r))
pathToPolygon :: forall r. Path r -> Maybe (SimplePolygon (Point 2 r))
pathToPolygon Path r
p = case Path r
pPath r
-> Getting
     (Endo [SimplePolygon (Point 2 r)])
     (Path r)
     (SimplePolygon (Point 2 r))
-> [SimplePolygon (Point 2 r)]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(Seq (PathSegment r)
 -> Const (Endo [SimplePolygon (Point 2 r)]) (Seq (PathSegment r)))
-> Path r -> Const (Endo [SimplePolygon (Point 2 r)]) (Path r)
forall r r' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Seq (PathSegment r)) (f (Seq (PathSegment r')))
-> p (Path r) (f (Path r'))
pathSegments((Seq (PathSegment r)
  -> Const (Endo [SimplePolygon (Point 2 r)]) (Seq (PathSegment r)))
 -> Path r -> Const (Endo [SimplePolygon (Point 2 r)]) (Path r))
-> ((SimplePolygon (Point 2 r)
     -> Const
          (Endo [SimplePolygon (Point 2 r)]) (SimplePolygon (Point 2 r)))
    -> Seq (PathSegment r)
    -> Const (Endo [SimplePolygon (Point 2 r)]) (Seq (PathSegment r)))
-> Getting
     (Endo [SimplePolygon (Point 2 r)])
     (Path r)
     (SimplePolygon (Point 2 r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathSegment r
 -> Const (Endo [SimplePolygon (Point 2 r)]) (PathSegment r))
-> Seq (PathSegment r)
-> Const (Endo [SimplePolygon (Point 2 r)]) (Seq (PathSegment r))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse((PathSegment r
  -> Const (Endo [SimplePolygon (Point 2 r)]) (PathSegment r))
 -> Seq (PathSegment r)
 -> Const (Endo [SimplePolygon (Point 2 r)]) (Seq (PathSegment r)))
-> ((SimplePolygon (Point 2 r)
     -> Const
          (Endo [SimplePolygon (Point 2 r)]) (SimplePolygon (Point 2 r)))
    -> PathSegment r
    -> Const (Endo [SimplePolygon (Point 2 r)]) (PathSegment r))
-> (SimplePolygon (Point 2 r)
    -> Const
         (Endo [SimplePolygon (Point 2 r)]) (SimplePolygon (Point 2 r)))
-> Seq (PathSegment r)
-> Const (Endo [SimplePolygon (Point 2 r)]) (Seq (PathSegment r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimplePolygon (Point 2 r)
 -> Const
      (Endo [SimplePolygon (Point 2 r)]) (SimplePolygon (Point 2 r)))
-> PathSegment r
-> Const (Endo [SimplePolygon (Point 2 r)]) (PathSegment r)
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (PathSegment r) (f (PathSegment r))
_PolygonPath of
                    [SimplePolygon (Point 2 r)
pg]  -> SimplePolygon (Point 2 r) -> Maybe (SimplePolygon (Point 2 r))
forall a. a -> Maybe a
Just SimplePolygon (Point 2 r)
pg
                    [SimplePolygon (Point 2 r)]
_     -> Maybe (SimplePolygon (Point 2 r))
forall a. Maybe a
Nothing
                    -- vs:hs -> Just . Right $ MultiPolygon vs hs





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


-- | Use the first prism to select the ipe object to depicle with, and the second
-- how to select the geometry object from there on. Then we can select the geometry
-- object, directly with its attributes here.
--
-- >>> testObject ^? _withAttrs _IpePath _asPolyLine
-- Just (PolyLine [Point2 0 0,Point2 10 10,Point2 200 100] :+ Attrs {NoAttr, NoAttr, NoAttr, NoAttr, Attr IpeColor (Named "red"), NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr})
_withAttrs       :: Prism' (IpeObject r) (i r :+ IpeAttributes i r) -> Prism' (i r) g
                 -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs :: forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs Prism' (IpeObject r) (i r :+ Attributes' r (AttributesOf i))
po Prism' (i r) g
pg = ((g :+ Attributes' r (AttributesOf i)) -> IpeObject r)
-> (IpeObject r -> Maybe (g :+ Attributes' r (AttributesOf i)))
-> Prism
     (IpeObject r)
     (IpeObject r)
     (g :+ Attributes' r (AttributesOf i))
     (g :+ Attributes' r (AttributesOf i))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (g :+ Attributes' r (AttributesOf i)) -> IpeObject r
g2o IpeObject r -> Maybe (g :+ Attributes' r (AttributesOf i))
o2g
  where
    g2o :: (g :+ Attributes' r (AttributesOf i)) -> IpeObject r
g2o    = AReview (IpeObject r) (i r :+ Attributes' r (AttributesOf i))
-> (i r :+ Attributes' r (AttributesOf i)) -> IpeObject r
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (IpeObject r) (i r :+ Attributes' r (AttributesOf i))
Prism' (IpeObject r) (i r :+ Attributes' r (AttributesOf i))
po ((i r :+ Attributes' r (AttributesOf i)) -> IpeObject r)
-> ((g :+ Attributes' r (AttributesOf i))
    -> i r :+ Attributes' r (AttributesOf i))
-> (g :+ Attributes' r (AttributesOf i))
-> IpeObject r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (g :+ Attributes' r (AttributesOf i))
  (i r :+ Attributes' r (AttributesOf i))
  g
  (i r)
-> (g -> i r)
-> (g :+ Attributes' r (AttributesOf i))
-> i r :+ Attributes' r (AttributesOf i)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (g :+ Attributes' r (AttributesOf i))
  (i r :+ Attributes' r (AttributesOf i))
  g
  (i r)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core (AReview (i r) g -> g -> i r
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (i r) g
Prism' (i r) g
pg)
    o2g :: IpeObject r -> Maybe (g :+ Attributes' r (AttributesOf i))
o2g IpeObject r
o  = Getting
  (First (i r :+ Attributes' r (AttributesOf i)))
  (IpeObject r)
  (i r :+ Attributes' r (AttributesOf i))
-> IpeObject r -> Maybe (i r :+ Attributes' r (AttributesOf i))
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First (i r :+ Attributes' r (AttributesOf i)))
  (IpeObject r)
  (i r :+ Attributes' r (AttributesOf i))
Prism' (IpeObject r) (i r :+ Attributes' r (AttributesOf i))
po IpeObject r
o Maybe (i r :+ Attributes' r (AttributesOf i))
-> ((i r :+ Attributes' r (AttributesOf i))
    -> Maybe (g :+ Attributes' r (AttributesOf i)))
-> Maybe (g :+ Attributes' r (AttributesOf i))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(i r
i :+ Attributes' r (AttributesOf i)
ats) -> (g
-> Attributes' r (AttributesOf i)
-> g :+ Attributes' r (AttributesOf i)
forall core extra. core -> extra -> core :+ extra
:+ Attributes' r (AttributesOf i)
ats) (g -> g :+ Attributes' r (AttributesOf i))
-> Maybe g -> Maybe (g :+ Attributes' r (AttributesOf i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (First g) (i r) g -> i r -> Maybe g
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First g) (i r) g
Prism' (i r) g
pg i r
i





-- instance HasDefaultIpeObject Path where
--   defaultIpeObject' = _IpePath




class HasDefaultFromIpe g where
  type DefaultFromIpe g :: Type -> Type
  defaultFromIpe :: (r ~ NumType g)
                 => Prism' (IpeObject r) (g :+ IpeAttributes (DefaultFromIpe g) r)

instance HasDefaultFromIpe (Point 2 r) where
  type DefaultFromIpe (Point 2 r) = IpeSymbol
  defaultFromIpe :: forall r.
(r ~ NumType (Point 2 r)) =>
Prism'
  (IpeObject r)
  (Point 2 r :+ IpeAttributes (DefaultFromIpe (Point 2 r)) r)
defaultFromIpe = Prism' (IpeObject r) (IpeSymbol r :+ IpeAttributes IpeSymbol r)
-> Prism' (IpeSymbol r) (Point 2 r)
-> Prism' (IpeObject r) (Point 2 r :+ IpeAttributes IpeSymbol r)
forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs p (IpeSymbol r :+ IpeAttributes IpeSymbol r)
  (f (IpeSymbol r :+ IpeAttributes IpeSymbol r))
-> p (IpeObject r) (f (IpeObject r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (IpeObject' IpeSymbol r) (f (IpeObject' IpeSymbol r))
-> p (IpeObject r) (f (IpeObject r))
Prism' (IpeObject r) (IpeSymbol r :+ IpeAttributes IpeSymbol r)
_IpeUse p (Point 2 r) (f (Point 2 r)) -> p (IpeSymbol r) (f (IpeSymbol r))
p (Point 2 r) (f (Point 2 r)) -> p (IpeSymbol r) (f (IpeSymbol r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Point 2 r) (f (Point 2 r)) -> p (IpeSymbol r) (f (IpeSymbol r))
Prism' (IpeSymbol r) (Point 2 r)
_asPoint

instance HasDefaultFromIpe (ClosedLineSegment (Point 2 r)) where
  type DefaultFromIpe (ClosedLineSegment (Point 2 r)) = Path
  defaultFromIpe :: forall r.
(r ~ NumType (ClosedLineSegment (Point 2 r))) =>
Prism'
  (IpeObject r)
  (ClosedLineSegment (Point 2 r)
   :+ IpeAttributes
        (DefaultFromIpe (ClosedLineSegment (Point 2 r))) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (ClosedLineSegment (Point 2 r))
-> Prism'
     (IpeObject r)
     (ClosedLineSegment (Point 2 r) :+ IpeAttributes Path r)
forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs p (Path r :+ IpeAttributes Path r)
  (f (Path r :+ IpeAttributes Path r))
-> p (IpeObject r) (f (IpeObject r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (IpeObject' Path r) (f (IpeObject' Path r))
-> p (IpeObject r) (f (IpeObject r))
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath p (ClosedLineSegment (Point 2 r))
  (f (ClosedLineSegment (Point 2 r)))
-> p (Path r) (f (Path r))
p (ClosedLineSegment (Point 2 r))
  (f (ClosedLineSegment (Point 2 r)))
-> p (Path r) (f (Path r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ClosedLineSegment (Point 2 r))
  (f (ClosedLineSegment (Point 2 r)))
-> p (Path r) (f (Path r))
Prism' (Path r) (ClosedLineSegment (Point 2 r))
_asClosedLineSegment

instance HasDefaultFromIpe (LineSegment AnEndPoint (Point 2 r)) where
  type DefaultFromIpe (LineSegment AnEndPoint (Point 2 r)) = Path
  defaultFromIpe :: forall r.
(r ~ NumType (LineSegment AnEndPoint (Point 2 r))) =>
Prism'
  (IpeObject r)
  (LineSegment AnEndPoint (Point 2 r)
   :+ IpeAttributes
        (DefaultFromIpe (LineSegment AnEndPoint (Point 2 r))) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (LineSegment AnEndPoint (Point 2 r))
-> Prism'
     (IpeObject r)
     (LineSegment AnEndPoint (Point 2 r) :+ IpeAttributes Path r)
forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs p (Path r :+ IpeAttributes Path r)
  (f (Path r :+ IpeAttributes Path r))
-> p (IpeObject r) (f (IpeObject r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (IpeObject' Path r) (f (IpeObject' Path r))
-> p (IpeObject r) (f (IpeObject r))
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath p (LineSegment AnEndPoint (Point 2 r))
  (f (LineSegment AnEndPoint (Point 2 r)))
-> p (Path r) (f (Path r))
p (LineSegment AnEndPoint (Point 2 r))
  (f (LineSegment AnEndPoint (Point 2 r)))
-> p (Path r) (f (Path r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (LineSegment AnEndPoint (Point 2 r))
  (f (LineSegment AnEndPoint (Point 2 r)))
-> p (Path r) (f (Path r))
Prism' (Path r) (LineSegment AnEndPoint (Point 2 r))
_asLineSegment

instance HasDefaultFromIpe (Ellipse r) where
  type DefaultFromIpe (Ellipse r) = Path
  defaultFromIpe :: forall r.
(r ~ NumType (Ellipse r)) =>
Prism'
  (IpeObject r)
  (Ellipse r :+ IpeAttributes (DefaultFromIpe (Ellipse r)) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (Ellipse r)
-> Prism' (IpeObject r) (Ellipse r :+ IpeAttributes Path r)
forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs p (Path r :+ IpeAttributes Path r)
  (f (Path r :+ IpeAttributes Path r))
-> p (IpeObject r) (f (IpeObject r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (IpeObject' Path r) (f (IpeObject' Path r))
-> p (IpeObject r) (f (IpeObject r))
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath p (Ellipse r) (f (Ellipse r)) -> p (Path r) (f (Path r))
p (Ellipse r) (f (Ellipse r)) -> p (Path r) (f (Path r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Ellipse r) (f (Ellipse r)) -> p (Path r) (f (Path r))
Prism' (Path r) (Ellipse r)
_asEllipse

instance (Radical r, Eq r) => HasDefaultFromIpe (Circle (Point 2 r)) where
  type DefaultFromIpe (Circle (Point 2 r)) = Path
  defaultFromIpe :: forall r.
(r ~ NumType (Circle (Point 2 r))) =>
Prism'
  (IpeObject r)
  (Circle (Point 2 r)
   :+ IpeAttributes (DefaultFromIpe (Circle (Point 2 r))) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (Circle (Point 2 r))
-> Prism'
     (IpeObject r) (Circle (Point 2 r) :+ IpeAttributes Path r)
forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs p (Path r :+ IpeAttributes Path r)
  (f (Path r :+ IpeAttributes Path r))
-> p (IpeObject r) (f (IpeObject r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (IpeObject' Path r) (f (IpeObject' Path r))
-> p (IpeObject r) (f (IpeObject r))
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath p (Circle (Point 2 r)) (f (Circle (Point 2 r)))
-> p (Path r) (f (Path r))
p (Circle (Point 2 r)) (f (Circle (Point 2 r)))
-> p (Path r) (f (Path r))
forall r. (Radical r, Eq r) => Prism' (Path r) (Circle (Point 2 r))
Prism' (Path r) (Circle (Point 2 r))
Prism' (Path r) (Circle (Point 2 r))
_asCircle

instance (Radical r, Eq r) => HasDefaultFromIpe (Disk (Point 2 r)) where
  type DefaultFromIpe (Disk (Point 2 r)) = Path
  defaultFromIpe :: forall r.
(r ~ NumType (Disk (Point 2 r))) =>
Prism'
  (IpeObject r)
  (Disk (Point 2 r)
   :+ IpeAttributes (DefaultFromIpe (Disk (Point 2 r))) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (Disk (Point 2 r))
-> Prism' (IpeObject r) (Disk (Point 2 r) :+ IpeAttributes Path r)
forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs p (Path r :+ IpeAttributes Path r)
  (f (Path r :+ IpeAttributes Path r))
-> p (IpeObject r) (f (IpeObject r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (IpeObject' Path r) (f (IpeObject' Path r))
-> p (IpeObject r) (f (IpeObject r))
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath p (Disk (Point 2 r)) (f (Disk (Point 2 r)))
-> p (Path r) (f (Path r))
p (Disk (Point 2 r)) (f (Disk (Point 2 r)))
-> p (Path r) (f (Path r))
forall r. (Radical r, Eq r) => Prism' (Path r) (Disk (Point 2 r))
Prism' (Path r) (Disk (Point 2 r))
Prism' (Path r) (Disk (Point 2 r))
_asDisk

instance HasDefaultFromIpe (PolyLine.PolyLine (Point 2 r)) where
  type DefaultFromIpe (PolyLine.PolyLine (Point 2 r)) = Path
  defaultFromIpe :: forall r.
(r ~ NumType (PolyLine (Point 2 r))) =>
Prism'
  (IpeObject r)
  (PolyLine (Point 2 r)
   :+ IpeAttributes (DefaultFromIpe (PolyLine (Point 2 r))) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (PolyLine (Point 2 r))
-> Prism'
     (IpeObject r) (PolyLine (Point 2 r) :+ IpeAttributes Path r)
forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs p (Path r :+ IpeAttributes Path r)
  (f (Path r :+ IpeAttributes Path r))
-> p (IpeObject r) (f (IpeObject r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (IpeObject' Path r) (f (IpeObject' Path r))
-> p (IpeObject r) (f (IpeObject r))
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
-> p (Path r) (f (Path r))
p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
-> p (Path r) (f (Path r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r)))
-> p (Path r) (f (Path r))
Prism' (Path r) (PolyLine (Point 2 r))
_asPolyLine


instance HasDefaultFromIpe (SimplePolygon (Point 2 r)) where
  type DefaultFromIpe (SimplePolygon (Point 2 r)) = Path
  defaultFromIpe :: forall r.
(r ~ NumType (SimplePolygon (Point 2 r))) =>
Prism'
  (IpeObject r)
  (SimplePolygon (Point 2 r)
   :+ IpeAttributes (DefaultFromIpe (SimplePolygon (Point 2 r))) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (SimplePolygon (Point 2 r))
-> Prism'
     (IpeObject r) (SimplePolygon (Point 2 r) :+ IpeAttributes Path r)
forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs p (Path r :+ IpeAttributes Path r)
  (f (Path r :+ IpeAttributes Path r))
-> p (IpeObject r) (f (IpeObject r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (IpeObject' Path r) (f (IpeObject' Path r))
-> p (IpeObject r) (f (IpeObject r))
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (Path r) (f (Path r))
p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (Path r) (f (Path r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r)))
-> p (Path r) (f (Path r))
Prism' (Path r) (SimplePolygon (Point 2 r))
_asSimplePolygon

-- instance HasDefaultFromIpe (MultiPolygon () r) where
--   type DefaultFromIpe (MultiPolygon () r) = Path
--   defaultFromIpe = _withAttrs _IpePath _asMultiPolygon

instance (Num r, Ord r) => HasDefaultFromIpe (Rectangle (Point 2 r)) where
  type DefaultFromIpe (Rectangle (Point 2 r)) = Path
  defaultFromIpe :: forall r.
(r ~ NumType (Rectangle (Point 2 r))) =>
Prism'
  (IpeObject r)
  (Rectangle (Point 2 r)
   :+ IpeAttributes (DefaultFromIpe (Rectangle (Point 2 r))) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (Rectangle (Point 2 r))
-> Prism'
     (IpeObject r) (Rectangle (Point 2 r) :+ IpeAttributes Path r)
forall r (i :: * -> *) g.
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs p (Path r :+ IpeAttributes Path r)
  (f (Path r :+ IpeAttributes Path r))
-> p (IpeObject r) (f (IpeObject r))
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (IpeObject' Path r) (f (IpeObject' Path r))
-> p (IpeObject r) (f (IpeObject r))
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath p (Rectangle (Point 2 r)) (f (Rectangle (Point 2 r)))
-> p (Path r) (f (Path r))
p (Rectangle (Point 2 r)) (f (Rectangle (Point 2 r)))
-> p (Path r) (f (Path r))
forall r. (Num r, Ord r) => Prism' (Path r) (Rectangle (Point 2 r))
Prism' (Path r) (Rectangle (Point 2 r))
Prism' (Path r) (Rectangle (Point 2 r))
_asRectangle


-- | Read all g's from some ipe page(s).
readAll   :: forall g r. (HasDefaultFromIpe g, r ~ NumType g)
          => IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
readAll :: forall g r.
(HasDefaultFromIpe g, r ~ NumType g) =>
IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
readAll IpePage r
p = IpePage r
pIpePage r
-> Getting
     (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
     (IpePage r)
     (g :+ Attributes' r (AttributesOf (DefaultFromIpe g)))
-> [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..([IpeObject r]
 -> Const
      (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
      [IpeObject r])
-> IpePage r
-> Const
     (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
     (IpePage r)
forall r r' (f :: * -> *).
Functor f =>
([IpeObject r] -> f [IpeObject r']) -> IpePage r -> f (IpePage r')
content(([IpeObject r]
  -> Const
       (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
       [IpeObject r])
 -> IpePage r
 -> Const
      (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
      (IpePage r))
-> (((g :+ Attributes' r (AttributesOf (DefaultFromIpe g)))
     -> Const
          (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
          (g :+ Attributes' r (AttributesOf (DefaultFromIpe g))))
    -> [IpeObject r]
    -> Const
         (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
         [IpeObject r])
-> Getting
     (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
     (IpePage r)
     (g :+ Attributes' r (AttributesOf (DefaultFromIpe g)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IpeObject r
 -> Const
      (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
      (IpeObject r))
-> [IpeObject r]
-> Const
     (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
     [IpeObject r]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse((IpeObject r
  -> Const
       (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
       (IpeObject r))
 -> [IpeObject r]
 -> Const
      (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
      [IpeObject r])
-> (((g :+ Attributes' r (AttributesOf (DefaultFromIpe g)))
     -> Const
          (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
          (g :+ Attributes' r (AttributesOf (DefaultFromIpe g))))
    -> IpeObject r
    -> Const
         (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
         (IpeObject r))
-> ((g :+ Attributes' r (AttributesOf (DefaultFromIpe g)))
    -> Const
         (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
         (g :+ Attributes' r (AttributesOf (DefaultFromIpe g))))
-> [IpeObject r]
-> Const
     (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
     [IpeObject r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((g :+ Attributes' r (AttributesOf (DefaultFromIpe g)))
 -> Const
      (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
      (g :+ Attributes' r (AttributesOf (DefaultFromIpe g))))
-> IpeObject r
-> Const
     (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
     (IpeObject r)
((g :+ IpeAttributes (DefaultFromIpe g) (NumType g))
 -> Const
      (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
      (g :+ IpeAttributes (DefaultFromIpe g) (NumType g)))
-> IpeObject (NumType g)
-> Const
     (Endo [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
     (IpeObject (NumType g))
forall r.
(r ~ NumType g) =>
Prism' (IpeObject r) (g :+ IpeAttributes (DefaultFromIpe g) r)
forall g r.
(HasDefaultFromIpe g, r ~ NumType g) =>
Prism' (IpeObject r) (g :+ IpeAttributes (DefaultFromIpe g) r)
Prism'
  (IpeObject (NumType g))
  (g :+ IpeAttributes (DefaultFromIpe g) (NumType g))
defaultFromIpe

-- | Convenience function from reading all g's from an ipe file. If there
-- is an error reading or parsing the file the error is "thrown away".
readAllFrom    :: forall g r. (HasDefaultFromIpe g, r ~ NumType g, Coordinate r, Eq r)
               => OsPath -> IO [g :+ IpeAttributes (DefaultFromIpe g) r]
readAllFrom :: forall g r.
(HasDefaultFromIpe g, r ~ NumType g, Coordinate r, Eq r) =>
OsPath -> IO [g :+ IpeAttributes (DefaultFromIpe g) r]
readAllFrom OsPath
fp = (IpePage (NumType g)
 -> [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
-> Either Text (IpePage (NumType g))
-> [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))]
forall m a. Monoid m => (a -> m) -> Either Text a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IpePage (NumType g)
-> [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))]
IpePage (NumType g)
-> [g :+ IpeAttributes (DefaultFromIpe g) (NumType g)]
forall g r.
(HasDefaultFromIpe g, r ~ NumType g) =>
IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
readAll (Either Text (IpePage (NumType g))
 -> [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))])
-> IO (Either Text (IpePage (NumType g)))
-> IO [g :+ Attributes' r (AttributesOf (DefaultFromIpe g))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> IO (Either Text (IpePage (NumType g)))
forall r.
(Coordinate r, Eq r) =>
OsPath -> IO (Either Text (IpePage r))
readSinglePageFile OsPath
fp

fromSingleton :: a -> Seq.Seq a
fromSingleton :: forall a. a -> Seq a
fromSingleton = a -> Seq a
forall a. a -> Seq a
Seq.singleton