{-# 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
  -- * 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.Attributes.Types
  , module Ipe.Value
  , IpeColor(..), named
  ) where

import Control.Lens hiding (views)
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
import Ipe.Attributes.Types

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

-- | 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) :+ PathAttributes r) -> IpeObject r)
-> (IpeObject r
    -> Maybe (HalfLine (Point 2 r) :+ PathAttributes r))
-> Prism
     (IpeObject r)
     (IpeObject r)
     (HalfLine (Point 2 r) :+ PathAttributes r)
     (HalfLine (Point 2 r) :+ PathAttributes r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (\(HalfLine (Point 2 r)
hl :+ PathAttributes r
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 (Path r :+ PathAttributes r)
-> ((Path r :+ PathAttributes r) -> Path r :+ PathAttributes r)
-> Path r :+ PathAttributes r
forall a b. a -> (a -> b) -> b
&(IpeAttributes Path r -> Identity (PathAttributes r))
-> (Path r :+ PathAttributes r)
-> Identity (Path r :+ PathAttributes r)
(IpeAttributes Path r -> Identity (IpeAttributes Path r))
-> IpeObject' Path r -> Identity (IpeObject' Path r)
forall (i :: * -> *) r (f :: * -> *).
Functor f =>
(IpeAttributes i r -> f (IpeAttributes i r))
-> IpeObject' i r -> f (IpeObject' i r)
attributes ((IpeAttributes Path r -> Identity (PathAttributes r))
 -> (Path r :+ PathAttributes r)
 -> Identity (Path r :+ PathAttributes r))
-> PathAttributes r
-> (Path r :+ PathAttributes r)
-> Path r :+ PathAttributes r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathAttributes r
ats)) IpeObject r -> Maybe (HalfLine (Point 2 r) :+ PathAttributes r)
objToHalfLine
    -- FIXME: this overwrites the attributes set by ipeHalfLine that is not entirely ideal
  where
    objToHalfLine :: IpeObject r -> Maybe (HalfLine (Point 2 r) :+ PathAttributes r)
objToHalfLine = \case
      IpePath (Path r
path' :+ IpeAttributes Path r
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 (PathAttributes r
IpeAttributes Path r
atsPathAttributes r
-> Getting
     (Maybe (IpeArrow r)) (PathAttributes r) (Maybe (IpeArrow r))
-> Maybe (IpeArrow r)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (IpeArrow r)) (PathAttributes r) (Maybe (IpeArrow r))
forall s a. HasArrow s a => Lens' s a
Lens' (PathAttributes r) (Maybe (IpeArrow r))
arrow, PathAttributes r
IpeAttributes Path r
atsPathAttributes r
-> Getting
     (Maybe (IpeArrow r)) (PathAttributes r) (Maybe (IpeArrow r))
-> Maybe (IpeArrow r)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (IpeArrow r)) (PathAttributes r) (Maybe (IpeArrow r))
forall s a. HasRArrow s a => Lens' s a
Lens' (PathAttributes r) (Maybe (IpeArrow r))
rArrow) of
                                          (Just IpeArrow r
_, Maybe (IpeArrow r)
Nothing) -> (HalfLine (Point 2 r) :+ PathAttributes r)
-> Maybe (HalfLine (Point 2 r) :+ PathAttributes r)
forall a. a -> Maybe a
Just ((HalfLine (Point 2 r) :+ PathAttributes r)
 -> Maybe (HalfLine (Point 2 r) :+ PathAttributes r))
-> (HalfLine (Point 2 r) :+ PathAttributes r)
-> Maybe (HalfLine (Point 2 r) :+ PathAttributes r)
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)
-> PathAttributes r -> HalfLine (Point 2 r) :+ PathAttributes r
forall core extra. core -> extra -> core :+ extra
:+ PathAttributes r
IpeAttributes Path r
ats
                                          (Maybe (IpeArrow r)
Nothing, Just IpeArrow r
_) -> (HalfLine (Point 2 r) :+ PathAttributes r)
-> Maybe (HalfLine (Point 2 r) :+ PathAttributes r)
forall a. a -> Maybe a
Just ((HalfLine (Point 2 r) :+ PathAttributes r)
 -> Maybe (HalfLine (Point 2 r) :+ PathAttributes r))
-> (HalfLine (Point 2 r) :+ PathAttributes r)
-> Maybe (HalfLine (Point 2 r) :+ PathAttributes r)
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)
-> PathAttributes r -> HalfLine (Point 2 r) :+ PathAttributes r
forall core extra. core -> extra -> core :+ extra
:+ PathAttributes r
IpeAttributes Path r
ats
                                          (Maybe (IpeArrow r), Maybe (IpeArrow r))
_                 -> Maybe (HalfLine (Point 2 r) :+ PathAttributes r)
forall a. Maybe a
Nothing
        Maybe (ClosedLineSegment (Point 2 r))
Nothing                      -> Maybe (HalfLine (Point 2 r) :+ PathAttributes r)
forall a. Maybe a
Nothing
      IpeObject r
_                    -> Maybe (HalfLine (Point 2 r) :+ PathAttributes r)
forall a. Maybe a
Nothing

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)
   :+ IpeAttributes (DefaultFromIpe (HalfLine (Point 2 r))) r)
  (f (HalfLine (Point 2 r)
      :+ IpeAttributes (DefaultFromIpe (HalfLine (Point 2 r))) 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