{-# 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(..)


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

  , Coordinate(..)
  ) where

import           Control.Applicative ((<|>))
import           Control.Lens hiding (Const, 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.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.Singletons
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Traversable as Tr
import           Data.Vinyl hiding (Label)
import           Data.Vinyl.Functor
import           Data.Vinyl.TypeLevel
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


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

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 => 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
  ipeReadText :: Text -> Either ConversionError t

-- | Reading an ipe lement from Xml
class IpeRead t where
  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"


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


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) -> Maybe (SimplePolygon (Point 2 r)))
-> (NonEmpty (Point 2 r) -> NonEmpty (Point 2 r))
-> NonEmpty (Point 2 r)
-> Maybe (SimplePolygon (Point 2 r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Point 2 r) -> NonEmpty (Point 2 r)
forall a. Eq a => NonEmpty a -> NonEmpty a
dropRepeats (NonEmpty (Point 2 r) -> Maybe (SimplePolygon (Point 2 r)))
-> NonEmpty (Point 2 r) -> Maybe (SimplePolygon (Point 2 r))
forall a b. (a -> b) -> a -> b
$ 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
                                  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       -> SimplePolygon (Point 2 r) -> PathSegment r
forall r. SimplePolygon (Point 2 r) -> PathSegment r
PolygonPath 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


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


dropRepeats :: Eq a => NonEmpty.NonEmpty a -> NonEmpty.NonEmpty a
dropRepeats :: forall a. Eq a => NonEmpty a -> NonEmpty a
dropRepeats = (NonEmpty a -> a) -> NonEmpty (NonEmpty a) -> NonEmpty a
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> a
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty (NonEmpty a) -> NonEmpty a)
-> (NonEmpty a -> NonEmpty (NonEmpty a))
-> NonEmpty a
-> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> NonEmpty (NonEmpty a)
forall a. Eq a => NonEmpty a -> NonEmpty (NonEmpty a)
NonEmpty.group1

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

-- | Basically IpeReadText for attributes. This class is not really meant to be
-- implemented directly. Just define an IpeReadText instance for the type
-- (Apply f at), then the generic instance below takes care of looking up the
-- name of the attribute, and calling the right ipeReadText value. This class
-- is just so that reifyConstraint in `ipeReadRec` can select the right
-- typeclass when building the rec.
class IpeReadAttr t where
  ipeReadAttr  :: Text -> Node Text Text -> Either ConversionError t

instance IpeReadText (Apply f at) => IpeReadAttr (Attr f at) where
  ipeReadAttr :: ConversionError
-> Node ConversionError ConversionError
-> Either ConversionError (Attr f at)
ipeReadAttr ConversionError
n (Element ConversionError
_ [(ConversionError, ConversionError)]
ats [Node ConversionError ConversionError]
_) = Maybe (Apply f at) -> Attr f at
forall u (f :: TyFun u (*) -> *) (label :: u).
Maybe (Apply f label) -> Attr f label
GAttr (Maybe (Apply f at) -> Attr f at)
-> Either ConversionError (Maybe (Apply f at))
-> Either ConversionError (Attr f at)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConversionError -> Either ConversionError (Apply f at))
-> Maybe ConversionError
-> Either ConversionError (Maybe (Apply f at))
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) -> Maybe a -> m (Maybe b)
Tr.mapM ConversionError -> Either ConversionError (Apply f at)
forall t.
IpeReadText t =>
ConversionError -> Either ConversionError t
ipeReadText (ConversionError
-> [(ConversionError, ConversionError)] -> Maybe ConversionError
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ConversionError
n [(ConversionError, ConversionError)]
ats)
  ipeReadAttr ConversionError
_ Node ConversionError ConversionError
_                 = ConversionError -> Either ConversionError (Attr f at)
forall a b. a -> Either a b
Left ConversionError
"IpeReadAttr: Element expected, Text found"

-- | Combination of zipRecWith and traverse
zipTraverseWith                       :: forall f g h i (rs :: [AttributeUniverse]). Applicative h
                                      => (forall (x :: AttributeUniverse). f x -> g x -> h (i x))
                                      -> Rec f rs -> Rec g rs -> h (Rec i rs)
zipTraverseWith :: forall (f :: AttributeUniverse -> *) (g :: AttributeUniverse -> *)
       (h :: * -> *) (i :: AttributeUniverse -> *)
       (rs :: [AttributeUniverse]).
Applicative h =>
(forall (x :: AttributeUniverse). f x -> g x -> h (i x))
-> Rec f rs -> Rec g rs -> h (Rec i rs)
zipTraverseWith forall (x :: AttributeUniverse). f x -> g x -> h (i x)
_ Rec f rs
RNil      Rec g rs
RNil      = Rec i rs -> h (Rec i rs)
forall a. a -> h a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec i rs
Rec i '[]
forall {u} (a :: u -> *). Rec a '[]
RNil
zipTraverseWith forall (x :: AttributeUniverse). f x -> g x -> h (i x)
f (f r
x :& Rec f rs
xs) (g r
y :& Rec g rs
ys) = i r -> Rec i rs -> Rec i rs
i r -> Rec i rs -> Rec i (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&) (i r -> Rec i rs -> Rec i rs)
-> h (i r) -> h (Rec i rs -> Rec i rs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f r -> g r -> h (i r)
forall (x :: AttributeUniverse). f x -> g x -> h (i x)
f f r
x g r
g r
y h (Rec i rs -> Rec i rs) -> h (Rec i rs) -> h (Rec i rs)
forall a b. h (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (x :: AttributeUniverse). f x -> g x -> h (i x))
-> Rec f rs -> Rec g rs -> h (Rec i rs)
forall (f :: AttributeUniverse -> *) (g :: AttributeUniverse -> *)
       (h :: * -> *) (i :: AttributeUniverse -> *)
       (rs :: [AttributeUniverse]).
Applicative h =>
(forall (x :: AttributeUniverse). f x -> g x -> h (i x))
-> Rec f rs -> Rec g rs -> h (Rec i rs)
zipTraverseWith f x -> g x -> h (i x)
forall (x :: AttributeUniverse). f x -> g x -> h (i x)
f Rec f rs
xs Rec g rs
Rec g rs
ys

-- | Reading the Attributes into a Rec (Attr f), all based on the types of f
-- (the type family mapping labels to types), and a list of labels (ats).
ipeReadRec       :: forall f ats.
                 ( RecApplicative ats
                 , ReifyConstraint IpeReadAttr (Attr f) ats
                 , RecAll (Attr f) ats IpeReadAttr
                 , AllConstrained IpeAttrName ats
                 )
                 => Proxy f -> Proxy ats
                 -> Node Text Text
                 -> Either ConversionError (Rec (Attr  f) ats)
ipeReadRec :: forall (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]).
(RecApplicative ats, ReifyConstraint IpeReadAttr (Attr f) ats,
 RecAll (Attr f) ats IpeReadAttr, AllConstrained IpeAttrName ats) =>
Proxy f
-> Proxy ats
-> Node ConversionError ConversionError
-> Either ConversionError (Rec (Attr f) ats)
ipeReadRec Proxy f
_ Proxy ats
_ Node ConversionError ConversionError
x = (forall (x :: AttributeUniverse).
 Const ConversionError x
 -> (:.) (Dict IpeReadAttr) (Attr f) x
 -> Either ConversionError (Attr f x))
-> Rec (Const ConversionError) ats
-> Rec (Dict IpeReadAttr :. Attr f) ats
-> Either ConversionError (Rec (Attr f) ats)
forall (f :: AttributeUniverse -> *) (g :: AttributeUniverse -> *)
       (h :: * -> *) (i :: AttributeUniverse -> *)
       (rs :: [AttributeUniverse]).
Applicative h =>
(forall (x :: AttributeUniverse). f x -> g x -> h (i x))
-> Rec f rs -> Rec g rs -> h (Rec i rs)
zipTraverseWith Const ConversionError x
-> (:.) (Dict IpeReadAttr) (Attr f) x
-> Either ConversionError (Attr f x)
forall (x :: AttributeUniverse).
Const ConversionError x
-> (:.) (Dict IpeReadAttr) (Attr f) x
-> Either ConversionError (Attr f x)
f (Rec (Attr Any) ats -> Rec (Const ConversionError) ats
forall (rs :: [AttributeUniverse]) (f :: AttributeUniverse -> *).
AllConstrained IpeAttrName rs =>
Rec f rs -> Rec (Const ConversionError) rs
writeAttrNames Rec (Attr Any) ats
forall {f :: TyFun AttributeUniverse (*) -> *}. Rec (Attr f) ats
r) Rec (Dict IpeReadAttr :. Attr f) ats
r'
  where
    r :: Rec (Attr f) ats
r  = (forall (x :: AttributeUniverse). Attr f x) -> Rec (Attr f) ats
forall {u} (rs :: [u]) (f :: u -> *).
RecApplicative rs =>
(forall (x :: u). f x) -> Rec f rs
forall (f :: AttributeUniverse -> *).
(forall (x :: AttributeUniverse). f x) -> Rec f ats
rpure (Maybe (Apply f x) -> Attr f x
forall u (f :: TyFun u (*) -> *) (label :: u).
Maybe (Apply f label) -> Attr f label
GAttr Maybe (Apply f x)
forall a. Maybe a
Nothing)
    r' :: Rec (Dict IpeReadAttr :. Attr f) ats
r' = forall {u} (c :: * -> Constraint) (f :: u -> *) (rs :: [u]).
ReifyConstraint c f rs =>
Rec f rs -> Rec (Dict c :. f) rs
forall (c :: * -> Constraint) (f :: AttributeUniverse -> *)
       (rs :: [AttributeUniverse]).
ReifyConstraint c f rs =>
Rec f rs -> Rec (Dict c :. f) rs
reifyConstraint @IpeReadAttr Rec (Attr f) ats
forall {f :: TyFun AttributeUniverse (*) -> *}. Rec (Attr f) ats
r


    f                              :: forall at.
                                      Const Text at
                                   -> (Dict IpeReadAttr :. Attr f) at
                                   -> Either ConversionError (Attr f at)
    f :: forall (x :: AttributeUniverse).
Const ConversionError x
-> (:.) (Dict IpeReadAttr) (Attr f) x
-> Either ConversionError (Attr f x)
f (Const ConversionError
n) (Compose (Dict Attr f at
_)) = ConversionError
-> Node ConversionError ConversionError
-> Either ConversionError (Attr f at)
forall t.
IpeReadAttr t =>
ConversionError
-> Node ConversionError ConversionError -> Either ConversionError t
ipeReadAttr ConversionError
n Node ConversionError ConversionError
x


-- | Reader for records. Given a proxy of some ipe type i, and a proxy of an
-- coordinate type r, read the IpeAttributes for i from the xml node.
ipeReadAttrs     :: forall proxy proxy' i r f ats.
                 ( f ~ AttrMapSym1 r, ats ~ AttributesOf i
                 , ReifyConstraint IpeReadAttr (Attr f) ats
                 , RecApplicative ats
                 , RecAll (Attr f) ats IpeReadAttr
                 , AllConstrained IpeAttrName ats
                 )
                 => proxy i -> proxy' r
                 -> Node Text Text
                 -> Either ConversionError (IpeAttributes i r)
ipeReadAttrs :: forall (proxy :: (* -> *) -> *) (proxy' :: * -> *) (i :: * -> *) r
       (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]).
(f ~ AttrMapSym1 r, ats ~ AttributesOf i,
 ReifyConstraint IpeReadAttr (Attr f) ats, RecApplicative ats,
 RecAll (Attr f) ats IpeReadAttr, AllConstrained IpeAttrName ats) =>
proxy i
-> proxy' r
-> Node ConversionError ConversionError
-> Either ConversionError (IpeAttributes i r)
ipeReadAttrs proxy i
_ proxy' r
_ = (Rec (Attr f) ats -> Attributes f ats)
-> Either ConversionError (Rec (Attr f) ats)
-> Either ConversionError (Attributes f ats)
forall a b.
(a -> b) -> Either ConversionError a -> Either ConversionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rec (Attr f) ats -> Attributes f ats
forall u (f :: TyFun u (*) -> *) (ats :: [u]).
Rec (Attr f) ats -> Attributes f ats
Attrs (Either ConversionError (Rec (Attr f) ats)
 -> Either ConversionError (Attributes f ats))
-> (Node ConversionError ConversionError
    -> Either ConversionError (Rec (Attr f) ats))
-> Node ConversionError ConversionError
-> Either ConversionError (Attributes f ats)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy f
-> Proxy ats
-> Node ConversionError ConversionError
-> Either ConversionError (Rec (Attr f) ats)
forall (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]).
(RecApplicative ats, ReifyConstraint IpeReadAttr (Attr f) ats,
 RecAll (Attr f) ats IpeReadAttr, AllConstrained IpeAttrName ats) =>
Proxy f
-> Proxy ats
-> Node ConversionError ConversionError
-> Either ConversionError (Rec (Attr f) ats)
ipeReadRec (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f) (Proxy ats
forall {k} (t :: k). Proxy t
Proxy :: Proxy ats)


-- testSym :: B.ByteString
-- testSym = "<use name=\"mark/disk(sx)\" pos=\"320 736\" size=\"normal\" stroke=\"black\"/>"




-- readAttrsFromXML :: B.ByteString -> Either

-- readSymAttrs :: Either ConversionError (IpeAttributes IpeSymbol Double)
-- readSymAttrs = readXML testSym
--                >>= ipeReadAttrs (Proxy :: Proxy IpeSymbol) (Proxy :: Proxy Double)





-- | 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)
                           , 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 (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]) (proxy :: * -> *).
(IpeRead (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 ConversionError ConversionError
-> Either ConversionError (i r :+ IpeAttributes i r)
ipeReadObject Proxy i
prI proxy r
prR Node ConversionError ConversionError
xml = i r -> Attributes' r ats -> i r :+ Attributes' r ats
forall core extra. core -> extra -> core :+ extra
(:+) (i r -> Attributes' r ats -> i r :+ Attributes' r ats)
-> Either ConversionError (i r)
-> Either
     ConversionError (Attributes' r ats -> i r :+ Attributes' r ats)
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 (Attributes' r ats -> i r :+ Attributes' r ats)
-> Either ConversionError (Attributes' r ats)
-> Either ConversionError (i r :+ Attributes' r ats)
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
<*> Proxy i
-> proxy r
-> Node ConversionError ConversionError
-> Either
     ConversionError (Attributes (AttrMapSym1 r) (AttributesOf i))
forall (proxy :: (* -> *) -> *) (proxy' :: * -> *) (i :: * -> *) r
       (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]).
(f ~ AttrMapSym1 r, ats ~ AttributesOf i,
 ReifyConstraint IpeReadAttr (Attr f) ats, RecApplicative ats,
 RecAll (Attr f) ats IpeReadAttr, AllConstrained IpeAttrName ats) =>
proxy i
-> proxy' r
-> Node ConversionError ConversionError
-> Either ConversionError (IpeAttributes i r)
ipeReadAttrs Proxy i
prI proxy r
prR Node ConversionError ConversionError
xml


--------------------------------------------------------------------------------
-- | 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
 :+ Attributes
      (AttrMapSym1 r)
      '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Pen,
         'Size])
-> IpeObject r
IpeObject' IpeSymbol r -> IpeObject r
forall r. IpeObject' IpeSymbol r -> IpeObject r
IpeUse       ((IpeSymbol r
  :+ Attributes
       (AttrMapSym1 r)
       '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Pen,
          'Size])
 -> IpeObject r)
-> Either
     ConversionError
     (IpeSymbol r
      :+ Attributes
           (AttrMapSym1 r)
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Pen,
              'Size])
-> 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 (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]) (proxy :: * -> *).
(IpeRead (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 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
 :+ Attributes
      (AttrMapSym1 r)
      '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
         'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
         'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> IpeObject r
IpeObject' Path r -> IpeObject r
forall r. IpeObject' Path r -> IpeObject r
IpePath      ((Path r
  :+ Attributes
       (AttrMapSym1 r)
       '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
          'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
          'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
 -> IpeObject r)
-> Either
     ConversionError
     (Path r
      :+ Attributes
           (AttrMapSym1 r)
           '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
              'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
              'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> 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 (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]) (proxy :: * -> *).
(IpeRead (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 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
 :+ Attributes
      (AttrMapSym1 r) '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip])
-> IpeObject r
IpeObject' Group r -> IpeObject r
forall r. IpeObject' Group r -> IpeObject r
IpeGroup     ((Group r
  :+ Attributes
       (AttrMapSym1 r) '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip])
 -> IpeObject r)
-> Either
     ConversionError
     (Group r
      :+ Attributes
           (AttrMapSym1 r) '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip])
-> 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 (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]) (proxy :: * -> *).
(IpeRead (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 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 :+ Attributes (AttrMapSym1 r) CommonAttributes)
-> IpeObject r
IpeObject' TextLabel r -> IpeObject r
forall r. IpeObject' TextLabel r -> IpeObject r
IpeTextLabel ((TextLabel r :+ Attributes (AttrMapSym1 r) CommonAttributes)
 -> IpeObject r)
-> Either
     ConversionError
     (TextLabel r :+ Attributes (AttrMapSym1 r) CommonAttributes)
-> 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 (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]) (proxy :: * -> *).
(IpeRead (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 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 :+ Attributes (AttrMapSym1 r) CommonAttributes)
-> IpeObject r
IpeObject' MiniPage r -> IpeObject r
forall r. IpeObject' MiniPage r -> IpeObject r
IpeMiniPage  ((MiniPage r :+ Attributes (AttrMapSym1 r) CommonAttributes)
 -> IpeObject r)
-> Either
     ConversionError
     (MiniPage r :+ Attributes (AttrMapSym1 r) CommonAttributes)
-> 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 (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]) (proxy :: * -> *).
(IpeRead (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 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 :+ Attributes (AttrMapSym1 r) CommonAttributes)
-> IpeObject r
IpeObject' Image r -> IpeObject r
forall r. IpeObject' Image r -> IpeObject r
IpeImage     ((Image r :+ Attributes (AttrMapSym1 r) CommonAttributes)
 -> IpeObject r)
-> Either
     ConversionError
     (Image r :+ Attributes (AttrMapSym1 r) CommonAttributes)
-> 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 (f :: TyFun AttributeUniverse (*) -> *)
       (ats :: [AttributeUniverse]) (proxy :: * -> *).
(IpeRead (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 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

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