module Text.Dot.Attributes where

import "this" Prelude

import Control.Lens

import Text.Dot.Types


--------------------------------------------------------------------------------
-- Attributes access

-- | Retrieves the 'Attributes' of the given t'Entity'.
--
-- Given an entity attribute, return a lens to the corresponding attributes map
-- in a given 'Text.Dot.DotGraph', which is an internal opaque type. This is
-- meant to be used inside the 'Text.Dot.DotT' monad, relying on the fact that
-- it is a State monad under the hood.
--
-- Using @OverloadedLists@ makes working with the full attributes map a bit
-- easier.
--
-- > graph do
-- >   x <- node "x"
-- >
-- >   -- replaces the entire mapping (erases the label!)
-- >   attributes x .= [("fontcolor", "red")]
-- >
-- >   -- combines the existing mapping with the new one, favoring old values
-- >   attributes x <>= [("fontcolor", "blue"), ("fontsize", "12")]
-- >
-- >   -- combines the existing mapping with the new one, favoring new values
-- >   attributes x <>:= [("fontcolor", "blue"), ("fontsize", "12")]
--
-- This function is best used with the provided field accessors, such as
-- 'fontcolor', to be more explicit about the way to deal with previous values.
attributes :: Entity -> Lens' DotGraph Attributes
attributes :: Entity -> Lens' DotGraph Attributes
attributes Entity
e = (HashMap Entity Attributes -> f (HashMap Entity Attributes))
-> DotGraph -> f DotGraph
Lens' DotGraph (HashMap Entity Attributes)
entityAttributes ((HashMap Entity Attributes -> f (HashMap Entity Attributes))
 -> DotGraph -> f DotGraph)
-> ((Attributes -> f Attributes)
    -> HashMap Entity Attributes -> f (HashMap Entity Attributes))
-> (Attributes -> f Attributes)
-> DotGraph
-> f DotGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Entity Attributes)
-> Lens'
     (HashMap Entity Attributes)
     (Maybe (IxValue (HashMap Entity Attributes)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Entity Attributes)
Entity
e ((Maybe Attributes -> f (Maybe Attributes))
 -> HashMap Entity Attributes -> f (HashMap Entity Attributes))
-> ((Attributes -> f Attributes)
    -> Maybe Attributes -> f (Maybe Attributes))
-> (Attributes -> f Attributes)
-> HashMap Entity Attributes
-> f (HashMap Entity Attributes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Iso' (Maybe Attributes) Attributes
forall a. Eq a => a -> Iso' (Maybe a) a
non Attributes
forall a. Monoid a => a
mempty

-- | Retrieves the default 'Attributes' of the given 'EntityType'.
--
-- Given an entity type, return a lens to the corresponding default attributes
-- map in a given 'Text.Dot.DotGraph', which is an internal opaque type. This is
-- meant to be used inside the 'Text.Dot.DotT' monad, relying on the fact that
-- it is a State monad under the hood.
--
-- After modifying the defaults for a given entity type, any new such entity
-- will have its attributes set to the new default values.
--
-- > graph do
-- >   node "x"
-- >   use (its fillcolor) -- Nothing
-- >
-- >   defaults Cluster . style ?= "dashed"
-- >   defaults Node <>= [("style", "filled"), ("fillcolor", "forestgreen")]
-- >
-- >   node "y"
-- >   use (its fillcolor) -- Just "forestgreen"
--
-- This function is best used with the provided field accessors, such as
-- 'fontcolor', to be more explicit about the way to deal with previous values.
defaults :: EntityType -> Lens' DotGraph Attributes
defaults :: EntityType -> Lens' DotGraph Attributes
defaults EntityType
t = (HashMap EntityType Attributes
 -> f (HashMap EntityType Attributes))
-> DotGraph -> f DotGraph
Lens' DotGraph (HashMap EntityType Attributes)
defaultAttributes ((HashMap EntityType Attributes
  -> f (HashMap EntityType Attributes))
 -> DotGraph -> f DotGraph)
-> ((Attributes -> f Attributes)
    -> HashMap EntityType Attributes
    -> f (HashMap EntityType Attributes))
-> (Attributes -> f Attributes)
-> DotGraph
-> f DotGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap EntityType Attributes)
-> Lens'
     (HashMap EntityType Attributes)
     (Maybe (IxValue (HashMap EntityType Attributes)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap EntityType Attributes)
EntityType
t ((Maybe Attributes -> f (Maybe Attributes))
 -> HashMap EntityType Attributes
 -> f (HashMap EntityType Attributes))
-> ((Attributes -> f Attributes)
    -> Maybe Attributes -> f (Maybe Attributes))
-> (Attributes -> f Attributes)
-> HashMap EntityType Attributes
-> f (HashMap EntityType Attributes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Iso' (Maybe Attributes) Attributes
forall a. Eq a => a -> Iso' (Maybe a) a
non Attributes
forall a. Monoid a => a
mempty

-- | Retrieves an attribute from the latest created t'Entity'.
--
-- Given a lens for a specific attribute, such as 'style' or 'label', this
-- combinator creates a lens that points to that attribute for the latest
-- created t'Entity'. Like 'attributes', it is meant to be used within the
-- 'Text.Dot.DotT' monad.
--
-- > graph do
-- >   its title ?= "my graph"
-- >
-- >   bar <- node "bar"
-- >   its fontsize ?= "34"
-- >
-- >   edge bar bar
-- >   its style ?= "dotted"
-- >
-- >   cluster do
-- >     its label ?= "cluster"
its :: Lens' Attributes (Maybe Text) -> Lens' DotGraph (Maybe Text)
its :: Lens' Attributes (Maybe Text) -> Lens' DotGraph (Maybe Text)
its Lens' Attributes (Maybe Text)
l Maybe Text -> f (Maybe Text)
f DotGraph
d = (Entity -> Lens' DotGraph Attributes
attributes (DotGraph -> Entity
_latest DotGraph
d) ((Attributes -> f Attributes) -> DotGraph -> f DotGraph)
-> ((Maybe Text -> f (Maybe Text)) -> Attributes -> f Attributes)
-> (Maybe Text -> f (Maybe Text))
-> DotGraph
-> f DotGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> f (Maybe Text)) -> Attributes -> f Attributes
Lens' Attributes (Maybe Text)
l) Maybe Text -> f (Maybe Text)
f DotGraph
d

-- | Simple alias for 'at'.
--
-- This makes the code a tiny bit more natural when accessing fields by name:
--
-- > graph do
-- >   node "x"
-- >
-- >   -- replace the old value, if any
-- >   its (attribute "fontcolor") ?= "red"
-- >   its (attribute "fontcolor") .= Just "red"
-- >
-- >   -- erase the attribute
-- >   its (attribute "fontcolor") .= Nothing
-- >
-- >   -- set the value if it wasn't previously set
-- >   its (attribute "fontcolor") %= ifAbsent "blue"
--
-- It is however preferable to use one of the provided attribute lenses to avoid
-- raw strings.
attribute :: Text -> Lens' Attributes (Maybe Text)
attribute :: Text -> Lens' Attributes (Maybe Text)
attribute = Text -> Lens' Attributes (Maybe Text)
Index Attributes -> Lens' Attributes (Maybe (IxValue Attributes))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at

-- | Replaces a 'Maybe' value only if it wasn't set.
--
-- >>> ifAbsent "foo" Nothing
-- Just "foo"
--
-- >>> ifAbsent "foo" (Just "bar")
-- Just "bar"
--
-- This is best used in conjuction with 'attribute', or one of the explicit
-- attribute accessors.
--
-- > foo <- node "foo"
-- > its fillcolor %= ifAbsent "blue"
ifAbsent :: a -> Maybe a -> Maybe a
ifAbsent :: forall a. a -> Maybe a -> Maybe a
ifAbsent a
x Maybe a
m = Maybe a
m Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Maybe a
forall a. a -> Maybe a
Just a
x


--------------------------------------------------------------------------------
-- All attributes

-- | Maps to the @_background@ attribute.
background         :: Lens' Attributes (Maybe Text)
background :: Lens' Attributes (Maybe Text)
background         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"_background"

-- | Maps to the @Damping@ attribute.
damping            :: Lens' Attributes (Maybe Text)
damping :: Lens' Attributes (Maybe Text)
damping            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"Damping"

-- | Maps to the @cluster@ attribute.
isCcluster         :: Lens' Attributes (Maybe Text)
isCcluster :: Lens' Attributes (Maybe Text)
isCcluster         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"cluster"

-- | Maps to the @K@ attribute.
k                  :: Lens' Attributes (Maybe Text)
k :: Lens' Attributes (Maybe Text)
k                  = Text -> Lens' Attributes (Maybe Text)
attribute Text
"K"

-- | Maps to the @class@ attribute.
svgClass           :: Lens' Attributes (Maybe Text)
svgClass :: Lens' Attributes (Maybe Text)
svgClass           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"class"

-- | Maps to the @id@ attribute.
svgID              :: Lens' Attributes (Maybe Text)
svgID :: Lens' Attributes (Maybe Text)
svgID              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"id"

-- | Maps to the @TBbalance@ attribute.
tbbalance          :: Lens' Attributes (Maybe Text)
tbbalance :: Lens' Attributes (Maybe Text)
tbbalance          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"TBbalance"

-- | Maps to the @URL@ attribute.
url                :: Lens' Attributes (Maybe Text)
url :: Lens' Attributes (Maybe Text)
url                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"URL"

area               :: Lens' Attributes (Maybe Text)
area :: Lens' Attributes (Maybe Text)
area               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"area"
arrowhead          :: Lens' Attributes (Maybe Text)
arrowhead :: Lens' Attributes (Maybe Text)
arrowhead          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"arrowhead"
arrowsize          :: Lens' Attributes (Maybe Text)
arrowsize :: Lens' Attributes (Maybe Text)
arrowsize          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"arrowsize"
arrowtail          :: Lens' Attributes (Maybe Text)
arrowtail :: Lens' Attributes (Maybe Text)
arrowtail          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"arrowtail"
bb                 :: Lens' Attributes (Maybe Text)
bb :: Lens' Attributes (Maybe Text)
bb                 = Text -> Lens' Attributes (Maybe Text)
attribute Text
"bb"
beautify           :: Lens' Attributes (Maybe Text)
beautify :: Lens' Attributes (Maybe Text)
beautify           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"beautify"
bgcolor            :: Lens' Attributes (Maybe Text)
bgcolor :: Lens' Attributes (Maybe Text)
bgcolor            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"bgcolor"
black              :: Lens' Attributes (Maybe Text)
black :: Lens' Attributes (Maybe Text)
black              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"black"
center             :: Lens' Attributes (Maybe Text)
center :: Lens' Attributes (Maybe Text)
center             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"center"
charset            :: Lens' Attributes (Maybe Text)
charset :: Lens' Attributes (Maybe Text)
charset            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"charset"
clusterrank        :: Lens' Attributes (Maybe Text)
clusterrank :: Lens' Attributes (Maybe Text)
clusterrank        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"clusterrank"
color              :: Lens' Attributes (Maybe Text)
color :: Lens' Attributes (Maybe Text)
color              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"color"
colorscheme        :: Lens' Attributes (Maybe Text)
colorscheme :: Lens' Attributes (Maybe Text)
colorscheme        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"colorscheme"
comment            :: Lens' Attributes (Maybe Text)
comment :: Lens' Attributes (Maybe Text)
comment            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"comment"
compound           :: Lens' Attributes (Maybe Text)
compound :: Lens' Attributes (Maybe Text)
compound           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"compound"
concentrate        :: Lens' Attributes (Maybe Text)
concentrate :: Lens' Attributes (Maybe Text)
concentrate        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"concentrate"
constraint         :: Lens' Attributes (Maybe Text)
constraint :: Lens' Attributes (Maybe Text)
constraint         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"constraint"
decorate           :: Lens' Attributes (Maybe Text)
decorate :: Lens' Attributes (Maybe Text)
decorate           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"decorate"
defaultdist        :: Lens' Attributes (Maybe Text)
defaultdist :: Lens' Attributes (Maybe Text)
defaultdist        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"defaultdist"
dim                :: Lens' Attributes (Maybe Text)
dim :: Lens' Attributes (Maybe Text)
dim                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"dim"
dimen              :: Lens' Attributes (Maybe Text)
dimen :: Lens' Attributes (Maybe Text)
dimen              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"dimen"
dir                :: Lens' Attributes (Maybe Text)
dir :: Lens' Attributes (Maybe Text)
dir                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"dir"
diredgeconstraints :: Lens' Attributes (Maybe Text)
diredgeconstraints :: Lens' Attributes (Maybe Text)
diredgeconstraints = Text -> Lens' Attributes (Maybe Text)
attribute Text
"diredgeconstraints"
distortion         :: Lens' Attributes (Maybe Text)
distortion :: Lens' Attributes (Maybe Text)
distortion         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"distortion"
dpi                :: Lens' Attributes (Maybe Text)
dpi :: Lens' Attributes (Maybe Text)
dpi                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"dpi"
edgeURL            :: Lens' Attributes (Maybe Text)
edgeURL :: Lens' Attributes (Maybe Text)
edgeURL            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"edgeURL"
edgehref           :: Lens' Attributes (Maybe Text)
edgehref :: Lens' Attributes (Maybe Text)
edgehref           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"edgehref"
edgetarget         :: Lens' Attributes (Maybe Text)
edgetarget :: Lens' Attributes (Maybe Text)
edgetarget         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"edgetarget"
edgetooltip        :: Lens' Attributes (Maybe Text)
edgetooltip :: Lens' Attributes (Maybe Text)
edgetooltip        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"edgetooltip"
epsilon            :: Lens' Attributes (Maybe Text)
epsilon :: Lens' Attributes (Maybe Text)
epsilon            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"epsilon"
esep               :: Lens' Attributes (Maybe Text)
esep :: Lens' Attributes (Maybe Text)
esep               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"esep"
fillcolor          :: Lens' Attributes (Maybe Text)
fillcolor :: Lens' Attributes (Maybe Text)
fillcolor          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"fillcolor"
fixedsize          :: Lens' Attributes (Maybe Text)
fixedsize :: Lens' Attributes (Maybe Text)
fixedsize          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"fixedsize"
fontcolor          :: Lens' Attributes (Maybe Text)
fontcolor :: Lens' Attributes (Maybe Text)
fontcolor          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"fontcolor"
fontname           :: Lens' Attributes (Maybe Text)
fontname :: Lens' Attributes (Maybe Text)
fontname           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"fontname"
fontnames          :: Lens' Attributes (Maybe Text)
fontnames :: Lens' Attributes (Maybe Text)
fontnames          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"fontnames"
fontpath           :: Lens' Attributes (Maybe Text)
fontpath :: Lens' Attributes (Maybe Text)
fontpath           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"fontpath"
fontsize           :: Lens' Attributes (Maybe Text)
fontsize :: Lens' Attributes (Maybe Text)
fontsize           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"fontsize"
forcelabels        :: Lens' Attributes (Maybe Text)
forcelabels :: Lens' Attributes (Maybe Text)
forcelabels        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"forcelabels"
gradientangle      :: Lens' Attributes (Maybe Text)
gradientangle :: Lens' Attributes (Maybe Text)
gradientangle      = Text -> Lens' Attributes (Maybe Text)
attribute Text
"gradientangle"
group              :: Lens' Attributes (Maybe Text)
group :: Lens' Attributes (Maybe Text)
group              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"group"
headURL            :: Lens' Attributes (Maybe Text)
headURL :: Lens' Attributes (Maybe Text)
headURL            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"headURL"
head_lp            :: Lens' Attributes (Maybe Text)
head_lp :: Lens' Attributes (Maybe Text)
head_lp            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"head_lp"
headclip           :: Lens' Attributes (Maybe Text)
headclip :: Lens' Attributes (Maybe Text)
headclip           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"headclip"
headhref           :: Lens' Attributes (Maybe Text)
headhref :: Lens' Attributes (Maybe Text)
headhref           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"headhref"
headlabel          :: Lens' Attributes (Maybe Text)
headlabel :: Lens' Attributes (Maybe Text)
headlabel          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"headlabel"
headport           :: Lens' Attributes (Maybe Text)
headport :: Lens' Attributes (Maybe Text)
headport           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"headport"
headtarget         :: Lens' Attributes (Maybe Text)
headtarget :: Lens' Attributes (Maybe Text)
headtarget         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"headtarget"
headtooltip        :: Lens' Attributes (Maybe Text)
headtooltip :: Lens' Attributes (Maybe Text)
headtooltip        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"headtooltip"
height             :: Lens' Attributes (Maybe Text)
height :: Lens' Attributes (Maybe Text)
height             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"height"
href               :: Lens' Attributes (Maybe Text)
href :: Lens' Attributes (Maybe Text)
href               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"href"
image              :: Lens' Attributes (Maybe Text)
image :: Lens' Attributes (Maybe Text)
image              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"image"
imagepath          :: Lens' Attributes (Maybe Text)
imagepath :: Lens' Attributes (Maybe Text)
imagepath          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"imagepath"
imagepos           :: Lens' Attributes (Maybe Text)
imagepos :: Lens' Attributes (Maybe Text)
imagepos           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"imagepos"
imagescale         :: Lens' Attributes (Maybe Text)
imagescale :: Lens' Attributes (Maybe Text)
imagescale         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"imagescale"
inputscale         :: Lens' Attributes (Maybe Text)
inputscale :: Lens' Attributes (Maybe Text)
inputscale         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"inputscale"
label              :: Lens' Attributes (Maybe Text)
label :: Lens' Attributes (Maybe Text)
label              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"label"
labelURL           :: Lens' Attributes (Maybe Text)
labelURL :: Lens' Attributes (Maybe Text)
labelURL           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labelURL"
label_scheme       :: Lens' Attributes (Maybe Text)
label_scheme :: Lens' Attributes (Maybe Text)
label_scheme       = Text -> Lens' Attributes (Maybe Text)
attribute Text
"label_scheme"
labelangle         :: Lens' Attributes (Maybe Text)
labelangle :: Lens' Attributes (Maybe Text)
labelangle         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labelangle"
labeldistance      :: Lens' Attributes (Maybe Text)
labeldistance :: Lens' Attributes (Maybe Text)
labeldistance      = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labeldistance"
labelfloat         :: Lens' Attributes (Maybe Text)
labelfloat :: Lens' Attributes (Maybe Text)
labelfloat         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labelfloat"
labelfontcolor     :: Lens' Attributes (Maybe Text)
labelfontcolor :: Lens' Attributes (Maybe Text)
labelfontcolor     = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labelfontcolor"
labelfontname      :: Lens' Attributes (Maybe Text)
labelfontname :: Lens' Attributes (Maybe Text)
labelfontname      = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labelfontname"
labelfontsize      :: Lens' Attributes (Maybe Text)
labelfontsize :: Lens' Attributes (Maybe Text)
labelfontsize      = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labelfontsize"
labelhref          :: Lens' Attributes (Maybe Text)
labelhref :: Lens' Attributes (Maybe Text)
labelhref          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labelhref"
labeljust          :: Lens' Attributes (Maybe Text)
labeljust :: Lens' Attributes (Maybe Text)
labeljust          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labeljust"
labelloc           :: Lens' Attributes (Maybe Text)
labelloc :: Lens' Attributes (Maybe Text)
labelloc           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labelloc"
labeltarget        :: Lens' Attributes (Maybe Text)
labeltarget :: Lens' Attributes (Maybe Text)
labeltarget        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labeltarget"
labeltooltip       :: Lens' Attributes (Maybe Text)
labeltooltip :: Lens' Attributes (Maybe Text)
labeltooltip       = Text -> Lens' Attributes (Maybe Text)
attribute Text
"labeltooltip"
landscape          :: Lens' Attributes (Maybe Text)
landscape :: Lens' Attributes (Maybe Text)
landscape          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"landscape"
layer              :: Lens' Attributes (Maybe Text)
layer :: Lens' Attributes (Maybe Text)
layer              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"layer"
layerlistsep       :: Lens' Attributes (Maybe Text)
layerlistsep :: Lens' Attributes (Maybe Text)
layerlistsep       = Text -> Lens' Attributes (Maybe Text)
attribute Text
"layerlistsep"
layers             :: Lens' Attributes (Maybe Text)
layers :: Lens' Attributes (Maybe Text)
layers             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"layers"
layerselect        :: Lens' Attributes (Maybe Text)
layerselect :: Lens' Attributes (Maybe Text)
layerselect        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"layerselect"
layersep           :: Lens' Attributes (Maybe Text)
layersep :: Lens' Attributes (Maybe Text)
layersep           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"layersep"
layout             :: Lens' Attributes (Maybe Text)
layout :: Lens' Attributes (Maybe Text)
layout             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"layout"
len                :: Lens' Attributes (Maybe Text)
len :: Lens' Attributes (Maybe Text)
len                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"len"
levels             :: Lens' Attributes (Maybe Text)
levels :: Lens' Attributes (Maybe Text)
levels             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"levels"
levelsgap          :: Lens' Attributes (Maybe Text)
levelsgap :: Lens' Attributes (Maybe Text)
levelsgap          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"levelsgap"
lhead              :: Lens' Attributes (Maybe Text)
lhead :: Lens' Attributes (Maybe Text)
lhead              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"lhead"
lheight            :: Lens' Attributes (Maybe Text)
lheight :: Lens' Attributes (Maybe Text)
lheight            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"lheight"
linelength         :: Lens' Attributes (Maybe Text)
linelength :: Lens' Attributes (Maybe Text)
linelength         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"linelength"
lp                 :: Lens' Attributes (Maybe Text)
lp :: Lens' Attributes (Maybe Text)
lp                 = Text -> Lens' Attributes (Maybe Text)
attribute Text
"lp"
ltail              :: Lens' Attributes (Maybe Text)
ltail :: Lens' Attributes (Maybe Text)
ltail              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"ltail"
lwidth             :: Lens' Attributes (Maybe Text)
lwidth :: Lens' Attributes (Maybe Text)
lwidth             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"lwidth"
margin             :: Lens' Attributes (Maybe Text)
margin :: Lens' Attributes (Maybe Text)
margin             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"margin"
maxiter            :: Lens' Attributes (Maybe Text)
maxiter :: Lens' Attributes (Maybe Text)
maxiter            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"maxiter"
mclimit            :: Lens' Attributes (Maybe Text)
mclimit :: Lens' Attributes (Maybe Text)
mclimit            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"mclimit"
mindist            :: Lens' Attributes (Maybe Text)
mindist :: Lens' Attributes (Maybe Text)
mindist            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"mindist"
minlen             :: Lens' Attributes (Maybe Text)
minlen :: Lens' Attributes (Maybe Text)
minlen             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"minlen"
mode               :: Lens' Attributes (Maybe Text)
mode :: Lens' Attributes (Maybe Text)
mode               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"mode"
model              :: Lens' Attributes (Maybe Text)
model :: Lens' Attributes (Maybe Text)
model              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"model"
newrank            :: Lens' Attributes (Maybe Text)
newrank :: Lens' Attributes (Maybe Text)
newrank            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"newrank"
nodesep            :: Lens' Attributes (Maybe Text)
nodesep :: Lens' Attributes (Maybe Text)
nodesep            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"nodesep"
nojustify          :: Lens' Attributes (Maybe Text)
nojustify :: Lens' Attributes (Maybe Text)
nojustify          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"nojustify"
normalize          :: Lens' Attributes (Maybe Text)
normalize :: Lens' Attributes (Maybe Text)
normalize          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"normalize"
notranslate        :: Lens' Attributes (Maybe Text)
notranslate :: Lens' Attributes (Maybe Text)
notranslate        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"notranslate"
nslimit            :: Lens' Attributes (Maybe Text)
nslimit :: Lens' Attributes (Maybe Text)
nslimit            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"nslimit"
nslimit1           :: Lens' Attributes (Maybe Text)
nslimit1 :: Lens' Attributes (Maybe Text)
nslimit1           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"nslimit1"
oneblock           :: Lens' Attributes (Maybe Text)
oneblock :: Lens' Attributes (Maybe Text)
oneblock           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"oneblock"
ordering           :: Lens' Attributes (Maybe Text)
ordering :: Lens' Attributes (Maybe Text)
ordering           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"ordering"
orientation        :: Lens' Attributes (Maybe Text)
orientation :: Lens' Attributes (Maybe Text)
orientation        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"orientation"
outputorder        :: Lens' Attributes (Maybe Text)
outputorder :: Lens' Attributes (Maybe Text)
outputorder        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"outputorder"
overlap            :: Lens' Attributes (Maybe Text)
overlap :: Lens' Attributes (Maybe Text)
overlap            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"overlap"
overlap_scaling    :: Lens' Attributes (Maybe Text)
overlap_scaling :: Lens' Attributes (Maybe Text)
overlap_scaling    = Text -> Lens' Attributes (Maybe Text)
attribute Text
"overlap_scaling"
overlap_shrink     :: Lens' Attributes (Maybe Text)
overlap_shrink :: Lens' Attributes (Maybe Text)
overlap_shrink     = Text -> Lens' Attributes (Maybe Text)
attribute Text
"overlap_shrink"
pack               :: Lens' Attributes (Maybe Text)
pack :: Lens' Attributes (Maybe Text)
pack               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"pack"
packmode           :: Lens' Attributes (Maybe Text)
packmode :: Lens' Attributes (Maybe Text)
packmode           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"packmode"
pad                :: Lens' Attributes (Maybe Text)
pad :: Lens' Attributes (Maybe Text)
pad                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"pad"
page               :: Lens' Attributes (Maybe Text)
page :: Lens' Attributes (Maybe Text)
page               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"page"
pagedir            :: Lens' Attributes (Maybe Text)
pagedir :: Lens' Attributes (Maybe Text)
pagedir            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"pagedir"
pencolor           :: Lens' Attributes (Maybe Text)
pencolor :: Lens' Attributes (Maybe Text)
pencolor           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"pencolor"
penwidth           :: Lens' Attributes (Maybe Text)
penwidth :: Lens' Attributes (Maybe Text)
penwidth           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"penwidth"
peripheries        :: Lens' Attributes (Maybe Text)
peripheries :: Lens' Attributes (Maybe Text)
peripheries        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"peripheries"
pin                :: Lens' Attributes (Maybe Text)
pin :: Lens' Attributes (Maybe Text)
pin                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"pin"
pos                :: Lens' Attributes (Maybe Text)
pos :: Lens' Attributes (Maybe Text)
pos                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"pos"
quadtree           :: Lens' Attributes (Maybe Text)
quadtree :: Lens' Attributes (Maybe Text)
quadtree           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"quadtree"
quantum            :: Lens' Attributes (Maybe Text)
quantum :: Lens' Attributes (Maybe Text)
quantum            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"quantum"
rank               :: Lens' Attributes (Maybe Text)
rank :: Lens' Attributes (Maybe Text)
rank               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"rank"
rankdir            :: Lens' Attributes (Maybe Text)
rankdir :: Lens' Attributes (Maybe Text)
rankdir            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"rankdir"
ranksep            :: Lens' Attributes (Maybe Text)
ranksep :: Lens' Attributes (Maybe Text)
ranksep            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"ranksep"
ratio              :: Lens' Attributes (Maybe Text)
ratio :: Lens' Attributes (Maybe Text)
ratio              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"ratio"
rects              :: Lens' Attributes (Maybe Text)
rects :: Lens' Attributes (Maybe Text)
rects              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"rects"
regular            :: Lens' Attributes (Maybe Text)
regular :: Lens' Attributes (Maybe Text)
regular            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"regular"
remincross         :: Lens' Attributes (Maybe Text)
remincross :: Lens' Attributes (Maybe Text)
remincross         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"remincross"
repulsiveforce     :: Lens' Attributes (Maybe Text)
repulsiveforce :: Lens' Attributes (Maybe Text)
repulsiveforce     = Text -> Lens' Attributes (Maybe Text)
attribute Text
"repulsiveforce"
resolution         :: Lens' Attributes (Maybe Text)
resolution :: Lens' Attributes (Maybe Text)
resolution         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"resolution"
root               :: Lens' Attributes (Maybe Text)
root :: Lens' Attributes (Maybe Text)
root               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"root"
rotate             :: Lens' Attributes (Maybe Text)
rotate :: Lens' Attributes (Maybe Text)
rotate             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"rotate"
rotation           :: Lens' Attributes (Maybe Text)
rotation :: Lens' Attributes (Maybe Text)
rotation           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"rotation"
samehead           :: Lens' Attributes (Maybe Text)
samehead :: Lens' Attributes (Maybe Text)
samehead           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"samehead"
sametail           :: Lens' Attributes (Maybe Text)
sametail :: Lens' Attributes (Maybe Text)
sametail           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"sametail"
samplepoints       :: Lens' Attributes (Maybe Text)
samplepoints :: Lens' Attributes (Maybe Text)
samplepoints       = Text -> Lens' Attributes (Maybe Text)
attribute Text
"samplepoints"
scale              :: Lens' Attributes (Maybe Text)
scale :: Lens' Attributes (Maybe Text)
scale              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"scale"
searchsize         :: Lens' Attributes (Maybe Text)
searchsize :: Lens' Attributes (Maybe Text)
searchsize         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"searchsize"
sep                :: Lens' Attributes (Maybe Text)
sep :: Lens' Attributes (Maybe Text)
sep                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"sep"
shape              :: Lens' Attributes (Maybe Text)
shape :: Lens' Attributes (Maybe Text)
shape              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"shape"
shapefile          :: Lens' Attributes (Maybe Text)
shapefile :: Lens' Attributes (Maybe Text)
shapefile          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"shapefile"
showboxes          :: Lens' Attributes (Maybe Text)
showboxes :: Lens' Attributes (Maybe Text)
showboxes          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"showboxes"
sides              :: Lens' Attributes (Maybe Text)
sides :: Lens' Attributes (Maybe Text)
sides              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"sides"
size               :: Lens' Attributes (Maybe Text)
size :: Lens' Attributes (Maybe Text)
size               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"size"
skew               :: Lens' Attributes (Maybe Text)
skew :: Lens' Attributes (Maybe Text)
skew               = Text -> Lens' Attributes (Maybe Text)
attribute Text
"skew"
smoothing          :: Lens' Attributes (Maybe Text)
smoothing :: Lens' Attributes (Maybe Text)
smoothing          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"smoothing"
sortv              :: Lens' Attributes (Maybe Text)
sortv :: Lens' Attributes (Maybe Text)
sortv              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"sortv"
splines            :: Lens' Attributes (Maybe Text)
splines :: Lens' Attributes (Maybe Text)
splines            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"splines"
start              :: Lens' Attributes (Maybe Text)
start :: Lens' Attributes (Maybe Text)
start              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"start"
style              :: Lens' Attributes (Maybe Text)
style :: Lens' Attributes (Maybe Text)
style              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"style"
stylesheet         :: Lens' Attributes (Maybe Text)
stylesheet :: Lens' Attributes (Maybe Text)
stylesheet         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"stylesheet"
tailURL            :: Lens' Attributes (Maybe Text)
tailURL :: Lens' Attributes (Maybe Text)
tailURL            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"tailURL"
tail_lp            :: Lens' Attributes (Maybe Text)
tail_lp :: Lens' Attributes (Maybe Text)
tail_lp            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"tail_lp"
tailclip           :: Lens' Attributes (Maybe Text)
tailclip :: Lens' Attributes (Maybe Text)
tailclip           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"tailclip"
tailhref           :: Lens' Attributes (Maybe Text)
tailhref :: Lens' Attributes (Maybe Text)
tailhref           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"tailhref"
taillabel          :: Lens' Attributes (Maybe Text)
taillabel :: Lens' Attributes (Maybe Text)
taillabel          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"taillabel"
tailport           :: Lens' Attributes (Maybe Text)
tailport :: Lens' Attributes (Maybe Text)
tailport           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"tailport"
tailtarget         :: Lens' Attributes (Maybe Text)
tailtarget :: Lens' Attributes (Maybe Text)
tailtarget         = Text -> Lens' Attributes (Maybe Text)
attribute Text
"tailtarget"
tailtooltip        :: Lens' Attributes (Maybe Text)
tailtooltip :: Lens' Attributes (Maybe Text)
tailtooltip        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"tailtooltip"
target             :: Lens' Attributes (Maybe Text)
target :: Lens' Attributes (Maybe Text)
target             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"target"
tooltip            :: Lens' Attributes (Maybe Text)
tooltip :: Lens' Attributes (Maybe Text)
tooltip            = Text -> Lens' Attributes (Maybe Text)
attribute Text
"tooltip"
truecolor          :: Lens' Attributes (Maybe Text)
truecolor :: Lens' Attributes (Maybe Text)
truecolor          = Text -> Lens' Attributes (Maybe Text)
attribute Text
"truecolor"
vertices           :: Lens' Attributes (Maybe Text)
vertices :: Lens' Attributes (Maybe Text)
vertices           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"vertices"
viewport           :: Lens' Attributes (Maybe Text)
viewport :: Lens' Attributes (Maybe Text)
viewport           = Text -> Lens' Attributes (Maybe Text)
attribute Text
"viewport"
voro_margin        :: Lens' Attributes (Maybe Text)
voro_margin :: Lens' Attributes (Maybe Text)
voro_margin        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"voro_margin"
weight             :: Lens' Attributes (Maybe Text)
weight :: Lens' Attributes (Maybe Text)
weight             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"weight"
width              :: Lens' Attributes (Maybe Text)
width :: Lens' Attributes (Maybe Text)
width              = Text -> Lens' Attributes (Maybe Text)
attribute Text
"width"
xdotversion        :: Lens' Attributes (Maybe Text)
xdotversion :: Lens' Attributes (Maybe Text)
xdotversion        = Text -> Lens' Attributes (Maybe Text)
attribute Text
"xdotversion"
xlabel             :: Lens' Attributes (Maybe Text)
xlabel :: Lens' Attributes (Maybe Text)
xlabel             = Text -> Lens' Attributes (Maybe Text)
attribute Text
"xlabel"
xlp                :: Lens' Attributes (Maybe Text)
xlp :: Lens' Attributes (Maybe Text)
xlp                = Text -> Lens' Attributes (Maybe Text)
attribute Text
"xlp"
z                  :: Lens' Attributes (Maybe Text)
z :: Lens' Attributes (Maybe Text)
z                  = Text -> Lens' Attributes (Maybe Text)
attribute Text
"z"