{-# 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
  , _asRectangle
  , _asTriangle

  , _asPolyLine
  , _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.Ext
import           Data.Geometry.Ball
import           Data.Geometry.Box
import           Data.Geometry.Ellipse (Ellipse, _EllipseCircle)
import           Ipe.Path
import           Ipe.Reader
import           Ipe.Types
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import qualified Data.Geometry.PolyLine as PolyLine
import           Data.Geometry.Polygon
import           Data.Geometry.Properties
import           Data.Geometry.Triangle
import qualified Data.LSeq as LSeq
import           Data.List.NonEmpty (NonEmpty(..))

--------------------------------------------------------------------------------
-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Ipe.Attributes
-- >>> import Ipe.Color(IpeColor(..))
-- >>> import Data.Geometry.Point
-- >>> :{
-- let testPath :: Path Int
--     testPath = Path . fromSingleton  . PolyLineSegment
--              . PolyLine.fromPoints . map ext
--              $ [ 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 :: 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 r1. Point 2 r1 -> Text -> IpeSymbol r1
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 r1 r2.
Lens (IpeSymbol r1) (IpeSymbol r2) (Point 2 r1) (Point 2 r2)
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 2 () r)
_asLineSegment :: p (LineSegment 2 () r) (f (LineSegment 2 () r))
-> p (Path r) (f (Path r))
_asLineSegment = (LineSegment 2 () r -> Path r)
-> (Path r -> Maybe (LineSegment 2 () r))
-> Prism
     (Path r) (Path r) (LineSegment 2 () r) (LineSegment 2 () r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' LineSegment 2 () r -> Path r
forall r. LineSegment 2 () r -> Path r
seg2path Path r -> Maybe (LineSegment 2 () r)
forall r. Path r -> Maybe (LineSegment 2 () r)
path2seg
  where
    seg2path :: LineSegment 2 () r -> Path r
seg2path   = AReview (Path r) (PolyLine 2 () r) -> PolyLine 2 () r -> Path r
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (Path r) (PolyLine 2 () r)
forall r. Prism' (Path r) (PolyLine 2 () r)
_asPolyLine (PolyLine 2 () r -> Path r)
-> (LineSegment 2 () r -> PolyLine 2 () r)
-> LineSegment 2 () r
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineSegment 2 () r -> PolyLine 2 () r
forall (d :: Nat) p r. LineSegment d p r -> PolyLine d p r
PolyLine.fromLineSegment
    path2seg :: Path r -> Maybe (LineSegment 2 () r)
path2seg Path r
p = PolyLine 2 () r -> Maybe (LineSegment 2 () r)
forall (d :: Nat) p r. PolyLine d p r -> Maybe (LineSegment d p r)
PolyLine.asLineSegment' (PolyLine 2 () r -> Maybe (LineSegment 2 () r))
-> Maybe (PolyLine 2 () r) -> Maybe (LineSegment 2 () r)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting (First (PolyLine 2 () r)) (Path r) (PolyLine 2 () r)
-> Path r -> Maybe (PolyLine 2 () r)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (PolyLine 2 () r)) (Path r) (PolyLine 2 () r)
forall r. Prism' (Path r) (PolyLine 2 () r)
_asPolyLine Path r
p

-- | Convert to a polyline. Ignores all non-polyline parts
--
-- >>> testPath ^? _asPolyLine
-- Just (PolyLine {_points = LSeq (fromList [Point2 [0,0] :+ (),Point2 [10,10] :+ (),Point2 [200,100] :+ ()])})
_asPolyLine :: Prism' (Path r) (PolyLine.PolyLine 2 () r)
_asPolyLine :: p (PolyLine 2 () r) (f (PolyLine 2 () r))
-> p (Path r) (f (Path r))
_asPolyLine = (PolyLine 2 () r -> Path r)
-> (Path r -> Maybe (PolyLine 2 () r))
-> Prism (Path r) (Path r) (PolyLine 2 () r) (PolyLine 2 () r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' PolyLine 2 () r -> Path r
forall r. PolyLine 2 () r -> Path r
poly2path Path r -> Maybe (PolyLine 2 () r)
path2poly
  where
    poly2path :: PolyLine 2 () r -> Path r
poly2path = LSeq 1 (PathSegment r) -> Path r
forall r1. LSeq 1 (PathSegment r1) -> Path r1
Path (LSeq 1 (PathSegment r) -> Path r)
-> (PolyLine 2 () r -> LSeq 1 (PathSegment r))
-> PolyLine 2 () r
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment r -> LSeq 1 (PathSegment r)
forall a. a -> LSeq 1 a
fromSingleton  (PathSegment r -> LSeq 1 (PathSegment r))
-> (PolyLine 2 () r -> PathSegment r)
-> PolyLine 2 () r
-> LSeq 1 (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyLine 2 () r -> PathSegment r
forall r. PolyLine 2 () r -> PathSegment r
PolyLineSegment
    path2poly :: Path r -> Maybe (PolyLine 2 () r)
path2poly = Getting (First (PolyLine 2 () r)) (Path r) (PolyLine 2 () r)
-> Path r -> Maybe (PolyLine 2 () r)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((LSeq 1 (PathSegment r)
 -> Const (First (PolyLine 2 () r)) (LSeq 1 (PathSegment r)))
-> Path r -> Const (First (PolyLine 2 () r)) (Path r)
forall r1 r2.
Iso
  (Path r1)
  (Path r2)
  (LSeq 1 (PathSegment r1))
  (LSeq 1 (PathSegment r2))
pathSegments((LSeq 1 (PathSegment r)
  -> Const (First (PolyLine 2 () r)) (LSeq 1 (PathSegment r)))
 -> Path r -> Const (First (PolyLine 2 () r)) (Path r))
-> ((PolyLine 2 () r
     -> Const (First (PolyLine 2 () r)) (PolyLine 2 () r))
    -> LSeq 1 (PathSegment r)
    -> Const (First (PolyLine 2 () r)) (LSeq 1 (PathSegment r)))
-> Getting (First (PolyLine 2 () r)) (Path r) (PolyLine 2 () r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathSegment r -> Const (First (PolyLine 2 () r)) (PathSegment r))
-> LSeq 1 (PathSegment r)
-> Const (First (PolyLine 2 () r)) (LSeq 1 (PathSegment r))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse((PathSegment r -> Const (First (PolyLine 2 () r)) (PathSegment r))
 -> LSeq 1 (PathSegment r)
 -> Const (First (PolyLine 2 () r)) (LSeq 1 (PathSegment r)))
-> ((PolyLine 2 () r
     -> Const (First (PolyLine 2 () r)) (PolyLine 2 () r))
    -> PathSegment r
    -> Const (First (PolyLine 2 () r)) (PathSegment r))
-> (PolyLine 2 () r
    -> Const (First (PolyLine 2 () r)) (PolyLine 2 () r))
-> LSeq 1 (PathSegment r)
-> Const (First (PolyLine 2 () r)) (LSeq 1 (PathSegment r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PolyLine 2 () r
 -> Const (First (PolyLine 2 () r)) (PolyLine 2 () r))
-> PathSegment r -> Const (First (PolyLine 2 () r)) (PathSegment r)
forall r. Prism' (PathSegment r) (PolyLine 2 () 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) (Polygon Simple () r)
_asSimplePolygon :: p (Polygon 'Simple () r) (f (Polygon 'Simple () r))
-> p (Path r) (f (Path r))
_asSimplePolygon = p (SomePolygon () r) (f (SomePolygon () r))
-> p (Path r) (f (Path r))
forall r. Prism' (Path r) (SomePolygon () r)
_asSomePolygon(p (SomePolygon () r) (f (SomePolygon () r))
 -> p (Path r) (f (Path r)))
-> (p (Polygon 'Simple () r) (f (Polygon 'Simple () r))
    -> p (SomePolygon () r) (f (SomePolygon () r)))
-> p (Polygon 'Simple () r) (f (Polygon 'Simple () r))
-> p (Path r) (f (Path r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p (Polygon 'Simple () r) (f (Polygon 'Simple () r))
-> p (SomePolygon () r) (f (SomePolygon () r))
forall a c b. Prism (Either a c) (Either b c) a b
_Left


-- | Tries to convert a path into a rectangle.
_asRectangle :: forall r. (Num r, Ord r) => Prism' (Path r) (Rectangle () r)
_asRectangle :: Prism' (Path r) (Rectangle () r)
_asRectangle = (Rectangle () r -> Path r)
-> (Path r -> Maybe (Rectangle () r))
-> Prism' (Path r) (Rectangle () r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Rectangle () r -> Path r
forall r. (Num r, Eq r) => Rectangle () r -> Path r
rectToPath Path r -> Maybe (Rectangle () r)
pathToRect
  where
    rectToPath :: Rectangle () r -> Path r
rectToPath (Rectangle () r -> Corners (Point 2 r :+ ())
forall r p. Num r => Rectangle p r -> Corners (Point 2 r :+ p)
corners -> Corners Point 2 r :+ ()
a Point 2 r :+ ()
b Point 2 r :+ ()
c Point 2 r :+ ()
d) = AReview (Path r) (SimplePolygon () r)
-> SimplePolygon () r -> Path r
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (Path r) (SimplePolygon () r)
forall r. Prism' (Path r) (Polygon 'Simple () r)
_asSimplePolygon (SimplePolygon () r -> Path r)
-> ([Point 2 r :+ ()] -> SimplePolygon () r)
-> [Point 2 r :+ ()]
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ ()] -> SimplePolygon () r
forall p r. (Eq r, Num r) => [Point 2 r :+ p] -> SimplePolygon p r
fromPoints ([Point 2 r :+ ()] -> Path r) -> [Point 2 r :+ ()] -> Path r
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ ()
a,Point 2 r :+ ()
b,Point 2 r :+ ()
c,Point 2 r :+ ()
d]
    pathToRect :: Path r -> Maybe (Rectangle () r)
pathToRect Path r
p = Path r
pPath r
-> Getting
     (First (SimplePolygon () r)) (Path r) (SimplePolygon () r)
-> Maybe (SimplePolygon () r)
forall s a. s -> Getting (First a) s a -> Maybe a
^?Getting (First (SimplePolygon () r)) (Path r) (SimplePolygon () r)
forall r. Prism' (Path r) (Polygon 'Simple () r)
_asSimplePolygon Maybe (SimplePolygon () r)
-> (SimplePolygon () r -> Maybe (Rectangle () r))
-> Maybe (Rectangle () r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SimplePolygon () r -> Maybe (Rectangle () r)
asRect

    asRect    :: SimplePolygon () r -> Maybe (Rectangle () r)
    asRect :: SimplePolygon () r -> Maybe (Rectangle () r)
asRect SimplePolygon () r
pg = case SimplePolygon () r
pgSimplePolygon () r
-> Getting
     (Endo [Point 2 r :+ ()]) (SimplePolygon () r) (Point 2 r :+ ())
-> [Point 2 r :+ ()]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(CircularVector (Point 2 r :+ ())
 -> Const
      (Endo [Point 2 r :+ ()]) (CircularVector (Point 2 r :+ ())))
-> SimplePolygon () r
-> Const (Endo [Point 2 r :+ ()]) (SimplePolygon () r)
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector((CircularVector (Point 2 r :+ ())
  -> Const
       (Endo [Point 2 r :+ ()]) (CircularVector (Point 2 r :+ ())))
 -> SimplePolygon () r
 -> Const (Endo [Point 2 r :+ ()]) (SimplePolygon () r))
-> (((Point 2 r :+ ())
     -> Const (Endo [Point 2 r :+ ()]) (Point 2 r :+ ()))
    -> CircularVector (Point 2 r :+ ())
    -> Const
         (Endo [Point 2 r :+ ()]) (CircularVector (Point 2 r :+ ())))
-> Getting
     (Endo [Point 2 r :+ ()]) (SimplePolygon () r) (Point 2 r :+ ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ ())
 -> Const (Endo [Point 2 r :+ ()]) (Point 2 r :+ ()))
-> CircularVector (Point 2 r :+ ())
-> Const
     (Endo [Point 2 r :+ ()]) (CircularVector (Point 2 r :+ ()))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse 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 (d :: Nat) (d :: Nat) a (point :: Nat -> * -> *)
       (point :: Nat -> * -> *) extra extra.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d), Eq a,
 ArityPeano (Peano (FromPeano (Peano d))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d,
 KnownNat (FromPeano (Peano d)), KnownNat (FromPeano (Peano d)),
 KnownNat d, AsAPoint point, AsAPoint point,
 Peano (FromPeano (Peano d) + 1) ~ 'S (Peano (FromPeano (Peano d))),
 (1 <=? d) ~ 'True, (1 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
(point d a :+ extra) -> (point d a :+ extra) -> Bool
isH Point 2 r :+ ()
a Point 2 r :+ ()
b Bool -> Bool -> Bool
&& (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Bool
forall (d :: Nat) (d :: Nat) a (point :: Nat -> * -> *)
       (point :: Nat -> * -> *) extra extra.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d), Eq a,
 ArityPeano (Peano (FromPeano (Peano d))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d,
 KnownNat (FromPeano (Peano d)), KnownNat (FromPeano (Peano d)),
 KnownNat d, AsAPoint point, AsAPoint point,
 Peano (FromPeano (Peano d) + 1) ~ 'S (Peano (FromPeano (Peano d))),
 (2 <=? d) ~ 'True, (2 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
(point d a :+ extra) -> (point d a :+ extra) -> Bool
isV Point 2 r :+ ()
b Point 2 r :+ ()
c Bool -> Bool -> Bool
&& (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Bool
forall (d :: Nat) (d :: Nat) a (point :: Nat -> * -> *)
       (point :: Nat -> * -> *) extra extra.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d), Eq a,
 ArityPeano (Peano (FromPeano (Peano d))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d,
 KnownNat (FromPeano (Peano d)), KnownNat (FromPeano (Peano d)),
 KnownNat d, AsAPoint point, AsAPoint point,
 Peano (FromPeano (Peano d) + 1) ~ 'S (Peano (FromPeano (Peano d))),
 (1 <=? d) ~ 'True, (1 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
(point d a :+ extra) -> (point d a :+ extra) -> Bool
isH Point 2 r :+ ()
c Point 2 r :+ ()
d Bool -> Bool -> Bool
&& (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Bool
forall (d :: Nat) (d :: Nat) a (point :: Nat -> * -> *)
       (point :: Nat -> * -> *) extra extra.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d), Eq a,
 ArityPeano (Peano (FromPeano (Peano d))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d,
 KnownNat (FromPeano (Peano d)), KnownNat (FromPeano (Peano d)),
 KnownNat d, AsAPoint point, AsAPoint point,
 Peano (FromPeano (Peano d) + 1) ~ 'S (Peano (FromPeano (Peano d))),
 (2 <=? d) ~ 'True, (2 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
(point d a :+ extra) -> (point d a :+ extra) -> Bool
isV Point 2 r :+ ()
d Point 2 r :+ ()
a -> Rectangle () r -> Maybe (Rectangle () r)
forall a. a -> Maybe a
Just ([Point 2 r :+ ()]
-> Box (Dimension (Point 2 r :+ ())) () (NumType (Point 2 r :+ ()))
forall g (c :: * -> *).
(IsBoxable g, Foldable c, Ord (NumType g), Arity (Dimension g)) =>
c g -> Box (Dimension g) () (NumType g)
boundingBoxList' [Point 2 r :+ ()
a,Point 2 r :+ ()
c])
        [Point 2 r :+ ()
a,Point 2 r :+ ()
b,Point 2 r :+ ()
c,Point 2 r :+ ()
d] | (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Bool
forall (d :: Nat) (d :: Nat) a (point :: Nat -> * -> *)
       (point :: Nat -> * -> *) extra extra.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d), Eq a,
 ArityPeano (Peano (FromPeano (Peano d))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d,
 KnownNat (FromPeano (Peano d)), KnownNat (FromPeano (Peano d)),
 KnownNat d, AsAPoint point, AsAPoint point,
 Peano (FromPeano (Peano d) + 1) ~ 'S (Peano (FromPeano (Peano d))),
 (2 <=? d) ~ 'True, (2 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
(point d a :+ extra) -> (point d a :+ extra) -> Bool
isV Point 2 r :+ ()
a Point 2 r :+ ()
b Bool -> Bool -> Bool
&& (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Bool
forall (d :: Nat) (d :: Nat) a (point :: Nat -> * -> *)
       (point :: Nat -> * -> *) extra extra.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d), Eq a,
 ArityPeano (Peano (FromPeano (Peano d))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d,
 KnownNat (FromPeano (Peano d)), KnownNat (FromPeano (Peano d)),
 KnownNat d, AsAPoint point, AsAPoint point,
 Peano (FromPeano (Peano d) + 1) ~ 'S (Peano (FromPeano (Peano d))),
 (1 <=? d) ~ 'True, (1 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
(point d a :+ extra) -> (point d a :+ extra) -> Bool
isH Point 2 r :+ ()
b Point 2 r :+ ()
c Bool -> Bool -> Bool
&& (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Bool
forall (d :: Nat) (d :: Nat) a (point :: Nat -> * -> *)
       (point :: Nat -> * -> *) extra extra.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d), Eq a,
 ArityPeano (Peano (FromPeano (Peano d))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d,
 KnownNat (FromPeano (Peano d)), KnownNat (FromPeano (Peano d)),
 KnownNat d, AsAPoint point, AsAPoint point,
 Peano (FromPeano (Peano d) + 1) ~ 'S (Peano (FromPeano (Peano d))),
 (2 <=? d) ~ 'True, (2 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
(point d a :+ extra) -> (point d a :+ extra) -> Bool
isV Point 2 r :+ ()
c Point 2 r :+ ()
d Bool -> Bool -> Bool
&& (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Bool
forall (d :: Nat) (d :: Nat) a (point :: Nat -> * -> *)
       (point :: Nat -> * -> *) extra extra.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d), Eq a,
 ArityPeano (Peano (FromPeano (Peano d))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d,
 KnownNat (FromPeano (Peano d)), KnownNat (FromPeano (Peano d)),
 KnownNat d, AsAPoint point, AsAPoint point,
 Peano (FromPeano (Peano d) + 1) ~ 'S (Peano (FromPeano (Peano d))),
 (1 <=? d) ~ 'True, (1 <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
(point d a :+ extra) -> (point d a :+ extra) -> Bool
isH Point 2 r :+ ()
d Point 2 r :+ ()
a -> Rectangle () r -> Maybe (Rectangle () r)
forall a. a -> Maybe a
Just ([Point 2 r :+ ()]
-> Box (Dimension (Point 2 r :+ ())) () (NumType (Point 2 r :+ ()))
forall g (c :: * -> *).
(IsBoxable g, Foldable c, Ord (NumType g), Arity (Dimension g)) =>
c g -> Box (Dimension g) () (NumType g)
boundingBoxList' [Point 2 r :+ ()
a,Point 2 r :+ ()
c])
        [Point 2 r :+ ()]
_                                                    -> Maybe (Rectangle () r)
forall a. Maybe a
Nothing

    isH :: (point d a :+ extra) -> (point d a :+ extra) -> Bool
isH (point d a
p :+ extra
_) (point d a
q :+ extra
_) = point d a
ppoint d a -> Getting a (point d a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (point d a) a
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== point d a
qpoint d a -> Getting a (point d a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (point d a) a
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord
    isV :: (point d a :+ extra) -> (point d a :+ extra) -> Bool
isV (point d a
p :+ extra
_) (point d a
q :+ extra
_) = point d a
ppoint d a -> Getting a (point d a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (point d a) a
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== point d a
qpoint d a -> Getting a (point d a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (point d a) a
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord


-- | Convert to a triangle
_asTriangle :: Prism' (Path r) (Triangle 2 () r)
_asTriangle :: p (Triangle 2 () r) (f (Triangle 2 () r))
-> p (Path r) (f (Path r))
_asTriangle = (Triangle 2 () r -> Path r)
-> (Path r -> Maybe (Triangle 2 () r))
-> Prism (Path r) (Path r) (Triangle 2 () r) (Triangle 2 () r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Triangle 2 () r -> Path r
forall a r. Triangle 2 a r -> Path r
triToPath Path r -> Maybe (Triangle 2 () r)
forall r1. Path r1 -> Maybe (Triangle 2 () r1)
path2tri
  where
    triToPath :: Triangle 2 a r -> Path r
triToPath (Triangle Point 2 r :+ a
p Point 2 r :+ a
q Point 2 r :+ a
r) = Polygon 'Simple () r -> Path r
forall (t :: PolygonType) r. Polygon t () r -> Path r
polygonToPath (Polygon 'Simple () r -> Path r)
-> ([Point 2 r :+ a] -> Polygon 'Simple () r)
-> [Point 2 r :+ a]
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ ()] -> Polygon 'Simple () r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints ([Point 2 r :+ ()] -> Polygon 'Simple () r)
-> ([Point 2 r :+ a] -> [Point 2 r :+ ()])
-> [Point 2 r :+ a]
-> Polygon 'Simple () r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ a) -> Point 2 r :+ ())
-> [Point 2 r :+ a] -> [Point 2 r :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Point 2 r :+ a)
-> ((Point 2 r :+ a) -> Point 2 r :+ ()) -> Point 2 r :+ ()
forall a b. a -> (a -> b) -> b
&(a -> Identity ())
-> (Point 2 r :+ a) -> Identity (Point 2 r :+ ())
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra ((a -> Identity ())
 -> (Point 2 r :+ a) -> Identity (Point 2 r :+ ()))
-> () -> (Point 2 r :+ a) -> Point 2 r :+ ()
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ()) ([Point 2 r :+ a] -> Path r) -> [Point 2 r :+ a] -> Path r
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ a
p,Point 2 r :+ a
q,Point 2 r :+ a
r]
    path2tri :: Path r1 -> Maybe (Triangle 2 () r1)
path2tri Path r1
p = case Path r1
pPath r1
-> Getting
     (Endo [Polygon 'Simple () r1]) (Path r1) (Polygon 'Simple () r1)
-> [Polygon 'Simple () r1]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(LSeq 1 (PathSegment r1)
 -> Const (Endo [Polygon 'Simple () r1]) (LSeq 1 (PathSegment r1)))
-> Path r1 -> Const (Endo [Polygon 'Simple () r1]) (Path r1)
forall r1 r2.
Iso
  (Path r1)
  (Path r2)
  (LSeq 1 (PathSegment r1))
  (LSeq 1 (PathSegment r2))
pathSegments((LSeq 1 (PathSegment r1)
  -> Const (Endo [Polygon 'Simple () r1]) (LSeq 1 (PathSegment r1)))
 -> Path r1 -> Const (Endo [Polygon 'Simple () r1]) (Path r1))
-> ((Polygon 'Simple () r1
     -> Const (Endo [Polygon 'Simple () r1]) (Polygon 'Simple () r1))
    -> LSeq 1 (PathSegment r1)
    -> Const (Endo [Polygon 'Simple () r1]) (LSeq 1 (PathSegment r1)))
-> Getting
     (Endo [Polygon 'Simple () r1]) (Path r1) (Polygon 'Simple () r1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathSegment r1
 -> Const (Endo [Polygon 'Simple () r1]) (PathSegment r1))
-> LSeq 1 (PathSegment r1)
-> Const (Endo [Polygon 'Simple () r1]) (LSeq 1 (PathSegment r1))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse((PathSegment r1
  -> Const (Endo [Polygon 'Simple () r1]) (PathSegment r1))
 -> LSeq 1 (PathSegment r1)
 -> Const (Endo [Polygon 'Simple () r1]) (LSeq 1 (PathSegment r1)))
-> ((Polygon 'Simple () r1
     -> Const (Endo [Polygon 'Simple () r1]) (Polygon 'Simple () r1))
    -> PathSegment r1
    -> Const (Endo [Polygon 'Simple () r1]) (PathSegment r1))
-> (Polygon 'Simple () r1
    -> Const (Endo [Polygon 'Simple () r1]) (Polygon 'Simple () r1))
-> LSeq 1 (PathSegment r1)
-> Const (Endo [Polygon 'Simple () r1]) (LSeq 1 (PathSegment r1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Polygon 'Simple () r1
 -> Const (Endo [Polygon 'Simple () r1]) (Polygon 'Simple () r1))
-> PathSegment r1
-> Const (Endo [Polygon 'Simple () r1]) (PathSegment r1)
forall r. Prism' (PathSegment r) (SimplePolygon () r)
_PolygonPath of
                    []   -> Maybe (Triangle 2 () r1)
forall a. Maybe a
Nothing
                    [Polygon 'Simple () r1
pg] -> case Polygon 'Simple () r1 -> NonEmpty (Point 2 r1 :+ ())
forall (t :: PolygonType) p r.
Polygon t p r -> NonEmpty (Point 2 r :+ p)
polygonVertices Polygon 'Simple () r1
pg of
                              (Point 2 r1 :+ ()
a :| [Point 2 r1 :+ ()
b,Point 2 r1 :+ ()
c]) -> Triangle 2 () r1 -> Maybe (Triangle 2 () r1)
forall a. a -> Maybe a
Just (Triangle 2 () r1 -> Maybe (Triangle 2 () r1))
-> Triangle 2 () r1 -> Maybe (Triangle 2 () r1)
forall a b. (a -> b) -> a -> b
$ (Point 2 r1 :+ ())
-> (Point 2 r1 :+ ()) -> (Point 2 r1 :+ ()) -> Triangle 2 () r1
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle Point 2 r1 :+ ()
a Point 2 r1 :+ ()
b Point 2 r1 :+ ()
c
                              NonEmpty (Point 2 r1 :+ ())
_            -> Maybe (Triangle 2 () r1)
forall a. Maybe a
Nothing
                    [Polygon 'Simple () r1]
_    -> Maybe (Triangle 2 () r1)
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 :: 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 r1. Path r1 -> Maybe (Ellipse r1)
toEllipse
  where
    toPath :: Ellipse r -> Path r
toPath      = LSeq 1 (PathSegment r) -> Path r
forall r1. LSeq 1 (PathSegment r1) -> Path r1
Path (LSeq 1 (PathSegment r) -> Path r)
-> (Ellipse r -> LSeq 1 (PathSegment r)) -> Ellipse r -> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment r -> LSeq 1 (PathSegment r)
forall a. a -> LSeq 1 a
fromSingleton  (PathSegment r -> LSeq 1 (PathSegment r))
-> (Ellipse r -> PathSegment r)
-> Ellipse r
-> LSeq 1 (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 r1 -> Maybe (Ellipse r1)
toEllipse Path r1
p = case Path r1
pPath r1
-> Getting (Endo [Ellipse r1]) (Path r1) (Ellipse r1)
-> [Ellipse r1]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(LSeq 1 (PathSegment r1)
 -> Const (Endo [Ellipse r1]) (LSeq 1 (PathSegment r1)))
-> Path r1 -> Const (Endo [Ellipse r1]) (Path r1)
forall r1 r2.
Iso
  (Path r1)
  (Path r2)
  (LSeq 1 (PathSegment r1))
  (LSeq 1 (PathSegment r2))
pathSegments((LSeq 1 (PathSegment r1)
  -> Const (Endo [Ellipse r1]) (LSeq 1 (PathSegment r1)))
 -> Path r1 -> Const (Endo [Ellipse r1]) (Path r1))
-> ((Ellipse r1 -> Const (Endo [Ellipse r1]) (Ellipse r1))
    -> LSeq 1 (PathSegment r1)
    -> Const (Endo [Ellipse r1]) (LSeq 1 (PathSegment r1)))
-> Getting (Endo [Ellipse r1]) (Path r1) (Ellipse r1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathSegment r1 -> Const (Endo [Ellipse r1]) (PathSegment r1))
-> LSeq 1 (PathSegment r1)
-> Const (Endo [Ellipse r1]) (LSeq 1 (PathSegment r1))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse((PathSegment r1 -> Const (Endo [Ellipse r1]) (PathSegment r1))
 -> LSeq 1 (PathSegment r1)
 -> Const (Endo [Ellipse r1]) (LSeq 1 (PathSegment r1)))
-> ((Ellipse r1 -> Const (Endo [Ellipse r1]) (Ellipse r1))
    -> PathSegment r1 -> Const (Endo [Ellipse r1]) (PathSegment r1))
-> (Ellipse r1 -> Const (Endo [Ellipse r1]) (Ellipse r1))
-> LSeq 1 (PathSegment r1)
-> Const (Endo [Ellipse r1]) (LSeq 1 (PathSegment r1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Ellipse r1 -> Const (Endo [Ellipse r1]) (Ellipse r1))
-> PathSegment r1 -> Const (Endo [Ellipse r1]) (PathSegment r1)
forall r. Prism' (PathSegment r) (Ellipse r)
_EllipseSegment of
                    [Ellipse r1
e] -> Ellipse r1 -> Maybe (Ellipse r1)
forall a. a -> Maybe a
Just Ellipse r1
e
                    [Ellipse r1]
_   -> Maybe (Ellipse r1)
forall a. Maybe a
Nothing

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

_asDisk :: (Floating r, Eq r) => Prism' (Path r) (Disk () r)
_asDisk :: Prism' (Path r) (Disk () r)
_asDisk = p (Circle () r) (f (Circle () r)) -> p (Path r) (f (Path r))
forall r. (Floating r, Eq r) => Prism' (Path r) (Circle () r)
_asCircle(p (Circle () r) (f (Circle () r)) -> p (Path r) (f (Path r)))
-> (p (Disk () r) (f (Disk () r))
    -> p (Circle () r) (f (Circle () r)))
-> p (Disk () r) (f (Disk () r))
-> p (Path r) (f (Path r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AnIso (Disk () r) (Disk () r) (Circle () r) (Circle () r)
-> Iso (Circle () r) (Circle () r) (Disk () r) (Disk () r)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (Disk () r) (Disk () r) (Circle () r) (Circle () r)
forall p r s. Iso (Disk p r) (Disk p s) (Circle p r) (Circle p s)
_DiskCircle


-- | Convert to a multipolygon
_asMultiPolygon :: Prism' (Path r) (MultiPolygon () r)
_asMultiPolygon :: p (MultiPolygon () r) (f (MultiPolygon () r))
-> p (Path r) (f (Path r))
_asMultiPolygon = p (SomePolygon () r) (f (SomePolygon () r))
-> p (Path r) (f (Path r))
forall r. Prism' (Path r) (SomePolygon () r)
_asSomePolygon(p (SomePolygon () r) (f (SomePolygon () r))
 -> p (Path r) (f (Path r)))
-> (p (MultiPolygon () r) (f (MultiPolygon () r))
    -> p (SomePolygon () r) (f (SomePolygon () r)))
-> p (MultiPolygon () r) (f (MultiPolygon () r))
-> p (Path r) (f (Path r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p (MultiPolygon () r) (f (MultiPolygon () r))
-> p (SomePolygon () r) (f (SomePolygon () r))
forall c a b. Prism (Either c a) (Either c b) a b
_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 :: p (SomePolygon () r) (f (SomePolygon () r))
-> p (Path r) (f (Path r))
_asSomePolygon = (SomePolygon () r -> Path r)
-> (Path r -> Maybe (SomePolygon () r))
-> Prism (Path r) (Path r) (SomePolygon () r) (SomePolygon () r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' SomePolygon () r -> Path r
forall (t :: PolygonType) r (t :: PolygonType).
Either (Polygon t () r) (Polygon t () r) -> Path r
embed Path r -> Maybe (SomePolygon () r)
forall r.
Path r -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
pathToPolygon
  where
    embed :: Either (Polygon t () r) (Polygon t () r) -> Path r
embed     = (Polygon t () r -> Path r)
-> (Polygon t () r -> Path r)
-> Either (Polygon t () r) (Polygon t () r)
-> Path r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Polygon t () r -> Path r
forall (t :: PolygonType) r. Polygon t () r -> Path r
polygonToPath Polygon t () r -> Path r
forall (t :: PolygonType) r. Polygon t () r -> Path r
polygonToPath


polygonToPath                      :: Polygon t () r -> Path r
polygonToPath :: Polygon t () r -> Path r
polygonToPath pg :: Polygon t () r
pg@SimplePolygon{}   = LSeq 1 (PathSegment r) -> Path r
forall r1. LSeq 1 (PathSegment r1) -> Path r1
Path (LSeq 1 (PathSegment r) -> Path r)
-> (SimplePolygon () r -> LSeq 1 (PathSegment r))
-> SimplePolygon () r
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment r -> LSeq 1 (PathSegment r)
forall a. a -> LSeq 1 a
fromSingleton (PathSegment r -> LSeq 1 (PathSegment r))
-> (SimplePolygon () r -> PathSegment r)
-> SimplePolygon () r
-> LSeq 1 (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimplePolygon () r -> PathSegment r
forall r. SimplePolygon () r -> PathSegment r
PolygonPath (SimplePolygon () r -> Path r) -> SimplePolygon () r -> Path r
forall a b. (a -> b) -> a -> b
$ Polygon t () r
SimplePolygon () r
pg
polygonToPath (MultiPolygon SimplePolygon () r
vs [SimplePolygon () r]
hs) = LSeq 1 (PathSegment r) -> Path r
forall r1. LSeq 1 (PathSegment r1) -> Path r1
Path (LSeq 1 (PathSegment r) -> Path r)
-> (NonEmpty (SimplePolygon () r) -> LSeq 1 (PathSegment r))
-> NonEmpty (SimplePolygon () r)
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (PathSegment r) -> LSeq 1 (PathSegment r)
forall a. NonEmpty a -> LSeq 1 a
LSeq.fromNonEmpty (NonEmpty (PathSegment r) -> LSeq 1 (PathSegment r))
-> (NonEmpty (SimplePolygon () r) -> NonEmpty (PathSegment r))
-> NonEmpty (SimplePolygon () r)
-> LSeq 1 (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimplePolygon () r -> PathSegment r)
-> NonEmpty (SimplePolygon () r) -> NonEmpty (PathSegment r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimplePolygon () r -> PathSegment r
forall r. SimplePolygon () r -> PathSegment r
PolygonPath
                                   (NonEmpty (SimplePolygon () r) -> Path r)
-> NonEmpty (SimplePolygon () r) -> Path r
forall a b. (a -> b) -> a -> b
$ SimplePolygon () r
vs SimplePolygon () r
-> [SimplePolygon () r] -> NonEmpty (SimplePolygon () r)
forall a. a -> [a] -> NonEmpty a
:| [SimplePolygon () r]
hs


pathToPolygon   :: Path r -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
pathToPolygon :: Path r -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
pathToPolygon Path r
p = case Path r
pPath r
-> Getting
     (Endo [SimplePolygon () r]) (Path r) (SimplePolygon () r)
-> [SimplePolygon () r]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(LSeq 1 (PathSegment r)
 -> Const (Endo [SimplePolygon () r]) (LSeq 1 (PathSegment r)))
-> Path r -> Const (Endo [SimplePolygon () r]) (Path r)
forall r1 r2.
Iso
  (Path r1)
  (Path r2)
  (LSeq 1 (PathSegment r1))
  (LSeq 1 (PathSegment r2))
pathSegments((LSeq 1 (PathSegment r)
  -> Const (Endo [SimplePolygon () r]) (LSeq 1 (PathSegment r)))
 -> Path r -> Const (Endo [SimplePolygon () r]) (Path r))
-> ((SimplePolygon () r
     -> Const (Endo [SimplePolygon () r]) (SimplePolygon () r))
    -> LSeq 1 (PathSegment r)
    -> Const (Endo [SimplePolygon () r]) (LSeq 1 (PathSegment r)))
-> Getting
     (Endo [SimplePolygon () r]) (Path r) (SimplePolygon () r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathSegment r
 -> Const (Endo [SimplePolygon () r]) (PathSegment r))
-> LSeq 1 (PathSegment r)
-> Const (Endo [SimplePolygon () r]) (LSeq 1 (PathSegment r))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse((PathSegment r
  -> Const (Endo [SimplePolygon () r]) (PathSegment r))
 -> LSeq 1 (PathSegment r)
 -> Const (Endo [SimplePolygon () r]) (LSeq 1 (PathSegment r)))
-> ((SimplePolygon () r
     -> Const (Endo [SimplePolygon () r]) (SimplePolygon () r))
    -> PathSegment r
    -> Const (Endo [SimplePolygon () r]) (PathSegment r))
-> (SimplePolygon () r
    -> Const (Endo [SimplePolygon () r]) (SimplePolygon () r))
-> LSeq 1 (PathSegment r)
-> Const (Endo [SimplePolygon () r]) (LSeq 1 (PathSegment r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimplePolygon () r
 -> Const (Endo [SimplePolygon () r]) (SimplePolygon () r))
-> PathSegment r
-> Const (Endo [SimplePolygon () r]) (PathSegment r)
forall r. Prism' (PathSegment r) (SimplePolygon () r)
_PolygonPath of
                    []    -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
forall a. Maybe a
Nothing
                    [SimplePolygon () r
pg]  -> Either (SimplePolygon () r) (MultiPolygon () r)
-> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
forall a. a -> Maybe a
Just (Either (SimplePolygon () r) (MultiPolygon () r)
 -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r)))
-> (SimplePolygon () r
    -> Either (SimplePolygon () r) (MultiPolygon () r))
-> SimplePolygon () r
-> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimplePolygon () r
-> Either (SimplePolygon () r) (MultiPolygon () r)
forall a b. a -> Either a b
Left  (SimplePolygon () r
 -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r)))
-> SimplePolygon () r
-> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
forall a b. (a -> b) -> a -> b
$ SimplePolygon () r
pg
                    SimplePolygon () r
vs:[SimplePolygon () r]
hs -> Either (SimplePolygon () r) (MultiPolygon () r)
-> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
forall a. a -> Maybe a
Just (Either (SimplePolygon () r) (MultiPolygon () r)
 -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r)))
-> (MultiPolygon () r
    -> Either (SimplePolygon () r) (MultiPolygon () r))
-> MultiPolygon () r
-> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiPolygon () r
-> Either (SimplePolygon () r) (MultiPolygon () r)
forall a b. b -> Either a b
Right (MultiPolygon () r
 -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r)))
-> MultiPolygon () r
-> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
forall a b. (a -> b) -> a -> b
$ SimplePolygon () r -> [SimplePolygon () r] -> MultiPolygon () r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> Polygon 'Multi p r
MultiPolygon SimplePolygon () r
vs [SimplePolygon () r]
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 {_points = LSeq (fromList [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})
_withAttrs       :: 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 :+ IpeAttributes i r)
-> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
_withAttrs Prism' (IpeObject r) (i r :+ IpeAttributes i r)
po Prism' (i r) g
pg = ((g :+ IpeAttributes i r) -> IpeObject r)
-> (IpeObject r -> Maybe (g :+ IpeAttributes i r))
-> Prism' (IpeObject r) (g :+ IpeAttributes i r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (g :+ IpeAttributes i r) -> IpeObject r
g2o IpeObject r -> Maybe (g :+ IpeAttributes i r)
o2g
  where
    g2o :: (g :+ IpeAttributes i r) -> IpeObject r
g2o    = AReview (IpeObject r) (i r :+ IpeAttributes i r)
-> (i r :+ IpeAttributes i r) -> IpeObject r
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (IpeObject r) (i r :+ IpeAttributes i r)
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
po ((i r :+ IpeAttributes i r) -> IpeObject r)
-> ((g :+ IpeAttributes i r) -> i r :+ IpeAttributes i r)
-> (g :+ IpeAttributes i r)
-> IpeObject r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter (g :+ IpeAttributes i r) (i r :+ IpeAttributes i r) g (i r)
-> (g -> i r)
-> (g :+ IpeAttributes i r)
-> i r :+ IpeAttributes i r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (g :+ IpeAttributes i r) (i r :+ IpeAttributes i r) g (i r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
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 :+ IpeAttributes i r)
o2g IpeObject r
o  = Getting
  (First (i r :+ IpeAttributes i r))
  (IpeObject r)
  (i r :+ IpeAttributes i r)
-> IpeObject r -> Maybe (i r :+ IpeAttributes i r)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First (i r :+ IpeAttributes i r))
  (IpeObject r)
  (i r :+ IpeAttributes i r)
Prism' (IpeObject r) (i r :+ IpeAttributes i r)
po IpeObject r
o Maybe (i r :+ IpeAttributes i r)
-> ((i r :+ IpeAttributes i r) -> Maybe (g :+ IpeAttributes i r))
-> Maybe (g :+ IpeAttributes i r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(i r
i :+ IpeAttributes i r
ats) -> (g -> IpeAttributes i r -> g :+ IpeAttributes i r
forall core extra. core -> extra -> core :+ extra
:+ IpeAttributes i r
ats) (g -> g :+ IpeAttributes i r)
-> Maybe g -> Maybe (g :+ IpeAttributes i r)
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 :: * -> *
--   defaultIpeObject :: proxy g -> Prism' (IpeObject r) (DefaultFromIpe g r :+ IpeAttributes (DefaultFromIpe g) r)
--   defaultFromIpe   :: proxy g -> Prism' (DefaultFromIpe g (NumType g)) g


class HasDefaultFromIpe g where
  type DefaultFromIpe g :: * -> *
  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 :: 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 forall r. Prism' (IpeObject r) (IpeObject' IpeSymbol r)
Prism' (IpeObject r) (IpeSymbol r :+ IpeAttributes IpeSymbol r)
_IpeUse forall r. Prism' (IpeSymbol r) (Point 2 r)
Prism' (IpeSymbol r) (Point 2 r)
_asPoint
    where


instance HasDefaultFromIpe (LineSegment 2 () r) where
  type DefaultFromIpe (LineSegment 2 () r) = Path
  defaultFromIpe :: Prism'
  (IpeObject r)
  (LineSegment 2 () r
   :+ IpeAttributes (DefaultFromIpe (LineSegment 2 () r)) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (LineSegment 2 () r)
-> Prism'
     (IpeObject r) (LineSegment 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 forall r. Prism' (IpeObject r) (IpeObject' Path r)
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath forall r. Prism' (Path r) (LineSegment 2 () r)
Prism' (Path r) (LineSegment 2 () r)
_asLineSegment

instance HasDefaultFromIpe (Ellipse r) where
  type DefaultFromIpe (Ellipse r) = Path
  defaultFromIpe :: 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 forall r. Prism' (IpeObject r) (IpeObject' Path r)
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath forall r. Prism' (Path r) (Ellipse r)
Prism' (Path r) (Ellipse r)
_asEllipse

instance (Floating r, Eq r) => HasDefaultFromIpe (Circle () r) where
  type DefaultFromIpe (Circle () r) = Path
  defaultFromIpe :: Prism'
  (IpeObject r)
  (Circle () r :+ IpeAttributes (DefaultFromIpe (Circle () r)) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (Circle () r)
-> Prism' (IpeObject r) (Circle () 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 forall r. Prism' (IpeObject r) (IpeObject' Path r)
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath forall r. (Floating r, Eq r) => Prism' (Path r) (Circle () r)
Prism' (Path r) (Circle () r)
_asCircle

instance (Floating r, Eq r) => HasDefaultFromIpe (Disk () r) where
  type DefaultFromIpe (Disk () r) = Path
  defaultFromIpe :: Prism'
  (IpeObject r)
  (Disk () r :+ IpeAttributes (DefaultFromIpe (Disk () r)) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (Disk () r)
-> Prism' (IpeObject r) (Disk () 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 forall r. Prism' (IpeObject r) (IpeObject' Path r)
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath forall r. (Floating r, Eq r) => Prism' (Path r) (Disk () r)
Prism' (Path r) (Disk () r)
_asDisk

instance HasDefaultFromIpe (PolyLine.PolyLine 2 () r) where
  type DefaultFromIpe (PolyLine.PolyLine 2 () r) = Path
  defaultFromIpe :: Prism'
  (IpeObject r)
  (PolyLine 2 () r
   :+ IpeAttributes (DefaultFromIpe (PolyLine 2 () r)) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (PolyLine 2 () r)
-> Prism' (IpeObject r) (PolyLine 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 forall r. Prism' (IpeObject r) (IpeObject' Path r)
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath forall r. Prism' (Path r) (PolyLine 2 () r)
Prism' (Path r) (PolyLine 2 () r)
_asPolyLine


instance HasDefaultFromIpe (SimplePolygon () r) where
  type DefaultFromIpe (SimplePolygon () r) = Path
  defaultFromIpe :: Prism'
  (IpeObject r)
  (SimplePolygon () r
   :+ IpeAttributes (DefaultFromIpe (SimplePolygon () r)) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (SimplePolygon () r)
-> Prism'
     (IpeObject r) (SimplePolygon () 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 forall r. Prism' (IpeObject r) (IpeObject' Path r)
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath forall r. Prism' (Path r) (Polygon 'Simple () r)
Prism' (Path r) (SimplePolygon () r)
_asSimplePolygon

instance HasDefaultFromIpe (MultiPolygon () r) where
  type DefaultFromIpe (MultiPolygon () r) = Path
  defaultFromIpe :: Prism'
  (IpeObject r)
  (MultiPolygon () r
   :+ IpeAttributes (DefaultFromIpe (MultiPolygon () r)) r)
defaultFromIpe = Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
-> Prism' (Path r) (MultiPolygon () r)
-> Prism' (IpeObject r) (MultiPolygon () 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 forall r. Prism' (IpeObject r) (IpeObject' Path r)
Prism' (IpeObject r) (Path r :+ IpeAttributes Path r)
_IpePath forall r. Prism' (Path r) (MultiPolygon () r)
Prism' (Path r) (MultiPolygon () r)
_asMultiPolygon


-- | 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 :: IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
readAll IpePage r
p = IpePage r
pIpePage r
-> Getting
     (Endo [g :+ IpeAttributes (DefaultFromIpe g) r])
     (IpePage r)
     (g :+ IpeAttributes (DefaultFromIpe g) r)
-> [g :+ IpeAttributes (DefaultFromIpe g) r]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..([IpeObject r]
 -> Const
      (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) [IpeObject r])
-> IpePage r
-> Const
     (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) (IpePage r)
forall r1 r2.
Lens (IpePage r1) (IpePage r2) [IpeObject r1] [IpeObject r2]
content(([IpeObject r]
  -> Const
       (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) [IpeObject r])
 -> IpePage r
 -> Const
      (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) (IpePage r))
-> (((g :+ IpeAttributes (DefaultFromIpe g) r)
     -> Const
          (Endo [g :+ IpeAttributes (DefaultFromIpe g) r])
          (g :+ IpeAttributes (DefaultFromIpe g) r))
    -> [IpeObject r]
    -> Const
         (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) [IpeObject r])
-> Getting
     (Endo [g :+ IpeAttributes (DefaultFromIpe g) r])
     (IpePage r)
     (g :+ IpeAttributes (DefaultFromIpe g) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IpeObject r
 -> Const
      (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) (IpeObject r))
-> [IpeObject r]
-> Const
     (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) [IpeObject r]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse((IpeObject r
  -> Const
       (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) (IpeObject r))
 -> [IpeObject r]
 -> Const
      (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) [IpeObject r])
-> (((g :+ IpeAttributes (DefaultFromIpe g) r)
     -> Const
          (Endo [g :+ IpeAttributes (DefaultFromIpe g) r])
          (g :+ IpeAttributes (DefaultFromIpe g) r))
    -> IpeObject r
    -> Const
         (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) (IpeObject r))
-> ((g :+ IpeAttributes (DefaultFromIpe g) r)
    -> Const
         (Endo [g :+ IpeAttributes (DefaultFromIpe g) r])
         (g :+ IpeAttributes (DefaultFromIpe g) r))
-> [IpeObject r]
-> Const
     (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) [IpeObject r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((g :+ IpeAttributes (DefaultFromIpe g) r)
 -> Const
      (Endo [g :+ IpeAttributes (DefaultFromIpe g) r])
      (g :+ IpeAttributes (DefaultFromIpe g) r))
-> IpeObject r
-> Const
     (Endo [g :+ IpeAttributes (DefaultFromIpe g) r]) (IpeObject r)
forall g r.
(HasDefaultFromIpe g, r ~ NumType g) =>
Prism' (IpeObject r) (g :+ IpeAttributes (DefaultFromIpe g) r)
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)
               => FilePath -> IO [g :+ IpeAttributes (DefaultFromIpe g) r]
readAllFrom :: FilePath -> IO [g :+ IpeAttributes (DefaultFromIpe g) r]
readAllFrom FilePath
fp = (IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r])
-> Either Text (IpePage r)
-> [g :+ IpeAttributes (DefaultFromIpe g) r]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
forall g r.
(HasDefaultFromIpe g, r ~ NumType g) =>
IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
readAll (Either Text (IpePage r)
 -> [g :+ IpeAttributes (DefaultFromIpe g) r])
-> IO (Either Text (IpePage r))
-> IO [g :+ IpeAttributes (DefaultFromIpe g) r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Either Text (IpePage r))
forall r.
(Coordinate r, Eq r) =>
FilePath -> IO (Either Text (IpePage r))
readSinglePageFile FilePath
fp

fromSingleton :: a -> LSeq.LSeq 1 a
fromSingleton :: a -> LSeq 1 a
fromSingleton = NonEmpty a -> LSeq 1 a
forall a. NonEmpty a -> LSeq 1 a
LSeq.fromNonEmpty (NonEmpty a -> LSeq 1 a) -> (a -> NonEmpty a) -> a -> LSeq 1 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [])