{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Ipe.Writer
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
-- Description :  Converting data types into IpeTypes
--
--------------------------------------------------------------------------------
module Ipe.Writer(
    writeIpeFile, writeIpeFile', writeIpePage
  , toIpeXML
  , printAsIpeSelection, toIpeSelectionXML

  , IpeWrite(..)
  , IpeWriteText(..)

  , IpeWriteAttributes(..)
  ) where

import           GHC.TypeLits (KnownNat)
import           Control.Lens hiding (Reversed)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Colour.SRGB (RGB (..))
import           Data.Eq.Approximate
import           Data.Fixed
import qualified Data.Foldable as F
import           Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import           Data.Ratio
import           Data.Semigroup.Foldable
import qualified Data.Sequence as Seq
import           Data.Text (Text)
import qualified Data.Text as Text
import           HGeometry.BezierSpline
import           HGeometry.Box
import           HGeometry.Ellipse (ellipseMatrix)
import           HGeometry.Ext
import           HGeometry.Foldable.Util
import           HGeometry.Interval.EndPoint
import           HGeometry.LineSegment
import qualified HGeometry.Matrix as Matrix
import           HGeometry.Number.Real.Rational
import           HGeometry.Number.Real.Interval
import           HGeometry.Point
import           HGeometry.PolyLine
import           HGeometry.Polygon.Class
import           HGeometry.Polygon.Simple
import           HGeometry.Vector
import           Ipe.Attributes
import           Ipe.Color (IpeColor (..))
import           Ipe.Path
import           Ipe.Types
import           Ipe.Value
import qualified System.File.OsPath as File
import           System.IO (hPutStrLn, stderr)
import           System.OsPath
import           Text.XML.Expat.Format (format)
import           Text.XML.Expat.Tree
import           Barbies
import           Data.Finitary
import           Data.Finite

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

-- | Write an IpeFiele to file.
writeIpeFile :: IpeWriteText r => OsPath -> IpeFile r -> IO ()
writeIpeFile :: forall r. IpeWriteText r => OsPath -> IpeFile r -> IO ()
writeIpeFile = (IpeFile r -> OsPath -> IO ()) -> OsPath -> IpeFile r -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IpeFile r -> OsPath -> IO ()
forall t. IpeWrite t => t -> OsPath -> IO ()
writeIpeFile'

-- | Creates a single page ipe file with the given page
writeIpePage    :: IpeWriteText r => OsPath -> IpePage r -> IO ()
writeIpePage :: forall r. IpeWriteText r => OsPath -> IpePage r -> IO ()
writeIpePage OsPath
fp = OsPath -> IpeFile r -> IO ()
forall r. IpeWriteText r => OsPath -> IpeFile r -> IO ()
writeIpeFile OsPath
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


-- | Convert the input to ipeXml, and prints it to standard out in such a way
-- that the copied text can be pasted into ipe as a geometry object.
printAsIpeSelection :: IpeWrite t => [t] -> IO ()
printAsIpeSelection :: forall t. IpeWrite t => [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

-- | Convert input into an ipe selection.
toIpeSelectionXML   :: IpeWrite t => [t] -> Maybe B.ByteString
toIpeSelectionXML :: forall t. IpeWrite t => [t] -> Maybe ByteString
toIpeSelectionXML [t]
xs = case (t -> Maybe (Node Text Text)) -> [t] -> [Node Text Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe t -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite [t]
xs of
                         []  -> Maybe ByteString
forall a. Maybe a
Nothing
                         [Node Text Text]
chs -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Node Text Text -> ByteString
forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
format (Node Text Text -> ByteString) -> Node Text Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node Text Text] -> Node Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"ipeselection" [] [Node Text Text]
chs

-- | Convert to Ipe xml
toIpeXML :: IpeWrite t => t -> Maybe B.ByteString
toIpeXML :: forall t. IpeWrite t => t -> Maybe ByteString
toIpeXML = (Node Text Text -> ByteString)
-> Maybe (Node Text Text) -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node Text Text -> ByteString
forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
format (Maybe (Node Text Text) -> Maybe ByteString)
-> (t -> Maybe (Node Text Text)) -> t -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite


-- | Convert to ipe XML and write the output to a file.
writeIpeFile'      :: IpeWrite t => t -> OsPath -> IO ()
writeIpeFile' :: forall t. IpeWrite t => t -> OsPath -> IO ()
writeIpeFile' t
i OsPath
fp = IO () -> (ByteString -> IO ()) -> Maybe ByteString -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ()
err (OsPath -> ByteString -> IO ()
File.writeFile OsPath
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 -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
          String
"writeIpeFile: error converting to xml. File '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OsPath -> String
forall a. Show a => a -> String
show OsPath
fp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'not written"

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

-- | For types that can produce a text value
class IpeWriteText t where
  ipeWriteText :: t -> Maybe Text

-- | Types that correspond to an XML Element. All instances should produce an
-- Element. If the type should produce a Node with the Text constructor, use
-- the `IpeWriteText` typeclass instead.
class IpeWrite t where
  ipeWrite :: t -> Maybe (Node Text Text)

instance IpeWrite t => IpeWrite [t] where
  ipeWrite :: [t] -> Maybe (Node Text Text)
ipeWrite [t]
gs = case (t -> Maybe (Node Text Text)) -> [t] -> [Node Text Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe t -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite [t]
gs of
                  [] -> Maybe (Node Text Text)
forall a. Maybe a
Nothing
                  [Node Text Text]
ns -> Node Text Text -> Maybe (Node Text Text)
forall a. a -> Maybe a
Just (Node Text Text -> Maybe (Node Text Text))
-> Node Text Text -> Maybe (Node Text Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node Text Text] -> Node Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"group" [] [Node Text Text]
ns

instance IpeWrite t => IpeWrite (NonEmpty t) where
  ipeWrite :: NonEmpty t -> Maybe (Node Text Text)
ipeWrite = [t] -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite ([t] -> Maybe (Node Text Text))
-> (NonEmpty t -> [t]) -> NonEmpty t -> Maybe (Node Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty t -> [t]
forall a. NonEmpty a -> [a]
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 (Node Text Text)
ipeWrite = (l -> Maybe (Node Text Text))
-> (r -> Maybe (Node Text Text))
-> Either l r
-> Maybe (Node Text Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either l -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite r -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite

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

instance IpeWriteText r => IpeWriteText (AbsolutelyApproximateValue tol r) where
  ipeWriteText :: AbsolutelyApproximateValue tol r -> Maybe Text
ipeWriteText = r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (r -> Maybe Text)
-> (AbsolutelyApproximateValue tol r -> r)
-> AbsolutelyApproximateValue tol r
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutelyApproximateValue tol r -> r
forall absolute_tolerance value.
AbsolutelyApproximateValue absolute_tolerance value -> value
unwrapAbsolutelyApproximateValue


instance IpeWriteText Text where
  ipeWriteText :: Text -> Maybe Text
ipeWriteText = Text -> Maybe Text
forall a. a -> Maybe a
Just

instance IpeWriteText String where
  ipeWriteText :: String -> Maybe Text
ipeWriteText = Text -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack


-- | Add attributes to a node
addAtts :: Node Text Text -> [(Text,Text)] -> Node Text Text
n :: Node Text Text
n@(Element {}) addAtts :: Node Text Text -> [(Text, Text)] -> Node Text Text
`addAtts` [(Text, Text)]
ats = Node Text Text
n { eAttributes = ats ++ eAttributes n }
Node Text Text
_ `addAtts` [(Text, Text)]
_   = String -> Node Text Text
forall a. HasCallStack => String -> a
error String
"addAts, requires Element"

-- | Same as `addAtts` but then for a Maybe node
mAddAtts  :: Maybe (Node Text Text) -> [(Text, Text)] -> Maybe (Node Text Text)
Maybe (Node Text Text)
mn mAddAtts :: Maybe (Node Text Text) -> [(Text, Text)] -> Maybe (Node Text Text)
`mAddAtts` [(Text, Text)]
ats = (Node Text Text -> Node Text Text)
-> Maybe (Node Text Text) -> Maybe (Node Text Text)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Node Text Text -> [(Text, Text)] -> Node Text Text
`addAtts` [(Text, Text)]
ats) Maybe (Node 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
. forall a b. (Real a, Fractional b) => a -> b
realToFrac @(RealNumber p) @Rational

instance Real r => IpeWriteText (IntervalReal r) where
  ipeWriteText :: IntervalReal r -> Maybe Text
ipeWriteText = Rational -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (Rational -> Maybe Text)
-> (IntervalReal r -> Rational) -> IntervalReal r -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac @(IntervalReal r) @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

-- | This instance converts the ratio to a Pico, and then displays that.
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 :: forall t. Show t => 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
. String -> Text
Text.pack (String -> Text) -> (t -> String) -> t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall a. Show a => a -> String
show

unwords' :: [Maybe Text] -> Maybe Text
unwords' :: [Maybe Text] -> Maybe Text
unwords' = ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence

unlines' :: [Maybe Text] -> Maybe Text
unlines' :: [Maybe Text] -> Maybe Text
unlines' = ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText [r]
xs
                                    Maybe (Text -> Text) -> Maybe Text -> Maybe Text
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
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 = (Seq Text -> Text) -> Maybe (Seq Text) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq Text -> Text
concat' (Maybe (Seq Text) -> Maybe Text)
-> (Path r -> Maybe (Seq Text)) -> Path r -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Maybe Text) -> Maybe (Seq Text)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Seq (m a) -> m (Seq a)
sequence (Seq (Maybe Text) -> Maybe (Seq Text))
-> (Path r -> Seq (Maybe Text)) -> Path r -> Maybe (Seq Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathSegment r -> Maybe Text)
-> Seq (PathSegment r) -> Seq (Maybe Text)
forall a b. (a -> b) -> Seq a -> Seq b
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 (Seq (PathSegment r) -> Seq (Maybe Text))
-> (Path r -> Seq (PathSegment r)) -> Path r -> Seq (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Seq (PathSegment r)) (Path r) (Seq (PathSegment r))
-> Path r -> Seq (PathSegment r)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq (PathSegment r)) (Path r) (Seq (PathSegment r))
forall r r' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Seq (PathSegment r)) (f (Seq (PathSegment r')))
-> p (Path r) (f (Path r'))
pathSegments
    where
      concat' :: Seq Text -> Text
concat' = (Text -> Text -> Text) -> Seq Text -> Text
forall a. (a -> a -> a) -> Seq a -> a
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 HorizontalAlignment where
  ipeWriteText :: HorizontalAlignment -> Maybe Text
ipeWriteText = \case
    HorizontalAlignment
AlignLeft    -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"left"
    HorizontalAlignment
AlignHCenter -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"center"
    HorizontalAlignment
AlignRight   -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"right"

instance IpeWriteText VerticalAlignment where
  ipeWriteText :: VerticalAlignment -> Maybe Text
ipeWriteText = \case
    VerticalAlignment
AlignTop      -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"top"
    VerticalAlignment
AlignVCenter  -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"center"
    VerticalAlignment
AlignBottom   -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"bottom"
    VerticalAlignment
AlignBaseline -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"baseline"

instance KnownNat n => IpeWriteText (Finite n) where
  ipeWriteText :: Finite n -> Maybe Text
ipeWriteText = forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText @Integer (Integer -> Maybe Text)
-> (Finite n -> Integer) -> Finite n -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite n -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IpeWriteText LineJoin where
  ipeWriteText :: LineJoin -> Maybe Text
ipeWriteText = Finite 3 -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText (Finite 3 -> Maybe Text)
-> (LineJoin -> Finite 3) -> LineJoin -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> Finite 3
LineJoin -> Finite (Cardinality LineJoin)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite

--------------------------------------------------------------------------------
instance IpeWriteText r => IpeWrite (IpeSymbol r) where
  ipeWrite :: IpeSymbol r -> Maybe (Node Text Text)
ipeWrite (Symbol Point 2 r
p Text
n) = Text -> Node Text Text
f (Text -> Node Text Text) -> Maybe Text -> Maybe (Node 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 -> Node Text Text
f Text
ps = Text -> [(Text, Text)] -> [Node Text Text] -> Node 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
      -- TODO: The third row should be (0,0,1) I guess.


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, Point_ point 2 r) => IpeWriteText (PolyLine point) where
  ipeWriteText :: PolyLine point -> Maybe Text
ipeWriteText PolyLine point
pl = case PolyLine point
plPolyLine point
-> Getting (Endo [Point 2 r]) (PolyLine point) (Point 2 r)
-> [Point 2 r]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..(point -> Const (Endo [Point 2 r]) point)
-> PolyLine point -> Const (Endo [Point 2 r]) (PolyLine point)
(Vertex (PolyLine point)
 -> Const (Endo [Point 2 r]) (Vertex (PolyLine point)))
-> PolyLine point -> Const (Endo [Point 2 r]) (PolyLine point)
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx (PolyLine point))
  (PolyLine point)
  (PolyLine point)
  (Vertex (PolyLine point))
  (Vertex (PolyLine point))
vertices((point -> Const (Endo [Point 2 r]) point)
 -> PolyLine point -> Const (Endo [Point 2 r]) (PolyLine point))
-> ((Point 2 r -> Const (Endo [Point 2 r]) (Point 2 r))
    -> point -> Const (Endo [Point 2 r]) point)
-> Getting (Endo [Point 2 r]) (PolyLine point) (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 -> Const (Endo [Point 2 r]) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint 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]
_          -> String -> Maybe Text
forall a. HasCallStack => String -> a
error String
"ipeWriteText. absurd. no vertices polyline"
    -- the polyline type guarantees that there is at least one point

instance (IpeWriteText r, Point_ point 2 r) => IpeWriteText (SimplePolygon point) where
  ipeWriteText :: SimplePolygon point -> Maybe Text
ipeWriteText SimplePolygon point
pg = NonEmpty (Point 2 r) -> Maybe Text
forall r. IpeWriteText r => NonEmpty (Point 2 r) -> Maybe Text
ipeWriteTextPolygonVertices (NonEmpty (Point 2 r) -> Maybe Text)
-> NonEmpty (Point 2 r) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Getting
  (NonEmptyDList (Point 2 r)) (SimplePolygon point) (Point 2 r)
-> SimplePolygon point -> NonEmpty (Point 2 r)
forall a s. Getting (NonEmptyDList a) s a -> s -> NonEmpty a
toNonEmptyOf ((point -> Const (NonEmptyDList (Point 2 r)) point)
-> SimplePolygon point
-> Const (NonEmptyDList (Point 2 r)) (SimplePolygon point)
(Vertex (SimplePolygon point)
 -> Const
      (NonEmptyDList (Point 2 r)) (Vertex (SimplePolygon point)))
-> SimplePolygon point
-> Const (NonEmptyDList (Point 2 r)) (SimplePolygon point)
forall polygon.
HasOuterBoundary polygon =>
IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
IndexedTraversal1'
  (VertexIx (SimplePolygon point))
  (SimplePolygon point)
  (Vertex (SimplePolygon point))
outerBoundary((point -> Const (NonEmptyDList (Point 2 r)) point)
 -> SimplePolygon point
 -> Const (NonEmptyDList (Point 2 r)) (SimplePolygon point))
-> ((Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r))
    -> point -> Const (NonEmptyDList (Point 2 r)) point)
-> Getting
     (NonEmptyDList (Point 2 r)) (SimplePolygon point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r))
-> point -> Const (NonEmptyDList (Point 2 r)) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) SimplePolygon point
pg

ipeWriteTextPolygonVertices :: IpeWriteText r => NonEmpty (Point 2 r) -> Maybe Text
ipeWriteTextPolygonVertices :: forall r. IpeWriteText r => NonEmpty (Point 2 r) -> Maybe Text
ipeWriteTextPolygonVertices = \case
    (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]

instance (IpeWriteText r, Point_ point 2 r) => IpeWriteText (CubicBezier point) where
  ipeWriteText :: CubicBezier point -> Maybe Text
ipeWriteText ((point -> Point 2 r)
-> CubicBezier point -> BezierSplineF (Vector 4) (Point 2 r)
forall a b.
(a -> b)
-> BezierSplineF (Vector 4) a -> BezierSplineF (Vector 4) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (point -> Getting (Point 2 r) point (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) -> 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 (Point 2 r)
p) = PolyLine (Point 2 r) -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText PolyLine (Point 2 r)
p
  ipeWriteText (PolygonPath Orientation
orient SimplePolygon (Point 2 r)
p) = case Orientation
orient of
    Orientation
AsIs     -> SimplePolygon (Point 2 r) -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText SimplePolygon (Point 2 r)
p
    Orientation
Reversed -> NonEmpty (Point 2 r) -> Maybe Text
forall r. IpeWriteText r => NonEmpty (Point 2 r) -> Maybe Text
ipeWriteTextPolygonVertices (NonEmpty (Point 2 r) -> Maybe Text)
-> (NonEmpty (Point 2 r) -> NonEmpty (Point 2 r))
-> NonEmpty (Point 2 r)
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Point 2 r) -> NonEmpty (Point 2 r)
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse
              (NonEmpty (Point 2 r) -> Maybe Text)
-> NonEmpty (Point 2 r) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Getting
  (NonEmptyDList (Point 2 r)) (SimplePolygon (Point 2 r)) (Point 2 r)
-> SimplePolygon (Point 2 r) -> NonEmpty (Point 2 r)
forall a s. Getting (NonEmptyDList a) s a -> s -> NonEmpty a
toNonEmptyOf ((Vertex (SimplePolygon (Point 2 r))
 -> Const
      (NonEmptyDList (Point 2 r)) (Vertex (SimplePolygon (Point 2 r))))
-> SimplePolygon (Point 2 r)
-> Const (NonEmptyDList (Point 2 r)) (SimplePolygon (Point 2 r))
Getting
  (NonEmptyDList (Point 2 r)) (SimplePolygon (Point 2 r)) (Point 2 r)
forall polygon.
HasOuterBoundary polygon =>
IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
IndexedTraversal1'
  (VertexIx (SimplePolygon (Point 2 r)))
  (SimplePolygon (Point 2 r))
  (Vertex (SimplePolygon (Point 2 r)))
outerBoundaryGetting
  (NonEmptyDList (Point 2 r)) (SimplePolygon (Point 2 r)) (Point 2 r)
-> ((Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r))
    -> Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r))
-> Getting
     (NonEmptyDList (Point 2 r)) (SimplePolygon (Point 2 r)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r))
-> Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' (Point 2 r) (Point 2 r)
asPoint) SimplePolygon (Point 2 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 (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Matrix 3 3 r) (f (Matrix 3 3 s))
-> p (Ellipse r) (f (Ellipse s))
ellipseMatrix)
  ipeWriteText (CubicBezierSegment CubicBezier (Point 2 r)
b) = CubicBezier (Point 2 r) -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText CubicBezier (Point 2 r)
b
  ipeWriteText PathSegment r
_                      = String -> Maybe Text
forall a. HasCallStack => String -> a
error String
"ipeWriteText: PathSegment, not implemented yet."

instance IpeWriteText r => IpeWrite (Path r) where
  ipeWrite :: Path r -> Maybe (Node Text Text)
ipeWrite Path r
p = (\Text
t -> Text -> [(Text, Text)] -> [Node Text Text] -> Node Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"path" [] [Text -> Node Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
t]) (Text -> Node Text Text) -> Maybe Text -> Maybe (Node 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 (Node Text Text)
ipeWrite (Group [IpeObject r]
gs) = [IpeObject r] -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite [IpeObject r]
gs

instance ( IpeWrite g, IpeWriteAttributes ats
         ) => IpeWrite (g :+ ats) where
  ipeWrite :: (g :+ ats) -> Maybe (Node Text Text)
ipeWrite (g
g :+ ats
ats) = g -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite g
g Maybe (Node Text Text) -> [(Text, Text)] -> Maybe (Node Text Text)
`mAddAtts` ats -> [(Text, Text)]
forall ats. IpeWriteAttributes ats => ats -> [(Text, Text)]
ipeWriteAttrs ats
ats


instance IpeWriteText r => IpeWrite (MiniPage r) where
  ipeWrite :: MiniPage r -> Maybe (Node Text Text)
ipeWrite (MiniPage Text
t Point 2 r
p r
w) = (\Text
pt Text
wt ->
                              Text -> [(Text, Text)] -> [Node Text Text] -> Node 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 -> Node Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
t]
                              ) (Text -> Text -> Node Text Text)
-> Maybe Text -> Maybe (Text -> Node 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 -> Node Text Text)
-> Maybe Text -> Maybe (Node Text Text)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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 (Node Text Text)
ipeWrite (Image ()
d (Box Point 2 r
a Point 2 r
b)) = (\Text
dt Text
p Text
q ->
                                   Text -> [(Text, Text)] -> [Node Text Text] -> Node 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 -> Node Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
dt]
                                 )
                               (Text -> Text -> Text -> Node Text Text)
-> Maybe Text -> Maybe (Text -> Text -> Node 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 -> Node Text Text)
-> Maybe Text -> Maybe (Text -> Node Text Text)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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 Point 2 r
a
                               Maybe (Text -> Node Text Text)
-> Maybe Text -> Maybe (Node Text Text)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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 Point 2 r
b

-- TODO: Replace this one with s.t. that writes the actual image payload
instance IpeWriteText () where
  ipeWriteText :: () -> Maybe Text
ipeWriteText () = Maybe Text
forall a. Maybe a
Nothing

instance IpeWriteText r => IpeWriteText (TextSizeUnit r) where
  ipeWriteText :: TextSizeUnit r -> Maybe Text
ipeWriteText (TextSizeUnit r
x) = r -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText r
x

instance IpeWriteText r => IpeWrite (TextLabel r) where
  ipeWrite :: TextLabel r -> Maybe (Node Text Text)
ipeWrite (Label Text
t Point 2 r
p) = (\Text
pt ->
                         Text -> [(Text, Text)] -> [Node Text Text] -> Node 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 -> Node Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
t]
                         ) (Text -> Node Text Text) -> Maybe Text -> Maybe (Node 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 (Node Text Text)
ipeWrite (IpeGroup     IpeObject' Group r
g) = (Group r :+ GroupAttributes r) -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite Group r :+ GroupAttributes r
IpeObject' Group r
g
    ipeWrite (IpeImage     IpeObject' Image r
i) = (Image r :+ ImageAttributes r) -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite Image r :+ ImageAttributes r
IpeObject' Image r
i
    ipeWrite (IpeTextLabel IpeObject' TextLabel r
l) = (TextLabel r :+ TextAttributes r) -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite TextLabel r :+ TextAttributes r
IpeObject' TextLabel r
l
    ipeWrite (IpeMiniPage  IpeObject' MiniPage r
m) = (MiniPage r :+ TextAttributes r) -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite MiniPage r :+ TextAttributes r
IpeObject' MiniPage r
m
    ipeWrite (IpeUse       IpeObject' IpeSymbol r
s) = (IpeSymbol r :+ SymbolAttributes r) -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite IpeSymbol r :+ SymbolAttributes r
IpeObject' IpeSymbol r
s
    ipeWrite (IpePath      IpeObject' Path r
p) = (Path r :+ PathAttributes r) -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite Path r :+ PathAttributes r
IpeObject' Path r
p

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

deriving instance IpeWriteText LayerName

instance IpeWrite LayerName where
  ipeWrite :: LayerName -> Maybe (Node Text Text)
ipeWrite (LayerName Text
n) = Node Text Text -> Maybe (Node Text Text)
forall a. a -> Maybe a
Just (Node Text Text -> Maybe (Node Text Text))
-> Node Text Text -> Maybe (Node Text Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node Text Text] -> Node 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 (Node Text Text)
ipeWrite (View [LayerName]
lrs LayerName
act) = Node Text Text -> Maybe (Node Text Text)
forall a. a -> Maybe a
Just (Node Text Text -> Maybe (Node Text Text))
-> Node Text Text -> Maybe (Node Text Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node Text Text] -> Node 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 (Node Text Text)
ipeWrite (IpePage [LayerName]
lrs [View]
vs [IpeObject r]
objs) = Node Text Text -> Maybe (Node Text Text)
forall a. a -> Maybe a
Just (Node Text Text -> Maybe (Node Text Text))
-> ([[Maybe (Node Text Text)]] -> Node Text Text)
-> [[Maybe (Node Text Text)]]
-> Maybe (Node Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Text -> [(Text, Text)] -> [Node Text Text] -> Node Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"page" [] ([Node Text Text] -> Node Text Text)
-> ([[Maybe (Node Text Text)]] -> [Node Text Text])
-> [[Maybe (Node Text Text)]]
-> Node Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Node Text Text)] -> [Node Text Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Node Text Text)] -> [Node Text Text])
-> ([[Maybe (Node Text Text)]] -> [Maybe (Node Text Text)])
-> [[Maybe (Node Text Text)]]
-> [Node Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe (Node Text Text)]] -> [Maybe (Node Text Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Maybe (Node Text Text)]] -> Maybe (Node Text Text))
-> [[Maybe (Node Text Text)]] -> Maybe (Node Text Text)
forall a b. (a -> b) -> a -> b
$
                                  [ (LayerName -> Maybe (Node Text Text))
-> [LayerName] -> [Maybe (Node Text Text)]
forall a b. (a -> b) -> [a] -> [b]
map LayerName -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite [LayerName]
lrs
                                  , (View -> Maybe (Node Text Text))
-> [View] -> [Maybe (Node Text Text)]
forall a b. (a -> b) -> [a] -> [b]
map View -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite [View]
vs
                                  , (IpeObject r -> Maybe (Node Text Text))
-> [IpeObject r] -> [Maybe (Node Text Text)]
forall a b. (a -> b) -> [a] -> [b]
map IpeObject r -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite [IpeObject r]
objs
                                  ]





instance IpeWrite IpeStyle where
  ipeWrite :: IpeStyle -> Maybe (Node Text Text)
ipeWrite (IpeStyle Maybe Text
_ Node Text Text
xml) = Node Text Text -> Maybe (Node Text Text)
forall a. a -> Maybe a
Just Node Text Text
xml


instance IpeWrite IpePreamble where
  ipeWrite :: IpePreamble -> Maybe (Node Text Text)
ipeWrite (IpePreamble Maybe Text
_ Text
latex) = Node Text Text -> Maybe (Node Text Text)
forall a. a -> Maybe a
Just (Node Text Text -> Maybe (Node Text Text))
-> Node Text Text -> Maybe (Node Text Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node Text Text] -> Node Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"preamble" [] [Text -> Node Text Text
forall (c :: * -> *) tag text. text -> NodeG c tag text
Text Text
latex]
  -- TODO: I probably want to do something with the encoding ....

instance (IpeWriteText r) => IpeWrite (IpeFile r) where
  ipeWrite :: IpeFile r -> Maybe (Node Text Text)
ipeWrite (IpeFile Maybe IpePreamble
mp [IpeStyle]
ss NonEmpty (IpePage r)
pgs) = Node Text Text -> Maybe (Node Text Text)
forall a. a -> Maybe a
Just (Node Text Text -> Maybe (Node Text Text))
-> Node Text Text -> Maybe (Node Text Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node Text Text] -> Node Text Text
forall (c :: * -> *) tag text.
tag -> [(tag, text)] -> c (NodeG c tag text) -> NodeG c tag text
Element Text
"ipe" [(Text, Text)]
ipeAtts [Node Text Text]
chs
    where
      ipeAtts :: [(Text, Text)]
ipeAtts = [(Text
"version",Text
"70005"),(Text
"creator", Text
"HGeometry")]
      chs :: [Node Text Text]
chs = [[Node Text Text]] -> [Node Text Text]
forall a. Monoid a => [a] -> a
mconcat [ [Maybe (Node Text Text)] -> [Node Text Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe IpePreamble
mp Maybe IpePreamble
-> (IpePreamble -> Maybe (Node Text Text))
-> Maybe (Node Text Text)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IpePreamble -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite]
                    , (IpeStyle -> Maybe (Node Text Text))
-> [IpeStyle] -> [Node Text Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IpeStyle -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite [IpeStyle]
ss
                    , (IpePage r -> Maybe (Node Text Text))
-> [IpePage r] -> [Node Text Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IpePage r -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite ([IpePage r] -> [Node Text Text])
-> (NonEmpty (IpePage r) -> [IpePage r])
-> NonEmpty (IpePage r)
-> [Node Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (IpePage r) -> [IpePage r]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmpty (IpePage r) -> [Node Text Text])
-> NonEmpty (IpePage r) -> [Node Text Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty (IpePage r)
pgs
                    ]




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

instance (IpeWriteText r, Point_ point 2 r, Functor f, Foldable1 f
         ) => IpeWrite (PolyLineF f point) where
  ipeWrite :: PolyLineF f point -> Maybe (Node Text Text)
ipeWrite = Path r -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite (Path r -> Maybe (Node Text Text))
-> (PolyLineF f point -> Path r)
-> PolyLineF f point
-> Maybe (Node Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyLineF f point -> Path r
forall point r (f :: * -> *).
(Point_ point 2 r, Functor f, Foldable1 f) =>
PolyLineF f point -> Path r
fromPolyLine

fromPolyLine               :: (Point_ point 2 r, Functor f, Foldable1 f)
                           => PolyLineF f point -> Path r
fromPolyLine :: forall point r (f :: * -> *).
(Point_ point 2 r, Functor f, Foldable1 f) =>
PolyLineF f point -> Path r
fromPolyLine (PolyLine f point
vs) =
  Seq (PathSegment r) -> Path r
forall r. Seq (PathSegment r) -> Path r
Path (Seq (PathSegment r) -> Path r)
-> (f point -> Seq (PathSegment r)) -> f point -> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment r -> Seq (PathSegment r)
forall a. a -> Seq a
Seq.singleton (PathSegment r -> Seq (PathSegment r))
-> (f point -> PathSegment r) -> f point -> Seq (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyLine (Point 2 r) -> PathSegment r
forall r. PolyLine (Point 2 r) -> PathSegment r
PolyLineSegment (PolyLine (Point 2 r) -> PathSegment r)
-> (f point -> PolyLine (Point 2 r)) -> f point -> PathSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyVector (Point 2 r) -> PolyLine (Point 2 r)
forall {k} (f :: k -> *) (point :: k). f point -> PolyLineF f point
PolyLine (NonEmptyVector (Point 2 r) -> PolyLine (Point 2 r))
-> (f point -> NonEmptyVector (Point 2 r))
-> f point
-> PolyLine (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Point 2 r) -> NonEmptyVector (Point 2 r)
forall (f :: * -> *) (g :: * -> *) a.
(HasFromFoldable1 f, Foldable1 g) =>
g a -> f a
forall (g :: * -> *) a. Foldable1 g => g a -> NonEmptyVector a
fromFoldable1 (f (Point 2 r) -> NonEmptyVector (Point 2 r))
-> (f point -> f (Point 2 r))
-> f point
-> NonEmptyVector (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (point -> Point 2 r) -> f point -> f (Point 2 r)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting (Point 2 r) point (Point 2 r) -> point -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) (f point -> Path r) -> f point -> Path r
forall a b. (a -> b) -> a -> b
$ f point
vs


instance ( IpeWriteText r
         , EndPoint_ (endPoint point)
         , IxValue (endPoint point) ~ point
         , Vertex (LineSegment endPoint point) ~ point

         , Point_ point 2 r
         ) => IpeWrite (LineSegment endPoint point) where
  ipeWrite :: LineSegment endPoint point -> Maybe (Node Text Text)
ipeWrite = forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite @(PolyLineF NonEmpty point) (PolyLineF NonEmpty point -> Maybe (Node Text Text))
-> (LineSegment endPoint point -> PolyLineF NonEmpty point)
-> LineSegment endPoint point
-> Maybe (Node Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview (PolyLineF NonEmpty point) (LineSegment endPoint point)
-> LineSegment endPoint point -> PolyLineF NonEmpty point
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (PolyLineF NonEmpty point) (LineSegment endPoint point)
forall lineSegment point polyLine.
(ConstructableLineSegment_ lineSegment point,
 ConstructablePolyLine_ polyLine point) =>
Prism' polyLine lineSegment
Prism' (PolyLineF NonEmpty point) (LineSegment endPoint point)
_PolyLineLineSegment

instance IpeWrite () where
  ipeWrite :: () -> Maybe (Node Text Text)
ipeWrite = Maybe (Node Text Text) -> () -> Maybe (Node Text Text)
forall a b. a -> b -> a
const Maybe (Node Text Text)
forall a. Maybe a
Nothing

instance ( IpeWriteText r, Point_ point 2 r, IpeWriteText r
         ) => IpeWrite (CubicBezier point) where
  ipeWrite :: CubicBezier point -> Maybe (Node Text Text)
ipeWrite = Path r -> Maybe (Node Text Text)
forall t. IpeWrite t => t -> Maybe (Node Text Text)
ipeWrite (Path r -> Maybe (Node Text Text))
-> (CubicBezier point -> Path r)
-> CubicBezier point
-> Maybe (Node Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (PathSegment r) -> Path r
forall r. Seq (PathSegment r) -> Path r
Path (Seq (PathSegment r) -> Path r)
-> (CubicBezier point -> Seq (PathSegment r))
-> CubicBezier point
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment r -> Seq (PathSegment r)
forall a. a -> Seq a
Seq.singleton (PathSegment r -> Seq (PathSegment r))
-> (CubicBezier point -> PathSegment r)
-> CubicBezier point
-> Seq (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier (Point 2 r) -> PathSegment r
forall r. CubicBezier (Point 2 r) -> PathSegment r
CubicBezierSegment (CubicBezier (Point 2 r) -> PathSegment r)
-> (CubicBezier point -> CubicBezier (Point 2 r))
-> CubicBezier point
-> PathSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (point -> Point 2 r)
-> CubicBezier point -> CubicBezier (Point 2 r)
forall a b.
(a -> b)
-> BezierSplineF (Vector 4) a -> BezierSplineF (Vector 4) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting (Point 2 r) point (Point 2 r) -> point -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint)

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

-- "| A class for for writing attributes "
class IpeWriteAttributes ats where
  -- | Write the attributes to pairs of texts
  ipeWriteAttrs :: ats -> [(Text,Text)]

instance ( AllB IpeWriteText (CommonAttributes r)
         ) => IpeWriteAttributes (CommonAttributes r Maybe) where
  ipeWriteAttrs :: CommonAttributes r Maybe -> [(Text, Text)]
ipeWriteAttrs = (forall a. Const [(Text, Text)] a -> [(Text, Text)])
-> CommonAttributes r (Const [(Text, Text)]) -> [(Text, Text)]
forall {k} (b :: (k -> *) -> *) m (f :: k -> *).
(TraversableB b, Monoid m) =>
(forall (a :: k). f a -> m) -> b f -> m
bfoldMap Const [(Text, Text)] a -> [(Text, Text)]
forall a. Const [(Text, Text)] a -> [(Text, Text)]
forall {k} a (b :: k). Const a b -> a
getConst (CommonAttributes r (Const [(Text, Text)]) -> [(Text, Text)])
-> (CommonAttributes r Maybe
    -> CommonAttributes r (Const [(Text, Text)]))
-> CommonAttributes r Maybe
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (c :: k -> Constraint) (b :: (k -> *) -> *)
       (f :: k -> *) (g :: k -> *) (h :: k -> *).
(AllB c b, ConstraintsB b, ApplicativeB b) =>
(forall (a :: k). c a => f a -> g a -> h a) -> b f -> b g -> b h
forall (c :: * -> Constraint) (b :: (* -> *) -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(AllB c b, ConstraintsB b, ApplicativeB b) =>
(forall a. c a => f a -> g a -> h a) -> b f -> b g -> b h
bzipWithC @IpeWriteText Const Text a -> Maybe a -> Const [(Text, Text)] a
forall a.
IpeWriteText a =>
Const Text a -> Maybe a -> Const [(Text, Text)] a
writeAttr CommonAttributes r (Const Text)
forall {k} (ats :: (k -> *) -> *).
AttributeNames ats =>
ats (Const Text)
attributeNames

writeAttr :: forall a. (IpeWriteText a) => Const Text a -> Maybe a -> Const [(Text,Text)] a
writeAttr :: forall a.
IpeWriteText a =>
Const Text a -> Maybe a -> Const [(Text, Text)] a
writeAttr (Const Text
attr) Maybe a
m = [(Text, Text)] -> Const [(Text, Text)] a
forall {k} a (b :: k). a -> Const a b
Const ([(Text, Text)] -> Const [(Text, Text)] a)
-> [(Text, Text)] -> Const [(Text, Text)] a
forall a b. (a -> b) -> a -> b
$ case Maybe a
m Maybe a -> (a -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe Text
forall t. IpeWriteText t => t -> Maybe Text
ipeWriteText of
  Maybe Text
Nothing  -> []
  Just Text
val -> [(Text
attr,Text
val)]

instance ( AllB IpeWriteText (CommonAttributes r), IpeWriteText r
         ) => IpeWriteAttributes (SymbolAttributes r) where
  ipeWriteAttrs :: SymbolAttributes r -> [(Text, Text)]
ipeWriteAttrs = SymbolAttributes r -> [(Text, Text)]
forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeWriteText b, HasCommonAttributes (b Maybe) r f,
 IpeWriteAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, ApplicativeB b, AttributeNames b) =>
b Maybe -> [(Text, Text)]
ipeWriteAttrs'

-- | Implementation of ipeWriteAttrs for the various attribue types
ipeWriteAttrs'     :: ( AllB IpeWriteText b, HasCommonAttributes (b Maybe) r f
                      , IpeWriteAttributes (CommonAttributes r f), TraversableB b
                      , ConstraintsB b, ApplicativeB b, AttributeNames b
                      ) => b Maybe -> [(Text, Text)]
ipeWriteAttrs' :: forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeWriteText b, HasCommonAttributes (b Maybe) r f,
 IpeWriteAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, ApplicativeB b, AttributeNames b) =>
b Maybe -> [(Text, Text)]
ipeWriteAttrs' b Maybe
ats = (forall a. Const [(Text, Text)] a -> [(Text, Text)])
-> b (Const [(Text, Text)]) -> [(Text, Text)]
forall {k} (b :: (k -> *) -> *) m (f :: k -> *).
(TraversableB b, Monoid m) =>
(forall (a :: k). f a -> m) -> b f -> m
bfoldMap Const [(Text, Text)] a -> [(Text, Text)]
forall a. Const [(Text, Text)] a -> [(Text, Text)]
forall {k} a (b :: k). Const a b -> a
getConst (forall {k} (c :: k -> Constraint) (b :: (k -> *) -> *)
       (f :: k -> *) (g :: k -> *) (h :: k -> *).
(AllB c b, ConstraintsB b, ApplicativeB b) =>
(forall (a :: k). c a => f a -> g a -> h a) -> b f -> b g -> b h
forall (c :: * -> Constraint) (b :: (* -> *) -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(AllB c b, ConstraintsB b, ApplicativeB b) =>
(forall a. c a => f a -> g a -> h a) -> b f -> b g -> b h
bzipWithC @IpeWriteText Const Text a -> Maybe a -> Const [(Text, Text)] a
forall a.
IpeWriteText a =>
Const Text a -> Maybe a -> Const [(Text, Text)] a
writeAttr b (Const Text)
forall {k} (ats :: (k -> *) -> *).
AttributeNames ats =>
ats (Const Text)
attributeNames b Maybe
ats)

instance ( AllB IpeWriteText (CommonAttributes r), IpeWriteText r
         ) => IpeWriteAttributes (GroupAttributes r) where
  ipeWriteAttrs :: GroupAttributes r -> [(Text, Text)]
ipeWriteAttrs = GroupAttributes r -> [(Text, Text)]
forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeWriteText b, HasCommonAttributes (b Maybe) r f,
 IpeWriteAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, ApplicativeB b, AttributeNames b) =>
b Maybe -> [(Text, Text)]
ipeWriteAttrs'

instance ( AllB IpeWriteText (CommonAttributes r), IpeWriteText r
         ) => IpeWriteAttributes (PathAttributes r) where
  ipeWriteAttrs :: PathAttributes r -> [(Text, Text)]
ipeWriteAttrs = PathAttributes r -> [(Text, Text)]
forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeWriteText b, HasCommonAttributes (b Maybe) r f,
 IpeWriteAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, ApplicativeB b, AttributeNames b) =>
b Maybe -> [(Text, Text)]
ipeWriteAttrs'

instance ( AllB IpeWriteText (CommonAttributes r), IpeWriteText r
         ) => IpeWriteAttributes (TextAttributes r) where
  ipeWriteAttrs :: TextAttributes r -> [(Text, Text)]
ipeWriteAttrs = TextAttributes r -> [(Text, Text)]
forall (b :: (* -> *) -> *) r (f :: * -> *).
(AllB IpeWriteText b, HasCommonAttributes (b Maybe) r f,
 IpeWriteAttributes (CommonAttributes r f), TraversableB b,
 ConstraintsB b, ApplicativeB b, AttributeNames b) =>
b Maybe -> [(Text, Text)]
ipeWriteAttrs'