{-# OPTIONS_GHC -Wno-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Ipe
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Reexports the functionality for reading and writing Ipe files.
--
--------------------------------------------------------------------------------
module Ipe(
  -- * Ipe Files
    IpeFile(IpeFile), preamble, styles, pages
  , ipeFile, singlePageFile, singlePageFromContent
  -- ** Reading Ipe files
  , readIpeFile
  , readSinglePageFile
  , readSinglePageFileThrow
  , readRawIpeFile
  , ConversionError
  -- *** Reading all Geometries from a single page ipe file
  , readAll, readAllDeep, readAllFrom
  -- ** Writing ipe files
  , writeIpeFile, writeIpeFile', writeIpePage
  , toIpeXML
  , printAsIpeSelection, toIpeSelectionXML


  -- * Ipe Pages
  , IpePage(IpePage), layers, views, content
  , emptyPage, fromContent
  , onLayer, contentInView
  , withDefaults

  -- * Content: Ipe Objects
  , IpeObject(..), _IpePath, _IpeUse, _IpeGroup, _IpeTextLabel, _IpeMiniPage, _IpeImage
  , IpeObject'
  , ipeObject'
  , ToObject(..)
  -- ** Specific Ipe-Objects
  , Path(Path), pathSegments
  , PathSegment(..)
  , IpeSymbol(Symbol), symbolPoint, symbolName
  , Group(Group), groupItems
  , TextLabel(..)
  , MiniPage(..), width
  , Image(Image), imageData, imageRect
  , IpeBitmap
  -- ** Attributes
  , IpeAttributes
  , Attributes', AttributesOf, AttrMap, AttrMapSym1
  , attributes, mapIpeAttrs, traverseIpeAttrs
  , commonAttributes
  -- * Layers and Views
  , LayerName(LayerName), layerName
  , View(View), layerNames, activeLayer
  -- * Ipe Syles and Preamble
  , IpeStyle(IpeStyle), styleName, styleData
  , basicIpeStyle, opacitiesStyle
  , readIpeStylesheet
  , addStyleSheet, addStyleSheetFrom
  , IpePreamble(IpePreamble), encoding, preambleData
  -- * Reading Geometries *From* Ipe
  , IpeRead(..)
  -- ** Converting *from* IpeObjects
  , _asPoint
  , _asLineSegment
  , _asClosedLineSegment
  , _asHalfLine
  , _asRectangle
  , _asTriangle
  , _asPolyLine
  , _asSimplePolygon
  , _asConvexPolygon
  , _asPolygonalDomain

  -- *** Dealing with Attributes
  , _withAttrs
  -- ** Default readers
  , HasDefaultFromIpe(..)

  -- * Converting *to* IpeObjects
  -- ** IpeWrite
  , IpeWrite(..)
  , IpeWriteText(..)
  -- ** IpeOut
  , module Ipe.IpeOut
  -- ** Batch reexports

  -- , module Ipe.Types
  -- , module Ipe.FromIpe
  , module Ipe.Attributes
  , module Ipe.Value
  , IpeColor(..), named
  ) where

import Control.Lens hiding (views)
import Data.Maybe (isJust)
import HGeometry.Ext
import HGeometry.HalfLine
import HGeometry.LineSegment
import HGeometry.Point
import Ipe.Attributes
import Ipe.Color
import Ipe.FromIpe
import Ipe.IpeOut
import Ipe.Reader
import Ipe.Types
import Ipe.Value
import Ipe.Writer

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

-- | Try to parse an Line segment with an arrow head as a HalfLine
_asHalfLine :: (Fractional r, Ord r, Show r)
            => Prism' (IpeObject r) (HalfLine (Point 2 r) :+ IpeAttributes Path r)
_asHalfLine :: forall r.
(Fractional r, Ord r, Show r) =>
Prism' (IpeObject r) (HalfLine (Point 2 r) :+ IpeAttributes Path r)
_asHalfLine = ((HalfLine (Point 2 r)
  :+ Attributes'
       r
       '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
          'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
          'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
 -> IpeObject r)
-> (IpeObject r
    -> Maybe
         (HalfLine (Point 2 r)
          :+ Attributes'
               r
               '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
                  'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
                  'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
-> Prism
     (IpeObject r)
     (IpeObject r)
     (HalfLine (Point 2 r)
      :+ Attributes'
           r
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
              'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
              'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
     (HalfLine (Point 2 r)
      :+ Attributes'
           r
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
              'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
              'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (\(HalfLine (Point 2 r)
hl :+ Attributes'
  r
  '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
     'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
     'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
ats) -> IpeObject' Path r -> IpeObject r
forall r. IpeObject' Path r -> IpeObject r
IpePath (IpeOut (HalfLine (Point 2 r)) Path r
forall r point.
(Ord r, Fractional r, Point_ point 2 r, Show r, Show point) =>
IpeOut (HalfLine point) Path r
ipeHalfLine HalfLine (Point 2 r)
hl IpeObject' Path r
-> Attributes (AttrMapSym1 r) (AttributesOf Path)
-> IpeObject' Path r
forall (i :: * -> *) r.
IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
! Attributes'
  r
  '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
     'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
     'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
Attributes (AttrMapSym1 r) (AttributesOf Path)
ats)) IpeObject r
-> Maybe
     (HalfLine (Point 2 r)
      :+ Attributes'
           r
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
              'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
              'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
objToHalfLine
  where
    objToHalfLine :: IpeObject r
-> Maybe
     (HalfLine (Point 2 r)
      :+ Attributes'
           r
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
              'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
              'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
objToHalfLine = \case
      IpePath (Path r
path' :+ Attributes (AttrMapSym1 r) (AttributesOf Path)
ats) -> case Path r
path'Path r
-> Getting
     (First (ClosedLineSegment (Point 2 r)))
     (Path r)
     (ClosedLineSegment (Point 2 r))
-> Maybe (ClosedLineSegment (Point 2 r))
forall s a. s -> Getting (First a) s a -> Maybe a
^?Getting
  (First (ClosedLineSegment (Point 2 r)))
  (Path r)
  (ClosedLineSegment (Point 2 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))
_asClosedLineSegment  of
        Just (ClosedLineSegment Point 2 r
s Point 2 r
t) -> case (SAttributeUniverse 'Arrow
-> Attributes'
     r
     '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
        'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
        'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> Bool
forall {k1} {at :: k1} {ats :: [k1]} {proxy :: k1 -> *}
       {f :: TyFun k1 (*) -> *}.
RElem at ats (RIndex at ats) =>
proxy at -> Attributes f ats -> Bool
hasAttr SAttributeUniverse 'Arrow
SArrow Attributes'
  r
  '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
     'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
     'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
Attributes (AttrMapSym1 r) (AttributesOf Path)
ats, SAttributeUniverse 'RArrow
-> Attributes'
     r
     '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
        'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
        'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> Bool
forall {k1} {at :: k1} {ats :: [k1]} {proxy :: k1 -> *}
       {f :: TyFun k1 (*) -> *}.
RElem at ats (RIndex at ats) =>
proxy at -> Attributes f ats -> Bool
hasAttr SAttributeUniverse 'RArrow
SRArrow Attributes'
  r
  '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
     'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
     'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
Attributes (AttrMapSym1 r) (AttributesOf Path)
ats) of
                                          (Bool
True,Bool
False) -> (HalfLine (Point 2 r)
 :+ Attributes'
      r
      '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
         'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
         'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Maybe
     (HalfLine (Point 2 r)
      :+ Attributes'
           r
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
              'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
              'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall a. a -> Maybe a
Just ((HalfLine (Point 2 r)
  :+ Attributes'
       r
       '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
          'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
          'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
 -> Maybe
      (HalfLine (Point 2 r)
       :+ Attributes'
            r
            '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
               'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
               'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
-> (HalfLine (Point 2 r)
    :+ Attributes'
         r
         '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
            'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
            'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Maybe
     (HalfLine (Point 2 r)
      :+ Attributes'
           r
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
              'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
              'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> Vector (Dimension (Point 2 r)) (NumType (Point 2 r))
-> HalfLine (Point 2 r)
forall point.
point -> Vector (Dimension point) (NumType point) -> HalfLine point
HalfLine Point 2 r
s (Point 2 r
t Point 2 r -> Point 2 r -> Vector 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. Point 2 r
s) HalfLine (Point 2 r)
-> Attributes'
     r
     '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
        'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
        'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> HalfLine (Point 2 r)
   :+ Attributes'
        r
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
           'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
  r
  '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
     'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
     'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
Attributes (AttrMapSym1 r) (AttributesOf Path)
ats
                                          (Bool
False,Bool
True) -> (HalfLine (Point 2 r)
 :+ Attributes'
      r
      '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
         'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
         'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Maybe
     (HalfLine (Point 2 r)
      :+ Attributes'
           r
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
              'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
              'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall a. a -> Maybe a
Just ((HalfLine (Point 2 r)
  :+ Attributes'
       r
       '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
          'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
          'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
 -> Maybe
      (HalfLine (Point 2 r)
       :+ Attributes'
            r
            '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
               'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
               'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
-> (HalfLine (Point 2 r)
    :+ Attributes'
         r
         '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
            'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
            'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Maybe
     (HalfLine (Point 2 r)
      :+ Attributes'
           r
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
              'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
              'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> Vector (Dimension (Point 2 r)) (NumType (Point 2 r))
-> HalfLine (Point 2 r)
forall point.
point -> Vector (Dimension point) (NumType point) -> HalfLine point
HalfLine Point 2 r
s (Point 2 r
s Point 2 r -> Point 2 r -> Vector 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. Point 2 r
t) HalfLine (Point 2 r)
-> Attributes'
     r
     '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
        'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
        'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> HalfLine (Point 2 r)
   :+ Attributes'
        r
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
           'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
  r
  '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
     'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
     'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
Attributes (AttrMapSym1 r) (AttributesOf Path)
ats
                                          (Bool, Bool)
_            -> Maybe
  (HalfLine (Point 2 r)
   :+ Attributes'
        r
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
           'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall a. Maybe a
Nothing
        Maybe (ClosedLineSegment (Point 2 r))
Nothing                      -> Maybe
  (HalfLine (Point 2 r)
   :+ Attributes'
        r
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
           'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall a. Maybe a
Nothing
      IpeObject r
_                    -> Maybe
  (HalfLine (Point 2 r)
   :+ Attributes'
        r
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
           'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall a. Maybe a
Nothing

    hasAttr :: proxy at -> Attributes f ats -> Bool
hasAttr proxy at
a = Maybe (Apply f at) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Apply f at) -> Bool)
-> (Attributes f ats -> Maybe (Apply f at))
-> Attributes f ats
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy at -> Attributes f ats -> Maybe (Apply f at)
forall {k1} (at :: k1) (ats :: [k1]) (proxy :: k1 -> *)
       (f :: TyFun k1 (*) -> *).
(at ∈ ats) =>
proxy at -> Attributes f ats -> Maybe (Apply f at)
lookupAttr proxy at
a


instance (Fractional r, Ord r, Show r) => HasDefaultFromIpe (HalfLine (Point 2 r)) where
  type DefaultFromIpe (HalfLine (Point 2 r)) = Path
  defaultFromIpe :: forall r.
(r ~ NumType (HalfLine (Point 2 r))) =>
Prism'
  (IpeObject r)
  (HalfLine (Point 2 r)
   :+ IpeAttributes (DefaultFromIpe (HalfLine (Point 2 r))) r)
defaultFromIpe = p (HalfLine (Point 2 r) :+ IpeAttributes Path r)
  (f (HalfLine (Point 2 r) :+ IpeAttributes Path r))
-> p (IpeObject r) (f (IpeObject r))
p (HalfLine (Point 2 r)
   :+ Attributes
        (AttrMapSym1 r)
        (AttributesOf (DefaultFromIpe (HalfLine (Point 2 r)))))
  (f (HalfLine (Point 2 r)
      :+ Attributes
           (AttrMapSym1 r)
           (AttributesOf (DefaultFromIpe (HalfLine (Point 2 r))))))
-> p (IpeObject r) (f (IpeObject r))
forall r.
(Fractional r, Ord r, Show r) =>
Prism' (IpeObject r) (HalfLine (Point 2 r) :+ IpeAttributes Path r)
Prism' (IpeObject r) (HalfLine (Point 2 r) :+ IpeAttributes Path r)
_asHalfLine