{-# 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
  , _asPolygonalDomain

  , toPolygonalDomain

  -- * Dealing with Attributes
  , _withAttrs

  -- * Default readers
  , HasDefaultFromIpe(..)

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

import           Control.Lens hiding (Simple)
import           Data.Kind (Type)
import qualified Data.Sequence as Seq
import           Data.Vector.NonEmpty (NonEmptyVector)
import           HGeometry.Ball
import           HGeometry.Box
import qualified HGeometry.Box as Box
import           HGeometry.Cyclic
import           HGeometry.Ellipse (Ellipse, _EllipseCircle)
import           HGeometry.Ext
import           HGeometry.Foldable.Util
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.Polygon.WithHoles
import           HGeometry.Properties
import           HGeometry.Triangle
import           Ipe.Path
import           Ipe.Reader
import           Ipe.Types
import           System.OsPath
import           Witherable

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

-- 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

-- | Convert to a polygonal domain
_asPolygonalDomain :: Prism' (Path r) (PolygonalDomain (Point 2 r))
_asPolygonalDomain :: forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (PolygonalDomain (Point 2 r)) (f (PolygonalDomain (Point 2 r)))
-> p (Path r) (f (Path r))
_asPolygonalDomain = (PolygonalDomain (Point 2 r) -> Path r)
-> (Path r -> Maybe (PolygonalDomain (Point 2 r)))
-> Prism
     (Path r)
     (Path r)
     (PolygonalDomain (Point 2 r))
     (PolygonalDomain (Point 2 r))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' PolygonalDomain (Point 2 r) -> Path r
forall {g :: * -> *} {r}.
(Foldable g, Functor g) =>
PolygonalDomainF g (Cyclic NonEmptyVector) (Point 2 r) -> Path r
toPath Path r -> Maybe (PolygonalDomain (Point 2 r))
forall {h' :: * -> *} {r}.
HasFromFoldable h' =>
Path r
-> Maybe (PolygonalDomainF h' (Cyclic NonEmptyVector) (Point 2 r))
toDomain
  where
    toPath :: PolygonalDomainF g (Cyclic NonEmptyVector) (Point 2 r) -> Path r
toPath (PolygonalDomain SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)
outer' g (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
holes') =
        Seq (PathSegment r) -> Path r
forall r. Seq (PathSegment r) -> Path r
Path (Seq (PathSegment r) -> Path r) -> Seq (PathSegment r) -> Path r
forall a b. (a -> b) -> a -> b
$ (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r) -> PathSegment r
forall {r}. SimplePolygon (Point 2 r) -> PathSegment r
pathPiece SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)
outer' PathSegment r -> Seq (PathSegment r) -> Seq (PathSegment r)
forall a. a -> Seq a -> Seq a
Seq.<| g (PathSegment r) -> Seq (PathSegment r)
forall (f :: * -> *) (g :: * -> *) a.
(HasFromFoldable f, Foldable g) =>
g a -> f a
forall (g :: * -> *) a. Foldable g => g a -> Seq a
fromFoldable ((SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)
 -> PathSegment r)
-> g (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
-> g (PathSegment r)
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r) -> PathSegment r
forall {r}. SimplePolygon (Point 2 r) -> PathSegment r
pathPiece g (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
holes'))
    pathPiece :: SimplePolygon (Point 2 r) -> PathSegment r
pathPiece = Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
forall r. Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
PolygonPath Orientation
AsIs

    toDomain :: Path r
-> Maybe (PolygonalDomainF h' (Cyclic NonEmptyVector) (Point 2 r))
toDomain Path r
path = ASetter
  (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r))
  (PolygonalDomainF h' (Cyclic NonEmptyVector) (Point 2 r))
  (Seq (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
  (h' (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
-> (Seq (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
    -> h' (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
-> PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r)
-> PolygonalDomainF h' (Cyclic NonEmptyVector) (Point 2 r)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r))
  (PolygonalDomainF h' (Cyclic NonEmptyVector) (Point 2 r))
  (Seq (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
  (h' (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
forall (h :: * -> *) (f1 :: * -> *) point (h' :: * -> *)
       (f2 :: * -> *).
Functor f2 =>
(h (SimplePolygonF f1 point) -> f2 (h' (SimplePolygonF f1 point)))
-> PolygonalDomainF h f1 point -> f2 (PolygonalDomainF h' f1 point)
theHoles Seq (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
-> h' (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
forall (f :: * -> *) (g :: * -> *) a.
(HasFromFoldable f, Foldable g) =>
g a -> f a
forall (g :: * -> *) a. Foldable g => g a -> h' a
fromFoldable (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r)
 -> PolygonalDomainF h' (Cyclic NonEmptyVector) (Point 2 r))
-> Maybe (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r))
-> Maybe (PolygonalDomainF h' (Cyclic NonEmptyVector) (Point 2 r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path r
-> Maybe (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r))
forall r.
Path r
-> Maybe (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r))
toPolygonalDomain Path r
path

-- | Convert to a path to a Polygonal Domain
toPolygonalDomain      :: Path r
                       -> Maybe (PolygonalDomainF Seq.Seq  (Cyclic NonEmptyVector) (Point 2 r))
toPolygonalDomain :: forall r.
Path r
-> Maybe (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r))
toPolygonalDomain Path r
path = case (PathSegment r
 -> Maybe (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
-> Seq (PathSegment r)
-> Seq (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
forall a b. (a -> Maybe b) -> Seq a -> Seq b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Getting
  (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
  (PathSegment r)
  (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
-> PathSegment r
-> Maybe (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (((Orientation, SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
 -> Const
      (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
      (Orientation, SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
-> PathSegment r
-> Const
     (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
     (PathSegment r)
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Orientation, SimplePolygon (Point 2 r))
  (f (Orientation, SimplePolygon (Point 2 r)))
-> p (PathSegment r) (f (PathSegment r))
_PolygonPath(((Orientation, SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
  -> Const
       (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
       (Orientation, SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
 -> PathSegment r
 -> Const
      (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
      (PathSegment r))
-> ((SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)
     -> Const
          (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
          (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
    -> (Orientation,
        SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
    -> Const
         (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
         (Orientation, SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
-> Getting
     (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
     (PathSegment r)
     (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)
 -> Const
      (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
      (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
-> (Orientation,
    SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
-> Const
     (First (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)))
     (Orientation, SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Orientation, SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
  (Orientation, SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
  (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
  (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
_2)) (Path r
pathPath r
-> Getting (Seq (PathSegment r)) (Path r) (Seq (PathSegment r))
-> Seq (PathSegment r)
forall s a. s -> Getting a s a -> a
^.Getting (Seq (PathSegment r)) (Path r) (Seq (PathSegment 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) of
                           SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)
outer' Seq.:<| Seq (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
holes' -> PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r)
-> Maybe (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r))
forall a. a -> Maybe a
Just (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r)
 -> Maybe
      (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r)))
-> PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r)
-> Maybe (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r))
forall a b. (a -> b) -> a -> b
$ SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)
-> Seq (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
-> PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r)
forall (h :: * -> *) (f :: * -> *) point.
SimplePolygonF f point
-> h (SimplePolygonF f point) -> PolygonalDomainF h f point
PolygonalDomain SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r)
outer' Seq (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
holes'
                           Seq (SimplePolygonF (Cyclic NonEmptyVector) (Point 2 r))
_                     -> Maybe (PolygonalDomainF Seq (Cyclic NonEmptyVector) (Point 2 r))
forall a. Maybe a
Nothing

-- | 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)))
rectToPath Path r -> Maybe (Rectangle (Point 2 r))
pathToRect
  where
    rectToPath :: Rectangle (Point 2 r) -> Path (NumType (Rectangle (Point 2 r)))
rectToPath = AReview
  (Path (NumType (Rectangle (Point 2 r))))
  (SimplePolygon (Point 2 (NumType (Rectangle (Point 2 r)))))
-> SimplePolygon (Point 2 (NumType (Rectangle (Point 2 r))))
-> Path (NumType (Rectangle (Point 2 r)))
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview
  (Path (NumType (Rectangle (Point 2 r))))
  (SimplePolygon (Point 2 (NumType (Rectangle (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 (SimplePolygon (Point 2 (NumType (Rectangle (Point 2 r))))
 -> Path (NumType (Rectangle (Point 2 r))))
-> (Rectangle (Point 2 r)
    -> SimplePolygon (Point 2 (NumType (Rectangle (Point 2 r)))))
-> Rectangle (Point 2 r)
-> Path (NumType (Rectangle (Point 2 r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Corners (Point 2 (NumType (Rectangle (Point 2 r))))
-> SimplePolygon (Point 2 (NumType (Rectangle (Point 2 r))))
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (Point 2 (NumType (Rectangle (Point 2 r))))
-> SimplePolygon (Point 2 (NumType (Rectangle (Point 2 r))))
uncheckedFromCCWPoints (Corners (Point 2 (NumType (Rectangle (Point 2 r))))
 -> SimplePolygon (Point 2 (NumType (Rectangle (Point 2 r)))))
-> (Rectangle (Point 2 r)
    -> Corners (Point 2 (NumType (Rectangle (Point 2 r)))))
-> Rectangle (Point 2 r)
-> SimplePolygon (Point 2 (NumType (Rectangle (Point 2 r))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle (Point 2 r)
-> Corners (Point 2 (NumType (Rectangle (Point 2 r))))
forall r rectangle point.
(Num r, Rectangle_ rectangle point, Point_ point 2 r) =>
rectangle -> Corners point
Box.corners
    -- shoudln't I reverse these corners
    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 = SimplePolygon (PointF (Vector 2 s)) -> Path s
forall r. SimplePolygon (Point 2 r) -> Path r
polygonToPath (SimplePolygon (PointF (Vector 2 s)) -> Path s)
-> (Triangle (PointF (Vector 2 s))
    -> SimplePolygon (PointF (Vector 2 s)))
-> Triangle (PointF (Vector 2 s))
-> Path s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Triangle (PointF (Vector 2 s))
-> SimplePolygon (PointF (Vector 2 s))
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (PointF (Vector 2 s)) -> SimplePolygon (PointF (Vector 2 s))
uncheckedFromCCWPoints
    path2tri :: Path r'
-> Maybe
     (Triangle
        (Vertex
           (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))))
path2tri Path r'
p = case Path r'
pPath r'
-> Getting
     (Endo
        [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
     (Path r')
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
-> [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(Seq (PathSegment r')
 -> Const
      (Endo
         [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
      (Seq (PathSegment r')))
-> Path r'
-> Const
     (Endo
        [SimplePolygonF (Cyclic NonEmptyVector) (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
          [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
       (Seq (PathSegment r')))
 -> Path r'
 -> Const
      (Endo
         [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
      (Path r'))
-> ((SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))
     -> Const
          (Endo
             [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
          (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
    -> Seq (PathSegment r')
    -> Const
         (Endo
            [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
         (Seq (PathSegment r')))
-> Getting
     (Endo
        [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
     (Path r')
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathSegment r'
 -> Const
      (Endo
         [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
      (PathSegment r'))
-> Seq (PathSegment r')
-> Const
     (Endo
        [SimplePolygonF (Cyclic NonEmptyVector) (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
          [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
       (PathSegment r'))
 -> Seq (PathSegment r')
 -> Const
      (Endo
         [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
      (Seq (PathSegment r')))
-> ((SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))
     -> Const
          (Endo
             [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
          (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
    -> PathSegment r'
    -> Const
         (Endo
            [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
         (PathSegment r'))
-> (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))
    -> Const
         (Endo
            [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
         (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
-> Seq (PathSegment r')
-> Const
     (Endo
        [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
     (Seq (PathSegment r'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Orientation,
  SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
 -> Const
      (Endo
         [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
      (Orientation,
       SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
-> PathSegment r'
-> Const
     (Endo
        [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
     (PathSegment r')
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Orientation, SimplePolygon (Point 2 r))
  (f (Orientation, SimplePolygon (Point 2 r)))
-> p (PathSegment r) (f (PathSegment r))
_PolygonPath(((Orientation,
   SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
  -> Const
       (Endo
          [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
       (Orientation,
        SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
 -> PathSegment r'
 -> Const
      (Endo
         [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
      (PathSegment r'))
-> ((SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))
     -> Const
          (Endo
             [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
          (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
    -> (Orientation,
        SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
    -> Const
         (Endo
            [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
         (Orientation,
          SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
-> (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))
    -> Const
         (Endo
            [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
         (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
-> PathSegment r'
-> Const
     (Endo
        [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
     (PathSegment r')
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))
 -> Const
      (Endo
         [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
      (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
-> (Orientation,
    SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
-> Const
     (Endo
        [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))])
     (Orientation,
      SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Orientation,
   SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
  (Orientation,
   SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
_2 of
                    []   -> Maybe
  (Triangle
     (Vertex
        (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))))
forall a. Maybe a
Nothing
                    [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))
pg] -> case SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))
pgSimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))
-> Getting
     (Endo
        [Vertex
           (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))])
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
     (Vertex
        (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
-> [Vertex
      (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting
  (Endo
     [Vertex
        (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))])
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
  (Vertex
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
  (Vertex
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
  (Vertex
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
vertices of
                              [Vertex
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
a,Vertex
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
b,Vertex
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
c] -> Triangle
  (Vertex
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
-> Maybe
     (Triangle
        (Vertex
           (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))))
forall a. a -> Maybe a
Just (Triangle
   (Vertex
      (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
 -> Maybe
      (Triangle
         (Vertex
            (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))))
-> Triangle
     (Vertex
        (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
-> Maybe
     (Triangle
        (Vertex
           (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))))
forall a b. (a -> b) -> a -> b
$ Vertex
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
-> Vertex
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
-> Vertex
     (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
-> Triangle
     (Vertex
        (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))))
forall point. point -> point -> point -> Triangle point
Triangle Vertex
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
a Vertex
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
b Vertex
  (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))
c
                              [Vertex
   (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))]
_       -> Maybe
  (Triangle
     (Vertex
        (SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r')))))
forall a. Maybe a
Nothing
                    [SimplePolygonF (Cyclic NonEmptyVector) (PointF (Vector 2 r'))]
_    -> Maybe
  (Triangle
     (Vertex
        (SimplePolygonF (Cyclic NonEmptyVector) (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
. Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
forall r. Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
PolygonPath Orientation
AsIs


-- 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
.((Orientation, SimplePolygon (Point 2 r))
 -> Const
      (Endo [SimplePolygon (Point 2 r)])
      (Orientation, SimplePolygon (Point 2 r)))
-> PathSegment r
-> Const (Endo [SimplePolygon (Point 2 r)]) (PathSegment r)
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Orientation, SimplePolygon (Point 2 r))
  (f (Orientation, SimplePolygon (Point 2 r)))
-> p (PathSegment r) (f (PathSegment r))
_PolygonPath(((Orientation, SimplePolygon (Point 2 r))
  -> Const
       (Endo [SimplePolygon (Point 2 r)])
       (Orientation, 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)))
    -> (Orientation, SimplePolygon (Point 2 r))
    -> Const
         (Endo [SimplePolygon (Point 2 r)])
         (Orientation, SimplePolygon (Point 2 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)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SimplePolygon (Point 2 r)
 -> Const
      (Endo [SimplePolygon (Point 2 r)]) (SimplePolygon (Point 2 r)))
-> (Orientation, SimplePolygon (Point 2 r))
-> Const
     (Endo [SimplePolygon (Point 2 r)])
     (Orientation, SimplePolygon (Point 2 r))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Orientation, SimplePolygon (Point 2 r))
  (Orientation, SimplePolygon (Point 2 r))
  (SimplePolygon (Point 2 r))
  (SimplePolygon (Point 2 r))
_2 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

-- | Read all 'a's looking into groups
readAllDeep   :: forall g r. (HasDefaultFromIpe g, r ~ NumType g)
              => IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
readAllDeep :: forall g r.
(HasDefaultFromIpe g, r ~ NumType g) =>
IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
readAllDeep 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] -> [IpeObject r])
-> ([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 (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to [IpeObject r] -> [IpeObject r]
forall r. [IpeObject r] -> [IpeObject r]
flattenContent(([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
.(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

-- | Helper to produce a singleton sequence
fromSingleton :: a -> Seq.Seq a
fromSingleton :: forall a. a -> Seq a
fromSingleton = a -> Seq a
forall a. a -> Seq a
Seq.singleton

-- | recursively flatten all groups into one big list
flattenContent :: [IpeObject r] -> [IpeObject r]
flattenContent :: forall r. [IpeObject r] -> [IpeObject r]
flattenContent = (IpeObject r -> [IpeObject r]) -> [IpeObject r] -> [IpeObject r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((IpeObject r -> [IpeObject r]) -> [IpeObject r] -> [IpeObject r])
-> (IpeObject r -> [IpeObject r]) -> [IpeObject r] -> [IpeObject r]
forall a b. (a -> b) -> a -> b
$ \case
                      IpeGroup (Group [IpeObject r]
gr :+ IpeAttributes Group r
_) -> [IpeObject r] -> [IpeObject r]
forall r. [IpeObject r] -> [IpeObject r]
flattenContent [IpeObject r]
gr
                      IpeObject r
obj                      -> [IpeObject r
obj]