{-# 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           Data.Ext
import           Data.Geometry hiding (head)
import           Data.Geometry.BezierSpline
import           Data.Geometry.Box
import           Data.Geometry.Ellipse (ellipseMatrix)
import qualified Data.Geometry.Matrix as Matrix
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 Data.Geometry.Polygon as Polygon
import qualified Data.LSeq as LSeq
import qualified Data.List as L
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe (fromMaybe, mapMaybe)
import           Data.Proxy
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           Text.XML.Expat.Tree


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

type ConversionError = Text


-- | Given a file path, tries to read an ipe file
readRawIpeFile :: (Coordinate r, Eq r)
               => FilePath -> IO (Either ConversionError (IpeFile r))
readRawIpeFile :: FilePath -> IO (Either ConversionError (IpeFile r))
readRawIpeFile = (ByteString -> Either ConversionError (IpeFile r))
-> IO ByteString -> IO (Either ConversionError (IpeFile r))
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)))
-> (FilePath -> IO ByteString)
-> FilePath
-> IO (Either ConversionError (IpeFile r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
B.readFile


-- | Given a file path, tries to read an ipe file.
--
-- This function applies all matrices to objects.
readIpeFile :: (Coordinate r, Eq r)
            => FilePath -> IO (Either ConversionError (IpeFile r))
readIpeFile :: FilePath -> 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 (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 (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)))
-> (FilePath -> IO (Either ConversionError (IpeFile r)))
-> FilePath
-> IO (Either ConversionError (IpeFile r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Either ConversionError (IpeFile r))
forall r.
(Coordinate r, Eq r) =>
FilePath -> 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)
                   => FilePath -> IO (Either ConversionError (IpePage r))
readSinglePageFile :: FilePath -> 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 (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 (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)))
-> (FilePath -> IO (Either ConversionError (IpeFile r)))
-> FilePath
-> IO (Either ConversionError (IpePage r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Either ConversionError (IpeFile r))
forall r.
(Coordinate r, Eq r) =>
FilePath -> IO (Either ConversionError (IpeFile r))
readIpeFile
  where
    f   :: IpeFile r -> IpePage r
    f :: 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 r2.
Lens
  (IpeFile r)
  (IpeFile r2)
  (NonEmpty (IpePage r))
  (NonEmpty (IpePage r2))
pages

-- | Tries to read a single page file, throws an error when this
-- fails. See 'readSinglePageFile' for further details.
readSinglePageFileThrow    :: (Coordinate r, Eq r) => FilePath -> IO (IpePage r)
readSinglePageFileThrow :: FilePath -> IO (IpePage r)
readSinglePageFileThrow FilePath
fp = FilePath -> IO (Either ConversionError (IpePage r))
forall r.
(Coordinate r, Eq r) =>
FilePath -> IO (Either ConversionError (IpePage r))
readSinglePageFile FilePath
fp IO (Either ConversionError (IpePage r))
-> (Either ConversionError (IpePage r) -> IO (IpePage r))
-> IO (IpePage r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left ConversionError
err -> FilePath -> IO (IpePage r)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (ConversionError -> FilePath
forall a. Show a => a -> FilePath
show ConversionError
err)
  Right IpePage r
p  -> IpePage r -> IO (IpePage r)
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 :: 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 (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 (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> ConversionError
T.pack (FilePath -> ConversionError)
-> (XMLParseError -> FilePath) -> XMLParseError -> ConversionError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XMLParseError -> FilePath
forall a. Show a => a -> FilePath
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 (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 (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 (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


ipeReadTextWith     :: (Text -> Either t v) -> Text -> Either ConversionError (IpeValue v)
ipeReadTextWith :: (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 () r) where
  ipeReadText :: ConversionError -> Either ConversionError (Rectangle () r)
ipeReadText = ConversionError -> Either ConversionError (Rectangle () r)
forall r.
Coordinate r =>
ConversionError -> Either ConversionError (Rectangle () 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 (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 FilePath
-> ParsecT ConversionError () Identity (r -> r -> RGB r)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConversionError () Identity FilePath
pWhiteSpace
                  ParsecT ConversionError () Identity (r -> r -> RGB r)
-> ParsecT ConversionError () Identity r
-> ParsecT ConversionError () Identity (r -> RGB r)
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 FilePath
-> ParsecT ConversionError () Identity (r -> RGB r)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConversionError () Identity FilePath
pWhiteSpace
                  ParsecT ConversionError () Identity (r -> RGB r)
-> ParsecT ConversionError () Identity r -> Parser (RGB r)
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 (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 (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 (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 (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.
Iso (Ellipse r) (Ellipse s) (Matrix 3 3 r) (Matrix 3 3 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 s t a b. APrism s t a b -> [s] -> ([s], [s])
span' APrism (Operation r) (Operation r) (Point 2 r) (Point 2 r)
forall r. Prism' (Operation r) (Point 2 r)
_LineTo [Operation r]
ops
                                      pts :: [Point 2 r :+ ()]
pts  = (Point 2 r -> Point 2 r :+ ()) -> [Point 2 r] -> [Point 2 r :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext ([Point 2 r] -> [Point 2 r :+ ()])
-> [Point 2 r] -> [Point 2 r :+ ()]
forall a b. (a -> b) -> a -> b
$ Point 2 r
sPoint 2 r -> [Point 2 r] -> [Point 2 r]
forall a. a -> [a] -> [a]
: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. Prism' (Operation r) (Point 2 r)
_LineTo) [Operation r]
ls
                                      poly :: SimplePolygon () r
poly = [Point 2 r :+ ()] -> SimplePolygon () r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
Polygon.unsafeFromPoints ([Point 2 r :+ ()] -> SimplePolygon () r)
-> ([Point 2 r :+ ()] -> [Point 2 r :+ ()])
-> [Point 2 r :+ ()]
-> SimplePolygon () r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ ()] -> [Point 2 r :+ ()]
forall a. Eq a => [a] -> [a]
dropRepeats ([Point 2 r :+ ()] -> SimplePolygon () r)
-> [Point 2 r :+ ()] -> SimplePolygon () r
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ ()]
pts
                                      pl :: PolyLine 2 () r
pl   = [Point 2 r :+ ()] -> PolyLine 2 () r
forall (d :: Nat) r p. [Point d r :+ p] -> PolyLine d p r
fromPointsUnsafe [Point 2 r :+ ()]
pts
                                  in case [Operation r]
xs of
                                       (Operation r
ClosePath : [Operation r]
xs') -> SimplePolygon () r -> PathSegment r
forall r. SimplePolygon () r -> PathSegment r
PolygonPath SimplePolygon () r
poly   PathSegment r -> [Operation r] -> Either a [PathSegment r]
<<| [Operation r]
xs'
                                       [Operation r]
_                 -> PolyLine 2 () r -> PathSegment r
forall r. PolyLine 2 () r -> PathSegment r
PolyLineSegment PolyLine 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 [BezierSpline 2 2 r -> PathSegment r
forall r. BezierSpline 2 2 r -> PathSegment r
QuadraticBezierSegment (BezierSpline 2 2 r -> PathSegment r)
-> BezierSpline 2 2 r -> PathSegment r
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r -> Point 2 r -> BezierSpline 2 2 r
forall (d :: Nat) r.
Point d r -> Point d r -> Point d r -> BezierSpline 2 d r
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 [BezierSpline 3 2 r -> PathSegment r
forall r. BezierSpline 3 2 r -> PathSegment r
CubicBezierSegment (BezierSpline 3 2 r -> PathSegment r)
-> BezierSpline 3 2 r -> PathSegment r
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> Point 2 r -> Point 2 r -> Point 2 r -> BezierSpline 3 2 r
forall (d :: Nat) r.
Point d r
-> Point d r -> Point d r -> Point d r -> BezierSpline 3 d r
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
$ (BezierSpline 3 2 r -> PathSegment r)
-> [BezierSpline 3 2 r] -> [PathSegment r]
forall a b. (a -> b) -> [a] -> [b]
map BezierSpline 3 2 r -> PathSegment r
forall r. BezierSpline 3 2 r -> PathSegment r
CubicBezierSegment ([BezierSpline 3 2 r] -> [PathSegment r])
-> [BezierSpline 3 2 r] -> [PathSegment r]
forall a b. (a -> b) -> a -> b
$ [Point 2 r] -> [BezierSpline 3 2 r]
forall r. Fractional r => [Point 2 r] -> [BezierSpline 3 2 r]
splineToCubicBeziers ([Point 2 r] -> [BezierSpline 3 2 r])
-> [Point 2 r] -> [BezierSpline 3 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 [BezierSpline 2 2 r -> PathSegment r
forall r. BezierSpline 2 2 r -> PathSegment r
QuadraticBezierSegment (BezierSpline 2 2 r -> PathSegment r)
-> BezierSpline 2 2 r -> PathSegment r
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r -> Point 2 r -> BezierSpline 2 2 r
forall (d :: Nat) r.
Point d r -> Point d r -> Point d r -> BezierSpline 2 d r
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 [BezierSpline 3 2 r -> PathSegment r
forall r. BezierSpline 3 2 r -> PathSegment r
CubicBezierSegment (BezierSpline 3 2 r -> PathSegment r)
-> BezierSpline 3 2 r -> PathSegment r
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> Point 2 r -> Point 2 r -> Point 2 r -> BezierSpline 3 2 r
forall (d :: Nat) r.
Point d r
-> Point d r -> Point d r -> Point d r -> BezierSpline 3 d r
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 s t a b -> [s] -> ([s], [s])
span' APrism s t a b
pr = (s -> Bool) -> [s] -> ([s], [s])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span (Bool -> Bool
not (Bool -> Bool) -> (s -> Bool) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism s t a b -> s -> Bool
forall s t a b. APrism s t a b -> s -> Bool
isn't APrism s 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] -> [BezierSpline 3 2 r]
splineToCubicBeziers :: [Point 2 r] -> [BezierSpline 3 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 -> BezierSpline 3 2 r
forall (d :: Nat) r.
Point d r
-> Point d r -> Point d r -> Point d r -> BezierSpline 3 d r
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 -> Diff (Point 2) r -> Point 2 r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (Point 2 r
c Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
b) Vector 2 r -> r -> Vector 2 r
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ r
2
      q :: Point 2 r
q = Point 2 r
c Point 2 r -> Diff (Point 2) r -> Point 2 r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (Point 2 r
d Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
c) Vector 2 r -> r -> Vector 2 r
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ r
3
      r :: Point 2 r
r = Point 2 r
p Point 2 r -> Diff (Point 2) r -> Point 2 r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (Point 2 r
q Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
p) Vector 2 r -> r -> Vector 2 r
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ r
2
  in (Point 2 r
-> Point 2 r -> Point 2 r -> Point 2 r -> BezierSpline 3 2 r
forall (d :: Nat) r.
Point d r
-> Point d r -> Point d r -> Point d r -> BezierSpline 3 d r
Bezier3 Point 2 r
a Point 2 r
b Point 2 r
p Point 2 r
r) BezierSpline 3 2 r -> [BezierSpline 3 2 r] -> [BezierSpline 3 2 r]
forall a. a -> [a] -> [a]
: [Point 2 r] -> [BezierSpline 3 2 r]
forall r. Fractional r => [Point 2 r] -> [BezierSpline 3 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]
_ = FilePath -> [BezierSpline 3 2 r]
forall a. HasCallStack => FilePath -> a
error FilePath
"splineToCubicBeziers needs at least four points"


dropRepeats :: Eq a => [a] -> [a]
dropRepeats :: [a] -> [a]
dropRepeats = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
L.group

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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LSeq 1 (PathSegment r) -> Path r
forall r. LSeq 1 (PathSegment r) -> Path r
Path (LSeq 1 (PathSegment r) -> Path r)
-> (NonEmpty (PathSegment r) -> LSeq 1 (PathSegment r))
-> NonEmpty (PathSegment r)
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (PathSegment r) -> LSeq 1 (PathSegment r)
forall a. NonEmpty a -> LSeq 1 a
LSeq.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

--------------------------------------------------------------------------------
-- 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)
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 (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 '[] -> h (Rec i '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 (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 (r : rs))
-> h (i r) -> h (Rec i rs -> Rec i (r : 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 (r : rs))
-> h (Rec i rs) -> h (Rec i (r : rs))
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 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 :: 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 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
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' = Rec (Attr f) ats -> Rec (Dict IpeReadAttr :. Attr f) ats
forall u (c :: * -> Constraint) (f :: u -> *) (rs :: [u]).
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 :: Const ConversionError at
-> (:.) (Dict IpeReadAttr) (Attr f) at
-> Either ConversionError (Attr f at)
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 :: 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 (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 :: 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy i
-> proxy r
-> Node ConversionError ConversionError
-> Either ConversionError (IpeAttributes i r)
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 (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)
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 (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' :: 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 (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 (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 (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 (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 (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 (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 () r -> Image r
forall r. () -> Rectangle () r -> Image r
Image () (Rectangle () r -> Image r)
-> Either ConversionError (Rectangle () 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 () r))
-> Either ConversionError (Rectangle () r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConversionError -> Either ConversionError (Rectangle () 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
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 (IpeSymbol r :+ IpeAttributes 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
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 (Path r :+ IpeAttributes 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
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 (Group r :+ IpeAttributes 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
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 (TextLabel r :+ IpeAttributes 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
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 (MiniPage r :+ IpeAttributes 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
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 (Image r :+ IpeAttributes 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 :: [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)
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. Prism (Either c a) (Either c b) a 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 (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 (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 :: [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. [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 :: FilePath -> IO (Either ConversionError IpeStyle)
readIpeStylesheet :: FilePath -> IO (Either ConversionError IpeStyle)
readIpeStylesheet = (ByteString -> Either ConversionError IpeStyle)
-> IO ByteString -> IO (Either ConversionError IpeStyle)
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))
-> (FilePath -> IO ByteString)
-> FilePath
-> IO (Either ConversionError IpeStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
B.readFile

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

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