{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ipe.Reader
  ( -- * Reading ipe Files
    readRawIpeFile
  , readIpeFile
  , readSinglePageFile
  , readSinglePageFileThrow
  , ConversionError
  -- * Readiing ipe style files
  , readIpeStylesheet
  , addStyleSheetFrom

    -- * Reading XML directly
  , fromIpeXML
  , readXML

    -- * Read classes
  , IpeReadText(..)
  , IpeRead(..)
  -- , IpeReadAttr(..)
  , IpeReadAttributes(..)
  , ipeReadAttrsFrom

    -- * Some low level implementation functions
  , ipeReadTextWith
  , ipeReadObject
  -- ,
  -- , ipeReadRec

  , Coordinate(..)
  ) where

import           Control.Applicative ((<|>),)
import           Control.Lens hiding (rmap)
import           Control.Monad ((<=<))
import           Data.Bifunctor
import qualified Data.ByteString as B
import           Data.Colour.SRGB (RGB(..))
import           Data.Either (rights)
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe (fromMaybe, mapMaybe)
import           Data.Proxy
import qualified Data.Sequence as Seq
import           Data.Text (Text)
import qualified Data.Text as T
import           HGeometry.BezierSpline
import           HGeometry.Box
import           HGeometry.Ellipse (ellipseMatrix)
import           HGeometry.Ext
import           HGeometry.Foldable.Util
import qualified HGeometry.Matrix as Matrix
import           HGeometry.Point
import           HGeometry.PolyLine (polyLineFromPoints)
import qualified HGeometry.Polygon.Simple as Polygon
import           HGeometry.Vector
import           Ipe.Attributes
import           Ipe.Color (IpeColor(..))
import           Ipe.Matrix
import           Ipe.ParserPrimitives (pInteger, pWhiteSpace)
import           Ipe.Path
import           Ipe.PathParser
import           Ipe.Types
import           Ipe.Value
import qualified System.File.OsPath as File
import           System.OsPath
import           Text.XML.Expat.Tree
import           Ipe.Attributes.Types
import           Barbies

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

type ConversionError = Text


-- | Given a file path, tries to read an ipe file
readRawIpeFile :: (Coordinate r, Eq r)
               => OsPath -> IO (Either ConversionError (IpeFile r))
readRawIpeFile :: forall r.
(Coordinate r, Eq r) =>
OsPath -> IO (Either ConversionError (IpeFile r))
readRawIpeFile = (ByteString -> Either ConversionError (IpeFile r))
-> IO ByteString -> IO (Either ConversionError (IpeFile r))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either ConversionError (IpeFile r)
forall {k} (t :: k -> *) (r :: k).
IpeRead (t r) =>
ByteString -> Either ConversionError (t r)
fromIpeXML (IO ByteString -> IO (Either ConversionError (IpeFile r)))
-> (OsPath -> IO ByteString)
-> OsPath
-> IO (Either ConversionError (IpeFile r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO ByteString
File.readFile'


-- | Given a file path, tries to read an ipe file.
--
-- This function applies all matrices to objects.
readIpeFile :: (Coordinate r, Eq r)
            => OsPath -> IO (Either ConversionError (IpeFile r))
readIpeFile :: forall r.
(Coordinate r, Eq r) =>
OsPath -> IO (Either ConversionError (IpeFile r))
readIpeFile = (Either ConversionError (IpeFile r)
 -> Either ConversionError (IpeFile r))
-> IO (Either ConversionError (IpeFile r))
-> IO (Either ConversionError (IpeFile r))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IpeFile r -> IpeFile r)
-> Either ConversionError (IpeFile r)
-> Either ConversionError (IpeFile r)
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second IpeFile r -> IpeFile r
forall r. (Fractional r, Eq r) => IpeFile r -> IpeFile r
applyMatrices) (IO (Either ConversionError (IpeFile r))
 -> IO (Either ConversionError (IpeFile r)))
-> (OsPath -> IO (Either ConversionError (IpeFile r)))
-> OsPath
-> IO (Either ConversionError (IpeFile r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO (Either ConversionError (IpeFile r))
forall r.
(Coordinate r, Eq r) =>
OsPath -> IO (Either ConversionError (IpeFile r))
readRawIpeFile


-- | Since most Ipe file contain only one page, we provide a shortcut for that
-- as well.
--
-- This function applies all matrices, and it makes sure there is at
-- least one layer and view in the page.
--
readSinglePageFile :: (Coordinate r, Eq r)
                   => OsPath -> IO (Either ConversionError (IpePage r))
readSinglePageFile :: forall r.
(Coordinate r, Eq r) =>
OsPath -> IO (Either ConversionError (IpePage r))
readSinglePageFile = (Either ConversionError (IpeFile r)
 -> Either ConversionError (IpePage r))
-> IO (Either ConversionError (IpeFile r))
-> IO (Either ConversionError (IpePage r))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IpeFile r -> IpePage r)
-> Either ConversionError (IpeFile r)
-> Either ConversionError (IpePage r)
forall a b.
(a -> b) -> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IpeFile r -> IpePage r
forall r. IpeFile r -> IpePage r
f) (IO (Either ConversionError (IpeFile r))
 -> IO (Either ConversionError (IpePage r)))
-> (OsPath -> IO (Either ConversionError (IpeFile r)))
-> OsPath
-> IO (Either ConversionError (IpePage r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO (Either ConversionError (IpeFile r))
forall r.
(Coordinate r, Eq r) =>
OsPath -> IO (Either ConversionError (IpeFile r))
readIpeFile
  where
    f   :: IpeFile r -> IpePage r
    f :: forall r. IpeFile r -> IpePage r
f IpeFile r
i = IpePage r -> IpePage r
forall r. IpePage r -> IpePage r
withDefaults (IpePage r -> IpePage r)
-> (NonEmpty (IpePage r) -> IpePage r)
-> NonEmpty (IpePage r)
-> IpePage r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (IpePage r) -> IpePage r
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty (IpePage r) -> IpePage r)
-> NonEmpty (IpePage r) -> IpePage r
forall a b. (a -> b) -> a -> b
$ IpeFile r
iIpeFile r
-> Getting
     (NonEmpty (IpePage r)) (IpeFile r) (NonEmpty (IpePage r))
-> NonEmpty (IpePage r)
forall s a. s -> Getting a s a -> a
^.Getting (NonEmpty (IpePage r)) (IpeFile r) (NonEmpty (IpePage r))
forall r r' (f :: * -> *).
Functor f =>
(NonEmpty (IpePage r) -> f (NonEmpty (IpePage r')))
-> IpeFile r -> f (IpeFile r')
pages

-- | Tries to read a single page file, throws an error when this
-- fails. See 'readSinglePageFile' for further details.
readSinglePageFileThrow    :: (Coordinate r, Eq r) => OsPath -> IO (IpePage r)
readSinglePageFileThrow :: forall r. (Coordinate r, Eq r) => OsPath -> IO (IpePage r)
readSinglePageFileThrow OsPath
fp = OsPath -> IO (Either ConversionError (IpePage r))
forall r.
(Coordinate r, Eq r) =>
OsPath -> IO (Either ConversionError (IpePage r))
readSinglePageFile OsPath
fp IO (Either ConversionError (IpePage r))
-> (Either ConversionError (IpePage r) -> IO (IpePage r))
-> IO (IpePage r)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left ConversionError
err -> String -> IO (IpePage r)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ConversionError -> String
forall a. Show a => a -> String
show ConversionError
err)
  Right IpePage r
p  -> IpePage r -> IO (IpePage r)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IpePage r
p

-- | Given a Bytestring, try to parse the bytestring into anything that is
-- IpeReadable, i.e. any of the Ipe elements.
fromIpeXML   :: IpeRead (t r) => B.ByteString -> Either ConversionError (t r)
fromIpeXML :: forall {k} (t :: k -> *) (r :: k).
IpeRead (t r) =>
ByteString -> Either ConversionError (t r)
fromIpeXML ByteString
b = ByteString
-> Either ConversionError (Node ConversionError ConversionError)
readXML ByteString
b Either ConversionError (Node ConversionError ConversionError)
-> (Node ConversionError ConversionError
    -> Either ConversionError (t r))
-> Either ConversionError (t r)
forall a b.
Either ConversionError a
-> (a -> Either ConversionError b) -> Either ConversionError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node ConversionError ConversionError
-> Either ConversionError (t r)
forall t.
IpeRead t =>
Node ConversionError ConversionError -> Either ConversionError t
ipeRead

-- | Reads the data from a Bytestring into a proper Node
readXML :: B.ByteString -> Either ConversionError (Node Text Text)
readXML :: ByteString
-> Either ConversionError (Node ConversionError ConversionError)
readXML = (XMLParseError -> ConversionError)
-> Either XMLParseError (Node ConversionError ConversionError)
-> Either ConversionError (Node ConversionError ConversionError)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ConversionError
T.pack (String -> ConversionError)
-> (XMLParseError -> String) -> XMLParseError -> ConversionError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XMLParseError -> String
forall a. Show a => a -> String
show) (Either XMLParseError (Node ConversionError ConversionError)
 -> Either ConversionError (Node ConversionError ConversionError))
-> (ByteString
    -> Either XMLParseError (Node ConversionError ConversionError))
-> ByteString
-> Either ConversionError (Node ConversionError ConversionError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseOptions ConversionError ConversionError
-> ByteString
-> Either XMLParseError (Node ConversionError ConversionError)
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> Either XMLParseError (Node tag text)
parse' ParseOptions ConversionError ConversionError
forall tag text. ParseOptions tag text
defaultParseOptions

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

-- | Reading an ipe elemtn from a Text value
class IpeReadText t where
  -- | Try to read the text content into a value of type t
  ipeReadText :: Text -> Either ConversionError t

-- | Reading an ipe lement from Xml
class IpeRead t where
  -- | Try to convert an xml tree into a value of type t
  ipeRead  :: Node Text Text -> Either ConversionError t

--------------------------------------------------------------------------------
--  ReadText instances

instance IpeReadText Text where
  ipeReadText :: ConversionError -> Either ConversionError ConversionError
ipeReadText = ConversionError -> Either ConversionError ConversionError
forall a b. b -> Either a b
Right

instance IpeReadText Int where
  ipeReadText :: ConversionError -> Either ConversionError Int
ipeReadText = (Integer -> Int)
-> Either ConversionError Integer -> Either ConversionError Int
forall a b.
(a -> b) -> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Either ConversionError Integer -> Either ConversionError Int)
-> (ConversionError -> Either ConversionError Integer)
-> ConversionError
-> Either ConversionError Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Integer -> ConversionError -> Either ConversionError Integer
forall a. Parser a -> ConversionError -> Either ConversionError a
runParser Parser Integer
pInteger

instance Coordinate r => IpeReadText (Point 2 r) where
  ipeReadText :: ConversionError -> Either ConversionError (Point 2 r)
ipeReadText = ConversionError -> Either ConversionError (Point 2 r)
forall r.
Coordinate r =>
ConversionError -> Either ConversionError (Point 2 r)
readPoint

instance Coordinate r => IpeReadText (Matrix.Matrix 3 3 r) where
  ipeReadText :: ConversionError -> Either ConversionError (Matrix 3 3 r)
ipeReadText = ConversionError -> Either ConversionError (Matrix 3 3 r)
forall r.
Coordinate r =>
ConversionError -> Either ConversionError (Matrix 3 3 r)
readMatrix

instance IpeReadText LayerName where
  ipeReadText :: ConversionError -> Either ConversionError LayerName
ipeReadText = LayerName -> Either ConversionError LayerName
forall a b. b -> Either a b
Right (LayerName -> Either ConversionError LayerName)
-> (ConversionError -> LayerName)
-> ConversionError
-> Either ConversionError LayerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversionError -> LayerName
LayerName

instance IpeReadText PinType where
  ipeReadText :: ConversionError -> Either ConversionError PinType
ipeReadText ConversionError
"yes" = PinType -> Either ConversionError PinType
forall a b. b -> Either a b
Right PinType
Yes
  ipeReadText ConversionError
"h"   = PinType -> Either ConversionError PinType
forall a b. b -> Either a b
Right PinType
Horizontal
  ipeReadText ConversionError
"v"   = PinType -> Either ConversionError PinType
forall a b. b -> Either a b
Right PinType
Vertical
  ipeReadText ConversionError
""    = PinType -> Either ConversionError PinType
forall a b. b -> Either a b
Right PinType
No
  ipeReadText ConversionError
_     = ConversionError -> Either ConversionError PinType
forall a b. a -> Either a b
Left ConversionError
"invalid PinType"

instance IpeReadText TransformationTypes where
  ipeReadText :: ConversionError -> Either ConversionError TransformationTypes
ipeReadText ConversionError
"affine"       = TransformationTypes -> Either ConversionError TransformationTypes
forall a b. b -> Either a b
Right TransformationTypes
Affine
  ipeReadText ConversionError
"rigid"        = TransformationTypes -> Either ConversionError TransformationTypes
forall a b. b -> Either a b
Right TransformationTypes
Rigid
  ipeReadText ConversionError
"translations" = TransformationTypes -> Either ConversionError TransformationTypes
forall a b. b -> Either a b
Right TransformationTypes
Translations
  ipeReadText ConversionError
_              = ConversionError -> Either ConversionError TransformationTypes
forall a b. a -> Either a b
Left ConversionError
"invalid TransformationType"

instance IpeReadText FillType where
  ipeReadText :: ConversionError -> Either ConversionError FillType
ipeReadText ConversionError
"wind"   = FillType -> Either ConversionError FillType
forall a b. b -> Either a b
Right FillType
Wind
  ipeReadText ConversionError
"eofill" = FillType -> Either ConversionError FillType
forall a b. b -> Either a b
Right FillType
EOFill
  ipeReadText ConversionError
_        = ConversionError -> Either ConversionError FillType
forall a b. a -> Either a b
Left ConversionError
"invalid FillType"

instance Coordinate r => IpeReadText (IpeArrow r) where
  ipeReadText :: ConversionError -> Either ConversionError (IpeArrow r)
ipeReadText ConversionError
t = case (Char -> Bool) -> ConversionError -> [ConversionError]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') ConversionError
t of
                    [ConversionError
n,ConversionError
s] -> ConversionError -> IpeSize r -> IpeArrow r
forall r. ConversionError -> IpeSize r -> IpeArrow r
IpeArrow (ConversionError -> IpeSize r -> IpeArrow r)
-> Either ConversionError ConversionError
-> Either ConversionError (IpeSize r -> IpeArrow r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversionError -> Either ConversionError ConversionError
forall a. a -> Either ConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConversionError
n Either ConversionError (IpeSize r -> IpeArrow r)
-> Either ConversionError (IpeSize r)
-> Either ConversionError (IpeArrow r)
forall a b.
Either ConversionError (a -> b)
-> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConversionError -> Either ConversionError (IpeSize r)
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText ConversionError
s
                    [ConversionError]
_     -> ConversionError -> Either ConversionError (IpeArrow r)
forall a b. a -> Either a b
Left ConversionError
"ipeArrow: name contains not exactly 1 / "

instance Coordinate r => IpeReadText (IpeDash r) where
  ipeReadText :: ConversionError -> Either ConversionError (IpeDash r)
ipeReadText ConversionError
t = IpeDash r -> Either ConversionError (IpeDash r)
forall a b. b -> Either a b
Right (IpeDash r -> Either ConversionError (IpeDash r))
-> (ConversionError -> IpeDash r)
-> ConversionError
-> Either ConversionError (IpeDash r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversionError -> IpeDash r
forall r. ConversionError -> IpeDash r
DashNamed (ConversionError -> Either ConversionError (IpeDash r))
-> ConversionError -> Either ConversionError (IpeDash r)
forall a b. (a -> b) -> a -> b
$ ConversionError
t
                  -- TODO: Implement proper parsing here


instance IpeReadText HorizontalAlignment where
  ipeReadText :: ConversionError -> Either ConversionError HorizontalAlignment
ipeReadText = \case
    ConversionError
"left"   -> HorizontalAlignment -> Either ConversionError HorizontalAlignment
forall a b. b -> Either a b
Right HorizontalAlignment
AlignLeft
    ConversionError
"center" -> HorizontalAlignment -> Either ConversionError HorizontalAlignment
forall a b. b -> Either a b
Right HorizontalAlignment
AlignHCenter
    ConversionError
"right"  -> HorizontalAlignment -> Either ConversionError HorizontalAlignment
forall a b. b -> Either a b
Right HorizontalAlignment
AlignRight
    ConversionError
_        -> ConversionError -> Either ConversionError HorizontalAlignment
forall a b. a -> Either a b
Left ConversionError
"invalid HorizontalAlignment"

instance IpeReadText VerticalAlignment where
  ipeReadText :: ConversionError -> Either ConversionError VerticalAlignment
ipeReadText = \case
    ConversionError
"top"      -> VerticalAlignment -> Either ConversionError VerticalAlignment
forall a b. b -> Either a b
Right VerticalAlignment
AlignTop
    ConversionError
"center"   -> VerticalAlignment -> Either ConversionError VerticalAlignment
forall a b. b -> Either a b
Right VerticalAlignment
AlignVCenter
    ConversionError
"bottom"   -> VerticalAlignment -> Either ConversionError VerticalAlignment
forall a b. b -> Either a b
Right VerticalAlignment
AlignBottom
    ConversionError
"baseline" -> VerticalAlignment -> Either ConversionError VerticalAlignment
forall a b. b -> Either a b
Right VerticalAlignment
AlignBaseline
    ConversionError
_          -> ConversionError -> Either ConversionError VerticalAlignment
forall a b. a -> Either a b
Left ConversionError
"invalid VerticalAlignment"


instance Coordinate r => IpeReadText (TextSizeUnit r) where
  ipeReadText :: ConversionError -> Either ConversionError (TextSizeUnit r)
ipeReadText = (r -> TextSizeUnit r)
-> Either ConversionError r
-> Either ConversionError (TextSizeUnit r)
forall a b.
(a -> b) -> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> TextSizeUnit r
forall r. r -> TextSizeUnit r
TextSizeUnit (Either ConversionError r
 -> Either ConversionError (TextSizeUnit r))
-> (ConversionError -> Either ConversionError r)
-> ConversionError
-> Either ConversionError (TextSizeUnit r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversionError -> Either ConversionError r
forall r.
Coordinate r =>
ConversionError -> Either ConversionError r
readCoordinate


ipeReadTextWith     :: (Text -> Either t v) -> Text -> Either ConversionError (IpeValue v)
ipeReadTextWith :: forall t v.
(ConversionError -> Either t v)
-> ConversionError -> Either ConversionError (IpeValue v)
ipeReadTextWith ConversionError -> Either t v
f ConversionError
t = case ConversionError -> Either t v
f ConversionError
t of
                        Right v
v -> IpeValue v -> Either ConversionError (IpeValue v)
forall a b. b -> Either a b
Right (v -> IpeValue v
forall v. v -> IpeValue v
Valued v
v)
                        Left t
_  -> IpeValue v -> Either ConversionError (IpeValue v)
forall a b. b -> Either a b
Right (ConversionError -> IpeValue v
forall v. ConversionError -> IpeValue v
Named ConversionError
t)


instance Coordinate r => IpeReadText (Rectangle (Point 2 r)) where
  ipeReadText :: ConversionError -> Either ConversionError (Rectangle (Point 2 r))
ipeReadText = ConversionError -> Either ConversionError (Rectangle (Point 2 r))
forall r.
Coordinate r =>
ConversionError -> Either ConversionError (Rectangle (Point 2 r))
readRectangle

instance Coordinate r => IpeReadText (RGB r) where
  ipeReadText :: ConversionError -> Either ConversionError (RGB r)
ipeReadText = Parser (RGB r) -> ConversionError -> Either ConversionError (RGB r)
forall a. Parser a -> ConversionError -> Either ConversionError a
runParser (Parser (RGB r)
pRGB Parser (RGB r) -> Parser (RGB r) -> Parser (RGB r)
forall a.
ParsecT ConversionError () Identity a
-> ParsecT ConversionError () Identity a
-> ParsecT ConversionError () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (RGB r)
pGrey)
    where
      pGrey :: Parser (RGB r)
pGrey = (\r
c -> r -> r -> r -> RGB r
forall a. a -> a -> a -> RGB a
RGB r
c r
c r
c) (r -> RGB r)
-> ParsecT ConversionError () Identity r -> Parser (RGB r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ConversionError () Identity r
forall r. Coordinate r => Parser r
pCoordinate
      pRGB :: Parser (RGB r)
pRGB  = r -> r -> r -> RGB r
forall a. a -> a -> a -> RGB a
RGB (r -> r -> r -> RGB r)
-> ParsecT ConversionError () Identity r
-> ParsecT ConversionError () Identity (r -> r -> RGB r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ConversionError () Identity r
forall r. Coordinate r => Parser r
pCoordinate ParsecT ConversionError () Identity (r -> r -> RGB r)
-> ParsecT ConversionError () Identity String
-> ParsecT ConversionError () Identity (r -> r -> RGB r)
forall a b.
ParsecT ConversionError () Identity a
-> ParsecT ConversionError () Identity b
-> ParsecT ConversionError () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConversionError () Identity String
pWhiteSpace
                  ParsecT ConversionError () Identity (r -> r -> RGB r)
-> ParsecT ConversionError () Identity r
-> ParsecT ConversionError () Identity (r -> RGB r)
forall a b.
ParsecT ConversionError () Identity (a -> b)
-> ParsecT ConversionError () Identity a
-> ParsecT ConversionError () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ConversionError () Identity r
forall r. Coordinate r => Parser r
pCoordinate ParsecT ConversionError () Identity (r -> RGB r)
-> ParsecT ConversionError () Identity String
-> ParsecT ConversionError () Identity (r -> RGB r)
forall a b.
ParsecT ConversionError () Identity a
-> ParsecT ConversionError () Identity b
-> ParsecT ConversionError () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConversionError () Identity String
pWhiteSpace
                  ParsecT ConversionError () Identity (r -> RGB r)
-> ParsecT ConversionError () Identity r -> Parser (RGB r)
forall a b.
ParsecT ConversionError () Identity (a -> b)
-> ParsecT ConversionError () Identity a
-> ParsecT ConversionError () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ConversionError () Identity r
forall r. Coordinate r => Parser r
pCoordinate

instance Coordinate r => IpeReadText (IpeColor r) where
  ipeReadText :: ConversionError -> Either ConversionError (IpeColor r)
ipeReadText = (IpeValue (RGB r) -> IpeColor r)
-> Either ConversionError (IpeValue (RGB r))
-> Either ConversionError (IpeColor r)
forall a b.
(a -> b) -> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IpeValue (RGB r) -> IpeColor r
forall r. IpeValue (RGB r) -> IpeColor r
IpeColor (Either ConversionError (IpeValue (RGB r))
 -> Either ConversionError (IpeColor r))
-> (ConversionError -> Either ConversionError (IpeValue (RGB r)))
-> ConversionError
-> Either ConversionError (IpeColor r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConversionError -> Either ConversionError (RGB r))
-> ConversionError -> Either ConversionError (IpeValue (RGB r))
forall t v.
(ConversionError -> Either t v)
-> ConversionError -> Either ConversionError (IpeValue v)
ipeReadTextWith ConversionError -> Either ConversionError (RGB r)
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText

instance Coordinate r => IpeReadText (IpePen r) where
  ipeReadText :: ConversionError -> Either ConversionError (IpePen r)
ipeReadText = (IpeValue r -> IpePen r)
-> Either ConversionError (IpeValue r)
-> Either ConversionError (IpePen r)
forall a b.
(a -> b) -> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IpeValue r -> IpePen r
forall r. IpeValue r -> IpePen r
IpePen (Either ConversionError (IpeValue r)
 -> Either ConversionError (IpePen r))
-> (ConversionError -> Either ConversionError (IpeValue r))
-> ConversionError
-> Either ConversionError (IpePen r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConversionError -> Either ConversionError r)
-> ConversionError -> Either ConversionError (IpeValue r)
forall t v.
(ConversionError -> Either t v)
-> ConversionError -> Either ConversionError (IpeValue v)
ipeReadTextWith ConversionError -> Either ConversionError r
forall r.
Coordinate r =>
ConversionError -> Either ConversionError r
readCoordinate

instance Coordinate r => IpeReadText (IpeSize r) where
  ipeReadText :: ConversionError -> Either ConversionError (IpeSize r)
ipeReadText = (IpeValue r -> IpeSize r)
-> Either ConversionError (IpeValue r)
-> Either ConversionError (IpeSize r)
forall a b.
(a -> b) -> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IpeValue r -> IpeSize r
forall r. IpeValue r -> IpeSize r
IpeSize (Either ConversionError (IpeValue r)
 -> Either ConversionError (IpeSize r))
-> (ConversionError -> Either ConversionError (IpeValue r))
-> ConversionError
-> Either ConversionError (IpeSize r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConversionError -> Either ConversionError r)
-> ConversionError -> Either ConversionError (IpeValue r)
forall t v.
(ConversionError -> Either t v)
-> ConversionError -> Either ConversionError (IpeValue v)
ipeReadTextWith ConversionError -> Either ConversionError r
forall r.
Coordinate r =>
ConversionError -> Either ConversionError r
readCoordinate

-- | Reads as a naimed value by default
instance IpeReadText (IpeValue r) where
  ipeReadText :: ConversionError -> Either ConversionError (IpeValue r)
ipeReadText = (ConversionError -> Either String r)
-> ConversionError -> Either ConversionError (IpeValue r)
forall t v.
(ConversionError -> Either t v)
-> ConversionError -> Either ConversionError (IpeValue v)
ipeReadTextWith (Either String r -> ConversionError -> Either String r
forall a b. a -> b -> a
const (Either String r -> ConversionError -> Either String r)
-> Either String r -> ConversionError -> Either String r
forall a b. (a -> b) -> a -> b
$ String -> Either String r
forall a b. a -> Either a b
Left String
"fail")

instance Coordinate r => IpeReadText [Operation r] where
  ipeReadText :: ConversionError -> Either ConversionError [Operation r]
ipeReadText = ConversionError -> Either ConversionError [Operation r]
forall r.
Coordinate r =>
ConversionError -> Either ConversionError [Operation r]
readPathOperations

instance (Coordinate r, Fractional r, Eq r) => IpeReadText (NonEmpty.NonEmpty (PathSegment r)) where
  ipeReadText :: ConversionError
-> Either ConversionError (NonEmpty (PathSegment r))
ipeReadText ConversionError
t = ConversionError -> Either ConversionError [Operation r]
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText ConversionError
t Either ConversionError [Operation r]
-> ([Operation r]
    -> Either ConversionError (NonEmpty (PathSegment r)))
-> Either ConversionError (NonEmpty (PathSegment r))
forall a b.
Either ConversionError a
-> (a -> Either ConversionError b) -> Either ConversionError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Operation r] -> Either ConversionError (NonEmpty (PathSegment r))
forall {a} {r}.
(IsString a, Eq r, Fractional r) =>
[Operation r] -> Either a (NonEmpty (PathSegment r))
fromOpsN
    where
      fromOpsN :: [Operation r] -> Either a (NonEmpty (PathSegment r))
fromOpsN [Operation r]
xs = case [Operation r] -> Either a [PathSegment r]
forall {a} {r}.
(IsString a, Eq r, Fractional r) =>
[Operation r] -> Either a [PathSegment r]
fromOps [Operation r]
xs of
                      Left a
l       -> a -> Either a (NonEmpty (PathSegment r))
forall a b. a -> Either a b
Left a
l
                      Right []     -> a -> Either a (NonEmpty (PathSegment r))
forall a b. a -> Either a b
Left a
"No path segments produced"
                      Right (PathSegment r
p:[PathSegment r]
ps) -> NonEmpty (PathSegment r) -> Either a (NonEmpty (PathSegment r))
forall a b. b -> Either a b
Right (NonEmpty (PathSegment r) -> Either a (NonEmpty (PathSegment r)))
-> NonEmpty (PathSegment r) -> Either a (NonEmpty (PathSegment r))
forall a b. (a -> b) -> a -> b
$ PathSegment r
p PathSegment r -> [PathSegment r] -> NonEmpty (PathSegment r)
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [PathSegment r]
ps

      fromOps :: [Operation r] -> Either a [PathSegment r]
fromOps []            = [PathSegment r] -> Either a [PathSegment r]
forall a b. b -> Either a b
Right []
      fromOps [Ellipse Matrix 3 3 r
m]   = [PathSegment r] -> Either a [PathSegment r]
forall a b. b -> Either a b
Right [Ellipse r -> PathSegment r
forall r. Ellipse r -> PathSegment r
EllipseSegment (Ellipse r -> PathSegment r)
-> (Matrix 3 3 r -> Ellipse r) -> Matrix 3 3 r -> PathSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Ellipse r) (Matrix 3 3 r) (Ellipse r)
-> Matrix 3 3 r -> Ellipse r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AnIso (Ellipse r) (Ellipse r) (Matrix 3 3 r) (Matrix 3 3 r)
-> Iso (Matrix 3 3 r) (Matrix 3 3 r) (Ellipse r) (Ellipse r)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (Ellipse r) (Ellipse r) (Matrix 3 3 r) (Matrix 3 3 r)
forall r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Matrix 3 3 r) (f (Matrix 3 3 s))
-> p (Ellipse r) (f (Ellipse s))
ellipseMatrix) (Matrix 3 3 r -> PathSegment r) -> Matrix 3 3 r -> PathSegment r
forall a b. (a -> b) -> a -> b
$ Matrix 3 3 r
m]
      fromOps (MoveTo Point 2 r
p:[Operation r]
xs) = Point 2 r -> [Operation r] -> Either a [PathSegment r]
fromOps' Point 2 r
p [Operation r]
xs
      fromOps [Operation r]
_             = a -> Either a [PathSegment r]
forall a b. a -> Either a b
Left a
"Path should start with a move to"

      fromOps' :: Point 2 r -> [Operation r] -> Either a [PathSegment r]
fromOps' Point 2 r
_ []             = a -> Either a [PathSegment r]
forall a b. a -> Either a b
Left a
"Found only a MoveTo operation"
      fromOps' Point 2 r
s (LineTo Point 2 r
q:[Operation r]
ops) = let ([Operation r]
ls,[Operation r]
xs) = APrism (Operation r) (Operation r) (Point 2 r) (Point 2 r)
-> [Operation r] -> ([Operation r], [Operation r])
forall {a} {t} {a} {b}. APrism a t a b -> [a] -> ([a], [a])
span' APrism (Operation r) (Operation r) (Point 2 r) (Point 2 r)
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Point 2 r) (f (Point 2 r)) -> p (Operation r) (f (Operation r))
_LineTo [Operation r]
ops
                                      pts :: NonEmpty (Point 2 r)
pts  = Point 2 r
s Point 2 r -> [Point 2 r] -> NonEmpty (Point 2 r)
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| Point 2 r
qPoint 2 r -> [Point 2 r] -> [Point 2 r]
forall a. a -> [a] -> [a]
:(Operation r -> Maybe (Point 2 r)) -> [Operation r] -> [Point 2 r]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Operation r
-> Getting (First (Point 2 r)) (Operation r) (Point 2 r)
-> Maybe (Point 2 r)
forall s a. s -> Getting (First a) s a -> Maybe a
^?Getting (First (Point 2 r)) (Operation r) (Point 2 r)
forall r (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Point 2 r) (f (Point 2 r)) -> p (Operation r) (f (Operation r))
_LineTo) [Operation r]
ls
                                      mPoly :: Maybe (SimplePolygon (Point 2 r))
mPoly = NonEmpty (Point 2 r) -> Maybe (SimplePolygon (Point 2 r))
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable f,
 ConstructableSimplePolygon simplePolygon point r) =>
f point -> Maybe simplePolygon
forall (f :: * -> *).
(Foldable f,
 ConstructableSimplePolygon
   (SimplePolygon (Point 2 r)) (Point 2 r) r) =>
f (Point 2 r) -> Maybe (SimplePolygon (Point 2 r))
Polygon.fromPoints NonEmpty (Point 2 r)
pts
                                      pl :: PolyLine (Point 2 r)
pl    = NonEmpty (Point 2 r) -> PolyLine (Point 2 r)
forall polyLine point (f :: * -> *).
(ConstructablePolyLine_ polyLine point, Foldable1 f) =>
f point -> polyLine
forall (f :: * -> *).
Foldable1 f =>
f (Point 2 r) -> PolyLine (Point 2 r)
polyLineFromPoints NonEmpty (Point 2 r)
pts
                                      or' :: Orientation
or'   = if NonEmpty (Point 2 r) -> Bool
forall r. (Eq r, Num r) => NonEmpty (Point 2 r) -> Bool
isCounterClockwise NonEmpty (Point 2 r)
pts
                                              then Orientation
Ipe.Path.AsIs
                                              else Orientation
Ipe.Path.Reversed
                                  in case [Operation r]
xs of
                                       (Operation r
ClosePath : [Operation r]
xs') -> case Maybe (SimplePolygon (Point 2 r))
mPoly of
                                         Maybe (SimplePolygon (Point 2 r))
Nothing         -> a -> Either a [PathSegment r]
forall a b. a -> Either a b
Left a
"simple polygon failed"
                                         Just SimplePolygon (Point 2 r)
poly       -> Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
forall r. Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
PolygonPath Orientation
or' SimplePolygon (Point 2 r)
poly PathSegment r -> [Operation r] -> Either a [PathSegment r]
<<| [Operation r]
xs'
                                       [Operation r]
_                 -> PolyLine (Point 2 r) -> PathSegment r
forall r. PolyLine (Point 2 r) -> PathSegment r
PolyLineSegment PolyLine (Point 2 r)
pl PathSegment r -> [Operation r] -> Either a [PathSegment r]
<<| [Operation r]
xs

      fromOps' Point 2 r
s [Spline [Point 2 r
a, Point 2 r
b]]  = [PathSegment r] -> Either a [PathSegment r]
forall a b. b -> Either a b
Right [QuadraticBezier (Point 2 r) -> PathSegment r
forall r. QuadraticBezier (Point 2 r) -> PathSegment r
QuadraticBezierSegment (QuadraticBezier (Point 2 r) -> PathSegment r)
-> QuadraticBezier (Point 2 r) -> PathSegment r
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r -> Point 2 r -> QuadraticBezier (Point 2 r)
forall point. point -> point -> point -> QuadraticBezier point
Bezier2 Point 2 r
s Point 2 r
a Point 2 r
b]
      fromOps' Point 2 r
s [Spline [Point 2 r
a, Point 2 r
b, Point 2 r
c]]  = [PathSegment r] -> Either a [PathSegment r]
forall a b. b -> Either a b
Right [CubicBezier (Point 2 r) -> PathSegment r
forall r. CubicBezier (Point 2 r) -> PathSegment r
CubicBezierSegment (CubicBezier (Point 2 r) -> PathSegment r)
-> CubicBezier (Point 2 r) -> PathSegment r
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> Point 2 r -> Point 2 r -> Point 2 r -> CubicBezier (Point 2 r)
forall point. point -> point -> point -> point -> CubicBezier point
Bezier3 Point 2 r
s Point 2 r
a Point 2 r
b Point 2 r
c]
      fromOps' Point 2 r
s [Spline [Point 2 r]
ps] = [PathSegment r] -> Either a [PathSegment r]
forall a b. b -> Either a b
Right ([PathSegment r] -> Either a [PathSegment r])
-> [PathSegment r] -> Either a [PathSegment r]
forall a b. (a -> b) -> a -> b
$ (CubicBezier (Point 2 r) -> PathSegment r)
-> [CubicBezier (Point 2 r)] -> [PathSegment r]
forall a b. (a -> b) -> [a] -> [b]
map CubicBezier (Point 2 r) -> PathSegment r
forall r. CubicBezier (Point 2 r) -> PathSegment r
CubicBezierSegment ([CubicBezier (Point 2 r)] -> [PathSegment r])
-> [CubicBezier (Point 2 r)] -> [PathSegment r]
forall a b. (a -> b) -> a -> b
$ [Point 2 r] -> [CubicBezier (Point 2 r)]
forall r. Fractional r => [Point 2 r] -> [CubicBezier (Point 2 r)]
splineToCubicBeziers ([Point 2 r] -> [CubicBezier (Point 2 r)])
-> [Point 2 r] -> [CubicBezier (Point 2 r)]
forall a b. (a -> b) -> a -> b
$ Point 2 r
s Point 2 r -> [Point 2 r] -> [Point 2 r]
forall a. a -> [a] -> [a]
: [Point 2 r]
ps
      -- these will not occur anymore with recent ipe files
      fromOps' Point 2 r
s [QCurveTo Point 2 r
a Point 2 r
b]  = [PathSegment r] -> Either a [PathSegment r]
forall a b. b -> Either a b
Right [QuadraticBezier (Point 2 r) -> PathSegment r
forall r. QuadraticBezier (Point 2 r) -> PathSegment r
QuadraticBezierSegment (QuadraticBezier (Point 2 r) -> PathSegment r)
-> QuadraticBezier (Point 2 r) -> PathSegment r
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r -> Point 2 r -> QuadraticBezier (Point 2 r)
forall point. point -> point -> point -> QuadraticBezier point
Bezier2 Point 2 r
s Point 2 r
a Point 2 r
b]
      fromOps' Point 2 r
s [CurveTo Point 2 r
a Point 2 r
b Point 2 r
c] = [PathSegment r] -> Either a [PathSegment r]
forall a b. b -> Either a b
Right [CubicBezier (Point 2 r) -> PathSegment r
forall r. CubicBezier (Point 2 r) -> PathSegment r
CubicBezierSegment (CubicBezier (Point 2 r) -> PathSegment r)
-> CubicBezier (Point 2 r) -> PathSegment r
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> Point 2 r -> Point 2 r -> Point 2 r -> CubicBezier (Point 2 r)
forall point. point -> point -> point -> point -> CubicBezier point
Bezier3 Point 2 r
s Point 2 r
a Point 2 r
b Point 2 r
c]
      fromOps' Point 2 r
_ [Operation r]
_ = a -> Either a [PathSegment r]
forall a b. a -> Either a b
Left a
"fromOpts': rest not implemented yet."

      span' :: APrism a t a b -> [a] -> ([a], [a])
span' APrism a t a b
pr = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism a t a b -> a -> Bool
forall s t a b. APrism s t a b -> s -> Bool
isn't APrism a t a b
pr)

      PathSegment r
x <<| :: PathSegment r -> [Operation r] -> Either a [PathSegment r]
<<| [Operation r]
xs = (PathSegment r
xPathSegment r -> [PathSegment r] -> [PathSegment r]
forall a. a -> [a] -> [a]
:) ([PathSegment r] -> [PathSegment r])
-> Either a [PathSegment r] -> Either a [PathSegment r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Operation r] -> Either a [PathSegment r]
fromOps [Operation r]
xs


-- | test if the sequence of points, forming a simple polygon, is in CCW order
isCounterClockwise :: (Eq r, Num r) => NonEmpty.NonEmpty (Point 2 r) -> Bool
isCounterClockwise :: forall r. (Eq r, Num r) => NonEmpty (Point 2 r) -> Bool
isCounterClockwise = (\r
x -> r
x r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r -> r
forall a. Num a => a -> a
abs r
x) (r -> Bool)
-> (NonEmpty (Point 2 r) -> r) -> NonEmpty (Point 2 r) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Point 2 r) -> r
NonEmpty (Point 2 r) -> NumType (Point 2 r)
forall {s}.
(Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Num (NumType s), Point_ s (Dimension s) (NumType s)) =>
NonEmpty s -> NumType s
signedArea2X'
  where
    signedArea2X' :: NonEmpty s -> NumType s
signedArea2X' NonEmpty s
poly = [NumType s] -> NumType s
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ 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 -> NumType s
forall a. Num a => a -> a -> a
* 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 NumType s -> NumType s -> NumType s
forall a. Num a => a -> a -> a
- 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 NumType s -> NumType s -> NumType s
forall a. Num a => a -> a -> a
* 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
                             | (s
p,s
q) <- NonEmpty s -> [(s, s)]
forall {b}. NonEmpty b -> [(b, b)]
edges NonEmpty s
poly
                             ]
    edges :: NonEmpty b -> [(b, b)]
edges NonEmpty b
poly = let poly' :: [b]
poly' = NonEmpty b -> [b]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty b
poly in [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [b]
poly' (NonEmpty b -> [b]
forall a. NonEmpty a -> [a]
NonEmpty.tail NonEmpty b
poly [b] -> [b] -> [b]
forall a. Semigroup a => a -> a -> a
<> [b]
poly')


-- | Read a list of control points of a uniform cubic B-spline and conver it
--   to cubic Bezier pieces
splineToCubicBeziers :: Fractional r => [Point 2 r] -> [CubicBezier (Point 2 r)]
splineToCubicBeziers :: forall r. Fractional r => [Point 2 r] -> [CubicBezier (Point 2 r)]
splineToCubicBeziers [Point 2 r
a, Point 2 r
b, Point 2 r
c, Point 2 r
d] = [Point 2 r
-> Point 2 r -> Point 2 r -> Point 2 r -> CubicBezier (Point 2 r)
forall point. point -> point -> point -> point -> CubicBezier point
Bezier3 Point 2 r
a Point 2 r
b Point 2 r
c Point 2 r
d]
splineToCubicBeziers (Point 2 r
a : Point 2 r
b : Point 2 r
c : Point 2 r
d : [Point 2 r]
rest) =
  let p :: Point 2 r
p = Point 2 r
b Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ ((Point 2 r
c 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
b) Vector 2 r -> r -> Vector 2 r
forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ r
2)
      q :: Point 2 r
q = Point 2 r
c Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ ((Point 2 r
d 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
c) Vector 2 r -> r -> Vector 2 r
forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ r
3)
      r :: Point 2 r
r = Point 2 r
p Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ ((Point 2 r
q 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
p) Vector 2 r -> r -> Vector 2 r
forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ r
2)
  in (Point 2 r
-> Point 2 r -> Point 2 r -> Point 2 r -> CubicBezier (Point 2 r)
forall point. point -> point -> point -> point -> CubicBezier point
Bezier3 Point 2 r
a Point 2 r
b Point 2 r
p Point 2 r
r) CubicBezier (Point 2 r)
-> [CubicBezier (Point 2 r)] -> [CubicBezier (Point 2 r)]
forall a. a -> [a] -> [a]
: [Point 2 r] -> [CubicBezier (Point 2 r)]
forall r. Fractional r => [Point 2 r] -> [CubicBezier (Point 2 r)]
splineToCubicBeziers (Point 2 r
r Point 2 r -> [Point 2 r] -> [Point 2 r]
forall a. a -> [a] -> [a]
: Point 2 r
q Point 2 r -> [Point 2 r] -> [Point 2 r]
forall a. a -> [a] -> [a]
: Point 2 r
d Point 2 r -> [Point 2 r] -> [Point 2 r]
forall a. a -> [a] -> [a]
: [Point 2 r]
rest)
splineToCubicBeziers [Point 2 r]
_ = String -> [CubicBezier (Point 2 r)]
forall a. HasCallStack => String -> a
error String
"splineToCubicBeziers needs at least four points"

instance (Coordinate r, Fractional r, Eq r) => IpeReadText (Path r) where
  ipeReadText :: ConversionError -> Either ConversionError (Path r)
ipeReadText = (NonEmpty (PathSegment r) -> Path r)
-> Either ConversionError (NonEmpty (PathSegment r))
-> Either ConversionError (Path r)
forall a b.
(a -> b) -> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq (PathSegment r) -> Path r
forall r. Seq (PathSegment r) -> Path r
Path (Seq (PathSegment r) -> Path r)
-> (NonEmpty (PathSegment r) -> Seq (PathSegment r))
-> NonEmpty (PathSegment r)
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (PathSegment r) -> Seq (PathSegment r)
forall a. NonEmpty a -> Seq a
fromNonEmpty') (Either ConversionError (NonEmpty (PathSegment r))
 -> Either ConversionError (Path r))
-> (ConversionError
    -> Either ConversionError (NonEmpty (PathSegment r)))
-> ConversionError
-> Either ConversionError (Path r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversionError
-> Either ConversionError (NonEmpty (PathSegment r))
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText
    where
      fromNonEmpty' :: NonEmpty.NonEmpty a -> Seq.Seq a
      fromNonEmpty' :: forall a. NonEmpty a -> Seq a
fromNonEmpty' = NonEmpty a -> Seq a
forall (f :: * -> *) (g :: * -> *) a.
(HasFromFoldable f, Foldable g) =>
g a -> f a
forall (g :: * -> *) a. Foldable g => g a -> Seq a
fromFoldable

--------------------------------------------------------------------------------
-- Reading attributes

class IpeReadAttributes ats where
  -- | Given the attributes in their text form, try to parse them
  ipeReadAttrs :: [(Text,Text)] -> Either ConversionError ats

instance ( AllB IpeReadText (CommonAttributes r)
         ) => IpeReadAttributes (CommonAttributes r Maybe) where
  ipeReadAttrs :: [(ConversionError, ConversionError)]
-> Either ConversionError (CommonAttributes r Maybe)
ipeReadAttrs [(ConversionError, ConversionError)]
textAts = forall {k} (c :: k -> Constraint) (b :: (k -> *) -> *)
       (f :: k -> *) (g :: k -> *) (e :: * -> *).
(TraversableB b, ConstraintsB b, AllB c b, Applicative e) =>
(forall (a :: k). c a => f a -> e (g a)) -> b f -> e (b g)
forall (c :: * -> Constraint) (b :: (* -> *) -> *) (f :: * -> *)
       (g :: * -> *) (e :: * -> *).
(TraversableB b, ConstraintsB b, AllB c b, Applicative e) =>
(forall a. c a => f a -> e (g a)) -> b f -> e (b g)
btraverseC @IpeReadText ([(ConversionError, ConversionError)]
-> IpeReadText a =>
   Const ConversionError a -> Either ConversionError (Maybe a)
forall value.
[(ConversionError, ConversionError)]
-> IpeReadText value =>
   Const ConversionError value -> Either ConversionError (Maybe value)
parseAttr [(ConversionError, ConversionError)]
textAts) CommonAttributes r (Const ConversionError)
forall {k} (ats :: (k -> *) -> *).
AttributeNames ats =>
ats (Const ConversionError)
attributeNames

-- | Parse some text attribute
parseAttr                      :: [(Text,Text)]
                               -> IpeReadText value
                               => Const Text value -> Either ConversionError (Maybe value)
parseAttr :: forall value.
[(ConversionError, ConversionError)]
-> IpeReadText value =>
   Const ConversionError value -> Either ConversionError (Maybe value)
parseAttr [(ConversionError, ConversionError)]
textAts (Const ConversionError
name) = (ConversionError -> Either ConversionError value)
-> Maybe ConversionError -> Either ConversionError (Maybe value)
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) -> Maybe a -> f (Maybe b)
traverse ConversionError -> Either ConversionError value
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText (Maybe ConversionError -> Either ConversionError (Maybe value))
-> Maybe ConversionError -> Either ConversionError (Maybe value)
forall a b. (a -> b) -> a -> b
$ ConversionError
-> [(ConversionError, ConversionError)] -> Maybe ConversionError
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ConversionError
name [(ConversionError, ConversionError)]
textAts
  -- case lookup name textAts of
  --                      Nothing  -> Right Nothing
  --                      Just txt -> Just <$> ipeReadText txt

instance ( AllB IpeReadText (SymbolAttributesF r), AllB IpeReadText (CommonAttributes r)
         , Eq r, Coordinate r
         ) => IpeReadAttributes (GroupAttributes r) where
  ipeReadAttrs :: [(ConversionError, ConversionError)]
-> Either ConversionError (GroupAttributes r)
ipeReadAttrs = [(ConversionError, ConversionError)]
-> Either ConversionError (GroupAttributes r)
forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeReadText b, HasCommonAttributes (b Maybe) r f,
 IpeReadAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, AttributeNames b) =>
[(ConversionError, ConversionError)]
-> Either ConversionError (b Maybe)
ipeReadAttrs'

-- | Implementation of ipeReadAttrs for the various attribue types
ipeReadAttrs'         :: (AllB IpeReadText b,
                          HasCommonAttributes (b Maybe) r f,
                          IpeReadAttributes (CommonAttributes r f), TraversableB b,
                          ConstraintsB b, AttributeNames b
                         ) => [(Text, Text)] -> Either ConversionError (b Maybe)
ipeReadAttrs' :: forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeReadText b, HasCommonAttributes (b Maybe) r f,
 IpeReadAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, AttributeNames b) =>
[(ConversionError, ConversionError)]
-> Either ConversionError (b Maybe)
ipeReadAttrs' [(ConversionError, ConversionError)]
textAts = CommonAttributes r f -> b Maybe -> b Maybe
forall {b} {r} {f :: * -> *}.
HasCommonAttributes b r f =>
CommonAttributes r f -> b -> b
combine' (CommonAttributes r f -> b Maybe -> b Maybe)
-> Either ConversionError (CommonAttributes r f)
-> Either ConversionError (b Maybe -> b Maybe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ConversionError, ConversionError)]
-> Either ConversionError (CommonAttributes r f)
forall ats.
IpeReadAttributes ats =>
[(ConversionError, ConversionError)] -> Either ConversionError ats
ipeReadAttrs [(ConversionError, ConversionError)]
textAts
                                 Either ConversionError (b Maybe -> b Maybe)
-> Either ConversionError (b Maybe)
-> Either ConversionError (b Maybe)
forall a b.
Either ConversionError (a -> b)
-> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} (c :: k -> Constraint) (b :: (k -> *) -> *)
       (f :: k -> *) (g :: k -> *) (e :: * -> *).
(TraversableB b, ConstraintsB b, AllB c b, Applicative e) =>
(forall (a :: k). c a => f a -> e (g a)) -> b f -> e (b g)
forall (c :: * -> Constraint) (b :: (* -> *) -> *) (f :: * -> *)
       (g :: * -> *) (e :: * -> *).
(TraversableB b, ConstraintsB b, AllB c b, Applicative e) =>
(forall a. c a => f a -> e (g a)) -> b f -> e (b g)
btraverseC @IpeReadText ([(ConversionError, ConversionError)]
-> IpeReadText a =>
   Const ConversionError a -> Either ConversionError (Maybe a)
forall value.
[(ConversionError, ConversionError)]
-> IpeReadText value =>
   Const ConversionError value -> Either ConversionError (Maybe value)
parseAttr [(ConversionError, ConversionError)]
textAts) b (Const ConversionError)
forall {k} (ats :: (k -> *) -> *).
AttributeNames ats =>
ats (Const ConversionError)
attributeNames
  where
    combine' :: CommonAttributes r f -> b -> b
combine' CommonAttributes r f
common b
rest = b
restb -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
&(CommonAttributes r f -> Identity (CommonAttributes r f))
-> b -> Identity b
forall c r (f :: * -> *).
HasCommonAttributes c r f =>
Lens' c (CommonAttributes r f)
Lens' b (CommonAttributes r f)
commonAttributes ((CommonAttributes r f -> Identity (CommonAttributes r f))
 -> b -> Identity b)
-> CommonAttributes r f -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommonAttributes r f
common

instance ( AllB IpeReadText (SymbolAttributesF r), AllB IpeReadText (CommonAttributes r)
         ) => IpeReadAttributes (SymbolAttributes r) where
  ipeReadAttrs :: [(ConversionError, ConversionError)]
-> Either ConversionError (SymbolAttributes r)
ipeReadAttrs = [(ConversionError, ConversionError)]
-> Either ConversionError (SymbolAttributes r)
forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeReadText b, HasCommonAttributes (b Maybe) r f,
 IpeReadAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, AttributeNames b) =>
[(ConversionError, ConversionError)]
-> Either ConversionError (b Maybe)
ipeReadAttrs'

instance ( AllB IpeReadText (SymbolAttributesF r), AllB IpeReadText (CommonAttributes r)
         , Coordinate r
         ) => IpeReadAttributes (PathAttributes r) where
  ipeReadAttrs :: [(ConversionError, ConversionError)]
-> Either ConversionError (PathAttributes r)
ipeReadAttrs = [(ConversionError, ConversionError)]
-> Either ConversionError (PathAttributes r)
forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeReadText b, HasCommonAttributes (b Maybe) r f,
 IpeReadAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, AttributeNames b) =>
[(ConversionError, ConversionError)]
-> Either ConversionError (b Maybe)
ipeReadAttrs'

instance ( AllB IpeReadText (SymbolAttributesF r), AllB IpeReadText (CommonAttributes r)
         , Coordinate r
         ) => IpeReadAttributes (TextAttributes r) where
  ipeReadAttrs :: [(ConversionError, ConversionError)]
-> Either ConversionError (TextAttributes r)
ipeReadAttrs = [(ConversionError, ConversionError)]
-> Either ConversionError (TextAttributes r)
forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeReadText b, HasCommonAttributes (b Maybe) r f,
 IpeReadAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, AttributeNames b) =>
[(ConversionError, ConversionError)]
-> Either ConversionError (b Maybe)
ipeReadAttrs'

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

-- | If we can ipeRead an ipe element, and we can ipeReadAttrs its attributes
-- we can properly read an ipe object using ipeReadObject
ipeReadObject         :: ( IpeRead (i r)
                         , IpeReadAttributes (IpeAttributes i r)
                         -- , f ~ AttrMapSym1 r, ats ~ AttributesOf i
                         -- , RecApplicative ats
                         -- , ReifyConstraint IpeReadAttr (Attr f) ats
                         -- , RecAll (Attr f) ats IpeReadAttr
                         -- , AllConstrained IpeAttrName ats
                         )
                      => Proxy i -> proxy r -> Node Text Text
                      -> Either ConversionError (i r :+ IpeAttributes i r)
ipeReadObject :: forall (i :: * -> *) r (proxy :: * -> *).
(IpeRead (i r), IpeReadAttributes (IpeAttributes i r)) =>
Proxy i
-> proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (i r :+ IpeAttributes i r)
ipeReadObject Proxy i
_ proxy r
_ Node ConversionError ConversionError
xml = i r -> IpeAttributes i r -> i r :+ IpeAttributes i r
forall core extra. core -> extra -> core :+ extra
(:+) (i r -> IpeAttributes i r -> i r :+ IpeAttributes i r)
-> Either ConversionError (i r)
-> Either
     ConversionError (IpeAttributes i r -> i r :+ IpeAttributes i r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node ConversionError ConversionError
-> Either ConversionError (i r)
forall t.
IpeRead t =>
Node ConversionError ConversionError -> Either ConversionError t
ipeRead Node ConversionError ConversionError
xml Either
  ConversionError (IpeAttributes i r -> i r :+ IpeAttributes i r)
-> Either ConversionError (IpeAttributes i r)
-> Either ConversionError (i r :+ IpeAttributes i r)
forall a b.
Either ConversionError (a -> b)
-> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node ConversionError ConversionError
-> Either ConversionError (IpeAttributes i r)
forall ats.
IpeReadAttributes ats =>
Node ConversionError ConversionError -> Either ConversionError ats
ipeReadAttrsFrom Node ConversionError ConversionError
xml

-- | read the attributes of a given node
ipeReadAttrsFrom :: IpeReadAttributes ats => Node Text Text -> Either ConversionError ats
ipeReadAttrsFrom :: forall ats.
IpeReadAttributes ats =>
Node ConversionError ConversionError -> Either ConversionError ats
ipeReadAttrsFrom = \case
  (Element ConversionError
_ [(ConversionError, ConversionError)]
ats [Node ConversionError ConversionError]
_) -> [(ConversionError, ConversionError)] -> Either ConversionError ats
forall ats.
IpeReadAttributes ats =>
[(ConversionError, ConversionError)] -> Either ConversionError ats
ipeReadAttrs [(ConversionError, ConversionError)]
ats
  Node ConversionError ConversionError
_                 -> ConversionError -> Either ConversionError ats
forall a b. a -> Either a b
Left ConversionError
"IpeReadAttrs': Element expected, Text found"

--------------------------------------------------------------------------------
-- | Ipe read instances

instance Coordinate r => IpeRead (IpeSymbol r) where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError (IpeSymbol r)
ipeRead (Element ConversionError
"use" [(ConversionError, ConversionError)]
ats [Node ConversionError ConversionError]
_) = case ConversionError
-> [(ConversionError, ConversionError)] -> Maybe ConversionError
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ConversionError
"pos" [(ConversionError, ConversionError)]
ats of
      Maybe ConversionError
Nothing -> ConversionError -> Either ConversionError (IpeSymbol r)
forall a b. a -> Either a b
Left ConversionError
"symbol without position"
      Just ConversionError
ps -> (Point 2 r -> ConversionError -> IpeSymbol r)
-> ConversionError -> Point 2 r -> IpeSymbol r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point 2 r -> ConversionError -> IpeSymbol r
forall r. Point 2 r -> ConversionError -> IpeSymbol r
Symbol ConversionError
name (Point 2 r -> IpeSymbol r)
-> Either ConversionError (Point 2 r)
-> Either ConversionError (IpeSymbol r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversionError -> Either ConversionError (Point 2 r)
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText ConversionError
ps
    where
      name :: ConversionError
name = ConversionError -> Maybe ConversionError -> ConversionError
forall a. a -> Maybe a -> a
fromMaybe ConversionError
"mark/disk(sx)" (Maybe ConversionError -> ConversionError)
-> Maybe ConversionError -> ConversionError
forall a b. (a -> b) -> a -> b
$ ConversionError
-> [(ConversionError, ConversionError)] -> Maybe ConversionError
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ConversionError
"name" [(ConversionError, ConversionError)]
ats
  ipeRead Node ConversionError ConversionError
_ = ConversionError -> Either ConversionError (IpeSymbol r)
forall a b. a -> Either a b
Left ConversionError
"symbol element expected, text found"

-- | Given a list of Nodes, try to parse all of them as a big text. If we
-- encounter anything else then text, the parsing fails.
allText :: [Node Text Text] -> Either ConversionError Text
allText :: [Node ConversionError ConversionError]
-> Either ConversionError ConversionError
allText = ([ConversionError] -> ConversionError)
-> Either ConversionError [ConversionError]
-> Either ConversionError ConversionError
forall a b.
(a -> b) -> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ConversionError] -> ConversionError
T.unlines (Either ConversionError [ConversionError]
 -> Either ConversionError ConversionError)
-> ([Node ConversionError ConversionError]
    -> Either ConversionError [ConversionError])
-> [Node ConversionError ConversionError]
-> Either ConversionError ConversionError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node ConversionError ConversionError
 -> Either ConversionError ConversionError)
-> [Node ConversionError ConversionError]
-> Either ConversionError [ConversionError]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Node ConversionError ConversionError
-> Either ConversionError ConversionError
forall {a} {c :: * -> *} {tag} {b}.
IsString a =>
NodeG c tag b -> Either a b
unT
  where
    unT :: NodeG c tag b -> Either a b
unT (Text b
t) = b -> Either a b
forall a b. b -> Either a b
Right b
t
    unT NodeG c tag b
_        = a -> Either a b
forall a b. a -> Either a b
Left a
"allText: Expected Text, found an Element"

instance (Coordinate r, Fractional r, Eq r) => IpeRead (Path r) where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError (Path r)
ipeRead (Element ConversionError
"path" [(ConversionError, ConversionError)]
_ [Node ConversionError ConversionError]
chs) = [Node ConversionError ConversionError]
-> Either ConversionError ConversionError
allText [Node ConversionError ConversionError]
chs Either ConversionError ConversionError
-> (ConversionError -> Either ConversionError (Path r))
-> Either ConversionError (Path r)
forall a b.
Either ConversionError a
-> (a -> Either ConversionError b) -> Either ConversionError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConversionError -> Either ConversionError (Path r)
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText
  ipeRead Node ConversionError ConversionError
_                      = ConversionError -> Either ConversionError (Path r)
forall a b. a -> Either a b
Left ConversionError
"path: expected element, found text"


lookup'   :: Text -> [(Text,a)] -> Either ConversionError a
lookup' :: forall a.
ConversionError
-> [(ConversionError, a)] -> Either ConversionError a
lookup' ConversionError
k = Either ConversionError a
-> (a -> Either ConversionError a)
-> Maybe a
-> Either ConversionError a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConversionError -> Either ConversionError a
forall a b. a -> Either a b
Left (ConversionError -> Either ConversionError a)
-> ConversionError -> Either ConversionError a
forall a b. (a -> b) -> a -> b
$ ConversionError
"lookup' " ConversionError -> ConversionError -> ConversionError
forall a. Semigroup a => a -> a -> a
<> ConversionError
k ConversionError -> ConversionError -> ConversionError
forall a. Semigroup a => a -> a -> a
<> ConversionError
" not found") a -> Either ConversionError a
forall a b. b -> Either a b
Right (Maybe a -> Either ConversionError a)
-> ([(ConversionError, a)] -> Maybe a)
-> [(ConversionError, a)]
-> Either ConversionError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConversionError -> [(ConversionError, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ConversionError
k

instance Coordinate r => IpeRead (TextLabel r) where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError (TextLabel r)
ipeRead (Element ConversionError
"text" [(ConversionError, ConversionError)]
ats [Node ConversionError ConversionError]
chs)
    | ConversionError
-> [(ConversionError, ConversionError)] -> Maybe ConversionError
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ConversionError
"type" [(ConversionError, ConversionError)]
ats Maybe ConversionError -> Maybe ConversionError -> Bool
forall a. Eq a => a -> a -> Bool
== ConversionError -> Maybe ConversionError
forall a. a -> Maybe a
Just ConversionError
"label" = ConversionError -> Point 2 r -> TextLabel r
forall r. ConversionError -> Point 2 r -> TextLabel r
Label
                                       (ConversionError -> Point 2 r -> TextLabel r)
-> Either ConversionError ConversionError
-> Either ConversionError (Point 2 r -> TextLabel r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node ConversionError ConversionError]
-> Either ConversionError ConversionError
allText [Node ConversionError ConversionError]
chs
                                       Either ConversionError (Point 2 r -> TextLabel r)
-> Either ConversionError (Point 2 r)
-> Either ConversionError (TextLabel r)
forall a b.
Either ConversionError (a -> b)
-> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ConversionError
-> [(ConversionError, ConversionError)]
-> Either ConversionError ConversionError
forall a.
ConversionError
-> [(ConversionError, a)] -> Either ConversionError a
lookup' ConversionError
"pos" [(ConversionError, ConversionError)]
ats Either ConversionError ConversionError
-> (ConversionError -> Either ConversionError (Point 2 r))
-> Either ConversionError (Point 2 r)
forall a b.
Either ConversionError a
-> (a -> Either ConversionError b) -> Either ConversionError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConversionError -> Either ConversionError (Point 2 r)
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText)
    | Bool
otherwise                         = ConversionError -> Either ConversionError (TextLabel r)
forall a b. a -> Either a b
Left ConversionError
"Not a Text label"
  ipeRead Node ConversionError ConversionError
_                             = ConversionError -> Either ConversionError (TextLabel r)
forall a b. a -> Either a b
Left ConversionError
"textlabel: Expected element, found text"



instance Coordinate r => IpeRead (MiniPage r) where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError (MiniPage r)
ipeRead (Element ConversionError
"text" [(ConversionError, ConversionError)]
ats [Node ConversionError ConversionError]
chs)
    | ConversionError
-> [(ConversionError, ConversionError)] -> Maybe ConversionError
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ConversionError
"type" [(ConversionError, ConversionError)]
ats Maybe ConversionError -> Maybe ConversionError -> Bool
forall a. Eq a => a -> a -> Bool
== ConversionError -> Maybe ConversionError
forall a. a -> Maybe a
Just ConversionError
"minipage" = ConversionError -> Point 2 r -> r -> MiniPage r
forall r. ConversionError -> Point 2 r -> r -> MiniPage r
MiniPage
                                          (ConversionError -> Point 2 r -> r -> MiniPage r)
-> Either ConversionError ConversionError
-> Either ConversionError (Point 2 r -> r -> MiniPage r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node ConversionError ConversionError]
-> Either ConversionError ConversionError
allText [Node ConversionError ConversionError]
chs
                                          Either ConversionError (Point 2 r -> r -> MiniPage r)
-> Either ConversionError (Point 2 r)
-> Either ConversionError (r -> MiniPage r)
forall a b.
Either ConversionError (a -> b)
-> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ConversionError
-> [(ConversionError, ConversionError)]
-> Either ConversionError ConversionError
forall a.
ConversionError
-> [(ConversionError, a)] -> Either ConversionError a
lookup' ConversionError
"pos"   [(ConversionError, ConversionError)]
ats Either ConversionError ConversionError
-> (ConversionError -> Either ConversionError (Point 2 r))
-> Either ConversionError (Point 2 r)
forall a b.
Either ConversionError a
-> (a -> Either ConversionError b) -> Either ConversionError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConversionError -> Either ConversionError (Point 2 r)
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText)
                                          Either ConversionError (r -> MiniPage r)
-> Either ConversionError r -> Either ConversionError (MiniPage r)
forall a b.
Either ConversionError (a -> b)
-> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ConversionError
-> [(ConversionError, ConversionError)]
-> Either ConversionError ConversionError
forall a.
ConversionError
-> [(ConversionError, a)] -> Either ConversionError a
lookup' ConversionError
"width" [(ConversionError, ConversionError)]
ats Either ConversionError ConversionError
-> (ConversionError -> Either ConversionError r)
-> Either ConversionError r
forall a b.
Either ConversionError a
-> (a -> Either ConversionError b) -> Either ConversionError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConversionError -> Either ConversionError r
forall r.
Coordinate r =>
ConversionError -> Either ConversionError r
readCoordinate)
    | Bool
otherwise                            = ConversionError -> Either ConversionError (MiniPage r)
forall a b. a -> Either a b
Left ConversionError
"Not a MiniPage"
  ipeRead Node ConversionError ConversionError
_                                = ConversionError -> Either ConversionError (MiniPage r)
forall a b. a -> Either a b
Left ConversionError
"MiniPage: Expected element, found text"


instance Coordinate r => IpeRead (Image r) where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError (Image r)
ipeRead (Element ConversionError
"image" [(ConversionError, ConversionError)]
ats [Node ConversionError ConversionError]
_) = () -> Rectangle (Point 2 r) -> Image r
forall r. () -> Rectangle (Point 2 r) -> Image r
Image () (Rectangle (Point 2 r) -> Image r)
-> Either ConversionError (Rectangle (Point 2 r))
-> Either ConversionError (Image r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConversionError
-> [(ConversionError, ConversionError)]
-> Either ConversionError ConversionError
forall a.
ConversionError
-> [(ConversionError, a)] -> Either ConversionError a
lookup' ConversionError
"rect" [(ConversionError, ConversionError)]
ats Either ConversionError ConversionError
-> (ConversionError
    -> Either ConversionError (Rectangle (Point 2 r)))
-> Either ConversionError (Rectangle (Point 2 r))
forall a b.
Either ConversionError a
-> (a -> Either ConversionError b) -> Either ConversionError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConversionError -> Either ConversionError (Rectangle (Point 2 r))
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText)
  ipeRead Node ConversionError ConversionError
_                       = ConversionError -> Either ConversionError (Image r)
forall a b. a -> Either a b
Left ConversionError
"Image: Element expected, text found"

instance (Coordinate r, Fractional r, Eq r) => IpeRead (IpeObject r) where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError (IpeObject r)
ipeRead Node ConversionError ConversionError
x = [Either ConversionError (IpeObject r)]
-> Either ConversionError (IpeObject r)
forall a. [Either ConversionError a] -> Either ConversionError a
firstRight [ (IpeSymbol r :+ SymbolAttributes r) -> IpeObject r
IpeObject' IpeSymbol r -> IpeObject r
forall r. IpeObject' IpeSymbol r -> IpeObject r
IpeUse       ((IpeSymbol r :+ SymbolAttributes r) -> IpeObject r)
-> Either ConversionError (IpeSymbol r :+ SymbolAttributes r)
-> Either ConversionError (IpeObject r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy IpeSymbol
-> Proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (IpeObject' IpeSymbol r)
forall (i :: * -> *) r (proxy :: * -> *).
(IpeRead (i r), IpeReadAttributes (IpeAttributes i r)) =>
Proxy i
-> proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (i r :+ IpeAttributes i r)
ipeReadObject (Proxy IpeSymbol
forall {k} (t :: k). Proxy t
Proxy :: Proxy IpeSymbol) Proxy r
r Node ConversionError ConversionError
x
                         , (Path r :+ PathAttributes r) -> IpeObject r
IpeObject' Path r -> IpeObject r
forall r. IpeObject' Path r -> IpeObject r
IpePath      ((Path r :+ PathAttributes r) -> IpeObject r)
-> Either ConversionError (Path r :+ PathAttributes r)
-> Either ConversionError (IpeObject r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Path
-> Proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (IpeObject' Path r)
forall (i :: * -> *) r (proxy :: * -> *).
(IpeRead (i r), IpeReadAttributes (IpeAttributes i r)) =>
Proxy i
-> proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (i r :+ IpeAttributes i r)
ipeReadObject (Proxy Path
forall {k} (t :: k). Proxy t
Proxy :: Proxy Path)      Proxy r
r Node ConversionError ConversionError
x
                         , (Group r :+ GroupAttributes r) -> IpeObject r
IpeObject' Group r -> IpeObject r
forall r. IpeObject' Group r -> IpeObject r
IpeGroup     ((Group r :+ GroupAttributes r) -> IpeObject r)
-> Either ConversionError (Group r :+ GroupAttributes r)
-> Either ConversionError (IpeObject r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Group
-> Proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (IpeObject' Group r)
forall (i :: * -> *) r (proxy :: * -> *).
(IpeRead (i r), IpeReadAttributes (IpeAttributes i r)) =>
Proxy i
-> proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (i r :+ IpeAttributes i r)
ipeReadObject (Proxy Group
forall {k} (t :: k). Proxy t
Proxy :: Proxy Group)     Proxy r
r Node ConversionError ConversionError
x
                         , (TextLabel r :+ TextAttributes r) -> IpeObject r
IpeObject' TextLabel r -> IpeObject r
forall r. IpeObject' TextLabel r -> IpeObject r
IpeTextLabel ((TextLabel r :+ TextAttributes r) -> IpeObject r)
-> Either ConversionError (TextLabel r :+ TextAttributes r)
-> Either ConversionError (IpeObject r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TextLabel
-> Proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (IpeObject' TextLabel r)
forall (i :: * -> *) r (proxy :: * -> *).
(IpeRead (i r), IpeReadAttributes (IpeAttributes i r)) =>
Proxy i
-> proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (i r :+ IpeAttributes i r)
ipeReadObject (Proxy TextLabel
forall {k} (t :: k). Proxy t
Proxy :: Proxy TextLabel) Proxy r
r Node ConversionError ConversionError
x
                         , (MiniPage r :+ TextAttributes r) -> IpeObject r
IpeObject' MiniPage r -> IpeObject r
forall r. IpeObject' MiniPage r -> IpeObject r
IpeMiniPage  ((MiniPage r :+ TextAttributes r) -> IpeObject r)
-> Either ConversionError (MiniPage r :+ TextAttributes r)
-> Either ConversionError (IpeObject r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy MiniPage
-> Proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (IpeObject' MiniPage r)
forall (i :: * -> *) r (proxy :: * -> *).
(IpeRead (i r), IpeReadAttributes (IpeAttributes i r)) =>
Proxy i
-> proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (i r :+ IpeAttributes i r)
ipeReadObject (Proxy MiniPage
forall {k} (t :: k). Proxy t
Proxy :: Proxy MiniPage)  Proxy r
r Node ConversionError ConversionError
x
                         , (Image r :+ ImageAttributes r) -> IpeObject r
IpeObject' Image r -> IpeObject r
forall r. IpeObject' Image r -> IpeObject r
IpeImage     ((Image r :+ ImageAttributes r) -> IpeObject r)
-> Either ConversionError (Image r :+ ImageAttributes r)
-> Either ConversionError (IpeObject r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Image
-> Proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (IpeObject' Image r)
forall (i :: * -> *) r (proxy :: * -> *).
(IpeRead (i r), IpeReadAttributes (IpeAttributes i r)) =>
Proxy i
-> proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (i r :+ IpeAttributes i r)
ipeReadObject (Proxy Image
forall {k} (t :: k). Proxy t
Proxy :: Proxy Image)     Proxy r
r Node ConversionError ConversionError
x
                         ]
    where
      r :: Proxy r
r = Proxy r
forall {k} (t :: k). Proxy t
Proxy :: Proxy r

firstRight :: [Either ConversionError a] -> Either ConversionError a
firstRight :: forall a. [Either ConversionError a] -> Either ConversionError a
firstRight = Either ConversionError a
-> (a -> Either ConversionError a)
-> Maybe a
-> Either ConversionError a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConversionError -> Either ConversionError a
forall a b. a -> Either a b
Left ConversionError
"No matching object") a -> Either ConversionError a
forall a b. b -> Either a b
Right (Maybe a -> Either ConversionError a)
-> ([Either ConversionError a] -> Maybe a)
-> [Either ConversionError a]
-> Either ConversionError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Leftmost a) [Either ConversionError a] a
-> [Either ConversionError a] -> Maybe a
forall a s. Getting (Leftmost a) s a -> s -> Maybe a
firstOf ((Either ConversionError a
 -> Const (Leftmost a) (Either ConversionError a))
-> [Either ConversionError a]
-> Const (Leftmost a) [Either ConversionError a]
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((Either ConversionError a
  -> Const (Leftmost a) (Either ConversionError a))
 -> [Either ConversionError a]
 -> Const (Leftmost a) [Either ConversionError a])
-> ((a -> Const (Leftmost a) a)
    -> Either ConversionError a
    -> Const (Leftmost a) (Either ConversionError a))
-> Getting (Leftmost a) [Either ConversionError a] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Const (Leftmost a) a)
-> Either ConversionError a
-> Const (Leftmost a) (Either ConversionError a)
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right)


instance (Coordinate r, Eq r) => IpeRead (Group r) where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError (Group r)
ipeRead (Element ConversionError
"group" [(ConversionError, ConversionError)]
_ [Node ConversionError ConversionError]
chs) = Group r -> Either ConversionError (Group r)
forall a b. b -> Either a b
Right (Group r -> Either ConversionError (Group r))
-> ([Node ConversionError ConversionError] -> Group r)
-> [Node ConversionError ConversionError]
-> Either ConversionError (Group r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IpeObject r] -> Group r
forall r. [IpeObject r] -> Group r
Group ([IpeObject r] -> Group r)
-> ([Node ConversionError ConversionError] -> [IpeObject r])
-> [Node ConversionError ConversionError]
-> Group r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either ConversionError (IpeObject r)] -> [IpeObject r]
forall a b. [Either a b] -> [b]
rights ([Either ConversionError (IpeObject r)] -> [IpeObject r])
-> ([Node ConversionError ConversionError]
    -> [Either ConversionError (IpeObject r)])
-> [Node ConversionError ConversionError]
-> [IpeObject r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node ConversionError ConversionError
 -> Either ConversionError (IpeObject r))
-> [Node ConversionError ConversionError]
-> [Either ConversionError (IpeObject r)]
forall a b. (a -> b) -> [a] -> [b]
map Node ConversionError ConversionError
-> Either ConversionError (IpeObject r)
forall t.
IpeRead t =>
Node ConversionError ConversionError -> Either ConversionError t
ipeRead ([Node ConversionError ConversionError]
 -> Either ConversionError (Group r))
-> [Node ConversionError ConversionError]
-> Either ConversionError (Group r)
forall a b. (a -> b) -> a -> b
$ [Node ConversionError ConversionError]
chs
  ipeRead Node ConversionError ConversionError
_                       = ConversionError -> Either ConversionError (Group r)
forall a b. a -> Either a b
Left ConversionError
"ipeRead Group: expected Element, found Text"


instance IpeRead LayerName where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError LayerName
ipeRead (Element ConversionError
"layer" [(ConversionError, ConversionError)]
ats [Node ConversionError ConversionError]
_) = ConversionError -> LayerName
LayerName (ConversionError -> LayerName)
-> Either ConversionError ConversionError
-> Either ConversionError LayerName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversionError
-> [(ConversionError, ConversionError)]
-> Either ConversionError ConversionError
forall a.
ConversionError
-> [(ConversionError, a)] -> Either ConversionError a
lookup' ConversionError
"name" [(ConversionError, ConversionError)]
ats
  ipeRead Node ConversionError ConversionError
_                       = ConversionError -> Either ConversionError LayerName
forall a b. a -> Either a b
Left ConversionError
"layer: Expected element, found text"

instance IpeRead View where
  ipeRead :: Node ConversionError ConversionError -> Either ConversionError View
ipeRead (Element ConversionError
"view" [(ConversionError, ConversionError)]
ats [Node ConversionError ConversionError]
_) = (\ConversionError
lrs LayerName
a -> [LayerName] -> LayerName -> View
View ((ConversionError -> LayerName) -> [ConversionError] -> [LayerName]
forall a b. (a -> b) -> [a] -> [b]
map ConversionError -> LayerName
LayerName ([ConversionError] -> [LayerName])
-> [ConversionError] -> [LayerName]
forall a b. (a -> b) -> a -> b
$ ConversionError -> [ConversionError]
T.words ConversionError
lrs) LayerName
a)
                                (ConversionError -> LayerName -> View)
-> Either ConversionError ConversionError
-> Either ConversionError (LayerName -> View)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConversionError
-> [(ConversionError, ConversionError)]
-> Either ConversionError ConversionError
forall a.
ConversionError
-> [(ConversionError, a)] -> Either ConversionError a
lookup' ConversionError
"layers" [(ConversionError, ConversionError)]
ats
                                Either ConversionError (LayerName -> View)
-> Either ConversionError LayerName -> Either ConversionError View
forall a b.
Either ConversionError (a -> b)
-> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ConversionError
-> [(ConversionError, ConversionError)]
-> Either ConversionError ConversionError
forall a.
ConversionError
-> [(ConversionError, a)] -> Either ConversionError a
lookup' ConversionError
"active" [(ConversionError, ConversionError)]
ats Either ConversionError ConversionError
-> (ConversionError -> Either ConversionError LayerName)
-> Either ConversionError LayerName
forall a b.
Either ConversionError a
-> (a -> Either ConversionError b) -> Either ConversionError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConversionError -> Either ConversionError LayerName
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText)
  ipeRead Node ConversionError ConversionError
_                      = ConversionError -> Either ConversionError View
forall a b. a -> Either a b
Left ConversionError
"View Expected element, found text"


-- TODO: this instance throws away all of our error collecting (and is pretty
-- slow/stupid since it tries parsing all children with all parsers)
instance (Coordinate r, Eq r) => IpeRead (IpePage r) where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError (IpePage r)
ipeRead (Element ConversionError
"page" [(ConversionError, ConversionError)]
_ [Node ConversionError ConversionError]
chs) = IpePage r -> Either ConversionError (IpePage r)
forall a b. b -> Either a b
Right (IpePage r -> Either ConversionError (IpePage r))
-> IpePage r -> Either ConversionError (IpePage r)
forall a b. (a -> b) -> a -> b
$ [LayerName] -> [View] -> [IpeObject r] -> IpePage r
forall r. [LayerName] -> [View] -> [IpeObject r] -> IpePage r
IpePage ([Node ConversionError ConversionError] -> [LayerName]
forall a.
IpeRead a =>
[Node ConversionError ConversionError] -> [a]
readAll [Node ConversionError ConversionError]
chs) ([Node ConversionError ConversionError] -> [View]
forall a.
IpeRead a =>
[Node ConversionError ConversionError] -> [a]
readAll [Node ConversionError ConversionError]
chs) ([Node ConversionError ConversionError] -> [IpeObject r]
forall a.
IpeRead a =>
[Node ConversionError ConversionError] -> [a]
readAll [Node ConversionError ConversionError]
chs)
  ipeRead Node ConversionError ConversionError
_                      = ConversionError -> Either ConversionError (IpePage r)
forall a b. a -> Either a b
Left ConversionError
"page: Element expected, text found"
      -- withDef   :: b -> Either a b -> Either c b
      -- withDef d = either (const $ Right d) Right

      -- readLayers  = withDef ["alpha"] . readAll
      -- readViews   = withDef []        . readAll
      -- readObjects = withDef []        . readAll

-- | try reading everything as an a. Throw away whatever fails.
readAll   :: IpeRead a => [Node Text Text] -> [a]
readAll :: forall a.
IpeRead a =>
[Node ConversionError ConversionError] -> [a]
readAll   = [Either ConversionError a] -> [a]
forall a b. [Either a b] -> [b]
rights ([Either ConversionError a] -> [a])
-> ([Node ConversionError ConversionError]
    -> [Either ConversionError a])
-> [Node ConversionError ConversionError]
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node ConversionError ConversionError -> Either ConversionError a)
-> [Node ConversionError ConversionError]
-> [Either ConversionError a]
forall a b. (a -> b) -> [a] -> [b]
map Node ConversionError ConversionError -> Either ConversionError a
forall t.
IpeRead t =>
Node ConversionError ConversionError -> Either ConversionError t
ipeRead


instance (Coordinate r, Eq r) => IpeRead (IpeFile r) where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError (IpeFile r)
ipeRead (Element ConversionError
"ipe" [(ConversionError, ConversionError)]
_ [Node ConversionError ConversionError]
chs) = case [Node ConversionError ConversionError] -> [IpePage r]
forall a.
IpeRead a =>
[Node ConversionError ConversionError] -> [a]
readAll [Node ConversionError ConversionError]
chs of
                                    []  -> ConversionError -> Either ConversionError (IpeFile r)
forall a b. a -> Either a b
Left ConversionError
"Ipe: no pages found"
                                    [IpePage r]
pgs -> IpeFile r -> Either ConversionError (IpeFile r)
forall a b. b -> Either a b
Right (IpeFile r -> Either ConversionError (IpeFile r))
-> IpeFile r -> Either ConversionError (IpeFile r)
forall a b. (a -> b) -> a -> b
$ Maybe IpePreamble
-> [IpeStyle] -> NonEmpty (IpePage r) -> IpeFile r
forall r.
Maybe IpePreamble
-> [IpeStyle] -> NonEmpty (IpePage r) -> IpeFile r
IpeFile Maybe IpePreamble
forall a. Maybe a
Nothing [] ([IpePage r] -> NonEmpty (IpePage r)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList [IpePage r]
pgs)
  ipeRead Node ConversionError ConversionError
_                     = ConversionError -> Either ConversionError (IpeFile r)
forall a b. a -> Either a b
Left ConversionError
"Ipe: Element expected, text found"


instance IpeRead IpeStyle where
  ipeRead :: Node ConversionError ConversionError
-> Either ConversionError IpeStyle
ipeRead = \case
    xml :: Node ConversionError ConversionError
xml@(Element ConversionError
"ipestyle" [(ConversionError, ConversionError)]
ats [Node ConversionError ConversionError]
_) -> IpeStyle -> Either ConversionError IpeStyle
forall a b. b -> Either a b
Right (IpeStyle -> Either ConversionError IpeStyle)
-> IpeStyle -> Either ConversionError IpeStyle
forall a b. (a -> b) -> a -> b
$ Maybe ConversionError
-> Node ConversionError ConversionError -> IpeStyle
IpeStyle (ConversionError
-> [(ConversionError, ConversionError)] -> Maybe ConversionError
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ConversionError
"name" [(ConversionError, ConversionError)]
ats) Node ConversionError ConversionError
xml
    Node ConversionError ConversionError
_                              -> ConversionError -> Either ConversionError IpeStyle
forall a b. a -> Either a b
Left ConversionError
"ipeStyle exptected. Something else found"


-- | Reads an Ipe stylesheet from Disk.
readIpeStylesheet :: OsPath -> IO (Either ConversionError IpeStyle)
readIpeStylesheet :: OsPath -> IO (Either ConversionError IpeStyle)
readIpeStylesheet = (ByteString -> Either ConversionError IpeStyle)
-> IO ByteString -> IO (Either ConversionError IpeStyle)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Node ConversionError ConversionError
-> Either ConversionError IpeStyle
forall t.
IpeRead t =>
Node ConversionError ConversionError -> Either ConversionError t
ipeRead (Node ConversionError ConversionError
 -> Either ConversionError IpeStyle)
-> (ByteString
    -> Either ConversionError (Node ConversionError ConversionError))
-> ByteString
-> Either ConversionError IpeStyle
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString
-> Either ConversionError (Node ConversionError ConversionError)
readXML) (IO ByteString -> IO (Either ConversionError IpeStyle))
-> (OsPath -> IO ByteString)
-> OsPath
-> IO (Either ConversionError IpeStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO ByteString
File.readFile'

-- | Given a path to a stylesheet, add it to the ipe file with the
-- highest priority. Throws an error when this fails.
addStyleSheetFrom      :: OsPath -> IpeFile r -> IO (IpeFile r)
addStyleSheetFrom :: forall r. OsPath -> IpeFile r -> IO (IpeFile r)
addStyleSheetFrom OsPath
fp IpeFile r
f = OsPath -> IO (Either ConversionError IpeStyle)
readIpeStylesheet OsPath
fp IO (Either ConversionError IpeStyle)
-> (Either ConversionError IpeStyle -> IO (IpeFile r))
-> IO (IpeFile r)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left ConversionError
err -> String -> IO (IpeFile r)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ConversionError -> String
forall a. Show a => a -> String
show ConversionError
err)
  Right IpeStyle
s  -> IpeFile r -> IO (IpeFile r)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IpeFile r -> IO (IpeFile r)) -> IpeFile r -> IO (IpeFile r)
forall a b. (a -> b) -> a -> b
$ IpeStyle -> IpeFile r -> IpeFile r
forall r. IpeStyle -> IpeFile r -> IpeFile r
addStyleSheet IpeStyle
s IpeFile r
f

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