{-# 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, review, (^.), (^..), toNonEmptyOf, IxValue)
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.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           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 qualified Ipe.Attributes as IA
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

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

-- | 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 = (NodeG [] Text Text -> ByteString)
-> Maybe (NodeG [] 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 (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 :: forall t. IpeWrite t => t -> Maybe ByteString
toIpeXML = (NodeG [] Text Text -> ByteString)
-> Maybe (NodeG [] 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 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 -> 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 (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 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 (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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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

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


-- | 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 :: 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 (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 a. Rec (Const a) rs -> [a]
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 Const Text a
-> Const (Maybe Text) a -> Const (Maybe (Text, Text)) a
forall {k} {k} {k} {f :: * -> *} {t} {b :: k} {a} {b :: k}
       {b :: k}.
Functor f =>
Const t b -> Const (f a) b -> Const (f (t, a)) 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 a) b -> Const (f (t, a)) b
f (Const t
n) (Const f a
mv) = f (t, a) -> Const (f (t, a)) b
forall k a (b :: k). a -> Const a b
Const (f (t, a) -> Const (f (t, a)) b) -> f (t, a) -> Const (f (t, a)) b
forall a b. (a -> b) -> a -> b
$ (t
n,) (a -> (t, a)) -> f a -> f (t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
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 :: 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 = (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
forall (f :: u -> *) (g :: u -> *).
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap (\(Compose (Dict f x
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 (c :: * -> Constraint) (f :: u -> *) (rs :: [u]).
ReifyConstraint c f rs =>
Rec f rs -> Rec (Dict c :. 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 :: 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 :: NodeG [] Text Text
n@(Element {}) addAtts :: NodeG [] Text Text -> [(Text, Text)] -> NodeG [] Text Text
`addAtts` [(Text, Text)]
ats = NodeG [] Text Text
n { eAttributes = ats ++ eAttributes n }
NodeG [] Text Text
_ `addAtts` [(Text, Text)]
_   = String -> NodeG [] 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 (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 a b. (a -> b) -> Maybe a -> Maybe b
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
. 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 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, 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 (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 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 (NodeG [] Text Text)
ipeWrite (Image ()
d (Box Point 2 r
a 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 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 -> NodeG [] Text Text)
-> Maybe Text -> Maybe (NodeG [] 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 (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 ImageAttributes)
-> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite Image r :+ Attributes' r ImageAttributes
IpeObject' Image r
i
    ipeWrite (IpeTextLabel IpeObject' TextLabel r
l) = (TextLabel r
 :+ Attributes'
      r
      '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Size, 'Width,
         'Height, 'Depth, 'VAlign, 'HAlign, 'Style, 'Opacity])
-> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite TextLabel r
:+ Attributes'
     r
     '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Size, 'Width,
        'Height, 'Depth, 'VAlign, 'HAlign, 'Style, 'Opacity]
IpeObject' TextLabel r
l
    ipeWrite (IpeMiniPage  IpeObject' MiniPage r
m) = (MiniPage r
 :+ Attributes'
      r
      '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Size, 'Width,
         'Height, 'Depth, 'VAlign, 'HAlign, 'Style, 'Opacity])
-> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite MiniPage r
:+ Attributes'
     r
     '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Size, 'Width,
        'Height, 'Depth, 'VAlign, 'HAlign, 'Style, 'Opacity]
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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 a. NonEmpty a -> [a]
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, Point_ point 2 r, Functor f, Foldable1 f
         ) => IpeWrite (PolyLineF f point) where
  ipeWrite :: PolyLineF f point -> Maybe (NodeG [] Text Text)
ipeWrite = Path r -> Maybe (NodeG [] Text Text)
forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite (Path r -> Maybe (NodeG [] Text Text))
-> (PolyLineF f point -> Path r)
-> PolyLineF f point
-> Maybe (NodeG [] 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 (NodeG [] Text Text)
ipeWrite = forall t. IpeWrite t => t -> Maybe (NodeG [] Text Text)
ipeWrite @(PolyLineF NonEmpty point) (PolyLineF NonEmpty point -> Maybe (NodeG [] Text Text))
-> (LineSegment endPoint point -> PolyLineF NonEmpty point)
-> LineSegment endPoint point
-> Maybe (NodeG [] 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 (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