Copyright | (C) Frank Staals |
---|---|
License | see the LICENSE file |
Maintainer | Frank Staals |
Safe Haskell | None |
Language | Haskell2010 |
Possible Attributes we can assign to items in an Ipe file
Synopsis
- data AttributeUniverse
- type LayerSym0 = 'Layer :: AttributeUniverse
- type MatrixSym0 = 'Matrix :: AttributeUniverse
- type PinSym0 = 'Pin :: AttributeUniverse
- type TransformationsSym0 = 'Transformations :: AttributeUniverse
- type StrokeSym0 = 'Stroke :: AttributeUniverse
- type FillSym0 = 'Fill :: AttributeUniverse
- type PenSym0 = 'Pen :: AttributeUniverse
- type SizeSym0 = 'Size :: AttributeUniverse
- type DashSym0 = 'Dash :: AttributeUniverse
- type LineCapSym0 = 'LineCap :: AttributeUniverse
- type LineJoinSym0 = 'LineJoin :: AttributeUniverse
- type FillRuleSym0 = 'FillRule :: AttributeUniverse
- type ArrowSym0 = 'Arrow :: AttributeUniverse
- type RArrowSym0 = 'RArrow :: AttributeUniverse
- type StrokeOpacitySym0 = 'StrokeOpacity :: AttributeUniverse
- type OpacitySym0 = 'Opacity :: AttributeUniverse
- type TilingSym0 = 'Tiling :: AttributeUniverse
- type GradientSym0 = 'Gradient :: AttributeUniverse
- type ClipSym0 = 'Clip :: AttributeUniverse
- data SAttributeUniverse z where
- SLayer :: SAttributeUniverse ('Layer :: AttributeUniverse)
- SMatrix :: SAttributeUniverse ('Matrix :: AttributeUniverse)
- SPin :: SAttributeUniverse ('Pin :: AttributeUniverse)
- STransformations :: SAttributeUniverse ('Transformations :: AttributeUniverse)
- SStroke :: SAttributeUniverse ('Stroke :: AttributeUniverse)
- SFill :: SAttributeUniverse ('Fill :: AttributeUniverse)
- SPen :: SAttributeUniverse ('Pen :: AttributeUniverse)
- SSize :: SAttributeUniverse ('Size :: AttributeUniverse)
- SDash :: SAttributeUniverse ('Dash :: AttributeUniverse)
- SLineCap :: SAttributeUniverse ('LineCap :: AttributeUniverse)
- SLineJoin :: SAttributeUniverse ('LineJoin :: AttributeUniverse)
- SFillRule :: SAttributeUniverse ('FillRule :: AttributeUniverse)
- SArrow :: SAttributeUniverse ('Arrow :: AttributeUniverse)
- SRArrow :: SAttributeUniverse ('RArrow :: AttributeUniverse)
- SStrokeOpacity :: SAttributeUniverse ('StrokeOpacity :: AttributeUniverse)
- SOpacity :: SAttributeUniverse ('Opacity :: AttributeUniverse)
- STiling :: SAttributeUniverse ('Tiling :: AttributeUniverse)
- SGradient :: SAttributeUniverse ('Gradient :: AttributeUniverse)
- SClip :: SAttributeUniverse ('Clip :: AttributeUniverse)
- type CommonAttributes = [Layer, Matrix, Pin, Transformations]
- type TextLabelAttributes = CommonAttributes
- type MiniPageAttributes = CommonAttributes
- type ImageAttributes = CommonAttributes
- type SymbolAttributes = CommonAttributes ++ [Stroke, Fill, Pen, Size]
- type PathAttributes = CommonAttributes ++ [Stroke, Fill, Dash, Pen, LineCap, LineJoin, FillRule, Arrow, RArrow, StrokeOpacity, Opacity, Tiling, Gradient]
- type GroupAttributes = CommonAttributes ++ '['Clip]
- newtype Attr (f :: TyFun u * -> *) (label :: u) = GAttr {}
- getAttr :: forall u (f :: TyFun u Type -> Type) (label :: u) u (f :: TyFun u Type -> Type) (label :: u). Iso (Attr (f :: TyFun u Type -> Type) (label :: u)) (Attr (f :: TyFun u Type -> Type) (label :: u)) (Maybe (Apply f label)) (Maybe (Apply f label))
- pattern Attr :: Apply f label -> Attr f label
- pattern NoAttr :: Attr f label
- traverseAttr :: Applicative h => (Apply f label -> h (Apply g label)) -> Attr f label -> h (Attr g label)
- pureAttr :: (Applicative h, Apply f a ~ Apply g a) => Attr f a -> h (Attr g a)
- newtype Attributes (f :: TyFun u * -> *) (ats :: [u]) = Attrs (Rec (Attr f) ats)
- unAttrs :: Lens (Attributes f ats) (Attributes f' ats') (Rec (Attr f) ats) (Rec (Attr f') ats')
- traverseAttrs :: Applicative h => (forall label. Attr f label -> h (Attr g label)) -> Attributes f ats -> h (Attributes g ats)
- zipRecsWith :: (forall a. f a -> g a -> h a) -> Rec f as -> Rec g as -> Rec h as
- ixAttr :: forall at ats proxy f. at ∈ ats => proxy at -> Lens' (Attributes f ats) (Maybe (Apply f at))
- _Attr :: forall at ats proxy f. (at ∈ ats, RecApplicative ats) => proxy at -> Prism' (Attributes f ats) (Apply f at)
- lookupAttr :: at ∈ ats => proxy at -> Attributes f ats -> Maybe (Apply f at)
- setAttr :: forall proxy at ats f. at ∈ ats => proxy at -> Apply f at -> Attributes f ats -> Attributes f ats
- takeAttr :: forall proxy at ats f. at ∈ ats => proxy at -> Attributes f ats -> (Maybe (Apply f at), Attributes f ats)
- unSetAttr :: forall proxy at ats f. at ∈ ats => proxy at -> Attributes f ats -> Attributes f ats
- attr :: (at ∈ ats, RecApplicative ats) => proxy at -> Apply f at -> Attributes f ats
- data PinType
- = No
- | Yes
- | Horizontal
- | Vertical
- data TransformationTypes
- = Affine
- | Rigid
- | Translations
- newtype IpeSize r = IpeSize (IpeValue r)
- newtype IpePen r = IpePen (IpeValue r)
- data IpeDash r
- = DashNamed Text
- | DashPattern [r] r
- data FillType
- type IpeOpacity = Text
- type IpeTiling = Text
- type IpeGradient = Text
- data IpeArrow r = IpeArrow {
- _arrowName :: Text
- _arrowSize :: IpeSize r
- arrowSize :: forall r r. Lens (IpeArrow r) (IpeArrow r) (IpeSize r) (IpeSize r)
- arrowName :: forall r. Lens' (IpeArrow r) Text
- normalArrow :: IpeArrow r
- class IpeAttrName (a :: AttributeUniverse) where
- writeAttrNames :: AllConstrained IpeAttrName rs => Rec f rs -> Rec (Const Text) rs
Documentation
data AttributeUniverse Source #
The possible Attributes supported in Ipe. To use these
attributes, you'll likely need their Singletons's version which is
Prefixed by an S
. E.g. the Fill
attribute is represented by a
singleton 'SFill :: Sing Fill'.
Layer | |
Matrix | |
Pin | |
Transformations | |
Stroke | |
Fill | |
Pen | |
Size | |
Dash | |
LineCap | |
LineJoin | |
FillRule | |
Arrow | |
RArrow | |
StrokeOpacity | |
Opacity | |
Tiling | |
Gradient | |
Clip |
Instances
type LayerSym0 = 'Layer :: AttributeUniverse Source #
type MatrixSym0 = 'Matrix :: AttributeUniverse Source #
type PinSym0 = 'Pin :: AttributeUniverse Source #
type TransformationsSym0 = 'Transformations :: AttributeUniverse Source #
type StrokeSym0 = 'Stroke :: AttributeUniverse Source #
type FillSym0 = 'Fill :: AttributeUniverse Source #
type PenSym0 = 'Pen :: AttributeUniverse Source #
type SizeSym0 = 'Size :: AttributeUniverse Source #
type DashSym0 = 'Dash :: AttributeUniverse Source #
type LineCapSym0 = 'LineCap :: AttributeUniverse Source #
type LineJoinSym0 = 'LineJoin :: AttributeUniverse Source #
type FillRuleSym0 = 'FillRule :: AttributeUniverse Source #
type ArrowSym0 = 'Arrow :: AttributeUniverse Source #
type RArrowSym0 = 'RArrow :: AttributeUniverse Source #
type StrokeOpacitySym0 = 'StrokeOpacity :: AttributeUniverse Source #
type OpacitySym0 = 'Opacity :: AttributeUniverse Source #
type TilingSym0 = 'Tiling :: AttributeUniverse Source #
type GradientSym0 = 'Gradient :: AttributeUniverse Source #
type ClipSym0 = 'Clip :: AttributeUniverse Source #
data SAttributeUniverse z where Source #
type CommonAttributes = [Layer, Matrix, Pin, Transformations] Source #
IpeObjects may have attributes. Essentially attributes are (key,value) pairs. The key is some name. Which attributes an object can have depends on the type of the object. However, all ipe objects support the Common Attributes
type TextLabelAttributes = CommonAttributes Source #
All attributes applicable to TextLabels
type MiniPageAttributes = CommonAttributes Source #
All attributes applicable to Minipages
type ImageAttributes = CommonAttributes Source #
All attributes applicable to Images
type SymbolAttributes = CommonAttributes ++ [Stroke, Fill, Pen, Size] Source #
All attributes applicable to Symbols/Marks
type PathAttributes = CommonAttributes ++ [Stroke, Fill, Dash, Pen, LineCap, LineJoin, FillRule, Arrow, RArrow, StrokeOpacity, Opacity, Tiling, Gradient] Source #
All attributes applicable to Paths
type GroupAttributes = CommonAttributes ++ '['Clip] Source #
All attributes applicable to Groups
A single attribute Attr
newtype Attr (f :: TyFun u * -> *) (label :: u) Source #
Attr implements the mapping from labels to types as specified by the
(symbol representing) the type family f
Instances
Eq (Apply f label) => Eq (Attr f label) Source # | |
Ord (Apply f label) => Ord (Attr f label) Source # | |
Defined in Ipe.Attributes | |
Read (Apply f label) => Read (Attr f label) Source # | |
Show (Apply f label) => Show (Attr f label) Source # | |
Semigroup (Attr f l) Source # | Give pref. to the *RIGHT* |
Monoid (Attr f l) Source # | |
IpeReadText (Apply f at) => IpeReadAttr (Attr f at) Source # | |
Defined in Ipe.Reader ipeReadAttr :: Text -> Node Text Text -> Either ConversionError (Attr f at) Source # | |
IpeWriteText (Apply f at) => IpeWriteText (Attr f at) Source # | |
Defined in Ipe.Writer |
getAttr :: forall u (f :: TyFun u Type -> Type) (label :: u) u (f :: TyFun u Type -> Type) (label :: u). Iso (Attr (f :: TyFun u Type -> Type) (label :: u)) (Attr (f :: TyFun u Type -> Type) (label :: u)) (Maybe (Apply f label)) (Maybe (Apply f label)) Source #
pattern Attr :: Apply f label -> Attr f label Source #
Constructor for constructing an Attr given an actual value.
traverseAttr :: Applicative h => (Apply f label -> h (Apply g label)) -> Attr f label -> h (Attr g label) Source #
Traverse an attribute.
pureAttr :: (Applicative h, Apply f a ~ Apply g a) => Attr f a -> h (Attr g a) Source #
Traverse for the situation where the type is not actually parameterized.
Attributes
newtype Attributes (f :: TyFun u * -> *) (ats :: [u]) Source #
A collection of Attributes.
Instances
unAttrs :: Lens (Attributes f ats) (Attributes f' ats') (Rec (Attr f) ats) (Rec (Attr f') ats') Source #
Get a vinyl Record with Attrs
traverseAttrs :: Applicative h => (forall label. Attr f label -> h (Attr g label)) -> Attributes f ats -> h (Attributes g ats) Source #
Traverse implementation for Attrs
zipRecsWith :: (forall a. f a -> g a -> h a) -> Rec f as -> Rec g as -> Rec h as Source #
Zip two Recs with the given function.
ixAttr :: forall at ats proxy f. at ∈ ats => proxy at -> Lens' (Attributes f ats) (Maybe (Apply f at)) Source #
Lens into a specific attribute, if it is set.
_Attr :: forall at ats proxy f. (at ∈ ats, RecApplicative ats) => proxy at -> Prism' (Attributes f ats) (Apply f at) Source #
Prism into a particular attribute.
lookupAttr :: at ∈ ats => proxy at -> Attributes f ats -> Maybe (Apply f at) Source #
Looks up a particular attribute.
setAttr :: forall proxy at ats f. at ∈ ats => proxy at -> Apply f at -> Attributes f ats -> Attributes f ats Source #
Sets a particular attribute
takeAttr :: forall proxy at ats f. at ∈ ats => proxy at -> Attributes f ats -> (Maybe (Apply f at), Attributes f ats) Source #
gets and removes the attribute from Attributes
unSetAttr :: forall proxy at ats f. at ∈ ats => proxy at -> Attributes f ats -> Attributes f ats Source #
unsets/Removes an attribute
attr :: (at ∈ ats, RecApplicative ats) => proxy at -> Apply f at -> Attributes f ats Source #
Creates a singleton attribute
Implementations for Common Attributes
Possible values for Pin
data TransformationTypes Source #
Possible values for Transformation
Instances
Eq TransformationTypes Source # | |
Defined in Ipe.Attributes (==) :: TransformationTypes -> TransformationTypes -> Bool # (/=) :: TransformationTypes -> TransformationTypes -> Bool # | |
Read TransformationTypes Source # | |
Defined in Ipe.Attributes | |
Show TransformationTypes Source # | |
Defined in Ipe.Attributes showsPrec :: Int -> TransformationTypes -> ShowS # show :: TransformationTypes -> String # showList :: [TransformationTypes] -> ShowS # | |
IpeReadText TransformationTypes Source # | |
Defined in Ipe.Reader | |
IpeWriteText TransformationTypes Source # | |
Defined in Ipe.Writer |
Text Attributes
Symbol Attributes
The optional Attributes for a symbol data SymbolAttributeUniverse = SymbolStroke | SymbolFill | SymbolPen | Size deriving (Show,Eq)
Size
Instances
Functor IpeSize Source # | |
Foldable IpeSize Source # | |
Defined in Ipe.Attributes fold :: Monoid m => IpeSize m -> m # foldMap :: Monoid m => (a -> m) -> IpeSize a -> m # foldMap' :: Monoid m => (a -> m) -> IpeSize a -> m # foldr :: (a -> b -> b) -> b -> IpeSize a -> b # foldr' :: (a -> b -> b) -> b -> IpeSize a -> b # foldl :: (b -> a -> b) -> b -> IpeSize a -> b # foldl' :: (b -> a -> b) -> b -> IpeSize a -> b # foldr1 :: (a -> a -> a) -> IpeSize a -> a # foldl1 :: (a -> a -> a) -> IpeSize a -> a # elem :: Eq a => a -> IpeSize a -> Bool # maximum :: Ord a => IpeSize a -> a # minimum :: Ord a => IpeSize a -> a # | |
Traversable IpeSize Source # | |
Eq r => Eq (IpeSize r) Source # | |
Ord r => Ord (IpeSize r) Source # | |
Defined in Ipe.Attributes | |
Show r => Show (IpeSize r) Source # | |
Coordinate r => IpeReadText (IpeSize r) Source # | |
Defined in Ipe.Reader ipeReadText :: Text -> Either ConversionError (IpeSize r) Source # | |
IpeWriteText r => IpeWriteText (IpeSize r) Source # | |
Defined in Ipe.Writer |
Pen/Thickness
Instances
Functor IpePen Source # | |
Foldable IpePen Source # | |
Defined in Ipe.Attributes fold :: Monoid m => IpePen m -> m # foldMap :: Monoid m => (a -> m) -> IpePen a -> m # foldMap' :: Monoid m => (a -> m) -> IpePen a -> m # foldr :: (a -> b -> b) -> b -> IpePen a -> b # foldr' :: (a -> b -> b) -> b -> IpePen a -> b # foldl :: (b -> a -> b) -> b -> IpePen a -> b # foldl' :: (b -> a -> b) -> b -> IpePen a -> b # foldr1 :: (a -> a -> a) -> IpePen a -> a # foldl1 :: (a -> a -> a) -> IpePen a -> a # elem :: Eq a => a -> IpePen a -> Bool # maximum :: Ord a => IpePen a -> a # minimum :: Ord a => IpePen a -> a # | |
Traversable IpePen Source # | |
Eq r => Eq (IpePen r) Source # | |
Ord r => Ord (IpePen r) Source # | |
Defined in Ipe.Attributes | |
Show r => Show (IpePen r) Source # | |
Coordinate r => IpeReadText (IpePen r) Source # | |
Defined in Ipe.Reader ipeReadText :: Text -> Either ConversionError (IpePen r) Source # | |
IpeWriteText r => IpeWriteText (IpePen r) Source # | |
Defined in Ipe.Writer |
Path Attributes
Possible values for Dash
DashNamed Text | |
DashPattern [r] r |
Instances
Functor IpeDash Source # | |
Foldable IpeDash Source # | |
Defined in Ipe.Attributes fold :: Monoid m => IpeDash m -> m # foldMap :: Monoid m => (a -> m) -> IpeDash a -> m # foldMap' :: Monoid m => (a -> m) -> IpeDash a -> m # foldr :: (a -> b -> b) -> b -> IpeDash a -> b # foldr' :: (a -> b -> b) -> b -> IpeDash a -> b # foldl :: (b -> a -> b) -> b -> IpeDash a -> b # foldl' :: (b -> a -> b) -> b -> IpeDash a -> b # foldr1 :: (a -> a -> a) -> IpeDash a -> a # foldl1 :: (a -> a -> a) -> IpeDash a -> a # elem :: Eq a => a -> IpeDash a -> Bool # maximum :: Ord a => IpeDash a -> a # minimum :: Ord a => IpeDash a -> a # | |
Traversable IpeDash Source # | |
Eq r => Eq (IpeDash r) Source # | |
Show r => Show (IpeDash r) Source # | |
Coordinate r => IpeReadText (IpeDash r) Source # | |
Defined in Ipe.Reader ipeReadText :: Text -> Either ConversionError (IpeDash r) Source # | |
IpeWriteText r => IpeWriteText (IpeDash r) Source # | |
Defined in Ipe.Writer |
Allowed Fill types
type IpeOpacity = Text Source #
IpeOpacity, IpeTyling, and IpeGradient are all symbolic values
type IpeGradient = Text Source #
Possible values for an ipe arrow
IpeArrow | |
|
Instances
Functor IpeArrow Source # | |
Foldable IpeArrow Source # | |
Defined in Ipe.Attributes fold :: Monoid m => IpeArrow m -> m # foldMap :: Monoid m => (a -> m) -> IpeArrow a -> m # foldMap' :: Monoid m => (a -> m) -> IpeArrow a -> m # foldr :: (a -> b -> b) -> b -> IpeArrow a -> b # foldr' :: (a -> b -> b) -> b -> IpeArrow a -> b # foldl :: (b -> a -> b) -> b -> IpeArrow a -> b # foldl' :: (b -> a -> b) -> b -> IpeArrow a -> b # foldr1 :: (a -> a -> a) -> IpeArrow a -> a # foldl1 :: (a -> a -> a) -> IpeArrow a -> a # elem :: Eq a => a -> IpeArrow a -> Bool # maximum :: Ord a => IpeArrow a -> a # minimum :: Ord a => IpeArrow a -> a # | |
Traversable IpeArrow Source # | |
Eq r => Eq (IpeArrow r) Source # | |
Show r => Show (IpeArrow r) Source # | |
Coordinate r => IpeReadText (IpeArrow r) Source # | |
Defined in Ipe.Reader ipeReadText :: Text -> Either ConversionError (IpeArrow r) Source # | |
IpeWriteText r => IpeWriteText (IpeArrow r) Source # | |
Defined in Ipe.Writer |
normalArrow :: IpeArrow r Source #
A normal arrow
Group Attributes
Attribute names in Ipe
class IpeAttrName (a :: AttributeUniverse) where Source #
For the types representing attribute values we can get the name/key to use when serializing to ipe.
Instances
IpeAttrName 'Layer Source # | |
IpeAttrName 'Matrix Source # | |
IpeAttrName 'Pin Source # | |
IpeAttrName 'Transformations Source # | |
Defined in Ipe.Attributes attrName :: proxy 'Transformations -> Text Source # | |
IpeAttrName 'Stroke Source # | |
IpeAttrName 'Fill Source # | |
IpeAttrName 'Pen Source # | |
IpeAttrName 'Size Source # | |
IpeAttrName 'Dash Source # | |
IpeAttrName 'LineCap Source # | |
IpeAttrName 'LineJoin Source # | |
IpeAttrName 'FillRule Source # | |
IpeAttrName 'Arrow Source # | |
IpeAttrName 'RArrow Source # | |
IpeAttrName 'StrokeOpacity Source # | |
Defined in Ipe.Attributes attrName :: proxy 'StrokeOpacity -> Text Source # | |
IpeAttrName 'Opacity Source # | |
IpeAttrName 'Tiling Source # | |
IpeAttrName 'Gradient Source # | |
IpeAttrName 'Clip Source # | |
writeAttrNames :: AllConstrained IpeAttrName rs => Rec f rs -> Rec (Const Text) rs Source #
Writing Attribute names