{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Ipe.Writer(
writeIpeFile, writeIpeFile', writeIpePage
, toIpeXML
, printAsIpeSelection, toIpeSelectionXML
, IpeWrite(..)
, IpeWriteText(..)
, ipeWriteAttrs, writeAttrValues
) where
import Control.Lens (view, (&), (.~), (^.), (^..))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Colour.SRGB (RGB (..))
import Data.Ext
import Data.Fixed
import qualified Data.Foldable as F
import Data.Geometry.BezierSpline
import Data.Geometry.Box
import Data.Geometry.Ellipse (ellipseMatrix)
import Ipe.Attributes
import qualified Ipe.Attributes as IA
import Ipe.Color (IpeColor (..))
import Ipe.Path
import Ipe.Types
import Ipe.Value
import Data.Geometry.LineSegment
import qualified Data.Geometry.Matrix as Matrix
import Data.Geometry.Point
import Data.Geometry.PolyLine
import Data.Geometry.Polygon (Polygon, holeList, outerBoundary,
outerBoundaryVector)
import Data.Geometry.Vector
import qualified Data.LSeq as LSeq
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.Ratio
import Data.RealNumber.Rational
import Data.Singletons
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Vinyl hiding (Label)
import Data.Vinyl.Functor
import Data.Vinyl.TypeLevel
import System.IO (hPutStrLn, stderr)
import Text.XML.Expat.Format (format')
import Text.XML.Expat.Tree
writeIpeFile :: IpeWriteText r => FilePath -> IpeFile r -> IO ()
writeIpeFile :: FilePath -> IpeFile r -> IO ()
writeIpeFile = (IpeFile r -> FilePath -> IO ()) -> FilePath -> IpeFile r -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IpeFile r -> FilePath -> IO ()
forall t. IpeWrite t => t -> FilePath -> IO ()
writeIpeFile'
writeIpePage :: IpeWriteText r => FilePath -> IpePage r -> IO ()
writeIpePage :: FilePath -> IpePage r -> IO ()
writeIpePage FilePath
fp = FilePath -> IpeFile r -> IO ()
forall r. IpeWriteText r => FilePath -> IpeFile r -> IO ()
writeIpeFile FilePath
fp (IpeFile r -> IO ())
-> (IpePage r -> IpeFile r) -> IpePage r -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpePage r -> IpeFile r
forall r. IpePage r -> IpeFile r
singlePageFile
printAsIpeSelection :: IpeWrite t => t -> IO ()
printAsIpeSelection :: t -> IO ()
printAsIpeSelection = ByteString -> IO ()
C.putStrLn (ByteString -> IO ()) -> (t -> ByteString) -> t -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString)
-> (t -> Maybe ByteString) -> t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe ByteString
forall t. IpeWrite t => t -> Maybe ByteString
toIpeSelectionXML
toIpeSelectionXML :: IpeWrite t => t -> Maybe B.ByteString
toIpeSelectionXML :: t -> Maybe ByteString
toIpeSelectionXML = (NodeG [] Text Text -> ByteString)
-> Maybe (NodeG [] Text Text) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeG [] Text Text -> ByteString
forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
format' (NodeG [] Text Text -> ByteString)
-> (NodeG [] Text Text -> NodeG [] Text Text)
-> NodeG [] Text Text
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeG [] Text Text -> NodeG [] Text Text
forall tag text.
IsString tag =>
NodeG [] tag text -> NodeG [] tag text
ipeSelection) (Maybe (NodeG [] Text Text) -> Maybe ByteString)
-> (t -> Maybe (NodeG [] Text Text)) -> t -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite
where
ipeSelection :: NodeG [] tag text -> NodeG [] tag text
ipeSelection NodeG [] tag text
x = tag -> [(tag, text)] -> [NodeG [] tag text] -> NodeG [] tag text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element tag
"ipeselection" [] [NodeG [] tag text
x]
toIpeXML :: IpeWrite t => t -> Maybe B.ByteString
toIpeXML :: t -> Maybe ByteString
toIpeXML = (NodeG [] Text Text -> ByteString)
-> Maybe (NodeG [] Text Text) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeG [] Text Text -> ByteString
forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
format' (Maybe (NodeG [] Text Text) -> Maybe ByteString)
-> (t -> Maybe (NodeG [] Text Text)) -> t -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite
writeIpeFile' :: IpeWrite t => t -> FilePath -> IO ()
writeIpeFile' :: t -> FilePath -> IO ()
writeIpeFile' t
i FilePath
fp = IO () -> (ByteString -> IO ()) -> Maybe ByteString -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ()
err (FilePath -> ByteString -> IO ()
B.writeFile FilePath
fp) (Maybe ByteString -> IO ())
-> (t -> Maybe ByteString) -> t -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe ByteString
forall t. IpeWrite t => t -> Maybe ByteString
toIpeXML (t -> IO ()) -> t -> IO ()
forall a b. (a -> b) -> a -> b
$ t
i
where
err :: IO ()
err = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"writeIpeFile: error converting to xml. File '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"'not written"
class IpeWriteText t where
ipeWriteText :: t -> Maybe Text
class IpeWrite t where
ipeWrite :: t -> Maybe (Node Text Text)
instance IpeWrite t => IpeWrite [t] where
ipeWrite :: [t] -> Maybe (NodeG [] Text Text)
ipeWrite [t]
gs = case (t -> Maybe (NodeG [] Text Text)) -> [t] -> [NodeG [] Text Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe t -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite [t]
gs of
[] -> Maybe (NodeG [] Text Text)
forall a. Maybe a
Nothing
[NodeG [] Text Text]
ns -> (NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a. a -> Maybe a
Just (NodeG [] Text Text -> Maybe (NodeG [] Text Text))
-> NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a b. (a -> b) -> a -> b
$ Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"group" [] [NodeG [] Text Text]
ns)
instance IpeWrite t => IpeWrite (NonEmpty t) where
ipeWrite :: NonEmpty t -> Maybe (NodeG [] Text Text)
ipeWrite = [t] -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite ([t] -> Maybe (NodeG [] Text Text))
-> (NonEmpty t -> [t]) -> NonEmpty t -> Maybe (NodeG [] Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty t -> [t]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
instance (IpeWrite l, IpeWrite r) => IpeWrite (Either l r) where
ipeWrite :: Either l r -> Maybe (NodeG [] Text Text)
ipeWrite = (l -> Maybe (NodeG [] Text Text))
-> (r -> Maybe (NodeG [] Text Text))
-> Either l r
-> Maybe (NodeG [] Text Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either l -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite r -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite
instance IpeWriteText (Apply f at) => IpeWriteText (Attr f at) where
ipeWriteText :: Attr f at -> Maybe Text
ipeWriteText Attr f at
att = Attr f at -> Maybe (Apply f at)
forall u (f :: TyFun u * -> *) (label :: u).
Attr f label -> Maybe (Apply f label)
_getAttr Attr f at
att Maybe (Apply f at) -> (Apply f at -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Apply f at -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText
instance (IpeWriteText l, IpeWriteText r) => IpeWriteText (Either l r) where
ipeWriteText :: Either l r -> Maybe Text
ipeWriteText = (l -> Maybe Text) -> (r -> Maybe Text) -> Either l r -> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either l -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText
ipeWriteAttrs :: ( RecordToList rs, RMap rs
, ReifyConstraint IpeWriteText (Attr f) rs
, AllConstrained IpeAttrName rs
, RecAll (Attr f) rs IpeWriteText
) => IA.Attributes f rs -> [(Text,Text)]
ipeWriteAttrs :: Attributes f rs -> [(Text, Text)]
ipeWriteAttrs (Attrs Rec (Attr f) rs
r) = [Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Text)] -> [(Text, Text)])
-> (Rec (Const (Maybe (Text, Text))) rs -> [Maybe (Text, Text)])
-> Rec (Const (Maybe (Text, Text))) rs
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (Const (Maybe (Text, Text))) rs -> [Maybe (Text, Text)]
forall u (rs :: [u]) a. RecordToList rs => Rec (Const a) rs -> [a]
recordToList (Rec (Const (Maybe (Text, Text))) rs -> [(Text, Text)])
-> Rec (Const (Maybe (Text, Text))) rs -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (forall (a :: AttributeUniverse).
Const Text a
-> Const (Maybe Text) a -> Const (Maybe (Text, Text)) a)
-> Rec (Const Text) rs
-> Rec (Const (Maybe Text)) rs
-> Rec (Const (Maybe (Text, Text))) rs
forall u (f :: u -> *) (g :: u -> *) (h :: u -> *) (as :: [u]).
(forall (a :: u). f a -> g a -> h a)
-> Rec f as -> Rec g as -> Rec h as
zipRecsWith forall k k k (f :: * -> *) t (b :: k) t (b :: k) (b :: k).
Functor f =>
Const t b -> Const (f t) b -> Const (f (t, t)) b
forall (a :: AttributeUniverse).
Const Text a
-> Const (Maybe Text) a -> Const (Maybe (Text, Text)) a
f (Rec (Attr f) rs -> Rec (Const Text) rs
forall (rs :: [AttributeUniverse]) (f :: AttributeUniverse -> *).
AllConstrained IpeAttrName rs =>
Rec f rs -> Rec (Const Text) rs
writeAttrNames Rec (Attr f) rs
r)
(Rec (Attr f) rs -> Rec (Const (Maybe Text)) rs
forall u (rs :: [u]) (f :: u -> *).
(RMap rs, ReifyConstraint IpeWriteText f rs,
RecAll f rs IpeWriteText) =>
Rec f rs -> Rec (Const (Maybe Text)) rs
writeAttrValues Rec (Attr f) rs
r)
where
f :: Const t b -> Const (f t) b -> Const (f (t, t)) b
f (Const t
n) (Const f t
mv) = f (t, t) -> Const (f (t, t)) b
forall k a (b :: k). a -> Const a b
Const (f (t, t) -> Const (f (t, t)) b) -> f (t, t) -> Const (f (t, t)) b
forall a b. (a -> b) -> a -> b
$ (t
n,) (t -> (t, t)) -> f t -> f (t, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f t
mv
writeAttrValues :: ( RMap rs, ReifyConstraint IpeWriteText f rs
, RecAll f rs IpeWriteText)
=> Rec f rs -> Rec (Const (Maybe Text)) rs
writeAttrValues :: Rec f rs -> Rec (Const (Maybe Text)) rs
writeAttrValues = (forall (x :: u).
(:.) (Dict IpeWriteText) f x -> Const (Maybe Text) x)
-> Rec (Dict IpeWriteText :. f) rs -> Rec (Const (Maybe Text)) rs
forall u (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap (\(Compose (Dict x)) -> Maybe Text -> Const (Maybe Text) x
forall k a (b :: k). a -> Const a b
Const (Maybe Text -> Const (Maybe Text) x)
-> Maybe Text -> Const (Maybe Text) x
forall a b. (a -> b) -> a -> b
$ f x -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText f x
x)
(Rec (Dict IpeWriteText :. f) rs -> Rec (Const (Maybe Text)) rs)
-> (Rec f rs -> Rec (Dict IpeWriteText :. f) rs)
-> Rec f rs
-> Rec (Const (Maybe Text)) rs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u (c :: * -> Constraint) (f :: u -> *) (rs :: [u]).
ReifyConstraint c f rs =>
Rec f rs -> Rec (Dict c :. f) rs
forall (f :: u -> *) (rs :: [u]).
ReifyConstraint IpeWriteText f rs =>
Rec f rs -> Rec (Dict IpeWriteText :. f) rs
reifyConstraint @IpeWriteText
instance IpeWriteText Text where
ipeWriteText :: Text -> Maybe Text
ipeWriteText = Text -> Maybe Text
forall a. a -> Maybe a
Just
instance IpeWriteText String where
ipeWriteText :: FilePath -> Maybe Text
ipeWriteText = Text -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (Text -> Maybe Text)
-> (FilePath -> Text) -> FilePath -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack
addAtts :: Node Text Text -> [(Text,Text)] -> Node Text Text
NodeG [] Text Text
n addAtts :: NodeG [] Text Text -> [(Text, Text)] -> NodeG [] Text Text
`addAtts` [(Text, Text)]
ats = NodeG [] Text Text
n { eAttributes :: [(Text, Text)]
eAttributes = [(Text, Text)]
ats [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ NodeG [] Text Text -> [(Text, Text)]
forall (c :: * -> *) tag text. NodeG c tag text -> [(tag, text)]
eAttributes NodeG [] Text Text
n }
mAddAtts :: Maybe (Node Text Text) -> [(Text, Text)] -> Maybe (Node Text Text)
Maybe (NodeG [] Text Text)
mn mAddAtts :: Maybe (NodeG [] Text Text)
-> [(Text, Text)] -> Maybe (NodeG [] Text Text)
`mAddAtts` [(Text, Text)]
ats = (NodeG [] Text Text -> NodeG [] Text Text)
-> Maybe (NodeG [] Text Text) -> Maybe (NodeG [] Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeG [] Text Text -> [(Text, Text)] -> NodeG [] Text Text
`addAtts` [(Text, Text)]
ats) Maybe (NodeG [] Text Text)
mn
instance IpeWriteText Double where
ipeWriteText :: Double -> Maybe Text
ipeWriteText = Double -> Maybe Text
forall t. Show t => t -> Maybe Text
writeByShow
instance IpeWriteText Float where
ipeWriteText :: Float -> Maybe Text
ipeWriteText = Float -> Maybe Text
forall t. Show t => t -> Maybe Text
writeByShow
instance IpeWriteText Int where
ipeWriteText :: Int -> Maybe Text
ipeWriteText = Int -> Maybe Text
forall t. Show t => t -> Maybe Text
writeByShow
instance IpeWriteText Integer where
ipeWriteText :: Integer -> Maybe Text
ipeWriteText = Integer -> Maybe Text
forall t. Show t => t -> Maybe Text
writeByShow
instance IpeWriteText (RealNumber p) where
ipeWriteText :: RealNumber p -> Maybe Text
ipeWriteText = Rational -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (Rational -> Maybe Text)
-> (RealNumber p -> Rational) -> RealNumber p -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Real (RealNumber p), Fractional Rational) =>
RealNumber p -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac @(RealNumber p) @Rational
instance HasResolution p => IpeWriteText (Fixed p) where
ipeWriteText :: Fixed p -> Maybe Text
ipeWriteText = Fixed p -> Maybe Text
forall t. Show t => t -> Maybe Text
writeByShow
instance Integral a => IpeWriteText (Ratio a) where
ipeWriteText :: Ratio a -> Maybe Text
ipeWriteText = Pico -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (Pico -> Maybe Text) -> (Ratio a -> Pico) -> Ratio a -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> Pico
f (Pico -> Pico) -> (Ratio a -> Pico) -> Ratio a -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (Rational -> Pico) -> (Ratio a -> Rational) -> Ratio a -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio a -> Rational
forall a. Real a => a -> Rational
toRational
where
f :: Pico -> Pico
f :: Pico -> Pico
f = Pico -> Pico
forall a. a -> a
id
writeByShow :: Show t => t -> Maybe Text
writeByShow :: t -> Maybe Text
writeByShow = Text -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (Text -> Maybe Text) -> (t -> Text) -> t -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack (FilePath -> Text) -> (t -> FilePath) -> t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> FilePath
forall a. Show a => a -> FilePath
show
unwords' :: [Maybe Text] -> Maybe Text
unwords' :: [Maybe Text] -> Maybe Text
unwords' = ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.unwords (Maybe [Text] -> Maybe Text)
-> ([Maybe Text] -> Maybe [Text]) -> [Maybe Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> Maybe [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
unlines' :: [Maybe Text] -> Maybe Text
unlines' :: [Maybe Text] -> Maybe Text
unlines' = ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.unlines (Maybe [Text] -> Maybe Text)
-> ([Maybe Text] -> Maybe [Text]) -> [Maybe Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> Maybe [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
instance IpeWriteText r => IpeWriteText (Point 2 r) where
ipeWriteText :: Point 2 r -> Maybe Text
ipeWriteText (Point2 r
x r
y) = [Maybe Text] -> Maybe Text
unwords' [r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText r
x, r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText r
y]
instance IpeWriteText v => IpeWriteText (IpeValue v) where
ipeWriteText :: IpeValue v -> Maybe Text
ipeWriteText (Named Text
t) = Text -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Text
t
ipeWriteText (Valued v
v) = v -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText v
v
instance IpeWriteText TransformationTypes where
ipeWriteText :: TransformationTypes -> Maybe Text
ipeWriteText TransformationTypes
Affine = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"affine"
ipeWriteText TransformationTypes
Rigid = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"rigid"
ipeWriteText TransformationTypes
Translations = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"translations"
instance IpeWriteText PinType where
ipeWriteText :: PinType -> Maybe Text
ipeWriteText PinType
No = Maybe Text
forall a. Maybe a
Nothing
ipeWriteText PinType
Yes = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"yes"
ipeWriteText PinType
Horizontal = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"h"
ipeWriteText PinType
Vertical = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"v"
instance IpeWriteText r => IpeWriteText (RGB r) where
ipeWriteText :: RGB r -> Maybe Text
ipeWriteText (RGB r
r r
g r
b) = [Maybe Text] -> Maybe Text
unwords' ([Maybe Text] -> Maybe Text)
-> ([r] -> [Maybe Text]) -> [r] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> Maybe Text) -> [r] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText ([r] -> Maybe Text) -> [r] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [r
r,r
g,r
b]
deriving instance IpeWriteText r => IpeWriteText (IpeSize r)
deriving instance IpeWriteText r => IpeWriteText (IpePen r)
deriving instance IpeWriteText r => IpeWriteText (IpeColor r)
instance IpeWriteText r => IpeWriteText (IpeDash r) where
ipeWriteText :: IpeDash r -> Maybe Text
ipeWriteText (DashNamed Text
t) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
ipeWriteText (DashPattern [r]
xs r
x) = (\[Text]
ts Text
t -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"["
, Text -> [Text] -> Text
Text.intercalate Text
" " [Text]
ts
, Text
"] ", Text
t ])
([Text] -> Text -> Text) -> Maybe [Text] -> Maybe (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (r -> Maybe Text) -> [r] -> Maybe [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText [r]
xs
Maybe (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText r
x
instance IpeWriteText FillType where
ipeWriteText :: FillType -> Maybe Text
ipeWriteText FillType
Wind = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"wind"
ipeWriteText FillType
EOFill = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"eofill"
instance IpeWriteText r => IpeWriteText (IpeArrow r) where
ipeWriteText :: IpeArrow r -> Maybe Text
ipeWriteText (IpeArrow Text
n IpeSize r
s) = (\Text
n' Text
s' -> Text
n' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s') (Text -> Text -> Text) -> Maybe Text -> Maybe (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Text
n
Maybe (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IpeSize r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText IpeSize r
s
instance IpeWriteText r => IpeWriteText (Path r) where
ipeWriteText :: Path r -> Maybe Text
ipeWriteText = (LSeq 1 Text -> Text) -> Maybe (LSeq 1 Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LSeq 1 Text -> Text
concat' (Maybe (LSeq 1 Text) -> Maybe Text)
-> (Path r -> Maybe (LSeq 1 Text)) -> Path r -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSeq 1 (Maybe Text) -> Maybe (LSeq 1 Text)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (LSeq 1 (Maybe Text) -> Maybe (LSeq 1 Text))
-> (Path r -> LSeq 1 (Maybe Text)) -> Path r -> Maybe (LSeq 1 Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathSegment r -> Maybe Text)
-> LSeq 1 (PathSegment r) -> LSeq 1 (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathSegment r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (LSeq 1 (PathSegment r) -> LSeq 1 (Maybe Text))
-> (Path r -> LSeq 1 (PathSegment r))
-> Path r
-> LSeq 1 (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (LSeq 1 (PathSegment r)) (Path r) (LSeq 1 (PathSegment r))
-> Path r -> LSeq 1 (PathSegment r)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (LSeq 1 (PathSegment r)) (Path r) (LSeq 1 (PathSegment r))
forall r r2.
Iso
(Path r)
(Path r2)
(LSeq 1 (PathSegment r))
(LSeq 1 (PathSegment r2))
pathSegments
where
concat' :: LSeq 1 Text -> Text
concat' = (Text -> Text -> Text) -> LSeq 1 Text -> Text
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldr1 (\Text
t Text
t' -> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t')
instance IpeWriteText r => IpeWrite (IpeSymbol r) where
ipeWrite :: IpeSymbol r -> Maybe (NodeG [] Text Text)
ipeWrite (Symbol Point 2 r
p Text
n) = Text -> NodeG [] Text Text
f (Text -> NodeG [] Text Text)
-> Maybe Text -> Maybe (NodeG [] Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
p
where
f :: Text -> NodeG [] Text Text
f Text
ps = Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"use" [ (Text
"pos", Text
ps)
, (Text
"name", Text
n)
] []
instance IpeWriteText r => IpeWriteText (Matrix.Matrix 3 3 r) where
ipeWriteText :: Matrix 3 3 r -> Maybe Text
ipeWriteText (Matrix.Matrix Vector 3 (Vector 3 r)
m) = [Maybe Text] -> Maybe Text
unwords' [Maybe Text
a,Maybe Text
b,Maybe Text
c,Maybe Text
d,Maybe Text
e,Maybe Text
f]
where
(Vector3 Vector 3 r
r1 Vector 3 r
r2 Vector 3 r
_) = Vector 3 (Vector 3 r)
m
(Vector3 Maybe Text
a Maybe Text
c Maybe Text
e) = r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (r -> Maybe Text) -> Vector 3 r -> Vector 3 (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector 3 r
r1
(Vector3 Maybe Text
b Maybe Text
d Maybe Text
f) = r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (r -> Maybe Text) -> Vector 3 r -> Vector 3 (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector 3 r
r2
instance IpeWriteText r => IpeWriteText (Operation r) where
ipeWriteText :: Operation r -> Maybe Text
ipeWriteText (MoveTo Point 2 r
p) = [Maybe Text] -> Maybe Text
unwords' [ Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
p, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"m"]
ipeWriteText (LineTo Point 2 r
p) = [Maybe Text] -> Maybe Text
unwords' [ Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
p, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"l"]
ipeWriteText (CurveTo Point 2 r
p Point 2 r
q Point 2 r
r) = [Maybe Text] -> Maybe Text
unwords' [ Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
p
, Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
q
, Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
r, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"c"]
ipeWriteText (QCurveTo Point 2 r
p Point 2 r
q) = [Maybe Text] -> Maybe Text
unwords' [ Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
p
, Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
q, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"q"]
ipeWriteText (Ellipse Matrix 3 3 r
m) = [Maybe Text] -> Maybe Text
unwords' [ Matrix 3 3 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Matrix 3 3 r
m, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"e"]
ipeWriteText (ArcTo Matrix 3 3 r
m Point 2 r
p) = [Maybe Text] -> Maybe Text
unwords' [ Matrix 3 3 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Matrix 3 3 r
m
, Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
p, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"a"]
ipeWriteText (Spline [Point 2 r]
pts) = [Maybe Text] -> Maybe Text
unlines' ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Point 2 r -> Maybe Text) -> [Point 2 r] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText [Point 2 r]
pts [Maybe Text] -> [Maybe Text] -> [Maybe Text]
forall a. Semigroup a => a -> a -> a
<> [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"s"]
ipeWriteText (ClosedSpline [Point 2 r]
pts) = [Maybe Text] -> Maybe Text
unlines' ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Point 2 r -> Maybe Text) -> [Point 2 r] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText [Point 2 r]
pts [Maybe Text] -> [Maybe Text] -> [Maybe Text]
forall a. Semigroup a => a -> a -> a
<> [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"u"]
ipeWriteText Operation r
ClosePath = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"h"
instance IpeWriteText r => IpeWriteText (PolyLine 2 () r) where
ipeWriteText :: PolyLine 2 () r -> Maybe Text
ipeWriteText PolyLine 2 () r
pl = case PolyLine 2 () r
plPolyLine 2 () r
-> Getting (Endo [Point 2 r]) (PolyLine 2 () r) (Point 2 r)
-> [Point 2 r]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(LSeq 2 (Point 2 r :+ ())
-> Const (Endo [Point 2 r]) (LSeq 2 (Point 2 r :+ ())))
-> PolyLine 2 () r -> Const (Endo [Point 2 r]) (PolyLine 2 () r)
forall (d1 :: Nat) p1 r1 (d2 :: Nat) p2 r2.
Iso
(PolyLine d1 p1 r1)
(PolyLine d2 p2 r2)
(LSeq 2 (Point d1 r1 :+ p1))
(LSeq 2 (Point d2 r2 :+ p2))
points((LSeq 2 (Point 2 r :+ ())
-> Const (Endo [Point 2 r]) (LSeq 2 (Point 2 r :+ ())))
-> PolyLine 2 () r -> Const (Endo [Point 2 r]) (PolyLine 2 () r))
-> ((Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> LSeq 2 (Point 2 r :+ ())
-> Const (Endo [Point 2 r]) (LSeq 2 (Point 2 r :+ ())))
-> Getting (Endo [Point 2 r]) (PolyLine 2 () r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ ()) -> Const (Endo [Point 2 r]) (Point 2 r :+ ()))
-> LSeq 2 (Point 2 r :+ ())
-> Const (Endo [Point 2 r]) (LSeq 2 (Point 2 r :+ ()))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse(((Point 2 r :+ ()) -> Const (Endo [Point 2 r]) (Point 2 r :+ ()))
-> LSeq 2 (Point 2 r :+ ())
-> Const (Endo [Point 2 r]) (LSeq 2 (Point 2 r :+ ())))
-> ((Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> (Point 2 r :+ ()) -> Const (Endo [Point 2 r]) (Point 2 r :+ ()))
-> (Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> LSeq 2 (Point 2 r :+ ())
-> Const (Endo [Point 2 r]) (LSeq 2 (Point 2 r :+ ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> (Point 2 r :+ ()) -> Const (Endo [Point 2 r]) (Point 2 r :+ ())
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core of
(Point 2 r
p : [Point 2 r]
rest) -> [Maybe Text] -> Maybe Text
unlines' ([Maybe Text] -> Maybe Text)
-> ([Operation r] -> [Maybe Text]) -> [Operation r] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Operation r -> Maybe Text) -> [Operation r] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Operation r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText ([Operation r] -> Maybe Text) -> [Operation r] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Operation r
forall r. Point 2 r -> Operation r
MoveTo Point 2 r
p Operation r -> [Operation r] -> [Operation r]
forall a. a -> [a] -> [a]
: (Point 2 r -> Operation r) -> [Point 2 r] -> [Operation r]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 r -> Operation r
forall r. Point 2 r -> Operation r
LineTo [Point 2 r]
rest
[Point 2 r]
_ -> FilePath -> Maybe Text
forall a. HasCallStack => FilePath -> a
error FilePath
"ipeWriteText. absurd. no vertices polyline"
instance IpeWriteText r => IpeWriteText (Polygon t () r) where
ipeWriteText :: Polygon t () r -> Maybe Text
ipeWriteText Polygon t () r
pg = ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Maybe [Text] -> Maybe Text)
-> ([Polygon 'Simple () r] -> Maybe [Text])
-> [Polygon 'Simple () r]
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Polygon 'Simple () r -> Maybe Text)
-> [Polygon 'Simple () r] -> Maybe [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Polygon 'Simple () r -> Maybe Text
forall r (t :: PolygonType) p.
IpeWriteText r =>
Polygon t p r -> Maybe Text
f ([Polygon 'Simple () r] -> Maybe Text)
-> [Polygon 'Simple () r] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Polygon t () r
pgPolygon t () r
-> Getting
(Polygon 'Simple () r) (Polygon t () r) (Polygon 'Simple () r)
-> Polygon 'Simple () r
forall s a. s -> Getting a s a -> a
^.Getting
(Polygon 'Simple () r) (Polygon t () r) (Polygon 'Simple () r)
forall (t :: PolygonType) p r.
Lens' (Polygon t p r) (SimplePolygon p r)
outerBoundary Polygon 'Simple () r
-> [Polygon 'Simple () r] -> [Polygon 'Simple () r]
forall a. a -> [a] -> [a]
: Polygon t () r -> [Polygon 'Simple () r]
forall (t :: PolygonType) p r.
Polygon t p r -> [Polygon 'Simple p r]
holeList Polygon t () r
pg
where
f :: Polygon t p r -> Maybe Text
f Polygon t p r
pg' = case Polygon t p r
pg'Polygon t p r
-> Getting (Endo [Point 2 r]) (Polygon t p r) (Point 2 r)
-> [Point 2 r]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(CircularVector (Point 2 r :+ p)
-> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p)))
-> Polygon t p r -> Const (Endo [Point 2 r]) (Polygon t p r)
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector((CircularVector (Point 2 r :+ p)
-> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p)))
-> Polygon t p r -> Const (Endo [Point 2 r]) (Polygon t p r))
-> ((Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> CircularVector (Point 2 r :+ p)
-> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p)))
-> Getting (Endo [Point 2 r]) (Polygon t p r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Endo [Point 2 r]) (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
-> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse(((Point 2 r :+ p) -> Const (Endo [Point 2 r]) (Point 2 r :+ p))
-> CircularVector (Point 2 r :+ p)
-> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Endo [Point 2 r]) (Point 2 r :+ p))
-> (Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> CircularVector (Point 2 r :+ p)
-> Const (Endo [Point 2 r]) (CircularVector (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Endo [Point 2 r]) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core of
(Point 2 r
p : [Point 2 r]
rest) -> [Maybe Text] -> Maybe Text
unlines' ([Maybe Text] -> Maybe Text)
-> ([Operation r] -> [Maybe Text]) -> [Operation r] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Operation r -> Maybe Text) -> [Operation r] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Operation r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText
([Operation r] -> Maybe Text) -> [Operation r] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Operation r
forall r. Point 2 r -> Operation r
MoveTo Point 2 r
p Operation r -> [Operation r] -> [Operation r]
forall a. a -> [a] -> [a]
: (Point 2 r -> Operation r) -> [Point 2 r] -> [Operation r]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 r -> Operation r
forall r. Point 2 r -> Operation r
LineTo [Point 2 r]
rest [Operation r] -> [Operation r] -> [Operation r]
forall a. [a] -> [a] -> [a]
++ [Operation r
forall r. Operation r
ClosePath]
[Point 2 r]
_ -> Maybe Text
forall a. Maybe a
Nothing
instance IpeWriteText r => IpeWriteText (BezierSpline 3 2 r) where
ipeWriteText :: BezierSpline 3 2 r -> Maybe Text
ipeWriteText (Bezier3 Point 2 r
p Point 2 r
q Point 2 r
r Point 2 r
s) = [Maybe Text] -> Maybe Text
unlines' ([Maybe Text] -> Maybe Text)
-> ([Operation r] -> [Maybe Text]) -> [Operation r] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Operation r -> Maybe Text) -> [Operation r] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Operation r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText ([Operation r] -> Maybe Text) -> [Operation r] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Point 2 r -> Operation r
forall r. Point 2 r -> Operation r
MoveTo Point 2 r
p, Point 2 r -> Point 2 r -> Point 2 r -> Operation r
forall r. Point 2 r -> Point 2 r -> Point 2 r -> Operation r
CurveTo Point 2 r
q Point 2 r
r Point 2 r
s]
instance IpeWriteText r => IpeWriteText (PathSegment r) where
ipeWriteText :: PathSegment r -> Maybe Text
ipeWriteText (PolyLineSegment PolyLine 2 () r
p) = PolyLine 2 () r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText PolyLine 2 () r
p
ipeWriteText (PolygonPath SimplePolygon () r
p) = SimplePolygon () r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText SimplePolygon () r
p
ipeWriteText (EllipseSegment Ellipse r
e) = Operation r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (Operation r -> Maybe Text) -> Operation r -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Matrix 3 3 r -> Operation r
forall r. Matrix 3 3 r -> Operation r
Ellipse (Ellipse r
eEllipse r
-> Getting (Matrix 3 3 r) (Ellipse r) (Matrix 3 3 r)
-> Matrix 3 3 r
forall s a. s -> Getting a s a -> a
^.Getting (Matrix 3 3 r) (Ellipse r) (Matrix 3 3 r)
forall r s.
Iso (Ellipse r) (Ellipse s) (Matrix 3 3 r) (Matrix 3 3 s)
ellipseMatrix)
ipeWriteText (CubicBezierSegment BezierSpline 3 2 r
b) = BezierSpline 3 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText BezierSpline 3 2 r
b
ipeWriteText PathSegment r
_ = FilePath -> Maybe Text
forall a. HasCallStack => FilePath -> a
error FilePath
"ipeWriteText: PathSegment, not implemented yet."
instance IpeWriteText r => IpeWrite (Path r) where
ipeWrite :: Path r -> Maybe (NodeG [] Text Text)
ipeWrite Path r
p = (\Text
t -> Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"path" [] [Text -> NodeG [] Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
t]) (Text -> NodeG [] Text Text)
-> Maybe Text -> Maybe (NodeG [] Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Path r
p
instance (IpeWriteText r) => IpeWrite (Group r) where
ipeWrite :: Group r -> Maybe (NodeG [] Text Text)
ipeWrite (Group [IpeObject r]
gs) = [IpeObject r] -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite [IpeObject r]
gs
instance ( AllConstrained IpeAttrName rs
, RecordToList rs, RMap rs
, ReifyConstraint IpeWriteText (Attr f) rs
, RecAll (Attr f) rs IpeWriteText
, IpeWrite g
) => IpeWrite (g :+ IA.Attributes f rs) where
ipeWrite :: (g :+ Attributes f rs) -> Maybe (NodeG [] Text Text)
ipeWrite (g
g :+ Attributes f rs
ats) = g -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite g
g Maybe (NodeG [] Text Text)
-> [(Text, Text)] -> Maybe (NodeG [] Text Text)
`mAddAtts` Attributes f rs -> [(Text, Text)]
forall (rs :: [AttributeUniverse])
(f :: TyFun AttributeUniverse * -> *).
(RecordToList rs, RMap rs,
ReifyConstraint IpeWriteText (Attr f) rs,
AllConstrained IpeAttrName rs, RecAll (Attr f) rs IpeWriteText) =>
Attributes f rs -> [(Text, Text)]
ipeWriteAttrs Attributes f rs
ats
instance IpeWriteText r => IpeWrite (MiniPage r) where
ipeWrite :: MiniPage r -> Maybe (NodeG [] Text Text)
ipeWrite (MiniPage Text
t Point 2 r
p r
w) = (\Text
pt Text
wt ->
Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"text" [ (Text
"pos", Text
pt)
, (Text
"type", Text
"minipage")
, (Text
"width", Text
wt)
] [Text -> NodeG [] Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
t]
) (Text -> Text -> NodeG [] Text Text)
-> Maybe Text -> Maybe (Text -> NodeG [] Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
p
Maybe (Text -> NodeG [] Text Text)
-> Maybe Text -> Maybe (NodeG [] Text Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText r
w
instance IpeWriteText r => IpeWrite (Image r) where
ipeWrite :: Image r -> Maybe (NodeG [] Text Text)
ipeWrite (Image ()
d (Box CWMin (Point 2 r) :+ ()
a CWMax (Point 2 r) :+ ()
b)) = (\Text
dt Text
p Text
q ->
Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"image" [(Text
"rect", Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q)] [Text -> NodeG [] Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
dt]
)
(Text -> Text -> Text -> NodeG [] Text Text)
-> Maybe Text -> Maybe (Text -> Text -> NodeG [] Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText ()
d
Maybe (Text -> Text -> NodeG [] Text Text)
-> Maybe Text -> Maybe (Text -> NodeG [] Text Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (CWMin (Point 2 r) :+ ()
a(CWMin (Point 2 r) :+ ())
-> Getting (Point 2 r) (CWMin (Point 2 r) :+ ()) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(CWMin (Point 2 r) -> Const (Point 2 r) (CWMin (Point 2 r)))
-> (CWMin (Point 2 r) :+ ())
-> Const (Point 2 r) (CWMin (Point 2 r) :+ ())
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((CWMin (Point 2 r) -> Const (Point 2 r) (CWMin (Point 2 r)))
-> (CWMin (Point 2 r) :+ ())
-> Const (Point 2 r) (CWMin (Point 2 r) :+ ()))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
-> CWMin (Point 2 r) -> Const (Point 2 r) (CWMin (Point 2 r)))
-> Getting (Point 2 r) (CWMin (Point 2 r) :+ ()) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> CWMin (Point 2 r) -> Const (Point 2 r) (CWMin (Point 2 r))
forall a1 a2. Iso (CWMin a1) (CWMin a2) a1 a2
cwMin)
Maybe (Text -> NodeG [] Text Text)
-> Maybe Text -> Maybe (NodeG [] Text Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (CWMax (Point 2 r) :+ ()
b(CWMax (Point 2 r) :+ ())
-> Getting (Point 2 r) (CWMax (Point 2 r) :+ ()) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(CWMax (Point 2 r) -> Const (Point 2 r) (CWMax (Point 2 r)))
-> (CWMax (Point 2 r) :+ ())
-> Const (Point 2 r) (CWMax (Point 2 r) :+ ())
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((CWMax (Point 2 r) -> Const (Point 2 r) (CWMax (Point 2 r)))
-> (CWMax (Point 2 r) :+ ())
-> Const (Point 2 r) (CWMax (Point 2 r) :+ ()))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
-> CWMax (Point 2 r) -> Const (Point 2 r) (CWMax (Point 2 r)))
-> Getting (Point 2 r) (CWMax (Point 2 r) :+ ()) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> CWMax (Point 2 r) -> Const (Point 2 r) (CWMax (Point 2 r))
forall a1 a2. Iso (CWMax a1) (CWMax a2) a1 a2
cwMax)
instance IpeWriteText () where
ipeWriteText :: () -> Maybe Text
ipeWriteText () = Maybe Text
forall a. Maybe a
Nothing
instance IpeWriteText r => IpeWrite (TextLabel r) where
ipeWrite :: TextLabel r -> Maybe (NodeG [] Text Text)
ipeWrite (Label Text
t Point 2 r
p) = (\Text
pt ->
Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"text" [(Text
"pos", Text
pt)
,(Text
"type", Text
"label")
] [Text -> NodeG [] Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
t]
) (Text -> NodeG [] Text Text)
-> Maybe Text -> Maybe (NodeG [] Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point 2 r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText Point 2 r
p
instance (IpeWriteText r) => IpeWrite (IpeObject r) where
ipeWrite :: IpeObject r -> Maybe (NodeG [] Text Text)
ipeWrite (IpeGroup IpeObject' Group r
g) = (Group r
:+ Attributes'
r '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip])
-> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite Group r
:+ Attributes' r '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
IpeObject' Group r
g
ipeWrite (IpeImage IpeObject' Image r
i) = (Image r :+ Attributes' r CommonAttributes)
-> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite Image r :+ Attributes' r CommonAttributes
IpeObject' Image r
i
ipeWrite (IpeTextLabel IpeObject' TextLabel r
l) = (TextLabel r :+ Attributes' r CommonAttributes)
-> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite TextLabel r :+ Attributes' r CommonAttributes
IpeObject' TextLabel r
l
ipeWrite (IpeMiniPage IpeObject' MiniPage r
m) = (MiniPage r :+ Attributes' r CommonAttributes)
-> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite MiniPage r :+ Attributes' r CommonAttributes
IpeObject' MiniPage r
m
ipeWrite (IpeUse IpeObject' IpeSymbol r
s) = (IpeSymbol r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Pen,
'Size])
-> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite IpeSymbol r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Pen,
'Size]
IpeObject' IpeSymbol r
s
ipeWrite (IpePath IpeObject' Path r
p) = (Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
IpeObject' Path r
p
deriving instance IpeWriteText LayerName
instance IpeWrite LayerName where
ipeWrite :: LayerName -> Maybe (NodeG [] Text Text)
ipeWrite (LayerName Text
n) = NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a. a -> Maybe a
Just (NodeG [] Text Text -> Maybe (NodeG [] Text Text))
-> NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a b. (a -> b) -> a -> b
$ Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"layer" [(Text
"name",Text
n)] []
instance IpeWrite View where
ipeWrite :: View -> Maybe (NodeG [] Text Text)
ipeWrite (View [LayerName]
lrs LayerName
act) = NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a. a -> Maybe a
Just (NodeG [] Text Text -> Maybe (NodeG [] Text Text))
-> NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a b. (a -> b) -> a -> b
$ Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"view" [ (Text
"layers", Text
ls)
, (Text
"active", LayerName
actLayerName -> Getting Text LayerName Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text LayerName Text
Iso' LayerName Text
layerName)
] []
where
ls :: Text
ls = [Text] -> Text
Text.unwords ([Text] -> Text) -> ([LayerName] -> [Text]) -> [LayerName] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayerName -> Text) -> [LayerName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (LayerName -> Getting Text LayerName Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text LayerName Text
Iso' LayerName Text
layerName) ([LayerName] -> Text) -> [LayerName] -> Text
forall a b. (a -> b) -> a -> b
$ [LayerName]
lrs
instance (IpeWriteText r) => IpeWrite (IpePage r) where
ipeWrite :: IpePage r -> Maybe (NodeG [] Text Text)
ipeWrite (IpePage [LayerName]
lrs [View]
vs [IpeObject r]
objs) = NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a. a -> Maybe a
Just (NodeG [] Text Text -> Maybe (NodeG [] Text Text))
-> ([[Maybe (NodeG [] Text Text)]] -> NodeG [] Text Text)
-> [[Maybe (NodeG [] Text Text)]]
-> Maybe (NodeG [] Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"page" [] ([NodeG [] Text Text] -> NodeG [] Text Text)
-> ([[Maybe (NodeG [] Text Text)]] -> [NodeG [] Text Text])
-> [[Maybe (NodeG [] Text Text)]]
-> NodeG [] Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (NodeG [] Text Text)] -> [NodeG [] Text Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (NodeG [] Text Text)] -> [NodeG [] Text Text])
-> ([[Maybe (NodeG [] Text Text)]] -> [Maybe (NodeG [] Text Text)])
-> [[Maybe (NodeG [] Text Text)]]
-> [NodeG [] Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe (NodeG [] Text Text)]] -> [Maybe (NodeG [] Text Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Maybe (NodeG [] Text Text)]] -> Maybe (NodeG [] Text Text))
-> [[Maybe (NodeG [] Text Text)]] -> Maybe (NodeG [] Text Text)
forall a b. (a -> b) -> a -> b
$
[ (LayerName -> Maybe (NodeG [] Text Text))
-> [LayerName] -> [Maybe (NodeG [] Text Text)]
forall a b. (a -> b) -> [a] -> [b]
map LayerName -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite [LayerName]
lrs
, (View -> Maybe (NodeG [] Text Text))
-> [View] -> [Maybe (NodeG [] Text Text)]
forall a b. (a -> b) -> [a] -> [b]
map View -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite [View]
vs
, (IpeObject r -> Maybe (NodeG [] Text Text))
-> [IpeObject r] -> [Maybe (NodeG [] Text Text)]
forall a b. (a -> b) -> [a] -> [b]
map IpeObject r -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite [IpeObject r]
objs
]
instance IpeWrite IpeStyle where
ipeWrite :: IpeStyle -> Maybe (NodeG [] Text Text)
ipeWrite (IpeStyle Maybe Text
_ NodeG [] Text Text
xml) = NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a. a -> Maybe a
Just NodeG [] Text Text
xml
instance IpeWrite IpePreamble where
ipeWrite :: IpePreamble -> Maybe (NodeG [] Text Text)
ipeWrite (IpePreamble Maybe Text
_ Text
latex) = NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a. a -> Maybe a
Just (NodeG [] Text Text -> Maybe (NodeG [] Text Text))
-> NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a b. (a -> b) -> a -> b
$ Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"preamble" [] [Text -> NodeG [] Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
latex]
instance (IpeWriteText r) => IpeWrite (IpeFile r) where
ipeWrite :: IpeFile r -> Maybe (NodeG [] Text Text)
ipeWrite (IpeFile Maybe IpePreamble
mp [IpeStyle]
ss NonEmpty (IpePage r)
pgs) = NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a. a -> Maybe a
Just (NodeG [] Text Text -> Maybe (NodeG [] Text Text))
-> NodeG [] Text Text -> Maybe (NodeG [] Text Text)
forall a b. (a -> b) -> a -> b
$ Text
-> [(Text, Text)] -> [NodeG [] Text Text] -> NodeG [] Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"ipe" [(Text, Text)]
ipeAtts [NodeG [] Text Text]
chs
where
ipeAtts :: [(Text, Text)]
ipeAtts = [(Text
"version",Text
"70005"),(Text
"creator", Text
"HGeometry")]
chs :: [NodeG [] Text Text]
chs = [[NodeG [] Text Text]] -> [NodeG [] Text Text]
forall a. Monoid a => [a] -> a
mconcat [ [Maybe (NodeG [] Text Text)] -> [NodeG [] Text Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe IpePreamble
mp Maybe IpePreamble
-> (IpePreamble -> Maybe (NodeG [] Text Text))
-> Maybe (NodeG [] Text Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IpePreamble -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite]
, (IpeStyle -> Maybe (NodeG [] Text Text))
-> [IpeStyle] -> [NodeG [] Text Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IpeStyle -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite [IpeStyle]
ss
, (IpePage r -> Maybe (NodeG [] Text Text))
-> [IpePage r] -> [NodeG [] Text Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IpePage r -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite ([IpePage r] -> [NodeG [] Text Text])
-> (NonEmpty (IpePage r) -> [IpePage r])
-> NonEmpty (IpePage r)
-> [NodeG [] Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (IpePage r) -> [IpePage r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmpty (IpePage r) -> [NodeG [] Text Text])
-> NonEmpty (IpePage r) -> [NodeG [] Text Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty (IpePage r)
pgs
]
instance (IpeWriteText r, IpeWrite p) => IpeWrite (PolyLine 2 p r) where
ipeWrite :: PolyLine 2 p r -> Maybe (NodeG [] Text Text)
ipeWrite PolyLine 2 p r
p = Path r -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite Path r
path
where
path :: Path r
path = PolyLine 2 () r -> Path r
forall r. PolyLine 2 () r -> Path r
fromPolyLine (PolyLine 2 () r -> Path r) -> PolyLine 2 () r -> Path r
forall a b. (a -> b) -> a -> b
$ PolyLine 2 p r
p PolyLine 2 p r
-> (PolyLine 2 p r -> PolyLine 2 () r) -> PolyLine 2 () r
forall a b. a -> (a -> b) -> b
& (LSeq 2 (Point 2 r :+ p) -> Identity (LSeq 2 (Point 2 r :+ ())))
-> PolyLine 2 p r -> Identity (PolyLine 2 () r)
forall (d1 :: Nat) p1 r1 (d2 :: Nat) p2 r2.
Iso
(PolyLine d1 p1 r1)
(PolyLine d2 p2 r2)
(LSeq 2 (Point d1 r1 :+ p1))
(LSeq 2 (Point d2 r2 :+ p2))
points((LSeq 2 (Point 2 r :+ p) -> Identity (LSeq 2 (Point 2 r :+ ())))
-> PolyLine 2 p r -> Identity (PolyLine 2 () r))
-> ((p -> Identity ())
-> LSeq 2 (Point 2 r :+ p) -> Identity (LSeq 2 (Point 2 r :+ ())))
-> (p -> Identity ())
-> PolyLine 2 p r
-> Identity (PolyLine 2 () r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Identity (Point 2 r :+ ()))
-> LSeq 2 (Point 2 r :+ p) -> Identity (LSeq 2 (Point 2 r :+ ()))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse(((Point 2 r :+ p) -> Identity (Point 2 r :+ ()))
-> LSeq 2 (Point 2 r :+ p) -> Identity (LSeq 2 (Point 2 r :+ ())))
-> ((p -> Identity ())
-> (Point 2 r :+ p) -> Identity (Point 2 r :+ ()))
-> (p -> Identity ())
-> LSeq 2 (Point 2 r :+ p)
-> Identity (LSeq 2 (Point 2 r :+ ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(p -> Identity ())
-> (Point 2 r :+ p) -> Identity (Point 2 r :+ ())
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra ((p -> Identity ())
-> PolyLine 2 p r -> Identity (PolyLine 2 () r))
-> () -> PolyLine 2 p r -> PolyLine 2 () r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ()
fromPolyLine :: PolyLine 2 () r -> Path r
fromPolyLine :: PolyLine 2 () r -> Path r
fromPolyLine = LSeq 1 (PathSegment r) -> Path r
forall r. LSeq 1 (PathSegment r) -> Path r
Path (LSeq 1 (PathSegment r) -> Path r)
-> (PolyLine 2 () r -> LSeq 1 (PathSegment r))
-> PolyLine 2 () 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 (NonEmpty (PathSegment r) -> LSeq 1 (PathSegment r))
-> (PolyLine 2 () r -> NonEmpty (PathSegment r))
-> PolyLine 2 () r
-> LSeq 1 (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathSegment r -> [PathSegment r] -> NonEmpty (PathSegment r)
forall a. a -> [a] -> NonEmpty a
:| []) (PathSegment r -> NonEmpty (PathSegment r))
-> (PolyLine 2 () r -> PathSegment r)
-> PolyLine 2 () r
-> NonEmpty (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyLine 2 () r -> PathSegment r
forall r. PolyLine 2 () r -> PathSegment r
PolyLineSegment
instance (IpeWriteText r) => IpeWrite (LineSegment 2 p r) where
ipeWrite :: LineSegment 2 p r -> Maybe (NodeG [] Text Text)
ipeWrite (LineSegment' Point 2 r :+ p
p Point 2 r :+ p
q) =
Path r -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite (Path r -> Maybe (NodeG [] Text Text))
-> ([Point 2 r :+ p] -> Path r)
-> [Point 2 r :+ p]
-> Maybe (NodeG [] Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyLine 2 () r -> Path r
forall r. PolyLine 2 () r -> Path r
fromPolyLine (PolyLine 2 () r -> Path r)
-> ([Point 2 r :+ p] -> PolyLine 2 () r)
-> [Point 2 r :+ p]
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r :+ ()] -> PolyLine 2 () r
forall (d :: Nat) r p. [Point d r :+ p] -> PolyLine d p r
fromPointsUnsafe ([Point 2 r :+ ()] -> PolyLine 2 () r)
-> ([Point 2 r :+ p] -> [Point 2 r :+ ()])
-> [Point 2 r :+ p]
-> PolyLine 2 () r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ p) -> Point 2 r :+ ())
-> [Point 2 r :+ p] -> [Point 2 r :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map ((p -> Identity ())
-> (Point 2 r :+ p) -> Identity (Point 2 r :+ ())
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra ((p -> Identity ())
-> (Point 2 r :+ p) -> Identity (Point 2 r :+ ()))
-> () -> (Point 2 r :+ p) -> Point 2 r :+ ()
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ()) ([Point 2 r :+ p] -> Maybe (NodeG [] Text Text))
-> [Point 2 r :+ p] -> Maybe (NodeG [] Text Text)
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ p
p,Point 2 r :+ p
q]
instance IpeWrite () where
ipeWrite :: () -> Maybe (NodeG [] Text Text)
ipeWrite = Maybe (NodeG [] Text Text) -> () -> Maybe (NodeG [] Text Text)
forall a b. a -> b -> a
const Maybe (NodeG [] Text Text)
forall a. Maybe a
Nothing