{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Ipe.Types
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data type modeling the various elements in Ipe files.
--
--------------------------------------------------------------------------------
module Ipe.Types(
  -- * Ipe Files
    IpeFile(IpeFile), preamble, styles, pages
  , ipeFile, singlePageFile, singlePageFromContent
  -- * Ipe Pages
  , IpePage(IpePage), layers, views, content
  , emptyPage, fromContent
  , onLayer, contentInView
  , withDefaults
  -- * Content: Ipe Objects
  , IpeObject(..), _IpeGroup, _IpeImage, _IpeTextLabel, _IpeMiniPage, _IpeUse, _IpePath
  , IpeObject'
  , ipeObject'
  , ToObject(..)
  -- ** Specific Ipe-Objects
  , Path(Path), pathSegments
  , PathSegment(..)
  , IpeSymbol(Symbol), symbolPoint, symbolName
  , Group(Group), groupItems
  , TextLabel(..)
  , MiniPage(..), width
  , Image(Image), imageData, rect
  , IpeBitmap
  -- * Attributes
  , IpeAttributes
  , Attributes', AttributesOf, AttrMap, AttrMapSym1
  , attributes, traverseIpeAttrs
  , commonAttributes
  -- * Layers and Views
  , LayerName(LayerName), layerName
  , View(View), layerNames, activeLayer
  -- * Styles and Preamble
  , addStyleSheet
  , IpeStyle(IpeStyle), styleName, styleData
  , basicIpeStyle
  , IpePreamble(IpePreamble), encoding, preambleData
  --
  -- , flattenGroups
  ) where


import           Control.Lens hiding (views)
import           Ipe.Attributes hiding (Matrix)
import           Ipe.Content
import           Ipe.Layer
import           Ipe.Literal
import qualified Data.List.NonEmpty as NE
import           Data.Maybe (mapMaybe)
import           Data.Semigroup (Endo)
import qualified Data.Set as Set
import           Data.Text (Text)
import           Text.XML.Expat.Tree (Node)


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


-- | The definition of a view
-- make active layer into an index ?
data View = View { View -> [LayerName]
_layerNames      :: [LayerName]
                 , View -> LayerName
_activeLayer     :: LayerName
                 }
          deriving (View -> View -> Bool
(View -> View -> Bool) -> (View -> View -> Bool) -> Eq View
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: View -> View -> Bool
$c/= :: View -> View -> Bool
== :: View -> View -> Bool
$c== :: View -> View -> Bool
Eq, Eq View
Eq View
-> (View -> View -> Ordering)
-> (View -> View -> Bool)
-> (View -> View -> Bool)
-> (View -> View -> Bool)
-> (View -> View -> Bool)
-> (View -> View -> View)
-> (View -> View -> View)
-> Ord View
View -> View -> Bool
View -> View -> Ordering
View -> View -> View
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: View -> View -> View
$cmin :: View -> View -> View
max :: View -> View -> View
$cmax :: View -> View -> View
>= :: View -> View -> Bool
$c>= :: View -> View -> Bool
> :: View -> View -> Bool
$c> :: View -> View -> Bool
<= :: View -> View -> Bool
$c<= :: View -> View -> Bool
< :: View -> View -> Bool
$c< :: View -> View -> Bool
compare :: View -> View -> Ordering
$ccompare :: View -> View -> Ordering
$cp1Ord :: Eq View
Ord, Int -> View -> ShowS
[View] -> ShowS
View -> String
(Int -> View -> ShowS)
-> (View -> String) -> ([View] -> ShowS) -> Show View
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [View] -> ShowS
$cshowList :: [View] -> ShowS
show :: View -> String
$cshow :: View -> String
showsPrec :: Int -> View -> ShowS
$cshowsPrec :: Int -> View -> ShowS
Show)
makeLenses ''View

-- instance Default


-- | for now we pretty much ignore these
data IpeStyle = IpeStyle { IpeStyle -> Maybe Text
_styleName :: Maybe Text
                         , IpeStyle -> Node Text Text
_styleData :: Node Text Text
                         }
              deriving (IpeStyle -> IpeStyle -> Bool
(IpeStyle -> IpeStyle -> Bool)
-> (IpeStyle -> IpeStyle -> Bool) -> Eq IpeStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpeStyle -> IpeStyle -> Bool
$c/= :: IpeStyle -> IpeStyle -> Bool
== :: IpeStyle -> IpeStyle -> Bool
$c== :: IpeStyle -> IpeStyle -> Bool
Eq,Int -> IpeStyle -> ShowS
[IpeStyle] -> ShowS
IpeStyle -> String
(Int -> IpeStyle -> ShowS)
-> (IpeStyle -> String) -> ([IpeStyle] -> ShowS) -> Show IpeStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpeStyle] -> ShowS
$cshowList :: [IpeStyle] -> ShowS
show :: IpeStyle -> String
$cshow :: IpeStyle -> String
showsPrec :: Int -> IpeStyle -> ShowS
$cshowsPrec :: Int -> IpeStyle -> ShowS
Show)
makeLenses ''IpeStyle


basicIpeStyle :: IpeStyle
basicIpeStyle :: IpeStyle
basicIpeStyle = Maybe Text -> Node Text Text -> IpeStyle
IpeStyle (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"basic") (String -> Node Text Text
xmlLiteral [litFile|resources/basic.isy|])



-- | The maybe string is the encoding
data IpePreamble  = IpePreamble { IpePreamble -> Maybe Text
_encoding     :: Maybe Text
                                , IpePreamble -> Text
_preambleData :: Text
                                }
                  deriving (IpePreamble -> IpePreamble -> Bool
(IpePreamble -> IpePreamble -> Bool)
-> (IpePreamble -> IpePreamble -> Bool) -> Eq IpePreamble
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpePreamble -> IpePreamble -> Bool
$c/= :: IpePreamble -> IpePreamble -> Bool
== :: IpePreamble -> IpePreamble -> Bool
$c== :: IpePreamble -> IpePreamble -> Bool
Eq,ReadPrec [IpePreamble]
ReadPrec IpePreamble
Int -> ReadS IpePreamble
ReadS [IpePreamble]
(Int -> ReadS IpePreamble)
-> ReadS [IpePreamble]
-> ReadPrec IpePreamble
-> ReadPrec [IpePreamble]
-> Read IpePreamble
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IpePreamble]
$creadListPrec :: ReadPrec [IpePreamble]
readPrec :: ReadPrec IpePreamble
$creadPrec :: ReadPrec IpePreamble
readList :: ReadS [IpePreamble]
$creadList :: ReadS [IpePreamble]
readsPrec :: Int -> ReadS IpePreamble
$creadsPrec :: Int -> ReadS IpePreamble
Read,Int -> IpePreamble -> ShowS
[IpePreamble] -> ShowS
IpePreamble -> String
(Int -> IpePreamble -> ShowS)
-> (IpePreamble -> String)
-> ([IpePreamble] -> ShowS)
-> Show IpePreamble
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpePreamble] -> ShowS
$cshowList :: [IpePreamble] -> ShowS
show :: IpePreamble -> String
$cshow :: IpePreamble -> String
showsPrec :: Int -> IpePreamble -> ShowS
$cshowsPrec :: Int -> IpePreamble -> ShowS
Show,Eq IpePreamble
Eq IpePreamble
-> (IpePreamble -> IpePreamble -> Ordering)
-> (IpePreamble -> IpePreamble -> Bool)
-> (IpePreamble -> IpePreamble -> Bool)
-> (IpePreamble -> IpePreamble -> Bool)
-> (IpePreamble -> IpePreamble -> Bool)
-> (IpePreamble -> IpePreamble -> IpePreamble)
-> (IpePreamble -> IpePreamble -> IpePreamble)
-> Ord IpePreamble
IpePreamble -> IpePreamble -> Bool
IpePreamble -> IpePreamble -> Ordering
IpePreamble -> IpePreamble -> IpePreamble
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IpePreamble -> IpePreamble -> IpePreamble
$cmin :: IpePreamble -> IpePreamble -> IpePreamble
max :: IpePreamble -> IpePreamble -> IpePreamble
$cmax :: IpePreamble -> IpePreamble -> IpePreamble
>= :: IpePreamble -> IpePreamble -> Bool
$c>= :: IpePreamble -> IpePreamble -> Bool
> :: IpePreamble -> IpePreamble -> Bool
$c> :: IpePreamble -> IpePreamble -> Bool
<= :: IpePreamble -> IpePreamble -> Bool
$c<= :: IpePreamble -> IpePreamble -> Bool
< :: IpePreamble -> IpePreamble -> Bool
$c< :: IpePreamble -> IpePreamble -> Bool
compare :: IpePreamble -> IpePreamble -> Ordering
$ccompare :: IpePreamble -> IpePreamble -> Ordering
$cp1Ord :: Eq IpePreamble
Ord)
makeLenses ''IpePreamble

type IpeBitmap = Text



--------------------------------------------------------------------------------
-- Ipe Pages

-- | An IpePage is essentially a Group, together with a list of layers and a
-- list of views.
data IpePage r = IpePage { IpePage r -> [LayerName]
_layers  :: [LayerName]
                         , IpePage r -> [View]
_views   :: [View]
                         , IpePage r -> [IpeObject r]
_content :: [IpeObject r]
                         }
              deriving (IpePage r -> IpePage r -> Bool
(IpePage r -> IpePage r -> Bool)
-> (IpePage r -> IpePage r -> Bool) -> Eq (IpePage r)
forall r. Eq r => IpePage r -> IpePage r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpePage r -> IpePage r -> Bool
$c/= :: forall r. Eq r => IpePage r -> IpePage r -> Bool
== :: IpePage r -> IpePage r -> Bool
$c== :: forall r. Eq r => IpePage r -> IpePage r -> Bool
Eq,Int -> IpePage r -> ShowS
[IpePage r] -> ShowS
IpePage r -> String
(Int -> IpePage r -> ShowS)
-> (IpePage r -> String)
-> ([IpePage r] -> ShowS)
-> Show (IpePage r)
forall r. Show r => Int -> IpePage r -> ShowS
forall r. Show r => [IpePage r] -> ShowS
forall r. Show r => IpePage r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpePage r] -> ShowS
$cshowList :: forall r. Show r => [IpePage r] -> ShowS
show :: IpePage r -> String
$cshow :: forall r. Show r => IpePage r -> String
showsPrec :: Int -> IpePage r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> IpePage r -> ShowS
Show)
makeLenses ''IpePage

-- | Creates an empty page with one layer and view.
emptyPage :: IpePage r
emptyPage :: IpePage r
emptyPage = [IpeObject r] -> IpePage r
forall r. [IpeObject r] -> IpePage r
fromContent []

-- | Creates a simple page with a single view.
fromContent     :: [IpeObject r] -> IpePage r
fromContent :: [IpeObject r] -> IpePage r
fromContent [IpeObject r]
obs = [LayerName] -> [View] -> [IpeObject r] -> IpePage r
forall r. [LayerName] -> [View] -> [IpeObject r] -> IpePage r
IpePage [LayerName]
layers' [[LayerName] -> LayerName -> View
View [LayerName]
layers' LayerName
a] [IpeObject r]
obs
  where
    layers' :: [LayerName]
layers' = Set LayerName -> [LayerName]
forall a. Set a -> [a]
Set.toList (Set LayerName -> [LayerName])
-> ([LayerName] -> Set LayerName) -> [LayerName] -> [LayerName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LayerName] -> Set LayerName
forall a. Ord a => [a] -> Set a
Set.fromList ([LayerName] -> [LayerName]) -> [LayerName] -> [LayerName]
forall a b. (a -> b) -> a -> b
$ LayerName
a LayerName -> [LayerName] -> [LayerName]
forall a. a -> [a] -> [a]
: (IpeObject r -> Maybe LayerName) -> [IpeObject r] -> [LayerName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (IpeObject r
-> Getting (Maybe LayerName) (IpeObject r) (Maybe LayerName)
-> Maybe LayerName
forall s a. s -> Getting a s a -> a
^.(Attributes (AttrMapSym1 r) CommonAttributes
 -> Const
      (Maybe LayerName) (Attributes (AttrMapSym1 r) CommonAttributes))
-> IpeObject r -> Const (Maybe LayerName) (IpeObject r)
forall r.
Lens' (IpeObject r) (Attributes (AttrMapSym1 r) CommonAttributes)
commonAttributes((Attributes (AttrMapSym1 r) CommonAttributes
  -> Const
       (Maybe LayerName) (Attributes (AttrMapSym1 r) CommonAttributes))
 -> IpeObject r -> Const (Maybe LayerName) (IpeObject r))
-> ((Maybe LayerName -> Const (Maybe LayerName) (Maybe LayerName))
    -> Attributes (AttrMapSym1 r) CommonAttributes
    -> Const
         (Maybe LayerName) (Attributes (AttrMapSym1 r) CommonAttributes))
-> Getting (Maybe LayerName) (IpeObject r) (Maybe LayerName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SAttributeUniverse 'Layer
-> Lens'
     (Attributes (AttrMapSym1 r) CommonAttributes)
     (Maybe (Apply (AttrMapSym1 r) 'Layer))
forall k1 (at :: k1) (ats :: [k1]) (proxy :: k1 -> *)
       (f :: TyFun k1 * -> *).
(at ∈ ats) =>
proxy at -> Lens' (Attributes f ats) (Maybe (Apply f at))
ixAttr SAttributeUniverse 'Layer
SLayer) [IpeObject r]
obs
    a :: LayerName
a       = LayerName
"alpha"

-- | Makes sure that the page has at least one layer and at least one
-- view, essentially matching the behaviour of ipe. In particular,
--
-- - if the page does not have any layers, it creates a layer named "alpha", and
-- - if the page does not have any views, it creates a view in which all layers are visible.
--
withDefaults :: IpePage r -> IpePage r
withDefaults :: IpePage r -> IpePage r
withDefaults = IpePage r -> IpePage r
forall r. IpePage r -> IpePage r
addView (IpePage r -> IpePage r)
-> (IpePage r -> IpePage r) -> IpePage r -> IpePage r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpePage r -> IpePage r
forall r. IpePage r -> IpePage r
addLayer
  where
    whenNull :: [a] -> [a] -> [a]
whenNull [a]
ys = \case
                    [] -> [a]
ys
                    [a]
xs -> [a]
xs
    addLayer :: IpePage r -> IpePage r
addLayer IpePage r
p = IpePage r
pIpePage r -> (IpePage r -> IpePage r) -> IpePage r
forall a b. a -> (a -> b) -> b
&([LayerName] -> Identity [LayerName])
-> IpePage r -> Identity (IpePage r)
forall r. Lens' (IpePage r) [LayerName]
layers (([LayerName] -> Identity [LayerName])
 -> IpePage r -> Identity (IpePage r))
-> ([LayerName] -> [LayerName]) -> IpePage r -> IpePage r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [LayerName] -> [LayerName] -> [LayerName]
forall a. [a] -> [a] -> [a]
whenNull [LayerName
"alpha"]
    addView :: IpePage r -> IpePage r
addView  IpePage r
p = IpePage r
pIpePage r -> (IpePage r -> IpePage r) -> IpePage r
forall a b. a -> (a -> b) -> b
&([View] -> Identity [View]) -> IpePage r -> Identity (IpePage r)
forall r. Lens' (IpePage r) [View]
views  (([View] -> Identity [View]) -> IpePage r -> Identity (IpePage r))
-> ([View] -> [View]) -> IpePage r -> IpePage r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [View] -> [View] -> [View]
forall a. [a] -> [a] -> [a]
whenNull [[LayerName] -> LayerName -> View
View (IpePage r
pIpePage r
-> Getting [LayerName] (IpePage r) [LayerName] -> [LayerName]
forall s a. s -> Getting a s a -> a
^.Getting [LayerName] (IpePage r) [LayerName]
forall r. Lens' (IpePage r) [LayerName]
layers) ([LayerName] -> LayerName
forall a. [a] -> a
head ([LayerName] -> LayerName) -> [LayerName] -> LayerName
forall a b. (a -> b) -> a -> b
$ IpePage r
pIpePage r
-> Getting [LayerName] (IpePage r) [LayerName] -> [LayerName]
forall s a. s -> Getting a s a -> a
^.Getting [LayerName] (IpePage r) [LayerName]
forall r. Lens' (IpePage r) [LayerName]
layers)]
                 -- note that the head is save, since we just made sure
                 -- with 'addLayer' that there is at least one layer

-- | This allows you to filter the objects on some layer.
--
-- >>> let page = IpePage [] [] []
-- >>> page^..content.onLayer "myLayer"
-- []
onLayer   :: LayerName -> Getting (Endo [IpeObject r]) [IpeObject r] (IpeObject r)
onLayer :: LayerName
-> Getting (Endo [IpeObject r]) [IpeObject r] (IpeObject r)
onLayer LayerName
n = Getting (Endo [IpeObject r]) [IpeObject r] (IpeObject r)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
foldedGetting (Endo [IpeObject r]) [IpeObject r] (IpeObject r)
-> ((IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
    -> IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
-> Getting (Endo [IpeObject r]) [IpeObject r] (IpeObject r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IpeObject r -> Bool)
-> (IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
-> IpeObject r
-> Const (Endo [IpeObject r]) (IpeObject r)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\IpeObject r
o -> IpeObject r
oIpeObject r
-> Getting (First LayerName) (IpeObject r) LayerName
-> Maybe LayerName
forall s a. s -> Getting (First a) s a -> Maybe a
^?(Attributes (AttrMapSym1 r) CommonAttributes
 -> Const
      (First LayerName) (Attributes (AttrMapSym1 r) CommonAttributes))
-> IpeObject r -> Const (First LayerName) (IpeObject r)
forall r.
Lens' (IpeObject r) (Attributes (AttrMapSym1 r) CommonAttributes)
commonAttributes((Attributes (AttrMapSym1 r) CommonAttributes
  -> Const
       (First LayerName) (Attributes (AttrMapSym1 r) CommonAttributes))
 -> IpeObject r -> Const (First LayerName) (IpeObject r))
-> ((LayerName -> Const (First LayerName) LayerName)
    -> Attributes (AttrMapSym1 r) CommonAttributes
    -> Const
         (First LayerName) (Attributes (AttrMapSym1 r) CommonAttributes))
-> Getting (First LayerName) (IpeObject r) LayerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SAttributeUniverse 'Layer
-> Prism'
     (Attributes (AttrMapSym1 r) CommonAttributes)
     (Apply (AttrMapSym1 r) 'Layer)
forall k1 (at :: k1) (ats :: [k1]) (proxy :: k1 -> *)
       (f :: TyFun k1 * -> *).
(at ∈ ats, RecApplicative ats) =>
proxy at -> Prism' (Attributes f ats) (Apply f at)
_Attr SAttributeUniverse 'Layer
SLayer Maybe LayerName -> Maybe LayerName -> Bool
forall a. Eq a => a -> a -> Bool
== LayerName -> Maybe LayerName
forall a. a -> Maybe a
Just LayerName
n)

-- | Gets all objects that are visible in the given view.
--
-- Note that views are indexed starting from 0. If the page does not
-- have any explicit view definitions, this function returns an empty
-- list.
--
-- >>> let page = IpePage [] [] []
-- >>> page^.contentInView 0
-- []
contentInView                     :: Word -> Getter (IpePage r) [IpeObject r]
contentInView :: Word -> Getter (IpePage r) [IpeObject r]
contentInView (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
i) = (IpePage r -> [IpeObject r])
-> Optic' (->) f (IpePage r) [IpeObject r]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to IpePage r -> [IpeObject r]
inView'
  where
    inView' :: IpePage r -> [IpeObject r]
inView' IpePage r
p = let lrs :: Set LayerName
lrs = [LayerName] -> Set LayerName
forall a. Ord a => [a] -> Set a
Set.fromList ([LayerName] -> Set LayerName)
-> ([View] -> [LayerName]) -> [View] -> Set LayerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (View -> [LayerName]) -> [View] -> [LayerName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (View -> Getting [LayerName] View [LayerName] -> [LayerName]
forall s a. s -> Getting a s a -> a
^.Getting [LayerName] View [LayerName]
Lens' View [LayerName]
layerNames) ([View] -> Set LayerName) -> [View] -> Set LayerName
forall a b. (a -> b) -> a -> b
$ IpePage r
pIpePage r -> Getting (Endo [View]) (IpePage r) View -> [View]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..([View] -> Const (Endo [View]) [View])
-> IpePage r -> Const (Endo [View]) (IpePage r)
forall r. Lens' (IpePage r) [View]
views(([View] -> Const (Endo [View]) [View])
 -> IpePage r -> Const (Endo [View]) (IpePage r))
-> ((View -> Const (Endo [View]) View)
    -> [View] -> Const (Endo [View]) [View])
-> Getting (Endo [View]) (IpePage r) View
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index [View] -> Traversal' [View] (IxValue [View])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [View]
i
                in IpePage r
pIpePage r
-> Getting (Endo [IpeObject r]) (IpePage r) (IpeObject r)
-> [IpeObject r]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..([IpeObject r] -> Const (Endo [IpeObject r]) [IpeObject r])
-> IpePage r -> Const (Endo [IpeObject r]) (IpePage r)
forall r r.
Lens (IpePage r) (IpePage r) [IpeObject r] [IpeObject r]
content(([IpeObject r] -> Const (Endo [IpeObject r]) [IpeObject r])
 -> IpePage r -> Const (Endo [IpeObject r]) (IpePage r))
-> ((IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
    -> [IpeObject r] -> Const (Endo [IpeObject r]) [IpeObject r])
-> Getting (Endo [IpeObject r]) (IpePage r) (IpeObject r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
-> [IpeObject r] -> Const (Endo [IpeObject r]) [IpeObject r]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded((IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
 -> [IpeObject r] -> Const (Endo [IpeObject r]) [IpeObject r])
-> ((IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
    -> IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
-> (IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
-> [IpeObject r]
-> Const (Endo [IpeObject r]) [IpeObject r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IpeObject r -> Bool)
-> (IpeObject r -> Const (Endo [IpeObject r]) (IpeObject r))
-> IpeObject r
-> Const (Endo [IpeObject r]) (IpeObject r)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (Set LayerName -> IpeObject r -> Bool
forall r. Set LayerName -> IpeObject r -> Bool
inVisibleLayer Set LayerName
lrs)

    inVisibleLayer :: Set LayerName -> IpeObject r -> Bool
inVisibleLayer Set LayerName
lrs IpeObject r
o = Bool -> (LayerName -> Bool) -> Maybe LayerName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (LayerName -> Set LayerName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set LayerName
lrs) (Maybe LayerName -> Bool) -> Maybe LayerName -> Bool
forall a b. (a -> b) -> a -> b
$ IpeObject r
oIpeObject r
-> Getting (First LayerName) (IpeObject r) LayerName
-> Maybe LayerName
forall s a. s -> Getting (First a) s a -> Maybe a
^?(Attributes (AttrMapSym1 r) CommonAttributes
 -> Const
      (First LayerName) (Attributes (AttrMapSym1 r) CommonAttributes))
-> IpeObject r -> Const (First LayerName) (IpeObject r)
forall r.
Lens' (IpeObject r) (Attributes (AttrMapSym1 r) CommonAttributes)
commonAttributes((Attributes (AttrMapSym1 r) CommonAttributes
  -> Const
       (First LayerName) (Attributes (AttrMapSym1 r) CommonAttributes))
 -> IpeObject r -> Const (First LayerName) (IpeObject r))
-> ((LayerName -> Const (First LayerName) LayerName)
    -> Attributes (AttrMapSym1 r) CommonAttributes
    -> Const
         (First LayerName) (Attributes (AttrMapSym1 r) CommonAttributes))
-> Getting (First LayerName) (IpeObject r) LayerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SAttributeUniverse 'Layer
-> Prism'
     (Attributes (AttrMapSym1 r) CommonAttributes)
     (Apply (AttrMapSym1 r) 'Layer)
forall k1 (at :: k1) (ats :: [k1]) (proxy :: k1 -> *)
       (f :: TyFun k1 * -> *).
(at ∈ ats, RecApplicative ats) =>
proxy at -> Prism' (Attributes f ats) (Apply f at)
_Attr SAttributeUniverse 'Layer
SLayer

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

-- | A complete ipe file
data IpeFile r = IpeFile { IpeFile r -> Maybe IpePreamble
_preamble :: Maybe IpePreamble
                         , IpeFile r -> [IpeStyle]
_styles   :: [IpeStyle]
                         , IpeFile r -> NonEmpty (IpePage r)
_pages    :: NE.NonEmpty (IpePage r)
                         }
               deriving (IpeFile r -> IpeFile r -> Bool
(IpeFile r -> IpeFile r -> Bool)
-> (IpeFile r -> IpeFile r -> Bool) -> Eq (IpeFile r)
forall r. Eq r => IpeFile r -> IpeFile r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpeFile r -> IpeFile r -> Bool
$c/= :: forall r. Eq r => IpeFile r -> IpeFile r -> Bool
== :: IpeFile r -> IpeFile r -> Bool
$c== :: forall r. Eq r => IpeFile r -> IpeFile r -> Bool
Eq,Int -> IpeFile r -> ShowS
[IpeFile r] -> ShowS
IpeFile r -> String
(Int -> IpeFile r -> ShowS)
-> (IpeFile r -> String)
-> ([IpeFile r] -> ShowS)
-> Show (IpeFile r)
forall r. Show r => Int -> IpeFile r -> ShowS
forall r. Show r => [IpeFile r] -> ShowS
forall r. Show r => IpeFile r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpeFile r] -> ShowS
$cshowList :: forall r. Show r => [IpeFile r] -> ShowS
show :: IpeFile r -> String
$cshow :: forall r. Show r => IpeFile r -> String
showsPrec :: Int -> IpeFile r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> IpeFile r -> ShowS
Show)
makeLenses ''IpeFile


-- | Convenience constructor for creating an ipe file without preamble
-- and with the default stylesheet.
ipeFile :: NE.NonEmpty (IpePage r) -> IpeFile r
ipeFile :: NonEmpty (IpePage r) -> IpeFile r
ipeFile = Maybe IpePreamble
-> [IpeStyle] -> NonEmpty (IpePage r) -> IpeFile r
forall r.
Maybe IpePreamble
-> [IpeStyle] -> NonEmpty (IpePage r) -> IpeFile r
IpeFile Maybe IpePreamble
forall a. Maybe a
Nothing [IpeStyle
basicIpeStyle]

-- | Convenience function to construct an ipe file consisting of a single page.
singlePageFile :: IpePage r -> IpeFile r
singlePageFile :: IpePage r -> IpeFile r
singlePageFile = NonEmpty (IpePage r) -> IpeFile r
forall r. NonEmpty (IpePage r) -> IpeFile r
ipeFile (NonEmpty (IpePage r) -> IpeFile r)
-> (IpePage r -> NonEmpty (IpePage r)) -> IpePage r -> IpeFile r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IpePage r -> [IpePage r] -> NonEmpty (IpePage r)
forall a. a -> [a] -> NonEmpty a
NE.:| [])

-- | Create a single page ipe file from a list of IpeObjects
singlePageFromContent :: [IpeObject r] -> IpeFile r
singlePageFromContent :: [IpeObject r] -> IpeFile r
singlePageFromContent = IpePage r -> IpeFile r
forall r. IpePage r -> IpeFile r
singlePageFile (IpePage r -> IpeFile r)
-> ([IpeObject r] -> IpePage r) -> [IpeObject r] -> IpeFile r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IpeObject r] -> IpePage r
forall r. [IpeObject r] -> IpePage r
fromContent


-- | Adds a stylesheet to the ipe file. This will be the first
-- stylesheet, i.e. it has priority over all previously imported stylesheets.
addStyleSheet     :: IpeStyle -> IpeFile r -> IpeFile r
addStyleSheet :: IpeStyle -> IpeFile r -> IpeFile r
addStyleSheet IpeStyle
s IpeFile r
f = IpeFile r
fIpeFile r -> (IpeFile r -> IpeFile r) -> IpeFile r
forall a b. a -> (a -> b) -> b
&([IpeStyle] -> Identity [IpeStyle])
-> IpeFile r -> Identity (IpeFile r)
forall r. Lens' (IpeFile r) [IpeStyle]
styles (([IpeStyle] -> Identity [IpeStyle])
 -> IpeFile r -> Identity (IpeFile r))
-> ([IpeStyle] -> [IpeStyle]) -> IpeFile r -> IpeFile r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (IpeStyle
sIpeStyle -> [IpeStyle] -> [IpeStyle]
forall a. a -> [a] -> [a]
:)