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

  , 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

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

-- | Given a prism to convert something of type g into an ipe file, a file path,
-- and a g. Convert the geometry and write it to file.

-- writeIpe        :: ( RecAll (Page r) gs IpeWrite
--                    , IpeWriteText r
--                    ) => Prism' (IpeFile gs r) g -> FilePath -> g -> IO ()
-- writeIpe p fp g = writeIpeFile (p # g) fp

-- | Write an IpeFiele to file.
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'

-- | Creates a single page ipe file with the given page
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


-- | 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 :: 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 :: 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]


-- | Convert to Ipe xml
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


-- | Convert to ipe XML and write the output to a file.
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"

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

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


-- | Functon to write all attributes in a Rec
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

-- | Writing the attribute values
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


-- | Add attributes to a node
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 }

-- | Same as `addAtts` but then for a Maybe node
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

-- | 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 :: 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
      -- 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 => 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"
    -- the polyline type guarantees that there is at least one point

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
    -- TODO: We are not really guaranteed that there is at least one point, it would
    -- be nice if the type could guarantee that.

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)

-- 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 => 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]
  -- TODO: I probably want to do something with the encoding ....

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
.~ ()
      -- TODO: Do something with the p's

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