{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ipe.Reader
(
readRawIpeFile
, readIpeFile
, readSinglePageFile
, readSinglePageFileThrow
, ConversionError
, readIpeStylesheet
, addStyleSheetFrom
, fromIpeXML
, readXML
, IpeReadText(..)
, IpeRead(..)
, IpeReadAttr(..)
, 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
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
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
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
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
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
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
class IpeReadText t where
ipeReadText :: Text -> Either ConversionError t
class IpeRead t where
ipeRead :: Node Text Text -> Either ConversionError t
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
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
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
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
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"
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
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
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)
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
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"
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"
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"
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"
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
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