{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Ipe.Attributes
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Possible Attributes we can assign to items in an Ipe file
--
--------------------------------------------------------------------------------
module Data.Geometry.Ipe.Attributes where

import Control.Lens hiding (rmap, Const)
import Data.Geometry.Ipe.Value
import Data.Singletons
import Data.Singletons.TH
import Data.Text (Text)
import Data.Vinyl
import Data.Vinyl.TypeLevel
import Data.Vinyl.Functor
import Text.Read (lexP, step, parens, prec, (+++)
                , Lexeme(Ident), readPrec, readListPrec, readListPrecDefault)

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


data AttributeUniverse = -- common
                         Layer | Matrix | Pin | Transformations
                       -- symbol
                       | Stroke | Fill | Pen | Size
                       -- Path
                       | Dash | LineCap | LineJoin
                       | FillRule | Arrow | RArrow | Opacity | Tiling | Gradient
                       -- Group
                       | Clip
                       -- Extra
--                       | X Text
                       deriving (Int -> AttributeUniverse -> ShowS
[AttributeUniverse] -> ShowS
AttributeUniverse -> String
(Int -> AttributeUniverse -> ShowS)
-> (AttributeUniverse -> String)
-> ([AttributeUniverse] -> ShowS)
-> Show AttributeUniverse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeUniverse] -> ShowS
$cshowList :: [AttributeUniverse] -> ShowS
show :: AttributeUniverse -> String
$cshow :: AttributeUniverse -> String
showsPrec :: Int -> AttributeUniverse -> ShowS
$cshowsPrec :: Int -> AttributeUniverse -> ShowS
Show,ReadPrec [AttributeUniverse]
ReadPrec AttributeUniverse
Int -> ReadS AttributeUniverse
ReadS [AttributeUniverse]
(Int -> ReadS AttributeUniverse)
-> ReadS [AttributeUniverse]
-> ReadPrec AttributeUniverse
-> ReadPrec [AttributeUniverse]
-> Read AttributeUniverse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeUniverse]
$creadListPrec :: ReadPrec [AttributeUniverse]
readPrec :: ReadPrec AttributeUniverse
$creadPrec :: ReadPrec AttributeUniverse
readList :: ReadS [AttributeUniverse]
$creadList :: ReadS [AttributeUniverse]
readsPrec :: Int -> ReadS AttributeUniverse
$creadsPrec :: Int -> ReadS AttributeUniverse
Read,AttributeUniverse -> AttributeUniverse -> Bool
(AttributeUniverse -> AttributeUniverse -> Bool)
-> (AttributeUniverse -> AttributeUniverse -> Bool)
-> Eq AttributeUniverse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeUniverse -> AttributeUniverse -> Bool
$c/= :: AttributeUniverse -> AttributeUniverse -> Bool
== :: AttributeUniverse -> AttributeUniverse -> Bool
$c== :: AttributeUniverse -> AttributeUniverse -> Bool
Eq)


genSingletons [ ''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, Opacity, Tiling, Gradient
                      ]

type GroupAttributes = CommonAttributes ++ '[ 'Clip]



--------------------------------------------------------------------------------
-- * Attr

-- | Attr implements the mapping from labels to types as specified by the
-- (symbol representing) the type family 'f'
newtype Attr (f :: TyFun u * -> *) -- Symbol repr. the Type family mapping
                                   -- Labels in universe u to concrete types
             (label :: u) = GAttr { Attr f label -> Maybe (Apply f label)
_getAttr :: Maybe (Apply f label) }


deriving instance Eq   (Apply f label) => Eq   (Attr f label)
deriving instance Ord  (Apply f label) => Ord  (Attr f label)

makeLenses ''Attr

-- | Constructor for constructing an Attr given an actual value.
pattern Attr   :: Apply f label -> Attr f label
pattern $bAttr :: Apply f label -> Attr f label
$mAttr :: forall r u (f :: u ~> *) (label :: u).
Attr f label -> (Apply f label -> r) -> (Void# -> r) -> r
Attr x = GAttr (Just x)

-- | An Attribute that is not set
pattern NoAttr :: Attr f label
pattern $bNoAttr :: Attr f label
$mNoAttr :: forall r u (f :: TyFun u * -> *) (label :: u).
Attr f label -> (Void# -> r) -> (Void# -> r) -> r
NoAttr = GAttr Nothing
{-# COMPLETE NoAttr, Attr #-}


traverseAttr   :: Applicative h => (Apply f label -> h (Apply g label))
               -> Attr f label -> h (Attr g label)
traverseAttr :: (Apply f label -> h (Apply g label))
-> Attr f label -> h (Attr g label)
traverseAttr Apply f label -> h (Apply g label)
f = \case
  Attr Apply f label
x -> Apply g label -> Attr g label
forall u (f :: u ~> *) (label :: u). Apply f label -> Attr f label
Attr (Apply g label -> Attr g label)
-> h (Apply g label) -> h (Attr g label)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Apply f label -> h (Apply g label)
f Apply f label
x
  Attr f label
NoAttr -> Attr g label -> h (Attr g label)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attr g label
forall u (f :: TyFun u * -> *) (label :: u). Attr f label
NoAttr

-- | Traverse for the situation where the type is not actually parameterized.
pureAttr :: (Applicative h, Apply f a ~ Apply g a) => Attr f a -> h (Attr g a)
pureAttr :: Attr f a -> h (Attr g a)
pureAttr = Attr g a -> h (Attr g a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attr g a -> h (Attr g a))
-> (Attr f a -> Attr g a) -> Attr f a -> h (Attr g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Attr Apply f a
a -> Apply g a -> Attr g a
forall u (f :: u ~> *) (label :: u). Apply f label -> Attr f label
Attr Apply f a
Apply g a
a
    Attr f a
NoAttr -> Attr g a
forall u (f :: TyFun u * -> *) (label :: u). Attr f label
NoAttr


instance Show (Apply f label) => Show (Attr f label) where
  showsPrec :: Int -> Attr f label -> ShowS
showsPrec Int
d Attr f label
NoAttr   = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"NoAttr"
    where app_prec :: Int
app_prec = Int
10
  showsPrec Int
d (Attr Apply f label
a) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
up_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                           String -> ShowS
showString String
"Attr " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Apply f label -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
up_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Apply f label
a
    where up_prec :: Int
up_prec  = Int
5

instance Read (Apply f label) => Read (Attr f label) where
  readPrec :: ReadPrec (Attr f label)
readPrec = ReadPrec (Attr f label) -> ReadPrec (Attr f label)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Attr f label) -> ReadPrec (Attr f label))
-> ReadPrec (Attr f label) -> ReadPrec (Attr f label)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadPrec (Attr f label) -> ReadPrec (Attr f label)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec (ReadPrec (Attr f label) -> ReadPrec (Attr f label))
-> ReadPrec (Attr f label) -> ReadPrec (Attr f label)
forall a b. (a -> b) -> a -> b
$ do
                                         Ident String
"NoAttr" <- ReadPrec Lexeme
lexP
                                         Attr f label -> ReadPrec (Attr f label)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attr f label
forall u (f :: TyFun u * -> *) (label :: u). Attr f label
NoAttr)
                  ReadPrec (Attr f label)
-> ReadPrec (Attr f label) -> ReadPrec (Attr f label)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ (Int -> ReadPrec (Attr f label) -> ReadPrec (Attr f label)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
up_prec (ReadPrec (Attr f label) -> ReadPrec (Attr f label))
-> ReadPrec (Attr f label) -> ReadPrec (Attr f label)
forall a b. (a -> b) -> a -> b
$ do
                                         Ident String
"Attr" <- ReadPrec Lexeme
lexP
                                         Apply f label
a <- ReadPrec (Apply f label) -> ReadPrec (Apply f label)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (Apply f label)
forall a. Read a => ReadPrec a
readPrec
                                         Attr f label -> ReadPrec (Attr f label)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attr f label -> ReadPrec (Attr f label))
-> Attr f label -> ReadPrec (Attr f label)
forall a b. (a -> b) -> a -> b
$ Apply f label -> Attr f label
forall u (f :: u ~> *) (label :: u). Apply f label -> Attr f label
Attr Apply f label
a)
    where
      app_prec :: Int
app_prec = Int
10
      up_prec :: Int
up_prec = Int
5
  readListPrec :: ReadPrec [Attr f label]
readListPrec = ReadPrec [Attr f label]
forall a. Read a => ReadPrec [a]
readListPrecDefault



-- | Give pref. to the *RIGHT*
instance Semigroup (Attr f l) where
  Attr f l
_ <> :: Attr f l -> Attr f l -> Attr f l
<> b :: Attr f l
b@(Attr Apply f l
_) = Attr f l
b
  Attr f l
a <> Attr f l
_          = Attr f l
a

instance Monoid (Attr f l) where
  mempty :: Attr f l
mempty  = Attr f l
forall u (f :: TyFun u * -> *) (label :: u). Attr f label
NoAttr
  mappend :: Attr f l -> Attr f l -> Attr f l
mappend = Attr f l -> Attr f l -> Attr f l
forall a. Semigroup a => a -> a -> a
(<>)

--------------------------------------------------------------------------------
-- * Attributes

-- | A collection of Attributes.
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')
unAttrs :: (Rec (Attr f) ats -> f (Rec (Attr f') ats'))
-> Attributes f ats -> f (Attributes f' ats')
unAttrs = (Attributes f ats -> Rec (Attr f) ats)
-> (Attributes f ats -> Rec (Attr f') ats' -> Attributes f' ats')
-> Lens
     (Attributes f ats)
     (Attributes f' ats')
     (Rec (Attr f) ats)
     (Rec (Attr f') ats')
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Attrs Rec (Attr f) ats
r) -> Rec (Attr f) ats
r) ((Rec (Attr f') ats' -> Attributes f' ats')
-> Attributes f ats -> Rec (Attr f') ats' -> Attributes f' ats'
forall a b. a -> b -> a
const Rec (Attr f') ats' -> Attributes f' ats'
forall u (f :: TyFun u * -> *) (ats :: [u]).
Rec (Attr f) ats -> Attributes f ats
Attrs)

deriving instance ( RMap ats, ReifyConstraint Show (Attr f) ats, RecordToList ats
                  , RecAll (Attr f) ats Show) => Show (Attributes f ats)
-- deriving instance (RecAll (Attr f) ats Read) => Read (Attributes f ats)

instance ( ReifyConstraint Eq (Attr f) ats, RecordToList ats
         , RecAll (Attr f) ats Eq)   => Eq   (Attributes f ats) where
  (Attrs Rec (Attr f) ats
a) == :: Attributes f ats -> Attributes f ats -> Bool
== (Attrs Rec (Attr f) ats
b) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool)
-> (Rec (Attr f) ats -> [Bool]) -> Rec (Attr f) ats -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (Const Bool) ats -> [Bool]
forall u (rs :: [u]) a. RecordToList rs => Rec (Const a) rs -> [a]
recordToList
                         (Rec (Const Bool) ats -> [Bool])
-> (Rec (Attr f) ats -> Rec (Const Bool) ats)
-> Rec (Attr f) ats
-> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: u).
 Attr f a -> (:.) (Dict Eq) (Attr f) a -> Const Bool a)
-> Rec (Attr f) ats
-> Rec (Dict Eq :. Attr f) ats
-> Rec (Const Bool) ats
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 (\Attr f a
x (Compose (Dict y)) -> Bool -> Const Bool a
forall k a (b :: k). a -> Const a b
Const (Bool -> Const Bool a) -> Bool -> Const Bool a
forall a b. (a -> b) -> a -> b
$ Attr f a
x Attr f a -> Attr f a -> Bool
forall a. Eq a => a -> a -> Bool
== Attr f a
y) Rec (Attr f) ats
a
                         (Rec (Dict Eq :. Attr f) ats -> Rec (Const Bool) ats)
-> (Rec (Attr f) ats -> Rec (Dict Eq :. Attr f) ats)
-> Rec (Attr f) ats
-> Rec (Const Bool) ats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall u (c :: * -> Constraint) (f :: u -> *) (rs :: [u]).
ReifyConstraint c f rs =>
Rec f rs -> Rec (Dict c :. f) rs
forall (f :: u -> *) (rs :: [u]).
ReifyConstraint Eq f rs =>
Rec f rs -> Rec (Dict Eq :. f) rs
reifyConstraint @Eq) (Rec (Attr f) ats -> Bool) -> Rec (Attr f) ats -> Bool
forall a b. (a -> b) -> a -> b
$ Rec (Attr f) ats
b

instance RecApplicative ats => Monoid (Attributes f ats) where
  mempty :: Attributes f ats
mempty        = Rec (Attr f) ats -> Attributes f ats
forall u (f :: TyFun u * -> *) (ats :: [u]).
Rec (Attr f) ats -> Attributes f ats
Attrs (Rec (Attr f) ats -> Attributes f ats)
-> Rec (Attr f) ats -> Attributes f ats
forall a b. (a -> b) -> a -> b
$ (forall (x :: u). Attr f x) -> Rec (Attr f) ats
forall u (rs :: [u]) (f :: u -> *).
RecApplicative rs =>
(forall (x :: u). f x) -> Rec f rs
rpure forall (x :: u). Attr f x
forall a. Monoid a => a
mempty
  Attributes f ats
a mappend :: Attributes f ats -> Attributes f ats -> Attributes f ats
`mappend` Attributes f ats
b = Attributes f ats
a Attributes f ats -> Attributes f ats -> Attributes f ats
forall a. Semigroup a => a -> a -> a
<> Attributes f ats
b

instance Semigroup (Attributes f ats) where
  (Attrs Rec (Attr f) ats
as) <> :: Attributes f ats -> Attributes f ats -> Attributes f ats
<> (Attrs Rec (Attr f) ats
bs) = Rec (Attr f) ats -> Attributes f ats
forall u (f :: TyFun u * -> *) (ats :: [u]).
Rec (Attr f) ats -> Attributes f ats
Attrs (Rec (Attr f) ats -> Attributes f ats)
-> Rec (Attr f) ats -> Attributes f ats
forall a b. (a -> b) -> a -> b
$ (forall (a :: u). Attr f a -> Attr f a -> Attr f a)
-> Rec (Attr f) ats -> Rec (Attr f) ats -> Rec (Attr f) ats
forall u (f :: u -> *) (g :: u -> *) (h :: u -> *) (as :: [u]).
(forall (a :: u). f a -> g a -> h a)
-> Rec f as -> Rec g as -> Rec h as
zipRecsWith forall (a :: u). Attr f a -> Attr f a -> Attr f a
forall a. Monoid a => a -> a -> a
mappend Rec (Attr f) ats
as Rec (Attr f) ats
bs

traverseAttrs               :: Applicative h
                            => (forall label. Attr f label -> h (Attr g label))
                            -> Attributes f ats -> h (Attributes g ats)
traverseAttrs :: (forall (label :: u). Attr f label -> h (Attr g label))
-> Attributes f ats -> h (Attributes g ats)
traverseAttrs forall (label :: u). Attr f label -> h (Attr g label)
f (Attrs Rec (Attr f) ats
ats) = Rec (Attr g) ats -> Attributes g ats
forall u (f :: TyFun u * -> *) (ats :: [u]).
Rec (Attr f) ats -> Attributes f ats
Attrs (Rec (Attr g) ats -> Attributes g ats)
-> h (Rec (Attr g) ats) -> h (Attributes g ats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (label :: u). Attr f label -> h (Attr g label))
-> Rec (Attr f) ats -> h (Rec (Attr g) ats)
forall u (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
rtraverse forall (label :: u). Attr f label -> h (Attr g label)
f Rec (Attr f) ats
ats



zipRecsWith                       :: (forall a. f a -> g a -> h a)
                                  -> Rec f as -> Rec g as -> Rec h as
zipRecsWith :: (forall (a :: u). f a -> g a -> h a)
-> Rec f as -> Rec g as -> Rec h as
zipRecsWith forall (a :: u). f a -> g a -> h a
_ Rec f as
RNil      Rec g as
_         = Rec h as
forall u (a :: u -> *). Rec a '[]
RNil
zipRecsWith forall (a :: u). f a -> g a -> h a
f (f r
r :& Rec f rs
rs) (g r
s :& Rec g rs
ss) = f r -> g r -> h r
forall (a :: u). f a -> g a -> h a
f f r
r g r
g r
s h r -> Rec h rs -> Rec h (r : rs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (forall (a :: u). f a -> g a -> h a)
-> Rec f rs -> Rec g rs -> Rec h rs
forall u (f :: u -> *) (g :: u -> *) (h :: u -> *) (as :: [u]).
(forall (a :: u). f a -> g a -> h a)
-> Rec f as -> Rec g as -> Rec h as
zipRecsWith forall (a :: u). f a -> g a -> h a
f Rec f rs
rs Rec g rs
Rec g rs
ss


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

-- | Lens into a specific attribute, if it is set.
ixAttr   :: forall at ats proxy f. (at ∈ ats)
         => proxy at -> Lens' (Attributes f ats) (Maybe (Apply f at))
ixAttr :: proxy at -> Lens' (Attributes f ats) (Maybe (Apply f at))
ixAttr proxy at
_ = (Rec (Attr f) ats -> f (Rec (Attr f) ats))
-> Attributes f ats -> f (Attributes f ats)
forall u u (f :: TyFun u * -> *) (ats :: [u])
       (f' :: TyFun u * -> *) (ats' :: [u]).
Lens
  (Attributes f ats)
  (Attributes f' ats')
  (Rec (Attr f) ats)
  (Rec (Attr f') ats')
unAttrs((Rec (Attr f) ats -> f (Rec (Attr f) ats))
 -> Attributes f ats -> f (Attributes f ats))
-> ((Maybe (Apply f at) -> f (Maybe (Apply f at)))
    -> Rec (Attr f) ats -> f (Rec (Attr f) ats))
-> (Maybe (Apply f at) -> f (Maybe (Apply f at)))
-> Attributes f ats
-> f (Attributes f ats)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall k (r :: k) (record :: (k -> *) -> [k] -> *) (rs :: [k])
       (f :: k -> *) (g :: * -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f,
 Functor g) =>
(f r -> g (f r)) -> record f rs -> g (record f rs)
forall (record :: (k1 -> *) -> [k1] -> *) (rs :: [k1])
       (f :: k1 -> *) (g :: * -> *).
(RecElem record at at rs rs (RIndex at rs), RecElemFCtx record f,
 Functor g) =>
(f at -> g (f at)) -> record f rs -> g (record f rs)
rlens @at)((Attr f at -> f (Attr f at))
 -> Rec (Attr f) ats -> f (Rec (Attr f) ats))
-> ((Maybe (Apply f at) -> f (Maybe (Apply f at)))
    -> Attr f at -> f (Attr f at))
-> (Maybe (Apply f at) -> f (Maybe (Apply f at)))
-> Rec (Attr f) ats
-> f (Rec (Attr f) ats)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Apply f at) -> f (Maybe (Apply f at)))
-> Attr f at -> f (Attr f at)
forall u (f :: TyFun u * -> *) (label :: u) u (f :: TyFun u * -> *)
       (label :: u).
Iso
  (Attr f label)
  (Attr f label)
  (Maybe (Apply f label))
  (Maybe (Apply f label))
getAttr

-- | Prism into a particular attribute.
_Attr   :: forall at ats proxy f. (at ∈ ats, RecApplicative ats)
         => proxy at -> Prism' (Attributes f ats) (Apply f at)
_Attr :: proxy at -> Prism' (Attributes f ats) (Apply f at)
_Attr proxy at
a = (Apply f at -> Attributes f ats)
-> (Attributes f ats -> Maybe (Apply f at))
-> Prism' (Attributes f ats) (Apply f at)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Apply f at -> Attributes f ats
setA Attributes f ats -> Maybe (Apply f at)
getA
  where
    setA :: Apply f at -> Attributes f ats
setA Apply f at
x = proxy at -> Apply f at -> Attributes f ats -> Attributes f ats
forall u (proxy :: u -> *) (at :: u) (ats :: [u]) (f :: u ~> *).
(at ∈ ats) =>
proxy at -> Apply f at -> Attributes f ats -> Attributes f ats
setAttr proxy at
a Apply f at
x Attributes f ats
forall a. Monoid a => a
mempty
    getA :: Attributes f ats -> Maybe (Apply f at)
getA = proxy at -> Attributes f ats -> Maybe (Apply f at)
forall k1 (at :: k1) (ats :: [k1]) (proxy :: k1 -> *)
       (f :: TyFun k1 * -> *).
(at ∈ ats) =>
proxy at -> Attributes f ats -> Maybe (Apply f at)
lookupAttr proxy at
a

-- | Looks up a particular attribute.
lookupAttr   :: (at ∈ ats) => proxy at -> Attributes f ats -> Maybe (Apply f at)
lookupAttr :: proxy at -> Attributes f ats -> Maybe (Apply f at)
lookupAttr proxy at
p = Getting
  (Maybe (Apply f at)) (Attributes f ats) (Maybe (Apply f at))
-> Attributes f ats -> Maybe (Apply f at)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (proxy at -> Lens' (Attributes f ats) (Maybe (Apply f at))
forall k1 (at :: k1) (ats :: [k1]) (proxy :: k1 -> *)
       (f :: TyFun k1 * -> *).
(at ∈ ats) =>
proxy at -> Lens' (Attributes f ats) (Maybe (Apply f at))
ixAttr proxy at
p)

-- | Sets a particular attribute
setAttr               :: forall proxy at ats f. (at ∈ ats)
                      => proxy at -> Apply f at -> Attributes f ats -> Attributes f ats
setAttr :: proxy at -> Apply f at -> Attributes f ats -> Attributes f ats
setAttr proxy at
_ Apply f at
a (Attrs Rec (Attr f) ats
r) = Rec (Attr f) ats -> Attributes f ats
forall u (f :: TyFun u * -> *) (ats :: [u]).
Rec (Attr f) ats -> Attributes f ats
Attrs (Rec (Attr f) ats -> Attributes f ats)
-> Rec (Attr f) ats -> Attributes f ats
forall a b. (a -> b) -> a -> b
$ Attr f at -> Rec (Attr f) ats -> Rec (Attr f) ats
forall k (r :: k) (rs :: [k]) (record :: (k -> *) -> [k] -> *)
       (f :: k -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
f r -> record f rs -> record f rs
rput (Apply f at -> Attr f at
forall u (f :: u ~> *) (label :: u). Apply f label -> Attr f label
Attr Apply f at
a :: Attr f at) Rec (Attr f) ats
r


-- | gets and removes the attribute from Attributes
takeAttr       :: forall proxy at ats f. (at ∈ ats)
               => proxy at -> Attributes f ats -> ( Maybe (Apply f at)
                                                  , Attributes f ats )
takeAttr :: proxy at
-> Attributes f ats -> (Maybe (Apply f at), Attributes f ats)
takeAttr proxy at
p Attributes f ats
ats = (proxy at -> Attributes f ats -> Maybe (Apply f at)
forall k1 (at :: k1) (ats :: [k1]) (proxy :: k1 -> *)
       (f :: TyFun k1 * -> *).
(at ∈ ats) =>
proxy at -> Attributes f ats -> Maybe (Apply f at)
lookupAttr proxy at
p Attributes f ats
ats, Attributes f ats
atsAttributes f ats
-> (Attributes f ats -> Attributes f ats) -> Attributes f ats
forall a b. a -> (a -> b) -> b
&proxy at -> Lens' (Attributes f ats) (Maybe (Apply f at))
forall k1 (at :: k1) (ats :: [k1]) (proxy :: k1 -> *)
       (f :: TyFun k1 * -> *).
(at ∈ ats) =>
proxy at -> Lens' (Attributes f ats) (Maybe (Apply f at))
ixAttr proxy at
p ((Maybe (Apply f at) -> Identity (Maybe (Apply f at)))
 -> Attributes f ats -> Identity (Attributes f ats))
-> Maybe (Apply f at) -> Attributes f ats -> Attributes f ats
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Apply f at)
forall a. Maybe a
Nothing)

-- | unsets/Removes an attribute
unSetAttr   :: forall proxy at ats f. (at ∈ ats)
            => proxy at -> Attributes f ats -> Attributes f ats
unSetAttr :: proxy at -> Attributes f ats -> Attributes f ats
unSetAttr proxy at
p = (Maybe (Apply f at), Attributes f ats) -> Attributes f ats
forall a b. (a, b) -> b
snd ((Maybe (Apply f at), Attributes f ats) -> Attributes f ats)
-> (Attributes f ats -> (Maybe (Apply f at), Attributes f ats))
-> Attributes f ats
-> Attributes f ats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy at
-> Attributes f ats -> (Maybe (Apply f at), Attributes f ats)
forall u (proxy :: u -> *) (at :: u) (ats :: [u])
       (f :: TyFun u * -> *).
(at ∈ ats) =>
proxy at
-> Attributes f ats -> (Maybe (Apply f at), Attributes f ats)
takeAttr proxy at
p

-- | Creates a singleton attribute
attr     :: (at ∈ ats, RecApplicative ats)
         => proxy at -> Apply f at -> Attributes f ats
attr :: proxy at -> Apply f at -> Attributes f ats
attr proxy at
p Apply f at
x = Apply f at
xApply f at
-> Getting (Attributes f ats) (Apply f at) (Attributes f ats)
-> Attributes f ats
forall s a. s -> Getting a s a -> a
^.AReview (Attributes f ats) (Apply f at)
-> Getter (Apply f at) (Attributes f ats)
forall t b. AReview t b -> Getter b t
re (proxy at -> Prism' (Attributes f ats) (Apply f at)
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 proxy at
p)

--------------------------------------------------------------------------------
-- | Common Attributes

-- 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 following
-- 'common attributes':

-- data CommonAttributeUniverse = Layer | Matrix | Pin | Transformations
--                              deriving (Show,Read,Eq)

-- | Possible values for Pin
data PinType = No | Yes | Horizontal | Vertical
             deriving (PinType -> PinType -> Bool
(PinType -> PinType -> Bool)
-> (PinType -> PinType -> Bool) -> Eq PinType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PinType -> PinType -> Bool
$c/= :: PinType -> PinType -> Bool
== :: PinType -> PinType -> Bool
$c== :: PinType -> PinType -> Bool
Eq,Int -> PinType -> ShowS
[PinType] -> ShowS
PinType -> String
(Int -> PinType -> ShowS)
-> (PinType -> String) -> ([PinType] -> ShowS) -> Show PinType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PinType] -> ShowS
$cshowList :: [PinType] -> ShowS
show :: PinType -> String
$cshow :: PinType -> String
showsPrec :: Int -> PinType -> ShowS
$cshowsPrec :: Int -> PinType -> ShowS
Show,ReadPrec [PinType]
ReadPrec PinType
Int -> ReadS PinType
ReadS [PinType]
(Int -> ReadS PinType)
-> ReadS [PinType]
-> ReadPrec PinType
-> ReadPrec [PinType]
-> Read PinType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PinType]
$creadListPrec :: ReadPrec [PinType]
readPrec :: ReadPrec PinType
$creadPrec :: ReadPrec PinType
readList :: ReadS [PinType]
$creadList :: ReadS [PinType]
readsPrec :: Int -> ReadS PinType
$creadsPrec :: Int -> ReadS PinType
Read)

-- | Possible values for Transformation
data TransformationTypes = Affine | Rigid | Translations deriving (Int -> TransformationTypes -> ShowS
[TransformationTypes] -> ShowS
TransformationTypes -> String
(Int -> TransformationTypes -> ShowS)
-> (TransformationTypes -> String)
-> ([TransformationTypes] -> ShowS)
-> Show TransformationTypes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransformationTypes] -> ShowS
$cshowList :: [TransformationTypes] -> ShowS
show :: TransformationTypes -> String
$cshow :: TransformationTypes -> String
showsPrec :: Int -> TransformationTypes -> ShowS
$cshowsPrec :: Int -> TransformationTypes -> ShowS
Show,ReadPrec [TransformationTypes]
ReadPrec TransformationTypes
Int -> ReadS TransformationTypes
ReadS [TransformationTypes]
(Int -> ReadS TransformationTypes)
-> ReadS [TransformationTypes]
-> ReadPrec TransformationTypes
-> ReadPrec [TransformationTypes]
-> Read TransformationTypes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TransformationTypes]
$creadListPrec :: ReadPrec [TransformationTypes]
readPrec :: ReadPrec TransformationTypes
$creadPrec :: ReadPrec TransformationTypes
readList :: ReadS [TransformationTypes]
$creadList :: ReadS [TransformationTypes]
readsPrec :: Int -> ReadS TransformationTypes
$creadsPrec :: Int -> ReadS TransformationTypes
Read,TransformationTypes -> TransformationTypes -> Bool
(TransformationTypes -> TransformationTypes -> Bool)
-> (TransformationTypes -> TransformationTypes -> Bool)
-> Eq TransformationTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransformationTypes -> TransformationTypes -> Bool
$c/= :: TransformationTypes -> TransformationTypes -> Bool
== :: TransformationTypes -> TransformationTypes -> Bool
$c== :: TransformationTypes -> TransformationTypes -> Bool
Eq)

-- type family CommonAttrElf (r :: *) (f :: CommonAttributeUniverse)where
--   CommonAttrElf r 'Layer          = Text
--   CommonAttrElf r 'Matrix         = Matrix 3 3 r
--   CommonAttrElf r Pin             = PinType
--   CommonAttrElf r Transformations = TransformationTypes

-- genDefunSymbols [''CommonAttrElf]


-- type CommonAttributes r =
--   Attributes (CommonAttrElfSym1 r) [ 'Layer, 'Matrix, Pin, Transformations ]

--------------------------------------------------------------------------------
-- Text Attributes

-- these Attributes are speicifc to IpeObjects representing TextLabels and
-- MiniPages. The same structure as for the `CommonAttributes' applies here.

-- | TODO

--------------------------------------------------------------------------------
-- | Symbol Attributes

-- | The optional Attributes for a symbol
-- data SymbolAttributeUniverse = SymbolStroke | SymbolFill | SymbolPen | Size
--                              deriving (Show,Eq)

newtype IpeSize  r = IpeSize  (IpeValue r) deriving (Int -> IpeSize r -> ShowS
[IpeSize r] -> ShowS
IpeSize r -> String
(Int -> IpeSize r -> ShowS)
-> (IpeSize r -> String)
-> ([IpeSize r] -> ShowS)
-> Show (IpeSize r)
forall r. Show r => Int -> IpeSize r -> ShowS
forall r. Show r => [IpeSize r] -> ShowS
forall r. Show r => IpeSize r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpeSize r] -> ShowS
$cshowList :: forall r. Show r => [IpeSize r] -> ShowS
show :: IpeSize r -> String
$cshow :: forall r. Show r => IpeSize r -> String
showsPrec :: Int -> IpeSize r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> IpeSize r -> ShowS
Show,IpeSize r -> IpeSize r -> Bool
(IpeSize r -> IpeSize r -> Bool)
-> (IpeSize r -> IpeSize r -> Bool) -> Eq (IpeSize r)
forall r. Eq r => IpeSize r -> IpeSize r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpeSize r -> IpeSize r -> Bool
$c/= :: forall r. Eq r => IpeSize r -> IpeSize r -> Bool
== :: IpeSize r -> IpeSize r -> Bool
$c== :: forall r. Eq r => IpeSize r -> IpeSize r -> Bool
Eq,Eq (IpeSize r)
Eq (IpeSize r)
-> (IpeSize r -> IpeSize r -> Ordering)
-> (IpeSize r -> IpeSize r -> Bool)
-> (IpeSize r -> IpeSize r -> Bool)
-> (IpeSize r -> IpeSize r -> Bool)
-> (IpeSize r -> IpeSize r -> Bool)
-> (IpeSize r -> IpeSize r -> IpeSize r)
-> (IpeSize r -> IpeSize r -> IpeSize r)
-> Ord (IpeSize r)
IpeSize r -> IpeSize r -> Bool
IpeSize r -> IpeSize r -> Ordering
IpeSize r -> IpeSize r -> IpeSize r
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
forall r. Ord r => Eq (IpeSize r)
forall r. Ord r => IpeSize r -> IpeSize r -> Bool
forall r. Ord r => IpeSize r -> IpeSize r -> Ordering
forall r. Ord r => IpeSize r -> IpeSize r -> IpeSize r
min :: IpeSize r -> IpeSize r -> IpeSize r
$cmin :: forall r. Ord r => IpeSize r -> IpeSize r -> IpeSize r
max :: IpeSize r -> IpeSize r -> IpeSize r
$cmax :: forall r. Ord r => IpeSize r -> IpeSize r -> IpeSize r
>= :: IpeSize r -> IpeSize r -> Bool
$c>= :: forall r. Ord r => IpeSize r -> IpeSize r -> Bool
> :: IpeSize r -> IpeSize r -> Bool
$c> :: forall r. Ord r => IpeSize r -> IpeSize r -> Bool
<= :: IpeSize r -> IpeSize r -> Bool
$c<= :: forall r. Ord r => IpeSize r -> IpeSize r -> Bool
< :: IpeSize r -> IpeSize r -> Bool
$c< :: forall r. Ord r => IpeSize r -> IpeSize r -> Bool
compare :: IpeSize r -> IpeSize r -> Ordering
$ccompare :: forall r. Ord r => IpeSize r -> IpeSize r -> Ordering
$cp1Ord :: forall r. Ord r => Eq (IpeSize r)
Ord,a -> IpeSize b -> IpeSize a
(a -> b) -> IpeSize a -> IpeSize b
(forall a b. (a -> b) -> IpeSize a -> IpeSize b)
-> (forall a b. a -> IpeSize b -> IpeSize a) -> Functor IpeSize
forall a b. a -> IpeSize b -> IpeSize a
forall a b. (a -> b) -> IpeSize a -> IpeSize b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> IpeSize b -> IpeSize a
$c<$ :: forall a b. a -> IpeSize b -> IpeSize a
fmap :: (a -> b) -> IpeSize a -> IpeSize b
$cfmap :: forall a b. (a -> b) -> IpeSize a -> IpeSize b
Functor,a -> IpeSize a -> Bool
IpeSize m -> m
IpeSize a -> [a]
IpeSize a -> Bool
IpeSize a -> Int
IpeSize a -> a
IpeSize a -> a
IpeSize a -> a
IpeSize a -> a
(a -> m) -> IpeSize a -> m
(a -> m) -> IpeSize a -> m
(a -> b -> b) -> b -> IpeSize a -> b
(a -> b -> b) -> b -> IpeSize a -> b
(b -> a -> b) -> b -> IpeSize a -> b
(b -> a -> b) -> b -> IpeSize a -> b
(a -> a -> a) -> IpeSize a -> a
(a -> a -> a) -> IpeSize a -> a
(forall m. Monoid m => IpeSize m -> m)
-> (forall m a. Monoid m => (a -> m) -> IpeSize a -> m)
-> (forall m a. Monoid m => (a -> m) -> IpeSize a -> m)
-> (forall a b. (a -> b -> b) -> b -> IpeSize a -> b)
-> (forall a b. (a -> b -> b) -> b -> IpeSize a -> b)
-> (forall b a. (b -> a -> b) -> b -> IpeSize a -> b)
-> (forall b a. (b -> a -> b) -> b -> IpeSize a -> b)
-> (forall a. (a -> a -> a) -> IpeSize a -> a)
-> (forall a. (a -> a -> a) -> IpeSize a -> a)
-> (forall a. IpeSize a -> [a])
-> (forall a. IpeSize a -> Bool)
-> (forall a. IpeSize a -> Int)
-> (forall a. Eq a => a -> IpeSize a -> Bool)
-> (forall a. Ord a => IpeSize a -> a)
-> (forall a. Ord a => IpeSize a -> a)
-> (forall a. Num a => IpeSize a -> a)
-> (forall a. Num a => IpeSize a -> a)
-> Foldable IpeSize
forall a. Eq a => a -> IpeSize a -> Bool
forall a. Num a => IpeSize a -> a
forall a. Ord a => IpeSize a -> a
forall m. Monoid m => IpeSize m -> m
forall a. IpeSize a -> Bool
forall a. IpeSize a -> Int
forall a. IpeSize a -> [a]
forall a. (a -> a -> a) -> IpeSize a -> a
forall m a. Monoid m => (a -> m) -> IpeSize a -> m
forall b a. (b -> a -> b) -> b -> IpeSize a -> b
forall a b. (a -> b -> b) -> b -> IpeSize a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: IpeSize a -> a
$cproduct :: forall a. Num a => IpeSize a -> a
sum :: IpeSize a -> a
$csum :: forall a. Num a => IpeSize a -> a
minimum :: IpeSize a -> a
$cminimum :: forall a. Ord a => IpeSize a -> a
maximum :: IpeSize a -> a
$cmaximum :: forall a. Ord a => IpeSize a -> a
elem :: a -> IpeSize a -> Bool
$celem :: forall a. Eq a => a -> IpeSize a -> Bool
length :: IpeSize a -> Int
$clength :: forall a. IpeSize a -> Int
null :: IpeSize a -> Bool
$cnull :: forall a. IpeSize a -> Bool
toList :: IpeSize a -> [a]
$ctoList :: forall a. IpeSize a -> [a]
foldl1 :: (a -> a -> a) -> IpeSize a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> IpeSize a -> a
foldr1 :: (a -> a -> a) -> IpeSize a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> IpeSize a -> a
foldl' :: (b -> a -> b) -> b -> IpeSize a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> IpeSize a -> b
foldl :: (b -> a -> b) -> b -> IpeSize a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> IpeSize a -> b
foldr' :: (a -> b -> b) -> b -> IpeSize a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> IpeSize a -> b
foldr :: (a -> b -> b) -> b -> IpeSize a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> IpeSize a -> b
foldMap' :: (a -> m) -> IpeSize a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> IpeSize a -> m
foldMap :: (a -> m) -> IpeSize a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> IpeSize a -> m
fold :: IpeSize m -> m
$cfold :: forall m. Monoid m => IpeSize m -> m
Foldable,Functor IpeSize
Foldable IpeSize
Functor IpeSize
-> Foldable IpeSize
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> IpeSize a -> f (IpeSize b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    IpeSize (f a) -> f (IpeSize a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> IpeSize a -> m (IpeSize b))
-> (forall (m :: * -> *) a.
    Monad m =>
    IpeSize (m a) -> m (IpeSize a))
-> Traversable IpeSize
(a -> f b) -> IpeSize a -> f (IpeSize b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => IpeSize (m a) -> m (IpeSize a)
forall (f :: * -> *) a.
Applicative f =>
IpeSize (f a) -> f (IpeSize a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IpeSize a -> m (IpeSize b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IpeSize a -> f (IpeSize b)
sequence :: IpeSize (m a) -> m (IpeSize a)
$csequence :: forall (m :: * -> *) a. Monad m => IpeSize (m a) -> m (IpeSize a)
mapM :: (a -> m b) -> IpeSize a -> m (IpeSize b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IpeSize a -> m (IpeSize b)
sequenceA :: IpeSize (f a) -> f (IpeSize a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
IpeSize (f a) -> f (IpeSize a)
traverse :: (a -> f b) -> IpeSize a -> f (IpeSize b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IpeSize a -> f (IpeSize b)
$cp2Traversable :: Foldable IpeSize
$cp1Traversable :: Functor IpeSize
Traversable)
newtype IpePen   r = IpePen   (IpeValue r) deriving (Int -> IpePen r -> ShowS
[IpePen r] -> ShowS
IpePen r -> String
(Int -> IpePen r -> ShowS)
-> (IpePen r -> String) -> ([IpePen r] -> ShowS) -> Show (IpePen r)
forall r. Show r => Int -> IpePen r -> ShowS
forall r. Show r => [IpePen r] -> ShowS
forall r. Show r => IpePen r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpePen r] -> ShowS
$cshowList :: forall r. Show r => [IpePen r] -> ShowS
show :: IpePen r -> String
$cshow :: forall r. Show r => IpePen r -> String
showsPrec :: Int -> IpePen r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> IpePen r -> ShowS
Show,IpePen r -> IpePen r -> Bool
(IpePen r -> IpePen r -> Bool)
-> (IpePen r -> IpePen r -> Bool) -> Eq (IpePen r)
forall r. Eq r => IpePen r -> IpePen r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpePen r -> IpePen r -> Bool
$c/= :: forall r. Eq r => IpePen r -> IpePen r -> Bool
== :: IpePen r -> IpePen r -> Bool
$c== :: forall r. Eq r => IpePen r -> IpePen r -> Bool
Eq,Eq (IpePen r)
Eq (IpePen r)
-> (IpePen r -> IpePen r -> Ordering)
-> (IpePen r -> IpePen r -> Bool)
-> (IpePen r -> IpePen r -> Bool)
-> (IpePen r -> IpePen r -> Bool)
-> (IpePen r -> IpePen r -> Bool)
-> (IpePen r -> IpePen r -> IpePen r)
-> (IpePen r -> IpePen r -> IpePen r)
-> Ord (IpePen r)
IpePen r -> IpePen r -> Bool
IpePen r -> IpePen r -> Ordering
IpePen r -> IpePen r -> IpePen r
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
forall r. Ord r => Eq (IpePen r)
forall r. Ord r => IpePen r -> IpePen r -> Bool
forall r. Ord r => IpePen r -> IpePen r -> Ordering
forall r. Ord r => IpePen r -> IpePen r -> IpePen r
min :: IpePen r -> IpePen r -> IpePen r
$cmin :: forall r. Ord r => IpePen r -> IpePen r -> IpePen r
max :: IpePen r -> IpePen r -> IpePen r
$cmax :: forall r. Ord r => IpePen r -> IpePen r -> IpePen r
>= :: IpePen r -> IpePen r -> Bool
$c>= :: forall r. Ord r => IpePen r -> IpePen r -> Bool
> :: IpePen r -> IpePen r -> Bool
$c> :: forall r. Ord r => IpePen r -> IpePen r -> Bool
<= :: IpePen r -> IpePen r -> Bool
$c<= :: forall r. Ord r => IpePen r -> IpePen r -> Bool
< :: IpePen r -> IpePen r -> Bool
$c< :: forall r. Ord r => IpePen r -> IpePen r -> Bool
compare :: IpePen r -> IpePen r -> Ordering
$ccompare :: forall r. Ord r => IpePen r -> IpePen r -> Ordering
$cp1Ord :: forall r. Ord r => Eq (IpePen r)
Ord,a -> IpePen b -> IpePen a
(a -> b) -> IpePen a -> IpePen b
(forall a b. (a -> b) -> IpePen a -> IpePen b)
-> (forall a b. a -> IpePen b -> IpePen a) -> Functor IpePen
forall a b. a -> IpePen b -> IpePen a
forall a b. (a -> b) -> IpePen a -> IpePen b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> IpePen b -> IpePen a
$c<$ :: forall a b. a -> IpePen b -> IpePen a
fmap :: (a -> b) -> IpePen a -> IpePen b
$cfmap :: forall a b. (a -> b) -> IpePen a -> IpePen b
Functor,a -> IpePen a -> Bool
IpePen m -> m
IpePen a -> [a]
IpePen a -> Bool
IpePen a -> Int
IpePen a -> a
IpePen a -> a
IpePen a -> a
IpePen a -> a
(a -> m) -> IpePen a -> m
(a -> m) -> IpePen a -> m
(a -> b -> b) -> b -> IpePen a -> b
(a -> b -> b) -> b -> IpePen a -> b
(b -> a -> b) -> b -> IpePen a -> b
(b -> a -> b) -> b -> IpePen a -> b
(a -> a -> a) -> IpePen a -> a
(a -> a -> a) -> IpePen a -> a
(forall m. Monoid m => IpePen m -> m)
-> (forall m a. Monoid m => (a -> m) -> IpePen a -> m)
-> (forall m a. Monoid m => (a -> m) -> IpePen a -> m)
-> (forall a b. (a -> b -> b) -> b -> IpePen a -> b)
-> (forall a b. (a -> b -> b) -> b -> IpePen a -> b)
-> (forall b a. (b -> a -> b) -> b -> IpePen a -> b)
-> (forall b a. (b -> a -> b) -> b -> IpePen a -> b)
-> (forall a. (a -> a -> a) -> IpePen a -> a)
-> (forall a. (a -> a -> a) -> IpePen a -> a)
-> (forall a. IpePen a -> [a])
-> (forall a. IpePen a -> Bool)
-> (forall a. IpePen a -> Int)
-> (forall a. Eq a => a -> IpePen a -> Bool)
-> (forall a. Ord a => IpePen a -> a)
-> (forall a. Ord a => IpePen a -> a)
-> (forall a. Num a => IpePen a -> a)
-> (forall a. Num a => IpePen a -> a)
-> Foldable IpePen
forall a. Eq a => a -> IpePen a -> Bool
forall a. Num a => IpePen a -> a
forall a. Ord a => IpePen a -> a
forall m. Monoid m => IpePen m -> m
forall a. IpePen a -> Bool
forall a. IpePen a -> Int
forall a. IpePen a -> [a]
forall a. (a -> a -> a) -> IpePen a -> a
forall m a. Monoid m => (a -> m) -> IpePen a -> m
forall b a. (b -> a -> b) -> b -> IpePen a -> b
forall a b. (a -> b -> b) -> b -> IpePen a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: IpePen a -> a
$cproduct :: forall a. Num a => IpePen a -> a
sum :: IpePen a -> a
$csum :: forall a. Num a => IpePen a -> a
minimum :: IpePen a -> a
$cminimum :: forall a. Ord a => IpePen a -> a
maximum :: IpePen a -> a
$cmaximum :: forall a. Ord a => IpePen a -> a
elem :: a -> IpePen a -> Bool
$celem :: forall a. Eq a => a -> IpePen a -> Bool
length :: IpePen a -> Int
$clength :: forall a. IpePen a -> Int
null :: IpePen a -> Bool
$cnull :: forall a. IpePen a -> Bool
toList :: IpePen a -> [a]
$ctoList :: forall a. IpePen a -> [a]
foldl1 :: (a -> a -> a) -> IpePen a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> IpePen a -> a
foldr1 :: (a -> a -> a) -> IpePen a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> IpePen a -> a
foldl' :: (b -> a -> b) -> b -> IpePen a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> IpePen a -> b
foldl :: (b -> a -> b) -> b -> IpePen a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> IpePen a -> b
foldr' :: (a -> b -> b) -> b -> IpePen a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> IpePen a -> b
foldr :: (a -> b -> b) -> b -> IpePen a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> IpePen a -> b
foldMap' :: (a -> m) -> IpePen a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> IpePen a -> m
foldMap :: (a -> m) -> IpePen a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> IpePen a -> m
fold :: IpePen m -> m
$cfold :: forall m. Monoid m => IpePen m -> m
Foldable,Functor IpePen
Foldable IpePen
Functor IpePen
-> Foldable IpePen
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> IpePen a -> f (IpePen b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    IpePen (f a) -> f (IpePen a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> IpePen a -> m (IpePen b))
-> (forall (m :: * -> *) a.
    Monad m =>
    IpePen (m a) -> m (IpePen a))
-> Traversable IpePen
(a -> f b) -> IpePen a -> f (IpePen b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => IpePen (m a) -> m (IpePen a)
forall (f :: * -> *) a.
Applicative f =>
IpePen (f a) -> f (IpePen a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IpePen a -> m (IpePen b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IpePen a -> f (IpePen b)
sequence :: IpePen (m a) -> m (IpePen a)
$csequence :: forall (m :: * -> *) a. Monad m => IpePen (m a) -> m (IpePen a)
mapM :: (a -> m b) -> IpePen a -> m (IpePen b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IpePen a -> m (IpePen b)
sequenceA :: IpePen (f a) -> f (IpePen a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
IpePen (f a) -> f (IpePen a)
traverse :: (a -> f b) -> IpePen a -> f (IpePen b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IpePen a -> f (IpePen b)
$cp2Traversable :: Foldable IpePen
$cp1Traversable :: Functor IpePen
Traversable)


-- -- | And the corresponding types
-- type family SymbolAttrElf (r :: *) (s :: SymbolAttributeUniverse) :: * where
--   SymbolAttrElf r SymbolStroke = IpeColor
--   SymbolAttrElf r SymbolPen    = IpePen r
--   SymbolAttrElf r SymbolFill   = IpeColor
--   SymbolAttrElf r Size         = IpeSize r

-- genDefunSymbols [''SymbolAttrElf]


-- type SymbolAttributes r = [SymbolStroke, SymbolFill, SymbolPen, Size]

-- type SymbolAttributes r =
--   Attributes (SymbolAttrElfSym1 r) [SymbolStroke, SymbolFill, SymbolPen, Size]

-------------------------------------------------------------------------------
-- | Path Attributes

-- | Possible attributes for a path
-- data PathAttributeUniverse = Stroke | Fill | Dash | Pen | LineCap | LineJoin
--                            | FillRule | Arrow | RArrow | Opacity | Tiling | Gradient
--                            deriving (Show,Eq)


-- | Possible values for Dash
data IpeDash r = DashNamed Text
               | DashPattern [r] r
               deriving (Int -> IpeDash r -> ShowS
[IpeDash r] -> ShowS
IpeDash r -> String
(Int -> IpeDash r -> ShowS)
-> (IpeDash r -> String)
-> ([IpeDash r] -> ShowS)
-> Show (IpeDash r)
forall r. Show r => Int -> IpeDash r -> ShowS
forall r. Show r => [IpeDash r] -> ShowS
forall r. Show r => IpeDash r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpeDash r] -> ShowS
$cshowList :: forall r. Show r => [IpeDash r] -> ShowS
show :: IpeDash r -> String
$cshow :: forall r. Show r => IpeDash r -> String
showsPrec :: Int -> IpeDash r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> IpeDash r -> ShowS
Show,IpeDash r -> IpeDash r -> Bool
(IpeDash r -> IpeDash r -> Bool)
-> (IpeDash r -> IpeDash r -> Bool) -> Eq (IpeDash r)
forall r. Eq r => IpeDash r -> IpeDash r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpeDash r -> IpeDash r -> Bool
$c/= :: forall r. Eq r => IpeDash r -> IpeDash r -> Bool
== :: IpeDash r -> IpeDash r -> Bool
$c== :: forall r. Eq r => IpeDash r -> IpeDash r -> Bool
Eq,a -> IpeDash b -> IpeDash a
(a -> b) -> IpeDash a -> IpeDash b
(forall a b. (a -> b) -> IpeDash a -> IpeDash b)
-> (forall a b. a -> IpeDash b -> IpeDash a) -> Functor IpeDash
forall a b. a -> IpeDash b -> IpeDash a
forall a b. (a -> b) -> IpeDash a -> IpeDash b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> IpeDash b -> IpeDash a
$c<$ :: forall a b. a -> IpeDash b -> IpeDash a
fmap :: (a -> b) -> IpeDash a -> IpeDash b
$cfmap :: forall a b. (a -> b) -> IpeDash a -> IpeDash b
Functor,IpeDash a -> Bool
(a -> m) -> IpeDash a -> m
(a -> b -> b) -> b -> IpeDash a -> b
(forall m. Monoid m => IpeDash m -> m)
-> (forall m a. Monoid m => (a -> m) -> IpeDash a -> m)
-> (forall m a. Monoid m => (a -> m) -> IpeDash a -> m)
-> (forall a b. (a -> b -> b) -> b -> IpeDash a -> b)
-> (forall a b. (a -> b -> b) -> b -> IpeDash a -> b)
-> (forall b a. (b -> a -> b) -> b -> IpeDash a -> b)
-> (forall b a. (b -> a -> b) -> b -> IpeDash a -> b)
-> (forall a. (a -> a -> a) -> IpeDash a -> a)
-> (forall a. (a -> a -> a) -> IpeDash a -> a)
-> (forall a. IpeDash a -> [a])
-> (forall a. IpeDash a -> Bool)
-> (forall a. IpeDash a -> Int)
-> (forall a. Eq a => a -> IpeDash a -> Bool)
-> (forall a. Ord a => IpeDash a -> a)
-> (forall a. Ord a => IpeDash a -> a)
-> (forall a. Num a => IpeDash a -> a)
-> (forall a. Num a => IpeDash a -> a)
-> Foldable IpeDash
forall a. Eq a => a -> IpeDash a -> Bool
forall a. Num a => IpeDash a -> a
forall a. Ord a => IpeDash a -> a
forall m. Monoid m => IpeDash m -> m
forall a. IpeDash a -> Bool
forall a. IpeDash a -> Int
forall a. IpeDash a -> [a]
forall a. (a -> a -> a) -> IpeDash a -> a
forall m a. Monoid m => (a -> m) -> IpeDash a -> m
forall b a. (b -> a -> b) -> b -> IpeDash a -> b
forall a b. (a -> b -> b) -> b -> IpeDash a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: IpeDash a -> a
$cproduct :: forall a. Num a => IpeDash a -> a
sum :: IpeDash a -> a
$csum :: forall a. Num a => IpeDash a -> a
minimum :: IpeDash a -> a
$cminimum :: forall a. Ord a => IpeDash a -> a
maximum :: IpeDash a -> a
$cmaximum :: forall a. Ord a => IpeDash a -> a
elem :: a -> IpeDash a -> Bool
$celem :: forall a. Eq a => a -> IpeDash a -> Bool
length :: IpeDash a -> Int
$clength :: forall a. IpeDash a -> Int
null :: IpeDash a -> Bool
$cnull :: forall a. IpeDash a -> Bool
toList :: IpeDash a -> [a]
$ctoList :: forall a. IpeDash a -> [a]
foldl1 :: (a -> a -> a) -> IpeDash a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> IpeDash a -> a
foldr1 :: (a -> a -> a) -> IpeDash a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> IpeDash a -> a
foldl' :: (b -> a -> b) -> b -> IpeDash a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> IpeDash a -> b
foldl :: (b -> a -> b) -> b -> IpeDash a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> IpeDash a -> b
foldr' :: (a -> b -> b) -> b -> IpeDash a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> IpeDash a -> b
foldr :: (a -> b -> b) -> b -> IpeDash a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> IpeDash a -> b
foldMap' :: (a -> m) -> IpeDash a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> IpeDash a -> m
foldMap :: (a -> m) -> IpeDash a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> IpeDash a -> m
fold :: IpeDash m -> m
$cfold :: forall m. Monoid m => IpeDash m -> m
Foldable,Functor IpeDash
Foldable IpeDash
Functor IpeDash
-> Foldable IpeDash
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> IpeDash a -> f (IpeDash b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    IpeDash (f a) -> f (IpeDash a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> IpeDash a -> m (IpeDash b))
-> (forall (m :: * -> *) a.
    Monad m =>
    IpeDash (m a) -> m (IpeDash a))
-> Traversable IpeDash
(a -> f b) -> IpeDash a -> f (IpeDash b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => IpeDash (m a) -> m (IpeDash a)
forall (f :: * -> *) a.
Applicative f =>
IpeDash (f a) -> f (IpeDash a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IpeDash a -> m (IpeDash b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IpeDash a -> f (IpeDash b)
sequence :: IpeDash (m a) -> m (IpeDash a)
$csequence :: forall (m :: * -> *) a. Monad m => IpeDash (m a) -> m (IpeDash a)
mapM :: (a -> m b) -> IpeDash a -> m (IpeDash b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IpeDash a -> m (IpeDash b)
sequenceA :: IpeDash (f a) -> f (IpeDash a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
IpeDash (f a) -> f (IpeDash a)
traverse :: (a -> f b) -> IpeDash a -> f (IpeDash b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IpeDash a -> f (IpeDash b)
$cp2Traversable :: Foldable IpeDash
$cp1Traversable :: Functor IpeDash
Traversable)

-- | Allowed Fill types
data FillType = Wind | EOFill deriving (Int -> FillType -> ShowS
[FillType] -> ShowS
FillType -> String
(Int -> FillType -> ShowS)
-> (FillType -> String) -> ([FillType] -> ShowS) -> Show FillType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FillType] -> ShowS
$cshowList :: [FillType] -> ShowS
show :: FillType -> String
$cshow :: FillType -> String
showsPrec :: Int -> FillType -> ShowS
$cshowsPrec :: Int -> FillType -> ShowS
Show,ReadPrec [FillType]
ReadPrec FillType
Int -> ReadS FillType
ReadS [FillType]
(Int -> ReadS FillType)
-> ReadS [FillType]
-> ReadPrec FillType
-> ReadPrec [FillType]
-> Read FillType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FillType]
$creadListPrec :: ReadPrec [FillType]
readPrec :: ReadPrec FillType
$creadPrec :: ReadPrec FillType
readList :: ReadS [FillType]
$creadList :: ReadS [FillType]
readsPrec :: Int -> ReadS FillType
$creadsPrec :: Int -> ReadS FillType
Read,FillType -> FillType -> Bool
(FillType -> FillType -> Bool)
-> (FillType -> FillType -> Bool) -> Eq FillType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FillType -> FillType -> Bool
$c/= :: FillType -> FillType -> Bool
== :: FillType -> FillType -> Bool
$c== :: FillType -> FillType -> Bool
Eq)

-- | IpeOpacity, IpeTyling, and IpeGradient are all symbolic values
type IpeOpacity  = Text
type IpeTiling   = Text
type IpeGradient = Text

-- | Possible values for an ipe arrow
data IpeArrow r = IpeArrow { IpeArrow r -> Text
_arrowName :: Text
                           , IpeArrow r -> IpeSize r
_arrowSize :: IpeSize r
                           } deriving (Int -> IpeArrow r -> ShowS
[IpeArrow r] -> ShowS
IpeArrow r -> String
(Int -> IpeArrow r -> ShowS)
-> (IpeArrow r -> String)
-> ([IpeArrow r] -> ShowS)
-> Show (IpeArrow r)
forall r. Show r => Int -> IpeArrow r -> ShowS
forall r. Show r => [IpeArrow r] -> ShowS
forall r. Show r => IpeArrow r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpeArrow r] -> ShowS
$cshowList :: forall r. Show r => [IpeArrow r] -> ShowS
show :: IpeArrow r -> String
$cshow :: forall r. Show r => IpeArrow r -> String
showsPrec :: Int -> IpeArrow r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> IpeArrow r -> ShowS
Show,IpeArrow r -> IpeArrow r -> Bool
(IpeArrow r -> IpeArrow r -> Bool)
-> (IpeArrow r -> IpeArrow r -> Bool) -> Eq (IpeArrow r)
forall r. Eq r => IpeArrow r -> IpeArrow r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpeArrow r -> IpeArrow r -> Bool
$c/= :: forall r. Eq r => IpeArrow r -> IpeArrow r -> Bool
== :: IpeArrow r -> IpeArrow r -> Bool
$c== :: forall r. Eq r => IpeArrow r -> IpeArrow r -> Bool
Eq,a -> IpeArrow b -> IpeArrow a
(a -> b) -> IpeArrow a -> IpeArrow b
(forall a b. (a -> b) -> IpeArrow a -> IpeArrow b)
-> (forall a b. a -> IpeArrow b -> IpeArrow a) -> Functor IpeArrow
forall a b. a -> IpeArrow b -> IpeArrow a
forall a b. (a -> b) -> IpeArrow a -> IpeArrow b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> IpeArrow b -> IpeArrow a
$c<$ :: forall a b. a -> IpeArrow b -> IpeArrow a
fmap :: (a -> b) -> IpeArrow a -> IpeArrow b
$cfmap :: forall a b. (a -> b) -> IpeArrow a -> IpeArrow b
Functor,IpeArrow a -> Bool
(a -> m) -> IpeArrow a -> m
(a -> b -> b) -> b -> IpeArrow a -> b
(forall m. Monoid m => IpeArrow m -> m)
-> (forall m a. Monoid m => (a -> m) -> IpeArrow a -> m)
-> (forall m a. Monoid m => (a -> m) -> IpeArrow a -> m)
-> (forall a b. (a -> b -> b) -> b -> IpeArrow a -> b)
-> (forall a b. (a -> b -> b) -> b -> IpeArrow a -> b)
-> (forall b a. (b -> a -> b) -> b -> IpeArrow a -> b)
-> (forall b a. (b -> a -> b) -> b -> IpeArrow a -> b)
-> (forall a. (a -> a -> a) -> IpeArrow a -> a)
-> (forall a. (a -> a -> a) -> IpeArrow a -> a)
-> (forall a. IpeArrow a -> [a])
-> (forall a. IpeArrow a -> Bool)
-> (forall a. IpeArrow a -> Int)
-> (forall a. Eq a => a -> IpeArrow a -> Bool)
-> (forall a. Ord a => IpeArrow a -> a)
-> (forall a. Ord a => IpeArrow a -> a)
-> (forall a. Num a => IpeArrow a -> a)
-> (forall a. Num a => IpeArrow a -> a)
-> Foldable IpeArrow
forall a. Eq a => a -> IpeArrow a -> Bool
forall a. Num a => IpeArrow a -> a
forall a. Ord a => IpeArrow a -> a
forall m. Monoid m => IpeArrow m -> m
forall a. IpeArrow a -> Bool
forall a. IpeArrow a -> Int
forall a. IpeArrow a -> [a]
forall a. (a -> a -> a) -> IpeArrow a -> a
forall m a. Monoid m => (a -> m) -> IpeArrow a -> m
forall b a. (b -> a -> b) -> b -> IpeArrow a -> b
forall a b. (a -> b -> b) -> b -> IpeArrow a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: IpeArrow a -> a
$cproduct :: forall a. Num a => IpeArrow a -> a
sum :: IpeArrow a -> a
$csum :: forall a. Num a => IpeArrow a -> a
minimum :: IpeArrow a -> a
$cminimum :: forall a. Ord a => IpeArrow a -> a
maximum :: IpeArrow a -> a
$cmaximum :: forall a. Ord a => IpeArrow a -> a
elem :: a -> IpeArrow a -> Bool
$celem :: forall a. Eq a => a -> IpeArrow a -> Bool
length :: IpeArrow a -> Int
$clength :: forall a. IpeArrow a -> Int
null :: IpeArrow a -> Bool
$cnull :: forall a. IpeArrow a -> Bool
toList :: IpeArrow a -> [a]
$ctoList :: forall a. IpeArrow a -> [a]
foldl1 :: (a -> a -> a) -> IpeArrow a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> IpeArrow a -> a
foldr1 :: (a -> a -> a) -> IpeArrow a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> IpeArrow a -> a
foldl' :: (b -> a -> b) -> b -> IpeArrow a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> IpeArrow a -> b
foldl :: (b -> a -> b) -> b -> IpeArrow a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> IpeArrow a -> b
foldr' :: (a -> b -> b) -> b -> IpeArrow a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> IpeArrow a -> b
foldr :: (a -> b -> b) -> b -> IpeArrow a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> IpeArrow a -> b
foldMap' :: (a -> m) -> IpeArrow a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> IpeArrow a -> m
foldMap :: (a -> m) -> IpeArrow a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> IpeArrow a -> m
fold :: IpeArrow m -> m
$cfold :: forall m. Monoid m => IpeArrow m -> m
Foldable,Functor IpeArrow
Foldable IpeArrow
Functor IpeArrow
-> Foldable IpeArrow
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> IpeArrow a -> f (IpeArrow b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    IpeArrow (f a) -> f (IpeArrow a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> IpeArrow a -> m (IpeArrow b))
-> (forall (m :: * -> *) a.
    Monad m =>
    IpeArrow (m a) -> m (IpeArrow a))
-> Traversable IpeArrow
(a -> f b) -> IpeArrow a -> f (IpeArrow b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => IpeArrow (m a) -> m (IpeArrow a)
forall (f :: * -> *) a.
Applicative f =>
IpeArrow (f a) -> f (IpeArrow a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IpeArrow a -> m (IpeArrow b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IpeArrow a -> f (IpeArrow b)
sequence :: IpeArrow (m a) -> m (IpeArrow a)
$csequence :: forall (m :: * -> *) a. Monad m => IpeArrow (m a) -> m (IpeArrow a)
mapM :: (a -> m b) -> IpeArrow a -> m (IpeArrow b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IpeArrow a -> m (IpeArrow b)
sequenceA :: IpeArrow (f a) -> f (IpeArrow a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
IpeArrow (f a) -> f (IpeArrow a)
traverse :: (a -> f b) -> IpeArrow a -> f (IpeArrow b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IpeArrow a -> f (IpeArrow b)
$cp2Traversable :: Foldable IpeArrow
$cp1Traversable :: Functor IpeArrow
Traversable)
makeLenses ''IpeArrow

normalArrow :: IpeArrow r
normalArrow :: IpeArrow r
normalArrow = Text -> IpeSize r -> IpeArrow r
forall r. Text -> IpeSize r -> IpeArrow r
IpeArrow Text
"normal" (IpeValue r -> IpeSize r
forall r. IpeValue r -> IpeSize r
IpeSize (IpeValue r -> IpeSize r) -> IpeValue r -> IpeSize r
forall a b. (a -> b) -> a -> b
$ Text -> IpeValue r
forall v. Text -> IpeValue v
Named Text
"normal/normal")

--------------------------------------------------------------------------------
-- | Group Attributes

-- | The only group attribute is a Clip
-- data GroupAttributeUniverse = Clip deriving (Show,Read,Eq,Ord)

-- A clipping path is a Path. Which is defined in Data.Geometry.Ipe.Types. To
-- avoid circular imports, we define GroupAttrElf and GroupAttribute there.

--------------------------------------------------------------------------------
-- * Attribute names in Ipe


-- | For the types representing attribute values we can get the name/key to use
-- when serializing to ipe.
class IpeAttrName (a :: AttributeUniverse) where
  attrName :: proxy a -> Text

-- CommonAttributeUnivers
instance IpeAttrName Layer           where attrName :: proxy 'Layer -> Text
attrName proxy 'Layer
_ = Text
"layer"
instance IpeAttrName Matrix          where attrName :: proxy 'Matrix -> Text
attrName proxy 'Matrix
_ = Text
"matrix"
instance IpeAttrName Pin             where attrName :: proxy 'Pin -> Text
attrName proxy 'Pin
_ = Text
"pin"
instance IpeAttrName Transformations where attrName :: proxy 'Transformations -> Text
attrName proxy 'Transformations
_ = Text
"transformations"

-- IpeSymbolAttributeUniversre
instance IpeAttrName Stroke       where attrName :: proxy 'Stroke -> Text
attrName proxy 'Stroke
_ = Text
"stroke"
instance IpeAttrName Fill         where attrName :: proxy 'Fill -> Text
attrName proxy 'Fill
_ = Text
"fill"
instance IpeAttrName Pen          where attrName :: proxy 'Pen -> Text
attrName proxy 'Pen
_ = Text
"pen"
instance IpeAttrName Size         where attrName :: proxy 'Size -> Text
attrName proxy 'Size
_ = Text
"size"

-- PathAttributeUniverse
instance IpeAttrName Dash       where attrName :: proxy 'Dash -> Text
attrName proxy 'Dash
_ = Text
"dash"
instance IpeAttrName LineCap    where attrName :: proxy 'LineCap -> Text
attrName proxy 'LineCap
_ = Text
"cap"
instance IpeAttrName LineJoin   where attrName :: proxy 'LineJoin -> Text
attrName proxy 'LineJoin
_ = Text
"join"
instance IpeAttrName FillRule   where attrName :: proxy 'FillRule -> Text
attrName proxy 'FillRule
_ = Text
"fillrule"
instance IpeAttrName Arrow      where attrName :: proxy 'Arrow -> Text
attrName proxy 'Arrow
_ = Text
"arrow"
instance IpeAttrName RArrow     where attrName :: proxy 'RArrow -> Text
attrName proxy 'RArrow
_ = Text
"rarrow"
instance IpeAttrName Opacity    where attrName :: proxy 'Opacity -> Text
attrName proxy 'Opacity
_ = Text
"opacity"
instance IpeAttrName Tiling     where attrName :: proxy 'Tiling -> Text
attrName proxy 'Tiling
_ = Text
"tiling"
instance IpeAttrName Gradient   where attrName :: proxy 'Gradient -> Text
attrName proxy 'Gradient
_ = Text
"gradient"

-- GroupAttributeUniverse
instance IpeAttrName Clip     where attrName :: proxy 'Clip -> Text
attrName proxy 'Clip
_ = Text
"clip"


-- -- | Function that states that all elements in xs satisfy a given constraint c
-- type family AllSatisfy (c :: k -> Constraint) (xs :: [k]) :: Constraint where
--   AllSatisfy c '[] = ()
--   AllSatisfy c (x ': xs) = (c x, AllSatisfy c xs)


-- | Writing Attribute names
writeAttrNames           :: AllConstrained IpeAttrName rs => Rec f rs -> Rec (Const Text) rs
writeAttrNames :: Rec f rs -> Rec (Const Text) rs
writeAttrNames Rec f rs
RNil      = Rec (Const Text) rs
forall u (a :: u -> *). Rec a '[]
RNil
writeAttrNames (f r
x :& Rec f rs
xs) = Text -> Const Text r
forall k a (b :: k). a -> Const a b
Const (f r -> Text
forall (f :: AttributeUniverse -> *) (s :: AttributeUniverse).
IpeAttrName s =>
f s -> Text
write'' f r
x) Const Text r -> Rec (Const Text) rs -> Rec (Const Text) (r : rs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec f rs -> Rec (Const Text) rs
forall (rs :: [AttributeUniverse]) (f :: AttributeUniverse -> *).
AllConstrained IpeAttrName rs =>
Rec f rs -> Rec (Const Text) rs
writeAttrNames Rec f rs
xs
  where
    write''   :: forall f s. IpeAttrName s => f s -> Text
    write'' :: f s -> Text
write'' f s
_ = Proxy s -> Text
forall (a :: AttributeUniverse) (proxy :: AttributeUniverse -> *).
IpeAttrName a =>
proxy a -> Text
attrName (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)

--

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