{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use ?~" #-}

-- | Example of Dot graph construction for the NumHask class heirarchy.
module DotParse.Examples.NumHask where

import qualified Algebra.Graph as G
import Chart
import Data.Bifunctor
import qualified Data.Map.Strict as Map
import Data.Monoid
import Data.Text (Text, pack)
import DotParse
import GHC.IO.Unsafe
import Optics.Core
import Prelude hiding (replicate)

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

data Class
  = Magma
  | Unital
  | Associative
  | Commutative
  | Invertible
  | Idempotent
  | Absorbing
  | Group
  | AbelianGroup
  | Additive
  | Subtractive
  | Multiplicative
  | Divisive
  | Distributive
  | Semiring
  | Ring
  | IntegralDomain
  | Field
  | ExpField
  | QuotientField
  | UpperBoundedField
  | LowerBoundedField
  | TrigField
  | -- Higher-kinded numbers
    AdditiveAction
  | SubtractiveAction
  | MultiplicativeAction
  | DivisiveAction
  | Module
  | -- Lattice
    JoinSemiLattice
  | MeetSemiLattice
  | Lattice
  | BoundedJoinSemiLattice
  | BoundedMeetSemiLattice
  | BoundedLattice
  | -- Number Types
    Integral
  | Ratio
  | -- Measure
    Signed
  | Norm
  | Basis
  | Direction
  | Epsilon
  deriving (Int -> Class -> ShowS
[Class] -> ShowS
Class -> String
(Int -> Class -> ShowS)
-> (Class -> String) -> ([Class] -> ShowS) -> Show Class
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Class] -> ShowS
$cshowList :: [Class] -> ShowS
show :: Class -> String
$cshow :: Class -> String
showsPrec :: Int -> Class -> ShowS
$cshowsPrec :: Int -> Class -> ShowS
Show, Class -> Class -> Bool
(Class -> Class -> Bool) -> (Class -> Class -> Bool) -> Eq Class
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Class -> Class -> Bool
$c/= :: Class -> Class -> Bool
== :: Class -> Class -> Bool
$c== :: Class -> Class -> Bool
Eq, Eq Class
Eq Class
-> (Class -> Class -> Ordering)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Bool)
-> (Class -> Class -> Class)
-> (Class -> Class -> Class)
-> Ord Class
Class -> Class -> Bool
Class -> Class -> Ordering
Class -> Class -> Class
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 :: Class -> Class -> Class
$cmin :: Class -> Class -> Class
max :: Class -> Class -> Class
$cmax :: Class -> Class -> Class
>= :: Class -> Class -> Bool
$c>= :: Class -> Class -> Bool
> :: Class -> Class -> Bool
$c> :: Class -> Class -> Bool
<= :: Class -> Class -> Bool
$c<= :: Class -> Class -> Bool
< :: Class -> Class -> Bool
$c< :: Class -> Class -> Bool
compare :: Class -> Class -> Ordering
$ccompare :: Class -> Class -> Ordering
$cp1Ord :: Eq Class
Ord)

data Family
  = Addition
  | Multiplication
  | Actor
  deriving (Int -> Family -> ShowS
[Family] -> ShowS
Family -> String
(Int -> Family -> ShowS)
-> (Family -> String) -> ([Family] -> ShowS) -> Show Family
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Family] -> ShowS
$cshowList :: [Family] -> ShowS
show :: Family -> String
$cshow :: Family -> String
showsPrec :: Int -> Family -> ShowS
$cshowsPrec :: Int -> Family -> ShowS
Show, Family -> Family -> Bool
(Family -> Family -> Bool)
-> (Family -> Family -> Bool) -> Eq Family
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Family -> Family -> Bool
$c/= :: Family -> Family -> Bool
== :: Family -> Family -> Bool
$c== :: Family -> Family -> Bool
Eq, Eq Family
Eq Family
-> (Family -> Family -> Ordering)
-> (Family -> Family -> Bool)
-> (Family -> Family -> Bool)
-> (Family -> Family -> Bool)
-> (Family -> Family -> Bool)
-> (Family -> Family -> Family)
-> (Family -> Family -> Family)
-> Ord Family
Family -> Family -> Bool
Family -> Family -> Ordering
Family -> Family -> Family
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 :: Family -> Family -> Family
$cmin :: Family -> Family -> Family
max :: Family -> Family -> Family
$cmax :: Family -> Family -> Family
>= :: Family -> Family -> Bool
$c>= :: Family -> Family -> Bool
> :: Family -> Family -> Bool
$c> :: Family -> Family -> Bool
<= :: Family -> Family -> Bool
$c<= :: Family -> Family -> Bool
< :: Family -> Family -> Bool
$c< :: Family -> Family -> Bool
compare :: Family -> Family -> Ordering
$ccompare :: Family -> Family -> Ordering
$cp1Ord :: Eq Family
Ord)

data Dependency = Dependency
  { Dependency -> Class
_class :: Class,
    Dependency -> Class
_dep :: Class,
    Dependency -> Maybe Family
_op :: Maybe Family
  }
  deriving (Int -> Dependency -> ShowS
[Dependency] -> ShowS
Dependency -> String
(Int -> Dependency -> ShowS)
-> (Dependency -> String)
-> ([Dependency] -> ShowS)
-> Show Dependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dependency] -> ShowS
$cshowList :: [Dependency] -> ShowS
show :: Dependency -> String
$cshow :: Dependency -> String
showsPrec :: Int -> Dependency -> ShowS
$cshowsPrec :: Int -> Dependency -> ShowS
Show, Dependency -> Dependency -> Bool
(Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool) -> Eq Dependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependency -> Dependency -> Bool
$c/= :: Dependency -> Dependency -> Bool
== :: Dependency -> Dependency -> Bool
$c== :: Dependency -> Dependency -> Bool
Eq, Eq Dependency
Eq Dependency
-> (Dependency -> Dependency -> Ordering)
-> (Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Dependency)
-> (Dependency -> Dependency -> Dependency)
-> Ord Dependency
Dependency -> Dependency -> Bool
Dependency -> Dependency -> Ordering
Dependency -> Dependency -> Dependency
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 :: Dependency -> Dependency -> Dependency
$cmin :: Dependency -> Dependency -> Dependency
max :: Dependency -> Dependency -> Dependency
$cmax :: Dependency -> Dependency -> Dependency
>= :: Dependency -> Dependency -> Bool
$c>= :: Dependency -> Dependency -> Bool
> :: Dependency -> Dependency -> Bool
$c> :: Dependency -> Dependency -> Bool
<= :: Dependency -> Dependency -> Bool
$c<= :: Dependency -> Dependency -> Bool
< :: Dependency -> Dependency -> Bool
$c< :: Dependency -> Dependency -> Bool
compare :: Dependency -> Dependency -> Ordering
$ccompare :: Dependency -> Dependency -> Ordering
$cp1Ord :: Eq Dependency
Ord)

dependencies :: [Dependency]
dependencies :: [Dependency]
dependencies =
  [ Class -> Class -> Maybe Family -> Dependency
Dependency Class
Unital Class
Magma Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Associative Class
Magma Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Commutative Class
Magma Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Invertible Class
Magma Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Idempotent Class
Magma Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Absorbing Class
Magma Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Group Class
Unital Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Group Class
Invertible Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Group Class
Associative Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
AbelianGroup Class
Unital Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
AbelianGroup Class
Invertible Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
AbelianGroup Class
Associative Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
AbelianGroup Class
Commutative Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Additive Class
Commutative (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Addition),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Additive Class
Unital (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Addition),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Additive Class
Associative (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Addition),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Subtractive Class
Invertible (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Addition),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Subtractive Class
Additive (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Addition),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Multiplicative Class
Unital (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Multiplication),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Multiplicative Class
Associative (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Multiplication),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Multiplicative Class
Commutative (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Multiplication),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Divisive Class
Invertible (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Multiplication),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Divisive Class
Multiplicative (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Multiplication),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Distributive Class
Additive (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Addition),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Distributive Class
Multiplicative (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Multiplication),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Distributive Class
Absorbing Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Ring Class
Distributive Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Ring Class
Subtractive (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Addition),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
IntegralDomain Class
Ring Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Field Class
Ring Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Field Class
Divisive (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Multiplication),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
ExpField Class
Field Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
QuotientField Class
Field Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
QuotientField Class
Ring Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
TrigField Class
Field Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
UpperBoundedField Class
Field Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
LowerBoundedField Class
Field Maybe Family
forall a. Maybe a
Nothing,
    -- higher-kinded relationships
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
AdditiveAction Class
Additive (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Actor),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
SubtractiveAction Class
Subtractive (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Actor),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
MultiplicativeAction Class
Multiplicative (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Actor),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
DivisiveAction Class
Divisive (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Actor),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Module Class
Distributive (Family -> Maybe Family
forall a. a -> Maybe a
Just Family
Actor),
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Module Class
MultiplicativeAction Maybe Family
forall a. Maybe a
Nothing,
    -- Lattice
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
JoinSemiLattice Class
Associative Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
JoinSemiLattice Class
Commutative Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
JoinSemiLattice Class
Idempotent Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
MeetSemiLattice Class
Associative Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
MeetSemiLattice Class
Commutative Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
MeetSemiLattice Class
Idempotent Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Lattice Class
JoinSemiLattice Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Lattice Class
MeetSemiLattice Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
BoundedJoinSemiLattice Class
JoinSemiLattice Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
BoundedJoinSemiLattice Class
Unital Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
BoundedMeetSemiLattice Class
MeetSemiLattice Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
BoundedMeetSemiLattice Class
Unital Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
BoundedLattice Class
BoundedJoinSemiLattice Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
BoundedLattice Class
BoundedMeetSemiLattice Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Signed Class
Ring Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Norm Class
Ring Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Basis Class
Ring Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Direction Class
Ring Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Epsilon Class
Subtractive Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Epsilon Class
MeetSemiLattice Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Integral Class
Ring Maybe Family
forall a. Maybe a
Nothing,
    Class -> Class -> Maybe Family -> Dependency
Dependency Class
Ratio Class
Field Maybe Family
forall a. Maybe a
Nothing
  ]

classesNH :: [Class]
classesNH :: [Class]
classesNH =
  [ Class
Additive,
    Class
Subtractive,
    Class
Multiplicative,
    Class
Divisive,
    Class
Distributive,
    Class
Ring,
    Class
Field,
    Class
ExpField,
    Class
QuotientField,
    Class
TrigField,
    Class
Signed,
    Class
Norm,
    Class
Direction,
    Class
MultiplicativeAction,
    Class
Module,
    Class
UpperBoundedField,
    Class
LowerBoundedField,
    Class
Integral,
    Class
Ratio
  ]

classesModule :: [(Class, Text)]
classesModule :: [(Class, Text)]
classesModule =
  [ (Class
Additive, Text
"NumHask-Algebra-Additive"),
    (Class
Subtractive, Text
"NumHask-Algebra-Additive"),
    (Class
Multiplicative, Text
"NumHask-Algebra-Multiplicative"),
    (Class
Divisive, Text
"NumHask-Algebra-Multiplicative"),
    (Class
Distributive, Text
"NumHask-Algebra-Distributive"),
    (Class
Ring, Text
"NumHask-Algebra-Ring"),
    (Class
Field, Text
"NumHask-Algebra-Field"),
    (Class
ExpField, Text
"NumHask-Algebra-Field"),
    (Class
QuotientField, Text
"NumHask-Algebra-Field"),
    (Class
TrigField, Text
"NumHask-Algebra-Field"),
    (Class
Signed, Text
"NumHask-Algebra-Metric"),
    (Class
Norm, Text
"NumHask-Algebra-Metric"),
    (Class
Direction, Text
"NumHask-Algebra-Metric"),
    (Class
MultiplicativeAction, Text
"NumHask-Algebra-Module"),
    (Class
Module, Text
"NumHask-Algebra-Module"),
    (Class
UpperBoundedField, Text
"NumHask-Algebra-Field"),
    (Class
LowerBoundedField, Text
"NumHask-Algebra-Field"),
    (Class
Integral, Text
"NumHask-Data-Integral"),
    (Class
Ratio, Text
"NumHask-Data-Rational")
  ]

dependenciesNH :: [Dependency] -> [Dependency]
dependenciesNH :: [Dependency] -> [Dependency]
dependenciesNH = (Dependency -> Bool) -> [Dependency] -> [Dependency]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Dependency Class
x0 Class
x1 Maybe Family
_) -> Class
x0 Class -> [Class] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Class]
classesNH Bool -> Bool -> Bool
&& Class
x1 Class -> [Class] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Class]
classesNH)

-- | NumHask Classes as an algebraic graph
graphNHG :: G.Graph Class
graphNHG :: Graph Class
graphNHG =
  [(Class, Class)] -> Graph Class
forall a. [(a, a)] -> Graph a
G.edges ((\(Dependency Class
x Class
y Maybe Family
_) -> (Class
x, Class
y)) (Dependency -> (Class, Class)) -> [Dependency] -> [(Class, Class)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dependency] -> [Dependency]
dependenciesNH [Dependency]
dependencies)
    Graph Class -> Graph Class -> Graph Class
forall a. Semigroup a => a -> a -> a
<> [Class] -> Graph Class
forall a. [a] -> Graph a
G.vertices [Class]
classesNH

-- | NumHask statements in a dot Graph with box shapes for the nodes.
dotGraphNH :: Directed -> Graph
dotGraphNH :: Directed -> Graph
dotGraphNH Directed
d =
  Graph
defaultGraph
    Graph -> (Graph -> Graph) -> Graph
forall a b. a -> (a -> b) -> b
& IsLabel
  "directed"
  (Optic A_Lens NoIx Graph Graph (Last Directed) (Last Directed))
Optic A_Lens NoIx Graph Graph (Last Directed) (Last Directed)
#directed Optic A_Lens NoIx Graph Graph (Last Directed) (Last Directed)
-> Last Directed -> Graph -> Graph
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Maybe Directed -> Last Directed
forall a. Maybe a -> Last a
Last (Directed -> Maybe Directed
forall a. a -> Maybe a
Just Directed
d)
    Graph -> (Graph -> Graph) -> Graph
forall a b. a -> (a -> b) -> b
& [Statement] -> Graph -> Graph
addStatements (Directed -> Graph ByteString -> [Statement]
toStatements Directed
d (String -> ByteString
packUTF8 (String -> ByteString) -> (Class -> String) -> Class -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> String
forall a. Show a => a -> String
show (Class -> ByteString) -> Graph Class -> Graph ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Graph Class
graphNHG))
    Graph -> (Graph -> Graph) -> Graph
forall a b. a -> (a -> b) -> b
& AttributeType -> ID -> Lens' Graph (Maybe ID)
attL AttributeType
NodeType (ByteString -> ID
ID ByteString
"shape") Lens' Graph (Maybe ID) -> Maybe ID -> Graph -> Graph
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ID -> Maybe ID
forall a. a -> Maybe a
Just (ByteString -> ID
ID ByteString
"box")
    Graph -> (Graph -> Graph) -> Graph
forall a b. a -> (a -> b) -> b
& ID -> Lens' Graph (Maybe ID)
gattL (ByteString -> ID
ID ByteString
"rankdir") Lens' Graph (Maybe ID) -> Maybe ID -> Graph -> Graph
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ID -> Maybe ID
forall a. a -> Maybe a
Just (ByteString -> ID
IDQuoted ByteString
"BT")

-- | 'dotGraphNH' after being positionally processed via 'processGraph'
dotGraphNH' :: Directed -> Graph
dotGraphNH' :: Directed -> Graph
dotGraphNH' Directed
d = IO Graph -> Graph
forall a. IO a -> a
unsafePerformIO (IO Graph -> Graph) -> IO Graph -> Graph
forall a b. (a -> b) -> a -> b
$ Graph -> IO Graph
processGraph (Directed -> Graph
dotGraphNH Directed
d)
{-# NOINLINE dotGraphNH' #-}

-- | 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.
toLink :: ID -> Text
toLink :: ID -> Text
toLink ID
i = [trimming|<a href="https://hackage.haskell.org/package/numhask/docs/$m.html#t:$t">$t</a>|]
  where
    t :: Text
t = String -> Text
pack (ID -> String
label ID
i)
    m :: Text
m = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Class -> Text) -> (Class, Text) -> (Text, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (Class -> String) -> Class -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> String
forall a. Show a => a -> String
show) ((Class, Text) -> (Text, Text))
-> [(Class, Text)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Class, Text)]
classesModule) Map Text Text -> Text -> Text
forall k a. Ord k => Map k a -> k -> a
Map.! Text
t

-- | A chart-svg chart with label links
--
-- > writeChartSvg "other/nh.svg" (graphToChart toLink (dotGraphNH' Directed))
--
-- ![NumHask Example](other/nh.svg)
writeNHChart :: IO ()
writeNHChart :: IO ()
writeNHChart = String -> ChartSvg -> IO ()
writeChartSvg String
"other/nh.svg" (ChartConfig -> Graph -> ChartSvg
graphToChartWith (ChartConfig
defaultChartConfig ChartConfig -> (ChartConfig -> ChartConfig) -> ChartConfig
forall a b. a -> (a -> b) -> b
& IsLabel
  "labelf"
  (Optic
     A_Lens NoIx ChartConfig ChartConfig (ID -> Text) (ID -> Text))
Optic A_Lens NoIx ChartConfig ChartConfig (ID -> Text) (ID -> Text)
#labelf Optic A_Lens NoIx ChartConfig ChartConfig (ID -> Text) (ID -> Text)
-> (ID -> Text) -> ChartConfig -> ChartConfig
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ID -> Text
toLink) (Directed -> Graph
dotGraphNH' Directed
Directed))