{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- | Example of Dot graph construction for the <https://hackage.haskell.org/package/chart-svg chart-svg> class heirarchy.
module DotParse.Examples.AST where

import Algebra.Graph.Labelled qualified as L
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as B
import Data.List qualified as List
import Data.List.NonEmpty hiding (filter, head, length, map, zip, zipWith, (!!))
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Monoid
import Data.String.Interpolate
import Data.These
import DotParse.Types
import GHC.Generics
import Optics.Core
import Prelude hiding (replicate)

-- $setup
-- >>> import DotParse
-- >>> :set -XOverloadedStrings

-- | A Haskell class and (informal) list of sub-components.
data SubComponents = SubComponents
  { SubComponents -> ByteString
classComponent :: ByteString,
    SubComponents -> [ByteString]
subComponents :: [ByteString]
  }
  deriving (SubComponents -> SubComponents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubComponents -> SubComponents -> Bool
$c/= :: SubComponents -> SubComponents -> Bool
== :: SubComponents -> SubComponents -> Bool
$c== :: SubComponents -> SubComponents -> Bool
Eq, Int -> SubComponents -> ShowS
[SubComponents] -> ShowS
SubComponents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubComponents] -> ShowS
$cshowList :: [SubComponents] -> ShowS
show :: SubComponents -> String
$cshow :: SubComponents -> String
showsPrec :: Int -> SubComponents -> ShowS
$cshowsPrec :: Int -> SubComponents -> ShowS
Show, Eq SubComponents
SubComponents -> SubComponents -> Bool
SubComponents -> SubComponents -> Ordering
SubComponents -> SubComponents -> SubComponents
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SubComponents -> SubComponents -> SubComponents
$cmin :: SubComponents -> SubComponents -> SubComponents
max :: SubComponents -> SubComponents -> SubComponents
$cmax :: SubComponents -> SubComponents -> SubComponents
>= :: SubComponents -> SubComponents -> Bool
$c>= :: SubComponents -> SubComponents -> Bool
> :: SubComponents -> SubComponents -> Bool
$c> :: SubComponents -> SubComponents -> Bool
<= :: SubComponents -> SubComponents -> Bool
$c<= :: SubComponents -> SubComponents -> Bool
< :: SubComponents -> SubComponents -> Bool
$c< :: SubComponents -> SubComponents -> Bool
compare :: SubComponents -> SubComponents -> Ordering
$ccompare :: SubComponents -> SubComponents -> Ordering
Ord, forall x. Rep SubComponents x -> SubComponents
forall x. SubComponents -> Rep SubComponents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubComponents x -> SubComponents
$cfrom :: forall x. SubComponents -> Rep SubComponents x
Generic)

-- | Relationship between a class, a sub-component and the class of the sub-component.
data ComponentEdge = ComponentEdge
  { ComponentEdge -> ByteString
edgeClassComponent :: ByteString,
    ComponentEdge -> ByteString
edgeSubComponent :: ByteString,
    ComponentEdge -> ByteString
subComponentClass :: ByteString,
    ComponentEdge -> Maybe ByteString
edgeLabel :: Maybe ByteString
  }
  deriving (ComponentEdge -> ComponentEdge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentEdge -> ComponentEdge -> Bool
$c/= :: ComponentEdge -> ComponentEdge -> Bool
== :: ComponentEdge -> ComponentEdge -> Bool
$c== :: ComponentEdge -> ComponentEdge -> Bool
Eq, Int -> ComponentEdge -> ShowS
[ComponentEdge] -> ShowS
ComponentEdge -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentEdge] -> ShowS
$cshowList :: [ComponentEdge] -> ShowS
show :: ComponentEdge -> String
$cshow :: ComponentEdge -> String
showsPrec :: Int -> ComponentEdge -> ShowS
$cshowsPrec :: Int -> ComponentEdge -> ShowS
Show, Eq ComponentEdge
ComponentEdge -> ComponentEdge -> Bool
ComponentEdge -> ComponentEdge -> Ordering
ComponentEdge -> ComponentEdge -> ComponentEdge
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentEdge -> ComponentEdge -> ComponentEdge
$cmin :: ComponentEdge -> ComponentEdge -> ComponentEdge
max :: ComponentEdge -> ComponentEdge -> ComponentEdge
$cmax :: ComponentEdge -> ComponentEdge -> ComponentEdge
>= :: ComponentEdge -> ComponentEdge -> Bool
$c>= :: ComponentEdge -> ComponentEdge -> Bool
> :: ComponentEdge -> ComponentEdge -> Bool
$c> :: ComponentEdge -> ComponentEdge -> Bool
<= :: ComponentEdge -> ComponentEdge -> Bool
$c<= :: ComponentEdge -> ComponentEdge -> Bool
< :: ComponentEdge -> ComponentEdge -> Bool
$c< :: ComponentEdge -> ComponentEdge -> Bool
compare :: ComponentEdge -> ComponentEdge -> Ordering
$ccompare :: ComponentEdge -> ComponentEdge -> Ordering
Ord, forall x. Rep ComponentEdge x -> ComponentEdge
forall x. ComponentEdge -> Rep ComponentEdge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComponentEdge x -> ComponentEdge
$cfrom :: forall x. ComponentEdge -> Rep ComponentEdge x
Generic)

-- | algebraic graph vertices
graphVs :: (Monoid a) => [SubComponents] -> L.Graph a (ByteString, ByteString)
graphVs :: forall a.
Monoid a =>
[SubComponents] -> Graph a (ByteString, ByteString)
graphVs [SubComponents]
cs =
  forall e a. Monoid e => [a] -> Graph e a
L.vertices forall a b. (a -> b) -> a -> b
$
    ((\ByteString
x -> (ByteString
x, ByteString
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "classComponent" a => a
#classComponent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SubComponents]
cs)
      forall a. Semigroup a => a -> a -> a
<> (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ SubComponents -> [(ByteString, ByteString)]
subs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SubComponents]
cs)

-- | Convert sub-components to a list of class, subcomponent bytestring tuples.
subs :: SubComponents -> [(ByteString, ByteString)]
subs :: SubComponents -> [(ByteString, ByteString)]
subs SubComponents
c = (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "classComponent" a => a
#classComponent SubComponents
c,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "subComponents" a => a
#subComponents SubComponents
c

-- | algebraic graph edges
graphEs :: [ComponentEdge] -> L.Graph (Maybe ByteString) (ByteString, ByteString)
graphEs :: [ComponentEdge]
-> Graph (Maybe ByteString) (ByteString, ByteString)
graphEs [ComponentEdge]
es =
  forall e a. Monoid e => [(e, a, a)] -> Graph e a
L.edges ((\ComponentEdge
c -> (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "edgeLabel" a => a
#edgeLabel ComponentEdge
c, (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "edgeClassComponent" a => a
#edgeClassComponent ComponentEdge
c, forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "edgeSubComponent" a => a
#edgeSubComponent ComponentEdge
c), (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "subComponentClass" a => a
#subComponentClass ComponentEdge
c, forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "subComponentClass" a => a
#subComponentClass ComponentEdge
c))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ComponentEdge]
es)

-- | algebraic graph
graphAST :: [SubComponents] -> [ComponentEdge] -> L.Graph (Maybe ByteString) (ByteString, ByteString)
graphAST :: [SubComponents]
-> [ComponentEdge]
-> Graph (Maybe ByteString) (ByteString, ByteString)
graphAST [SubComponents]
cs [ComponentEdge]
es =
  forall a.
Monoid a =>
[SubComponents] -> Graph a (ByteString, ByteString)
graphVs [SubComponents]
cs forall a. Semigroup a => a -> a -> a
<> [ComponentEdge]
-> Graph (Maybe ByteString) (ByteString, ByteString)
graphEs [ComponentEdge]
es

-- | Create a list of 'SubComponents' from a list of 'ComponentEdge's
fromCEs :: [ComponentEdge] -> [SubComponents]
fromCEs :: [ComponentEdge] -> [SubComponents]
fromCEs [ComponentEdge]
es = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> [ByteString] -> SubComponents
SubComponents) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) ((\ComponentEdge
e -> (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "edgeClassComponent" a => a
#edgeClassComponent ComponentEdge
e, [forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "edgeSubComponent" a => a
#edgeSubComponent ComponentEdge
e])) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ComponentEdge]
es)

-- | Convert an algebraic Graph into dot record nodes
recordNodes :: L.Graph (Maybe ByteString) (ByteString, ByteString) -> [Statement]
recordNodes :: Graph (Maybe ByteString) (ByteString, ByteString) -> [Statement]
recordNodes Graph (Maybe ByteString) (ByteString, ByteString)
g = (\(ByteString
s, [ByteString]
cs) -> NodeStatement -> Statement
StatementNode forall a b. (a -> b) -> a -> b
$ ID -> Maybe Port -> Map ID ID -> NodeStatement
NodeStatement (ByteString -> ID
IDQuoted ByteString
s) forall a. Maybe a
Nothing (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ByteString -> ID
ID ByteString
"label", ByteString -> ID
IDQuoted ((ByteString, [ByteString]) -> ByteString
ls (ByteString
s, [ByteString]
cs)))] forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
url -> [(ByteString -> ID
ID ByteString
"URL", ByteString -> ID
IDQuoted ByteString
url)]) (ByteString -> Maybe ByteString
toURL ByteString
s)))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ByteString, [ByteString])]
supers
  where
    ls :: (ByteString, [ByteString]) -> ByteString
ls (ByteString
s, [ByteString]
cs) = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"|" forall a b. (a -> b) -> a -> b
$ (ByteString
"<x" forall a. Semigroup a => a -> a -> a
<> ByteString
s forall a. Semigroup a => a -> a -> a
<> ByteString
"> " forall a. Semigroup a => a -> a -> a
<> ByteString
s) forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteString
y -> ByteString
" <x" forall a. Semigroup a => a -> a -> a
<> ByteString
y forall a. Semigroup a => a -> a -> a
<> ByteString
"> " forall a. Semigroup a => a -> a -> a
<> ByteString
y) [ByteString]
cs
    supers :: [(ByteString, [ByteString])]
supers = (\(ByteString
s, [ByteString]
cs) -> (ByteString
s, forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= ByteString
s) [ByteString]
cs)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) ((\(ByteString
s, ByteString
c) -> (ByteString
s, [ByteString
c])) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a e. Ord a => Graph e a -> [a]
L.vertexList Graph (Maybe ByteString) (ByteString, ByteString)
g))

-- | Convert an algebraic Graph into dot edges
recordEdges :: Directed -> L.Graph (Maybe ByteString) (ByteString, ByteString) -> [Statement]
recordEdges :: Directed
-> Graph (Maybe ByteString) (ByteString, ByteString) -> [Statement]
recordEdges Directed
d Graph (Maybe ByteString) (ByteString, ByteString)
g =
  ( \(Maybe ByteString
l, (ByteString
s0, ByteString
c0), (ByteString
s1, ByteString
c1)) ->
      EdgeStatement -> Statement
StatementEdge forall a b. (a -> b) -> a -> b
$
        EdgeOp -> EdgeID -> NonEmpty EdgeID -> Map ID ID -> EdgeStatement
EdgeStatement
          (Directed -> EdgeOp
fromDirected Directed
d)
          (ID -> Maybe Port -> EdgeID
EdgeID (ByteString -> ID
IDQuoted ByteString
s0) (forall a. a -> Maybe a
Just (These ID Compass -> Port
Port (forall a b. a -> These a b
This (ByteString -> ID
IDQuoted (ByteString
"x" forall a. Semigroup a => a -> a -> a
<> ByteString
c0))))))
          (forall a. [a] -> NonEmpty a
fromList [ID -> Maybe Port -> EdgeID
EdgeID (ByteString -> ID
IDQuoted ByteString
c1) (forall a. a -> Maybe a
Just (These ID Compass -> Port
Port (forall a b. a -> These a b
This (ByteString -> ID
IDQuoted (ByteString
"x" forall a. Semigroup a => a -> a -> a
<> ByteString
s1)))))])
          (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ByteString -> ID
ID ByteString
"label", ByteString -> ID
IDQuoted (forall a. a -> Maybe a -> a
fromMaybe ByteString
"x" Maybe ByteString
l))])
  )
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. (Eq e, Monoid e, Ord a) => Graph e a -> [(e, a, a)]
L.edgeList Graph (Maybe ByteString) (ByteString, ByteString)
g

-- | create Statements from a (edge labelled) algebraic graph
--
-- https://graphviz.org/Gallery/directed/datastruct.html
toStatementsRecord :: Directed -> L.Graph (Maybe ByteString) (ByteString, ByteString) -> [Statement]
toStatementsRecord :: Directed
-> Graph (Maybe ByteString) (ByteString, ByteString) -> [Statement]
toStatementsRecord Directed
d Graph (Maybe ByteString) (ByteString, ByteString)
g =
  Directed
-> Graph (Maybe ByteString) (ByteString, ByteString) -> [Statement]
recordEdges Directed
d Graph (Maybe ByteString) (ByteString, ByteString)
g forall a. Semigroup a => a -> a -> a
<> Graph (Maybe ByteString) (ByteString, ByteString) -> [Statement]
recordNodes Graph (Maybe ByteString) (ByteString, ByteString)
g

-- | Convert a node ID to a label for chart-svg charts
-- Doing this directly in dot doesn't quite work because the engines get the width of the link wrong.
toURL :: ByteString -> Maybe ByteString
toURL :: ByteString -> Maybe ByteString
toURL ByteString
name = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ItemModule
i' -> [i|https://hackage.haskell.org/package/#{view #itemPackage i'}/docs/#{view #itemModule i'}.html\#t:#{view #item i'}|]) Maybe ItemModule
item
  where
    item :: Maybe ItemModule
item = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
== ByteString
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "item" a => a
#item) [ItemModule]
itemModules

-- | AST 'Graph'
--
-- > gAST = dotAST allSC componentEdges
-- > C.writeFile "other/ast.dot" $ dotPrint defaultDotConfig gAST
-- > bsSvg <- processDotWith Directed ["-Tsvg"] (dotPrint defaultDotConfig gAST)
-- > C.writeFile "other/ast.svg" bsSvg
dotAST :: [SubComponents] -> [ComponentEdge] -> Graph
dotAST :: [SubComponents] -> [ComponentEdge] -> Graph
dotAST [SubComponents]
sc [ComponentEdge]
ce =
  Graph
defaultGraph
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (AttributeType -> ID -> Lens' Graph (Maybe ID)
attL AttributeType
GraphType (ByteString -> ID
ID ByteString
"size")) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> ID
IDQuoted ByteString
"5")
    forall a b. a -> (a -> b) -> b
& [Statement] -> Graph -> Graph
addStatements (Directed
-> Graph (Maybe ByteString) (ByteString, ByteString) -> [Statement]
toStatementsRecord Directed
Directed ([SubComponents]
-> [ComponentEdge]
-> Graph (Maybe ByteString) (ByteString, ByteString)
graphAST [SubComponents]
sc [ComponentEdge]
ce))
    forall a b. a -> (a -> b) -> b
& AttributeType -> ID -> Lens' Graph (Maybe ID)
attL AttributeType
NodeType (ByteString -> ID
ID ByteString
"shape")
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just (ByteString -> ID
ID ByteString
"record")
    forall a b. a -> (a -> b) -> b
& ID -> Lens' Graph (Maybe ID)
gattL (ByteString -> ID
ID ByteString
"rankdir")
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just (ByteString -> ID
IDQuoted ByteString
"LR")

-- | Link values
data ItemModule = ItemModule {ItemModule -> ByteString
item :: ByteString, ItemModule -> ByteString
itemModule :: ByteString, ItemModule -> ByteString
itemPackage :: ByteString} deriving (ItemModule -> ItemModule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemModule -> ItemModule -> Bool
$c/= :: ItemModule -> ItemModule -> Bool
== :: ItemModule -> ItemModule -> Bool
$c== :: ItemModule -> ItemModule -> Bool
Eq, Int -> ItemModule -> ShowS
[ItemModule] -> ShowS
ItemModule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemModule] -> ShowS
$cshowList :: [ItemModule] -> ShowS
show :: ItemModule -> String
$cshow :: ItemModule -> String
showsPrec :: Int -> ItemModule -> ShowS
$cshowsPrec :: Int -> ItemModule -> ShowS
Show, forall x. Rep ItemModule x -> ItemModule
forall x. ItemModule -> Rep ItemModule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ItemModule x -> ItemModule
$cfrom :: forall x. ItemModule -> Rep ItemModule x
Generic)

-- | List of link values
itemModules :: [ItemModule]
itemModules :: [ItemModule]
itemModules =
  [ ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"ChartOptions" ByteString
"Chart-Markup" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"MarkupOptions" ByteString
"Chart-Markup" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"CssOptions" ByteString
"Chart-Markup" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"ChartTree" ByteString
"Chart-Primitive" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Chart" ByteString
"Chart-Primitive" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"HudOptions" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"RenderStyle" ByteString
"Chart-Markup" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"ChartAspect" ByteString
"Chart-Primitive" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"ShapeRendering" ByteString
"Chart-Markup" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"PreferColorScheme" ByteString
"Chart-Primitive" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Tree" ByteString
"Data-Tree" ByteString
"containers",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Priority" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"TitleOptions" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"AxisOptions" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"LegendOptions" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"FrameOptions" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Adjustments" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Ticks" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Tick" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Place" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"TickStyle" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"AxisBar" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"HudChartSection" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"TickExtend" ByteString
"Chart-Hud" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"FormatN" ByteString
"Data-FormatN" ByteString
"formatn",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"FStyle" ByteString
"Data-FormatN" ByteString
"formatn",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Colour" ByteString
"Data-Colour" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Style" ByteString
"Chart-Style" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"EscapeText" ByteString
"Chart-Style" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"GlyphShape" ByteString
"Chart-Style" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Anchor" ByteString
"Chart-Style" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"LineCap" ByteString
"Chart-Style" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"LineJoin" ByteString
"Chart-Style" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"ScaleP" ByteString
"Chart-Style" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"ChartData" ByteString
"Chart-Primitive" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"PathData" ByteString
"Data-Path" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"ArcInfo" ByteString
"Data-Path" ByteString
"chart-svg",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Rect" ByteString
"NumHask-Space-Rect" ByteString
"numhask-space",
    ByteString -> ByteString -> ByteString -> ItemModule
ItemModule ByteString
"Point" ByteString
"NumHask-Space-Point" ByteString
"numhask-space"
  ]

-- | list of chart-svg component edges
componentEdges :: [ComponentEdge]
componentEdges :: [ComponentEdge]
componentEdges =
  [ ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartOptions" ByteString
"markupOptions" ByteString
"MarkupOptions" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartOptions" ByteString
"hudOptions" ByteString
"HudOptions" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartOptions" ByteString
"chartTree" ByteString
"ChartTree" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"MarkupOptions" ByteString
"chartAspect" ByteString
"ChartAspect" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"MarkupOptions" ByteString
"cssOptions" ByteString
"CssOptions" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"MarkupOptions" ByteString
"renderStyle" ByteString
"RenderStyle" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"CssOptions" ByteString
"shapeRendering" ByteString
"ShapeRendering" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"CssOptions" ByteString
"preferColorScheme" ByteString
"PreferColorScheme" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"HudOptions" ByteString
"axes" ByteString
"AxisOptions" (forall a. a -> Maybe a
Just ByteString
"each % #item"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"HudOptions" ByteString
"frames" ByteString
"FrameOptions" (forall a. a -> Maybe a
Just ByteString
"each % #item"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"HudOptions" ByteString
"legends" ByteString
"LegendOptions" (forall a. a -> Maybe a
Just ByteString
"each % #item"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"HudOptions" ByteString
"titles" ByteString
"TitleOptions" (forall a. a -> Maybe a
Just ByteString
"each % #item"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"HudOptions" ByteString
"axes" ByteString
"Priority" (forall a. a -> Maybe a
Just ByteString
"each % #priority"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"HudOptions" ByteString
"frames" ByteString
"Priority" (forall a. a -> Maybe a
Just ByteString
"each % #priority"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"HudOptions" ByteString
"legends" ByteString
"Priority" (forall a. a -> Maybe a
Just ByteString
"each % #priority"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"HudOptions" ByteString
"titles" ByteString
"Priority" (forall a. a -> Maybe a
Just ByteString
"each % #priority"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"AxisOptions" ByteString
"axisBar" ByteString
"AxisBar" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"AxisOptions" ByteString
"adjustments" ByteString
"Adjustments" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"AxisOptions" ByteString
"ticks" ByteString
"Ticks" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"AxisOptions" ByteString
"place" ByteString
"Place" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"AxisBar" ByteString
"style" ByteString
"Style" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"AxisBar" ByteString
"anchorTo" ByteString
"HudChartSection" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Tick" ByteString
"formatN'" ByteString
"FormatN" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"FormatN" ByteString
"fstyle" ByteString
"FStyle" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Tick" ByteString
"tickExtend'" ByteString
"TickExtend" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Ticks" ByteString
"tick" ByteString
"Tick" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Ticks" ByteString
"glyphTick" ByteString
"TickStyle" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Ticks" ByteString
"textTick" ByteString
"TickStyle" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Ticks" ByteString
"lineTick" ByteString
"TickStyle" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"TickStyle" ByteString
"style" ByteString
"Style" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"TickStyle" ByteString
"anchorTo" ByteString
"HudChartSection" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"FrameOptions" ByteString
"frame" ByteString
"Style" (forall a. a -> Maybe a
Just ByteString
"#frame % _Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"FrameOptions" ByteString
"anchorTo" ByteString
"HudChartSection" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"TitleOptions" ByteString
"style" ByteString
"Style" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"TitleOptions" ByteString
"place" ByteString
"Place" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"TitleOptions" ByteString
"anchor" ByteString
"Anchor" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartTree" ByteString
"tree" ByteString
"Tree" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartTree" ByteString
"charts'" ByteString
"Chart" (forall a. a -> Maybe a
Just ByteString
"each"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Chart" ByteString
"chartStyle" ByteString
"Style" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Chart" ByteString
"chartData" ByteString
"ChartData" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartData" ByteString
"rectData'" ByteString
"Rect" (forall a. a -> Maybe a
Just ByteString
"_Just % each"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartData" ByteString
"lineData'" ByteString
"Point" (forall a. a -> Maybe a
Just ByteString
"_Just % each % each"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartData" ByteString
"glyphData'" ByteString
"Point" (forall a. a -> Maybe a
Just ByteString
"_Just % each"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartData" ByteString
"textData'" ByteString
"(Text,Point)" (forall a. a -> Maybe a
Just ByteString
"_Just % each"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"(Text,Point)" ByteString
"_2" ByteString
"Point" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartData" ByteString
"pathData'" ByteString
"PathData" (forall a. a -> Maybe a
Just ByteString
"_Just % each"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"ChartData" ByteString
"blankData'" ByteString
"Rect" (forall a. a -> Maybe a
Just ByteString
"_Just % each"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"LegendOptions" ByteString
"textStyle" ByteString
"Style" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"LegendOptions" ByteString
"frame" ByteString
"Style" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"LegendOptions" ByteString
"place" ByteString
"Place" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"LegendOptions" ByteString
"scaleP" ByteString
"ScaleP" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"LegendOptions" ByteString
"legendCharts" ByteString
"Chart" (forall a. a -> Maybe a
Just ByteString
"each % _2 % each"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"PathData" ByteString
"ArcP" ByteString
"ArcInfo" (forall a. a -> Maybe a
Just ByteString
"(ArcP arcinfo _)"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"color" ByteString
"Colour" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"borderColor" ByteString
"Colour" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"scaleP" ByteString
"ScaleP" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"anchor" ByteString
"Anchor" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"translate" ByteString
"Point" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"escapeText" ByteString
"EscapeText" (forall a. a -> Maybe a
Just ByteString
""),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"frame" ByteString
"Style" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"lineCap" ByteString
"LineCap" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"lineJoin" ByteString
"LineJoin" (forall a. a -> Maybe a
Just ByteString
"_Just"),
    ByteString
-> ByteString -> ByteString -> Maybe ByteString -> ComponentEdge
ComponentEdge ByteString
"Style" ByteString
"glyphShape" ByteString
"GlyphShape" (forall a. a -> Maybe a
Just ByteString
"")
  ]

-- | list of chart-svg subcomponents
allSC :: [SubComponents]
allSC :: [SubComponents]
allSC =
  [ SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"AxisBar",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"style",
            ByteString
"size",
            ByteString
"buffer",
            ByteString
"overhang",
            ByteString
"anchorTo"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"AxisOptions",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"axisBar",
            ByteString
"adjustments",
            ByteString
"ticks",
            ByteString
"place"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"Chart",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"chartStyle",
            ByteString
"chartData"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"ChartData",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"rectData'",
            ByteString
"lineData'",
            ByteString
"glyphData'",
            ByteString
"textData'",
            ByteString
"pathData'",
            ByteString
"blankData'"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"ChartOptions",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"markupOptions",
            ByteString
"hudOptions",
            ByteString
"chartTree"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"ChartTree",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"tree",
            ByteString
"charts'"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"FrameOptions",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"frame",
            ByteString
"anchorTo",
            ByteString
"buffer"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"HudOptions",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"axes",
            ByteString
"frames",
            ByteString
"legends",
            ByteString
"titles"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"MarkupOptions",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"markupHeight",
            ByteString
"chartAspect",
            ByteString
"cssOptions",
            ByteString
"renderStyle"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"(Text,Point)",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"_1",
            ByteString
"_2"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"TickStyle",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"style",
            ByteString
"anchorTo",
            ByteString
"buffer"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"Ticks",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"tick",
            ByteString
"glyphTick",
            ByteString
"textTick",
            ByteString
"lineTick"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"TitleOptions",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"text",
            ByteString
"style",
            ByteString
"place",
            ByteString
"anchor",
            ByteString
"buffer"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"RenderStyle",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"Compact",
            ByteString
"Indented"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"CssOptions",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"shapeRendering",
            ByteString
"preferColorScheme",
            ByteString
"fontFamilies",
            ByteString
"cssExtra"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"ChartAspect",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"FixedAspect",
            ByteString
"CanvasAspect",
            ByteString
"ChartAspect",
            ByteString
"UnscaledAspect"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"HudChartSection",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"CanvasSection",
            ByteString
"CanvasStyleSection",
            ByteString
"HudSection",
            ByteString
"HudStyleSection"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"Adjustments",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"maxXRatio",
            ByteString
"maxYRatio",
            ByteString
"angledRatio",
            ByteString
"allowDiagonal"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"Tick",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"TickNone",
            ByteString
"TickLabels",
            ByteString
"TickRound",
            ByteString
"TickExact",
            ByteString
"TickPlaced",
            ByteString
"numTicks'",
            ByteString
"formatN'",
            ByteString
"tickExtend'"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"TickExtend",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"TickExtend",
            ByteString
"NoTickExtend"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"FStyle",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"FSDecimal",
            ByteString
"FSExponent",
            ByteString
"FSComma",
            ByteString
"FSFixed Int",
            ByteString
"FSPercent",
            ByteString
"FSDollar",
            ByteString
"FSPrec",
            ByteString
"FSCommaPrec",
            ByteString
"FSNone"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"FormatN",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"fstyle",
            ByteString
"sigFigs",
            ByteString
"maxDistinguishIterations",
            ByteString
"addLPad",
            ByteString
"cutRightZeros"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"ShapeRendering",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"UseGeometricPrecision",
            ByteString
"UseCssCrisp",
            ByteString
"NoShapeRendering"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"PreferColorScheme",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"PreferHud",
            ByteString
"PreferDark",
            ByteString
"PreferLight",
            ByteString
"PreferNormal"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"Place",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"PlaceLeft",
            ByteString
"PlaceRight",
            ByteString
"PlaceTop",
            ByteString
"PlaceBottom",
            ByteString
"PlaceAbsolute"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"LegendOptions",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"legendSize",
            ByteString
"buffer",
            ByteString
"vgap",
            ByteString
"hgap",
            ByteString
"textStyle",
            ByteString
"innerPad",
            ByteString
"outerPad",
            ByteString
"frame",
            ByteString
"place",
            ByteString
"scaleChartsBy",
            ByteString
"scaleP",
            ByteString
"legendCharts"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"Anchor",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"AnchorMiddle",
            ByteString
"AnchorStart",
            ByteString
"AnchorEnd"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"Point",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"_x",
            ByteString
"_y"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"PathData",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"StartP",
            ByteString
"LineP",
            ByteString
"CubicP",
            ByteString
"QuadP",
            ByteString
"ArcP"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"ArcInfo",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"radii",
            ByteString
"phi",
            ByteString
"large",
            ByteString
"clockwise"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"Style",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"size",
            ByteString
"borderSize",
            ByteString
"color",
            ByteString
"borderColor",
            ByteString
"scaleP",
            ByteString
"anchor",
            ByteString
"rotation",
            ByteString
"translate",
            ByteString
"escapeText",
            ByteString
"frame",
            ByteString
"lineCap",
            ByteString
"lineJoin",
            ByteString
"dasharray",
            ByteString
"dashoffset",
            ByteString
"hsize",
            ByteString
"vsize",
            ByteString
"vshift",
            ByteString
"glyphShape"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"ScaleP",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"NoScaleP",
            ByteString
"ScalePX",
            ByteString
"ScalePY",
            ByteString
"ScalePMinDim",
            ByteString
"ScalePArea"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"Colour",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"opac'",
            ByteString
"lightness'",
            ByteString
"chroma'",
            ByteString
"hue'"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"EscapeText",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"EscapeText",
            ByteString
"NoEscapeText"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"LineCap",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"LineCapButt",
            ByteString
"LineCapRound",
            ByteString
"LineCapSquare"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"LineJoin",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"LineJoinMiter",
            ByteString
"LineJoinBevel",
            ByteString
"LineJoinRound"
          ]
      },
    SubComponents
      { classComponent :: ByteString
classComponent = ByteString
"GlyphShape",
        subComponents :: [ByteString]
subComponents =
          [ ByteString
"CircleGlyph",
            ByteString
"SquareGlyph",
            ByteString
"EllipseGlyph",
            ByteString
"RectSharpGlyph",
            ByteString
"RectRoundedGlyph",
            ByteString
"TriangleGlyph",
            ByteString
"VLineGlyph",
            ByteString
"HLineGlyph",
            ByteString
"PathGlyph"
          ]
      }
  ]