module ExportGraphViz.ExportGraphViz
(
categoryToGraph,
catToDot,
catToPdf,
genToDot,
genToPdf,
diagToDotCluster,
diagToPdfCluster,
diagToDot,
diagToPdf,
diagToDot2,
diagToPdf2,
natToDot,
natToPdf,
coneToDot,
coneToPdf
)
where
import FiniteCategory.FiniteCategory
import Diagram.Diagram
import FunctorCategory.FunctorCategory
import Utils.AssociationList
import ConeCategory.ConeCategory
import Subcategories.FreeSubcategory
import Data.List (elemIndex,intercalate)
import qualified Data.Text.Lazy as L (pack)
import qualified Data.Text.Lazy.IO as IO (putStrLn)
import IO.CreateAndWriteFile (createAndWriteFile)
import IO.PrettyPrint
import Data.Graph.Inductive.Graph (mkGraph, Node, Edge, LNode, LEdge)
import Data.Graph.Inductive.PatriciaTree (Gr)
import Data.GraphViz (graphToDot, nonClusteredParams, fmtNode, fmtEdge, GraphvizParams(..), NodeCluster(..), blankParams,GraphID( Num ), Number(..))
import Data.GraphViz.Attributes.Complete (Label(StrLabel), Attribute(Label))
import Data.Word (Word8)
import Data.GraphViz.Attributes (X11Color(..), color)
import Data.GraphViz.Printing (renderDot, toDot)
import Data.Maybe
import System.Process (callCommand)
objToNode :: (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode :: forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c
c o
o
| Maybe Node
index Maybe Node -> Maybe Node -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Node
forall a. Maybe a
Nothing = [Char] -> Node
forall a. HasCallStack => [Char] -> a
error([Char]
"Call objToNod on an object not in the category.")
| Bool
otherwise = Node
i
where
Just Node
i = Maybe Node
index
index :: Maybe Node
index = o -> [o] -> Maybe Node
forall a. Eq a => a -> [a] -> Maybe Node
elemIndex o
o (c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
c)
objToLNode :: (Eq o, PrettyPrintable o, FiniteCategory c m o) => c -> o -> LNode String
objToLNode :: forall o c m.
(Eq o, PrettyPrintable o, FiniteCategory c m o) =>
c -> o -> LNode [Char]
objToLNode c
c o
o = (c -> o -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c
c o
o, o -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint o
o)
arToEdge :: (Eq o, Morphism m o, FiniteCategory c m o) => c -> m -> Edge
arToEdge :: forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> m -> Edge
arToEdge c
c m
m = ((c -> o -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c
c)(o -> Node) -> (m -> o) -> m -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> o
forall m o. Morphism m o => m -> o
source (m -> Node) -> m -> Node
forall a b. (a -> b) -> a -> b
$ m
m, (c -> o -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c
c)(o -> Node) -> (m -> o) -> m -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> o
forall m o. Morphism m o => m -> o
target (m -> Node) -> m -> Node
forall a b. (a -> b) -> a -> b
$ m
m)
arToLEdge :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, FiniteCategory c m o) => c -> m -> LEdge String
arToLEdge :: forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> m -> LEdge [Char]
arToLEdge c
c m
m = ((c -> o -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c
c)(o -> Node) -> (m -> o) -> m -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> o
forall m o. Morphism m o => m -> o
source (m -> Node) -> m -> Node
forall a b. (a -> b) -> a -> b
$ m
m, (c -> o -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c
c)(o -> Node) -> (m -> o) -> m -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> o
forall m o. Morphism m o => m -> o
target (m -> Node) -> m -> Node
forall a b. (a -> b) -> a -> b
$ m
m, m -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint m
m)
categoryToGraph :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, FiniteCategory c m o) => c -> Gr String String
categoryToGraph :: forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr [Char] [Char]
categoryToGraph c
c = [LNode [Char]] -> [LEdge [Char]] -> Gr [Char] [Char]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph (c -> o -> LNode [Char]
forall o c m.
(Eq o, PrettyPrintable o, FiniteCategory c m o) =>
c -> o -> LNode [Char]
objToLNode c
c (o -> LNode [Char]) -> [o] -> [LNode [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
c)) (c -> m -> LEdge [Char]
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> m -> LEdge [Char]
arToLEdge c
c (m -> LEdge [Char]) -> [m] -> [LEdge [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> [m]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c
c))
dotToPdf :: IO () -> String -> IO ()
dotToPdf :: IO () -> [Char] -> IO ()
dotToPdf IO ()
dot [Char]
path = IO ()
dot IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO ()
callCommand ([Char]
"dot "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
path[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" -o "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
path[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
".pdf -T pdf")
catToDot :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> String -> IO ()
catToDot :: forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
GeneratedFiniteCategory c m o) =>
c -> [Char] -> IO ()
catToDot c
c [Char]
path = [Char] -> Text -> IO ()
createAndWriteFile [Char]
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ DotCode -> Text
renderDot (DotCode -> Text) -> DotCode -> Text
forall a b. (a -> b) -> a -> b
$ DotGraph Node -> DotCode
forall a. PrintDot a => a -> DotCode
toDot DotGraph Node
dot_file where
dot_file :: DotGraph Node
dot_file = GraphvizParams Node [Char] [Char] () [Char]
-> Gr [Char] [Char] -> DotGraph Node
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
graphToDot GraphvizParams Node [Char] Any () [Char]
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode :: LNode [Char] -> Attributes
fmtNode= \(Node
n,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label))],
fmtEdge :: LEdge [Char] -> Attributes
fmtEdge= \(Node
n1,Node
n2,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)),
if [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
label [[Char]]
generatorsLabels then X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Black else X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Gray80]} (c -> Gr [Char] [Char]
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr [Char] [Char]
categoryToGraph c
c)
generators :: [m]
generators = c -> [m]
forall c m o.
(GeneratedFiniteCategory c m o, GeneratedFiniteCategory c m o,
Morphism m o) =>
c -> [m]
genArrows c
c
generatorsLabels :: [[Char]]
generatorsLabels = m -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint (m -> [Char]) -> [m] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m]
generators
catToPdf :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> String -> IO ()
catToPdf :: forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
GeneratedFiniteCategory c m o) =>
c -> [Char] -> IO ()
catToPdf c
c [Char]
path = IO () -> [Char] -> IO ()
dotToPdf (c -> [Char] -> IO ()
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
GeneratedFiniteCategory c m o) =>
c -> [Char] -> IO ()
catToDot c
c [Char]
path) [Char]
path
categoryToGeneratorGraph :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> Gr String String
categoryToGeneratorGraph :: forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
GeneratedFiniteCategory c m o) =>
c -> Gr [Char] [Char]
categoryToGeneratorGraph c
c = [LNode [Char]] -> [LEdge [Char]] -> Gr [Char] [Char]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph (c -> o -> LNode [Char]
forall o c m.
(Eq o, PrettyPrintable o, FiniteCategory c m o) =>
c -> o -> LNode [Char]
objToLNode c
c (o -> LNode [Char]) -> [o] -> [LNode [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
c)) (c -> m -> LEdge [Char]
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> m -> LEdge [Char]
arToLEdge c
c (m -> LEdge [Char]) -> [m] -> [LEdge [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> [m]
forall c m o.
(GeneratedFiniteCategory c m o, GeneratedFiniteCategory c m o,
Morphism m o) =>
c -> [m]
genArrows c
c))
genToDot :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> String -> IO ()
genToDot :: forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
GeneratedFiniteCategory c m o) =>
c -> [Char] -> IO ()
genToDot c
c [Char]
path = [Char] -> Text -> IO ()
createAndWriteFile [Char]
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ DotCode -> Text
renderDot (DotCode -> Text) -> DotCode -> Text
forall a b. (a -> b) -> a -> b
$ DotGraph Node -> DotCode
forall a. PrintDot a => a -> DotCode
toDot DotGraph Node
dot_file where
dot_file :: DotGraph Node
dot_file = GraphvizParams Node [Char] [Char] () [Char]
-> Gr [Char] [Char] -> DotGraph Node
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
graphToDot GraphvizParams Node [Char] Any () [Char]
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode :: LNode [Char] -> Attributes
fmtNode= \(Node
n,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label))],
fmtEdge :: LEdge [Char] -> Attributes
fmtEdge= \(Node
n1,Node
n2,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label))]} (c -> Gr [Char] [Char]
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
GeneratedFiniteCategory c m o) =>
c -> Gr [Char] [Char]
categoryToGeneratorGraph c
c)
genToPdf :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> String -> IO ()
genToPdf :: forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
GeneratedFiniteCategory c m o) =>
c -> [Char] -> IO ()
genToPdf c
c [Char]
path = IO () -> [Char] -> IO ()
dotToPdf (c -> [Char] -> IO ()
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
GeneratedFiniteCategory c m o) =>
c -> [Char] -> IO ()
genToDot c
c [Char]
path) [Char]
path
diagObjToNodeCluster :: (Eq o, FiniteCategory c m o) => c -> Bool -> o -> Node
diagObjToNodeCluster :: forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNodeCluster c
c Bool
b o
o
| Maybe Node
index Maybe Node -> Maybe Node -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Node
forall a. Maybe a
Nothing = [Char] -> Node
forall a. HasCallStack => [Char] -> a
error([Char]
"Call diagObjToNod on an object not in the category.")
| Bool
otherwise = if Bool
b then Node
2Node -> Node -> Node
forall a. Num a => a -> a -> a
*Node
i else Node
2Node -> Node -> Node
forall a. Num a => a -> a -> a
*Node
iNode -> Node -> Node
forall a. Num a => a -> a -> a
+Node
1
where
Just Node
i = Maybe Node
index
index :: Maybe Node
index = o -> [o] -> Maybe Node
forall a. Eq a => a -> [a] -> Maybe Node
elemIndex o
o (c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
c)
diagObjToLNodeCluster :: (Eq o, PrettyPrintable o, FiniteCategory c m o) => c -> Bool -> o -> LNode String
diagObjToLNodeCluster :: forall o c m.
(Eq o, PrettyPrintable o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode [Char]
diagObjToLNodeCluster c
c Bool
b o
o = (c -> Bool -> o -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNodeCluster c
c Bool
b o
o, o -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint o
o)
diagArToEdgeCluster :: (Eq o, Morphism m o, FiniteCategory c m o) => c -> Bool -> m -> Edge
diagArToEdgeCluster :: forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> Bool -> m -> Edge
diagArToEdgeCluster c
c Bool
b m
m = ((c -> Bool -> o -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNodeCluster c
c Bool
b)(o -> Node) -> (m -> o) -> m -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> o
forall m o. Morphism m o => m -> o
source (m -> Node) -> m -> Node
forall a b. (a -> b) -> a -> b
$ m
m, (c -> Bool -> o -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNodeCluster c
c Bool
b)(o -> Node) -> (m -> o) -> m -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> o
forall m o. Morphism m o => m -> o
target (m -> Node) -> m -> Node
forall a b. (a -> b) -> a -> b
$ m
m)
diagArToLEdgeCluster :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, FiniteCategory c m o) => c -> Bool -> m -> LEdge String
diagArToLEdgeCluster :: forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> Bool -> m -> LEdge [Char]
diagArToLEdgeCluster c
c Bool
b m
m = ((c -> Bool -> o -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNodeCluster c
c Bool
b)(o -> Node) -> (m -> o) -> m -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> o
forall m o. Morphism m o => m -> o
source (m -> Node) -> m -> Node
forall a b. (a -> b) -> a -> b
$ m
m, (c -> Bool -> o -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNodeCluster c
c Bool
b)(o -> Node) -> (m -> o) -> m -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> o
forall m o. Morphism m o => m -> o
target (m -> Node) -> m -> Node
forall a b. (a -> b) -> a -> b
$ m
m, m -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint m
m)
diagToGraphCluster :: (Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1, Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1,
Eq c2, Eq o2, PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2, GeneratedFiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Gr String String
diagToGraphCluster :: forall c1 o1 m1 c2 o2 m2.
(Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1,
Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1, Eq c2, Eq o2,
PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2,
GeneratedFiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Gr [Char] [Char]
diagToGraphCluster Diagram c1 m1 o1 c2 m2 o2
f = [LNode [Char]] -> [LEdge [Char]] -> Gr [Char] [Char]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph ((c1 -> Bool -> o1 -> LNode [Char]
forall o c m.
(Eq o, PrettyPrintable o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode [Char]
diagObjToLNodeCluster (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
f) Bool
True (o1 -> LNode [Char]) -> [o1] -> [LNode [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
f)))[LNode [Char]] -> [LNode [Char]] -> [LNode [Char]]
forall a. [a] -> [a] -> [a]
++(c2 -> Bool -> o2 -> LNode [Char]
forall o c m.
(Eq o, PrettyPrintable o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode [Char]
diagObjToLNodeCluster (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
f) Bool
False (o2 -> LNode [Char]) -> [o2] -> [LNode [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c2 -> [o2]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
f)))) ((c1 -> Bool -> m1 -> LEdge [Char]
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> Bool -> m -> LEdge [Char]
diagArToLEdgeCluster (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
f) Bool
True (m1 -> LEdge [Char]) -> [m1] -> [LEdge [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c1 -> [m1]
forall c m o.
(GeneratedFiniteCategory c m o, GeneratedFiniteCategory c m o,
Morphism m o) =>
c -> [m]
genArrows (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
f)))[LEdge [Char]] -> [LEdge [Char]] -> [LEdge [Char]]
forall a. [a] -> [a] -> [a]
++(c2 -> Bool -> m2 -> LEdge [Char]
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> Bool -> m -> LEdge [Char]
diagArToLEdgeCluster (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
f) Bool
False (m2 -> LEdge [Char]) -> [m2] -> [LEdge [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c2 -> [m2]
forall c m o.
(GeneratedFiniteCategory c m o, GeneratedFiniteCategory c m o,
Morphism m o) =>
c -> [m]
genArrows (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
f))))
diagToDotCluster :: (Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1, Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1,
Eq c2, Eq o2, PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2, GeneratedFiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> String -> IO ()
diagToDotCluster :: forall c1 o1 m1 c2 o2 m2.
(Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1,
Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1, Eq c2, Eq o2,
PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2,
GeneratedFiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
diagToDotCluster f :: Diagram c1 m1 o1 c2 m2 o2
f@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=c1
s,tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=c2
t,omap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap=AssociationList o1 o2
om,mmap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap=AssociationList m1 m2
fm} [Char]
path = [Char] -> Text -> IO ()
createAndWriteFile [Char]
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ DotCode -> Text
renderDot (DotCode -> Text) -> DotCode -> Text
forall a b. (a -> b) -> a -> b
$ DotGraph Node -> DotCode
forall a. PrintDot a => a -> DotCode
toDot DotGraph Node
dot_file where
dot_file :: DotGraph Node
dot_file = GraphvizParams Node [Char] [Char] Node [Char]
-> Gr [Char] [Char] -> DotGraph Node
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
graphToDot Params :: forall n nl el cl l.
Bool
-> [GlobalAttributes]
-> ((n, nl) -> NodeCluster cl (n, l))
-> (cl -> Bool)
-> (cl -> GraphID)
-> (cl -> [GlobalAttributes])
-> ((n, l) -> Attributes)
-> ((n, n, el) -> Attributes)
-> GraphvizParams n nl el cl l
Params {
isDirected :: Bool
isDirected = Bool
True
,globalAttributes :: [GlobalAttributes]
globalAttributes = []
,clusterBy :: LNode [Char] -> NodeCluster Node (LNode [Char])
clusterBy = (\(Node
n,[Char]
nl) -> if (Node
n Node -> Node -> Node
forall a. Integral a => a -> a -> a
`mod` Node
2) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
0 then (Node
-> NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char])
forall c a. c -> NodeCluster c a -> NodeCluster c a
C ((Maybe Node -> Node
forall a. HasCallStack => Maybe a -> a
fromJust (o2 -> [o2] -> Maybe Node
forall a. Eq a => a -> [a] -> Maybe Node
elemIndex (AssociationList o1 o2
om AssociationList o1 o2 -> o1 -> o2
forall a b. Eq a => AssociationList a b -> a -> b
!-! ((c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob c1
s) [o1] -> Node -> o1
forall a. [a] -> Node -> a
!! (Node
n Node -> Node -> Node
forall a. Integral a => a -> a -> a
`div` Node
2))) (c2 -> [o2]
forall c m o. FiniteCategory c m o => c -> [o]
ob c2
t)))) (NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char]))
-> NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char])
forall a b. (a -> b) -> a -> b
$ LNode [Char] -> NodeCluster Node (LNode [Char])
forall c a. a -> NodeCluster c a
N (Node
n,[Char]
nl)) else (Node
-> NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char])
forall c a. c -> NodeCluster c a -> NodeCluster c a
C (Maybe Node -> Node
forall a. HasCallStack => Maybe a -> a
fromJust (o2 -> [o2] -> Maybe Node
forall a. Eq a => a -> [a] -> Maybe Node
elemIndex ((c2 -> [o2]
forall c m o. FiniteCategory c m o => c -> [o]
ob c2
t) [o2] -> Node -> o2
forall a. [a] -> Node -> a
!! (Node
n Node -> Node -> Node
forall a. Integral a => a -> a -> a
`div` Node
2)) (c2 -> [o2]
forall c m o. FiniteCategory c m o => c -> [o]
ob c2
t))) (NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char]))
-> NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char])
forall a b. (a -> b) -> a -> b
$ LNode [Char] -> NodeCluster Node (LNode [Char])
forall c a. a -> NodeCluster c a
N (Node
n,[Char]
nl)))
,isDotCluster :: Node -> Bool
isDotCluster = Bool -> Node -> Bool
forall a b. a -> b -> a
const Bool
True
,clusterID :: Node -> GraphID
clusterID = Number -> GraphID
Num (Number -> GraphID) -> (Node -> Number) -> Node -> GraphID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Number
Int
,fmtCluster :: Node -> [GlobalAttributes]
fmtCluster = [GlobalAttributes] -> Node -> [GlobalAttributes]
forall a b. a -> b -> a
const []
,fmtNode :: LNode [Char] -> Attributes
fmtNode = \(Node
n,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)), if (Node
n Node -> Node -> Node
forall a. Integral a => a -> a -> a
`mod` Node
2) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
0 then X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Green else X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Blue]
,fmtEdge :: LEdge [Char] -> Attributes
fmtEdge= \(Node
n1,Node
n2,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label))]
} (Diagram c1 m1 o1 c2 m2 o2 -> Gr [Char] [Char]
forall c1 o1 m1 c2 o2 m2.
(Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1,
Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1, Eq c2, Eq o2,
PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2,
GeneratedFiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Gr [Char] [Char]
diagToGraphCluster Diagram c1 m1 o1 c2 m2 o2
f)
diagToPdfCluster :: (Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1, Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1,
Eq c2, Eq o2, PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2, GeneratedFiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> String -> IO ()
diagToPdfCluster :: forall c1 o1 m1 c2 o2 m2.
(Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1,
Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1, Eq c2, Eq o2,
PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2,
GeneratedFiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
diagToPdfCluster Diagram c1 m1 o1 c2 m2 o2
f [Char]
path = IO () -> [Char] -> IO ()
dotToPdf (Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
forall c1 o1 m1 c2 o2 m2.
(Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1,
Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1, Eq c2, Eq o2,
PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2,
GeneratedFiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
diagToDotCluster Diagram c1 m1 o1 c2 m2 o2
f [Char]
path) [Char]
path
indexAr :: (Morphism m o, FiniteCategory c m o, Eq o, Eq m) => c -> m -> Int
indexAr :: forall m o c.
(Morphism m o, FiniteCategory c m o, Eq o, Eq m) =>
c -> m -> Node
indexAr c
c m
m
| m -> [m] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem m
m (c -> [m]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c
c) = Maybe Node -> Node
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Node -> Node) -> Maybe Node -> Node
forall a b. (a -> b) -> a -> b
$ m -> [m] -> Maybe Node
forall a. Eq a => a -> [a] -> Maybe Node
elemIndex m
m (c -> [m]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c
c)
| Bool
otherwise = [Char] -> Node
forall a. HasCallStack => [Char] -> a
error [Char]
"indexAr of arrow not in category"
indexOb :: (FiniteCategory c m o, Eq o) => c -> o -> Int
indexOb :: forall c m o. (FiniteCategory c m o, Eq o) => c -> o -> Node
indexOb c
c o
o
| o -> [o] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem o
o (c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
c) = Maybe Node -> Node
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Node -> Node) -> Maybe Node -> Node
forall a b. (a -> b) -> a -> b
$ o -> [o] -> Maybe Node
forall a. Eq a => a -> [a] -> Maybe Node
elemIndex o
o (c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
c)
| Bool
otherwise = [Char] -> Node
forall a. HasCallStack => [Char] -> a
error [Char]
"indexOb of object not in category"
diagObjToNode :: (Eq o, FiniteCategory c m o) => c -> Bool -> o -> Node
diagObjToNode :: forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNode c
c Bool
b o
o
| Maybe Node
index Maybe Node -> Maybe Node -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Node
forall a. Maybe a
Nothing = [Char] -> Node
forall a. HasCallStack => [Char] -> a
error([Char]
"Call diagObjToNode on an object not in the category.")
| Bool
otherwise = if Bool
b then Node
4Node -> Node -> Node
forall a. Num a => a -> a -> a
*Node
i else Node
4Node -> Node -> Node
forall a. Num a => a -> a -> a
*Node
iNode -> Node -> Node
forall a. Num a => a -> a -> a
+Node
1
where
Just Node
i = Maybe Node
index
index :: Maybe Node
index = o -> [o] -> Maybe Node
forall a. Eq a => a -> [a] -> Maybe Node
elemIndex o
o (c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
c)
diagObjToLNode :: (Eq o, PrettyPrintable o, FiniteCategory c m o) => c -> Bool -> o -> LNode String
diagObjToLNode :: forall o c m.
(Eq o, PrettyPrintable o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode [Char]
diagObjToLNode c
c Bool
b o
o = (c -> Bool -> o -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNode c
c Bool
b o
o, o -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint o
o)
invisNodeSrc :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> m1 -> LNode String
invisNodeSrc :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode [Char]
invisNodeSrc f :: Diagram c1 m1 o1 c2 m2 o2
f@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=c1
s,tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=c2
t,mmap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap=AssociationList m1 m2
_,omap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap=AssociationList o1 o2
_} m1
m = (Node
4Node -> Node -> Node
forall a. Num a => a -> a -> a
*(c1 -> m1 -> Node
forall m o c.
(Morphism m o, FiniteCategory c m o, Eq o, Eq m) =>
c -> m -> Node
indexAr c1
s m1
m)Node -> Node -> Node
forall a. Num a => a -> a -> a
+Node
2, m1 -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint m1
m)
invisNodeTgt :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> m2 -> LNode String
invisNodeTgt :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode [Char]
invisNodeTgt f :: Diagram c1 m1 o1 c2 m2 o2
f@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=c1
s,tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=c2
t,mmap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap=AssociationList m1 m2
_,omap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap=AssociationList o1 o2
_} m2
m = (Node
4Node -> Node -> Node
forall a. Num a => a -> a -> a
*(c2 -> m2 -> Node
forall m o c.
(Morphism m o, FiniteCategory c m o, Eq o, Eq m) =>
c -> m -> Node
indexAr c2
t m2
m)Node -> Node -> Node
forall a. Num a => a -> a -> a
+Node
3, m2 -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint m2
m)
diagArToLEdges :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> Either m1 m2 -> [LEdge String]
diagArToLEdges :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge [Char]]
diagArToLEdges f :: Diagram c1 m1 o1 c2 m2 o2
f@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=c1
s,tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=c2
t,omap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap=AssociationList o1 o2
_,mmap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap=AssociationList m1 m2
_} (Left m1
m) = [((c1 -> Bool -> o1 -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNode c1
s Bool
True)(o1 -> Node) -> (m1 -> o1) -> m1 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m1 -> o1
forall m o. Morphism m o => m -> o
source (m1 -> Node) -> m1 -> Node
forall a b. (a -> b) -> a -> b
$ m1
m, LNode [Char] -> Node
forall a b. (a, b) -> a
fst(LNode [Char] -> Node) -> (m1 -> LNode [Char]) -> m1 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode [Char]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode [Char]
invisNodeSrc Diagram c1 m1 o1 c2 m2 o2
f) (m1 -> Node) -> m1 -> Node
forall a b. (a -> b) -> a -> b
$ m1
m, [Char]
""),(LNode [Char] -> Node
forall a b. (a, b) -> a
fst(LNode [Char] -> Node) -> (m1 -> LNode [Char]) -> m1 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode [Char]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode [Char]
invisNodeSrc Diagram c1 m1 o1 c2 m2 o2
f) (m1 -> Node) -> m1 -> Node
forall a b. (a -> b) -> a -> b
$ m1
m,(c1 -> Bool -> o1 -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNode c1
s Bool
True)(o1 -> Node) -> (m1 -> o1) -> m1 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m1 -> o1
forall m o. Morphism m o => m -> o
target (m1 -> Node) -> m1 -> Node
forall a b. (a -> b) -> a -> b
$ m1
m, [Char]
"")]
diagArToLEdges f :: Diagram c1 m1 o1 c2 m2 o2
f@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=c1
s,tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=c2
t,omap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap=AssociationList o1 o2
_,mmap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap=AssociationList m1 m2
_} (Right m2
m) = [((c2 -> Bool -> o2 -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNode c2
t Bool
False)(o2 -> Node) -> (m2 -> o2) -> m2 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m2 -> o2
forall m o. Morphism m o => m -> o
source (m2 -> Node) -> m2 -> Node
forall a b. (a -> b) -> a -> b
$ m2
m, LNode [Char] -> Node
forall a b. (a, b) -> a
fst(LNode [Char] -> Node) -> (m2 -> LNode [Char]) -> m2 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode [Char]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode [Char]
invisNodeTgt Diagram c1 m1 o1 c2 m2 o2
f) (m2 -> Node) -> m2 -> Node
forall a b. (a -> b) -> a -> b
$ m2
m, [Char]
""),(LNode [Char] -> Node
forall a b. (a, b) -> a
fst(LNode [Char] -> Node) -> (m2 -> LNode [Char]) -> m2 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode [Char]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode [Char]
invisNodeTgt Diagram c1 m1 o1 c2 m2 o2
f) (m2 -> Node) -> m2 -> Node
forall a b. (a -> b) -> a -> b
$ m2
m,(c2 -> Bool -> o2 -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNode c2
t Bool
False)(o2 -> Node) -> (m2 -> o2) -> m2 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m2 -> o2
forall m o. Morphism m o => m -> o
target (m2 -> Node) -> m2 -> Node
forall a b. (a -> b) -> a -> b
$ m2
m, [Char]
"")]
linkArrows :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> [LEdge String]
linkArrows :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [LEdge [Char]]
linkArrows f :: Diagram c1 m1 o1 c2 m2 o2
f@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=c1
s,tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=c2
t,omap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap=AssociationList o1 o2
_,mmap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap=AssociationList m1 m2
fm} = (\m1
m->(LNode [Char] -> Node
forall a b. (a, b) -> a
fst(Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode [Char]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode [Char]
invisNodeSrc Diagram c1 m1 o1 c2 m2 o2
f m1
m),LNode [Char] -> Node
forall a b. (a, b) -> a
fst(Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode [Char]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode [Char]
invisNodeTgt Diagram c1 m1 o1 c2 m2 o2
f (AssociationList m1 m2
fm AssociationList m1 m2 -> m1 -> m2
forall a b. Eq a => AssociationList a b -> a -> b
!-! m1
m)),[Char]
"")) (m1 -> LEdge [Char]) -> [m1] -> [LEdge [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c1
s)
linkObjects :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> [LEdge String]
linkObjects :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [LEdge [Char]]
linkObjects f :: Diagram c1 m1 o1 c2 m2 o2
f@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=c1
s,tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=c2
t,omap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap=AssociationList o1 o2
om,mmap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap=AssociationList m1 m2
_} = (\o1
o->(c1 -> Bool -> o1 -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNode c1
s Bool
True o1
o,c2 -> Bool -> o2 -> Node
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> Bool -> o -> Node
diagObjToNode c2
t Bool
False (AssociationList o1 o2
om AssociationList o1 o2 -> o1 -> o2
forall a b. Eq a => AssociationList a b -> a -> b
!-! o1
o),[Char]
"")) (o1 -> LEdge [Char]) -> [o1] -> [LEdge [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob c1
s)
diagToGraph :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> Gr String String
diagToGraph :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Gr [Char] [Char]
diagToGraph Diagram c1 m1 o1 c2 m2 o2
f = [LNode [Char]] -> [LEdge [Char]] -> Gr [Char] [Char]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph ((c1 -> Bool -> o1 -> LNode [Char]
forall o c m.
(Eq o, PrettyPrintable o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode [Char]
diagObjToLNode (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
f) Bool
True (o1 -> LNode [Char]) -> [o1] -> [LNode [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
f)))[LNode [Char]] -> [LNode [Char]] -> [LNode [Char]]
forall a. [a] -> [a] -> [a]
++(c2 -> Bool -> o2 -> LNode [Char]
forall o c m.
(Eq o, PrettyPrintable o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode [Char]
diagObjToLNode (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
f) Bool
False (o2 -> LNode [Char]) -> [o2] -> [LNode [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c2 -> [o2]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
f)))[LNode [Char]] -> [LNode [Char]] -> [LNode [Char]]
forall a. [a] -> [a] -> [a]
++((Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode [Char]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode [Char]
invisNodeSrc Diagram c1 m1 o1 c2 m2 o2
f) (m1 -> LNode [Char]) -> [m1] -> [LNode [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
f)))[LNode [Char]] -> [LNode [Char]] -> [LNode [Char]]
forall a. [a] -> [a] -> [a]
++((Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode [Char]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode [Char]
invisNodeTgt Diagram c1 m1 o1 c2 m2 o2
f) (m2 -> LNode [Char]) -> [m2] -> [LNode [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c2 -> [m2]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
f))))
(([[LEdge [Char]]] -> [LEdge [Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge [Char]]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge [Char]]
diagArToLEdges Diagram c1 m1 o1 c2 m2 o2
f (Either m1 m2 -> [LEdge [Char]])
-> [Either m1 m2] -> [[LEdge [Char]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m1 -> Either m1 m2
forall a b. a -> Either a b
Left (m1 -> Either m1 m2) -> [m1] -> [Either m1 m2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
f))))[[LEdge [Char]]] -> [[LEdge [Char]]] -> [[LEdge [Char]]]
forall a. [a] -> [a] -> [a]
++(Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge [Char]]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge [Char]]
diagArToLEdges Diagram c1 m1 o1 c2 m2 o2
f (Either m1 m2 -> [LEdge [Char]])
-> [Either m1 m2] -> [[LEdge [Char]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m2 -> Either m1 m2
forall a b. b -> Either a b
Right (m2 -> Either m1 m2) -> [m2] -> [Either m1 m2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c2 -> [m2]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
f))))))[LEdge [Char]] -> [LEdge [Char]] -> [LEdge [Char]]
forall a. [a] -> [a] -> [a]
++(Diagram c1 m1 o1 c2 m2 o2 -> [LEdge [Char]]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [LEdge [Char]]
linkArrows Diagram c1 m1 o1 c2 m2 o2
f)[LEdge [Char]] -> [LEdge [Char]] -> [LEdge [Char]]
forall a. [a] -> [a] -> [a]
++(Diagram c1 m1 o1 c2 m2 o2 -> [LEdge [Char]]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrintable m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [LEdge [Char]]
linkObjects Diagram c1 m1 o1 c2 m2 o2
f))
diagToDot :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> String -> IO ()
diagToDot :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
diagToDot f :: Diagram c1 m1 o1 c2 m2 o2
f@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=c1
s,tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=c2
t,omap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap=AssociationList o1 o2
om,mmap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap=AssociationList m1 m2
fm} [Char]
path = [Char] -> Text -> IO ()
createAndWriteFile [Char]
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ DotCode -> Text
renderDot (DotCode -> Text) -> DotCode -> Text
forall a b. (a -> b) -> a -> b
$ DotGraph Node -> DotCode
forall a. PrintDot a => a -> DotCode
toDot DotGraph Node
dot_file where
dot_file :: DotGraph Node
dot_file = GraphvizParams Node [Char] [Char] Node [Char]
-> Gr [Char] [Char] -> DotGraph Node
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
graphToDot Params :: forall n nl el cl l.
Bool
-> [GlobalAttributes]
-> ((n, nl) -> NodeCluster cl (n, l))
-> (cl -> Bool)
-> (cl -> GraphID)
-> (cl -> [GlobalAttributes])
-> ((n, l) -> Attributes)
-> ((n, n, el) -> Attributes)
-> GraphvizParams n nl el cl l
Params {
isDirected :: Bool
isDirected = Bool
True
,globalAttributes :: [GlobalAttributes]
globalAttributes = []
,clusterBy :: LNode [Char] -> NodeCluster Node (LNode [Char])
clusterBy = (\(Node
n,[Char]
nl) -> case () of
()
_ | (Node
n Node -> Node -> Node
forall a. Integral a => a -> a -> a
`mod` Node
2) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
0 -> (Node
-> NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char])
forall c a. c -> NodeCluster c a -> NodeCluster c a
C Node
0 (NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char]))
-> NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char])
forall a b. (a -> b) -> a -> b
$ LNode [Char] -> NodeCluster Node (LNode [Char])
forall c a. a -> NodeCluster c a
N (Node
n,[Char]
nl))
| (Node
n Node -> Node -> Node
forall a. Integral a => a -> a -> a
`mod` Node
2) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
1 -> (Node
-> NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char])
forall c a. c -> NodeCluster c a -> NodeCluster c a
C Node
1 (NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char]))
-> NodeCluster Node (LNode [Char])
-> NodeCluster Node (LNode [Char])
forall a b. (a -> b) -> a -> b
$ LNode [Char] -> NodeCluster Node (LNode [Char])
forall c a. a -> NodeCluster c a
N (Node
n,[Char]
nl)))
,isDotCluster :: Node -> Bool
isDotCluster = Bool -> Node -> Bool
forall a b. a -> b -> a
const Bool
True
,clusterID :: Node -> GraphID
clusterID = Number -> GraphID
Num (Number -> GraphID) -> (Node -> Number) -> Node -> GraphID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Number
Int
,fmtCluster :: Node -> [GlobalAttributes]
fmtCluster = [GlobalAttributes] -> Node -> [GlobalAttributes]
forall a b. a -> b -> a
const []
,fmtNode :: LNode [Char] -> Attributes
fmtNode = \(Node
n,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)), Node -> Attribute
forall {a}. Integral a => a -> Attribute
fmtColorN Node
n]
,fmtEdge :: LEdge [Char] -> Attributes
fmtEdge= \e :: LEdge [Char]
e@(Node
n1,Node
n2,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)), LEdge [Char] -> Attribute
forall {a} {a} {c}.
(Integral a, Integral a) =>
(a, a, c) -> Attribute
fmtColorE LEdge [Char]
e]
} (Diagram c1 m1 o1 c2 m2 o2 -> Gr [Char] [Char]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Gr [Char] [Char]
diagToGraph Diagram c1 m1 o1 c2 m2 o2
f)
where
fmtColorN :: a -> Attribute
fmtColorN a
n | a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
4 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Green
| a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
4 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Blue
| a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
4 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
2 = X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Red
| a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
4 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
3 = X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Pink
fmtColorE :: (a, a, c) -> Attribute
fmtColorE (a
s,a
t,c
_) | a
s `mod ` a
4 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = if a
t a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 then X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Red else X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Green
| a
t `mod ` a
4 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Green
| a
s `mod ` a
4 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Blue
| a
t `mod ` a
4 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Blue
| Bool
otherwise = X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Black
diagToPdf :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> String -> IO ()
diagToPdf :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
diagToPdf Diagram c1 m1 o1 c2 m2 o2
f [Char]
path = IO () -> [Char] -> IO ()
dotToPdf (Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
diagToDot Diagram c1 m1 o1 c2 m2 o2
f [Char]
path) [Char]
path
diagToDot2 :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> String -> IO ()
diagToDot2 :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
diagToDot2 f :: Diagram c1 m1 o1 c2 m2 o2
f@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=c1
s,tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=c2
t,omap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap=AssociationList o1 o2
om,mmap :: forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap=AssociationList m1 m2
fm} [Char]
path = [Char] -> Text -> IO ()
createAndWriteFile [Char]
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ DotCode -> Text
renderDot (DotCode -> Text) -> DotCode -> Text
forall a b. (a -> b) -> a -> b
$ DotGraph Node -> DotCode
forall a. PrintDot a => a -> DotCode
toDot DotGraph Node
dot_file where
dot_file :: DotGraph Node
dot_file = GraphvizParams Node [Char] [Char] () [Char]
-> Gr [Char] [Char] -> DotGraph Node
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
graphToDot GraphvizParams Node [Char] Any () [Char]
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode :: LNode [Char] -> Attributes
fmtNode= \(Node
n,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)), Node -> Attribute
colorNode Node
n],
fmtEdge :: LEdge [Char] -> Attributes
fmtEdge= \(Node
n1,Node
n2,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)), [Char] -> Attribute
colorEdge [Char]
label]} (c2 -> Gr [Char] [Char]
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr [Char] [Char]
categoryToGraph c2
t)
where
colorNode :: Node -> Attribute
colorNode Node
n = case () of
()
_ | Node
countPredN Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
0 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Black
| Node
countPredN Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
1 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange
| Node
countPredN Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
2 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange1
| Node
countPredN Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
3 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange2
| Node
countPredN Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
4 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange3
| Node
countPredN Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
5 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange4
| Bool
otherwise -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
OrangeRed4
where
countPredN :: Node
countPredN = [Integer] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
length [Integer
1 | o1
o <- (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob c1
s), (c2 -> o2 -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c2
t (AssociationList o1 o2
om AssociationList o1 o2 -> o1 -> o2
forall a b. Eq a => AssociationList a b -> a -> b
!-! o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n]
colorEdge :: [Char] -> Attribute
colorEdge [Char]
e = case () of
()
_ | Node
countPredE Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
0 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Black
| Node
countPredE Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
1 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange
| Node
countPredE Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
2 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange1
| Node
countPredE Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
3 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange2
| Node
countPredE Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
4 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange3
| Node
countPredE Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
5 -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange4
| Bool
otherwise -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
OrangeRed4
where
countPredE :: Node
countPredE = [Integer] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
length [Integer
1 | m1
m <- (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c1
s), (m2 -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint (AssociationList m1 m2
fm AssociationList m1 m2 -> m1 -> m2
forall a b. Eq a => AssociationList a b -> a -> b
!-! m1
m)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
e]
diagToPdf2 :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> String -> IO ()
diagToPdf2 :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
diagToPdf2 Diagram c1 m1 o1 c2 m2 o2
f [Char]
path = IO () -> [Char] -> IO ()
dotToPdf (Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
diagToDot2 Diagram c1 m1 o1 c2 m2 o2
f [Char]
path) [Char]
path
natToDot :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
(NaturalTransformation c1 m1 o1 c2 m2 o2) -> String -> IO ()
natToDot :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
natToDot NaturalTransformation{srcNT :: forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
srcNT=Diagram c1 m1 o1 c2 m2 o2
s,tgtNT :: forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
tgtNT=Diagram c1 m1 o1 c2 m2 o2
t,component :: forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2 -> o1 -> m2
component=o1 -> m2
c} [Char]
path = [Char] -> Text -> IO ()
createAndWriteFile [Char]
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ DotCode -> Text
renderDot (DotCode -> Text) -> DotCode -> Text
forall a b. (a -> b) -> a -> b
$ DotGraph Node -> DotCode
forall a. PrintDot a => a -> DotCode
toDot DotGraph Node
dot_file where
dot_file :: DotGraph Node
dot_file = GraphvizParams Node [Char] [Char] () [Char]
-> Gr [Char] [Char] -> DotGraph Node
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
graphToDot GraphvizParams Node [Char] Any () [Char]
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode :: LNode [Char] -> Attributes
fmtNode= \(Node
n,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)), Node -> Attribute
colorNode Node
n],
fmtEdge :: LEdge [Char] -> Attributes
fmtEdge= \(Node
n1,Node
n2,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)), [Char] -> Attribute
colorEdge [Char]
label]} (c2 -> Gr [Char] [Char]
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr [Char] [Char]
categoryToGraph (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
s))
where
colorNode :: Node -> Attribute
colorNode Node
n = case () of
()
_ | Bool
predNSrc Bool -> Bool -> Bool
&& Bool
predNTgt -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Turquoise
| Bool
predNSrc -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Green
| Bool
predNTgt -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Blue
| Bool
otherwise -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Black
where
predNSrc :: Bool
predNSrc = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(c2 -> o2 -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
s) ((Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap Diagram c1 m1 o1 c2 m2 o2
s) AssociationList o1 o2 -> o1 -> o2
forall a b. Eq a => AssociationList a b -> a -> b
!-! o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n | o1
o <- (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
s))]
predNTgt :: Bool
predNTgt = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(c2 -> o2 -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
t) ((Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap Diagram c1 m1 o1 c2 m2 o2
t) AssociationList o1 o2 -> o1 -> o2
forall a b. Eq a => AssociationList a b -> a -> b
!-! o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n | o1
o <- (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
t))]
colorEdge :: [Char] -> Attribute
colorEdge [Char]
e = case () of
()
_ | Bool
predESrc Bool -> Bool -> Bool
&& Bool
predETgt Bool -> Bool -> Bool
&& Bool
predENat -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Beige
| Bool
predESrc Bool -> Bool -> Bool
&& Bool
predETgt -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Turquoise
| Bool
predESrc Bool -> Bool -> Bool
&& Bool
predENat -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange
| Bool
predETgt Bool -> Bool -> Bool
&& Bool
predENat -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
LightBlue
| Bool
predESrc -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Green
| Bool
predETgt -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Blue
| Bool
predENat -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Yellow
| Bool
otherwise -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Black
where
predESrc :: Bool
predESrc = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint ((Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
s) AssociationList m1 m2 -> m1 -> m2
forall a b. Eq a => AssociationList a b -> a -> b
!-! m1
m)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
e | m1
m <- (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
s))]
predETgt :: Bool
predETgt = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint ((Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
t) AssociationList m1 m2 -> m1 -> m2
forall a b. Eq a => AssociationList a b -> a -> b
!-! m1
m)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
e | m1
m <- (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
t))]
predENat :: Bool
predENat = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint (o1 -> m2
c o1
o)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
e | o1
o <- (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
s))]
natToPdf :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
(NaturalTransformation c1 m1 o1 c2 m2 o2) -> String -> IO ()
natToPdf :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
natToPdf NaturalTransformation c1 m1 o1 c2 m2 o2
nt [Char]
path = IO () -> [Char] -> IO ()
dotToPdf (NaturalTransformation c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
natToDot NaturalTransformation c1 m1 o1 c2 m2 o2
nt [Char]
path) [Char]
path
extractFromTarget :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2) =>
(NaturalTransformation c1 m1 o1 c2 m2 o2) -> (FreeSubcategory c2 m2 o2)
NaturalTransformation{srcNT :: forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
srcNT=Diagram c1 m1 o1 c2 m2 o2
s,tgtNT :: forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
tgtNT=Diagram c1 m1 o1 c2 m2 o2
t,component :: forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2 -> o1 -> m2
component=o1 -> m2
c} = c2 -> [m2] -> FreeSubcategory c2 m2 o2
forall c m o. c -> [m] -> FreeSubcategory c m o
FreeSubcategory (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
s) ([(Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
s) AssociationList m1 m2 -> m1 -> m2
forall a b. Eq a => AssociationList a b -> a -> b
!-! m1
m | m1
m <- (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
s))][m2] -> [m2] -> [m2]
forall a. [a] -> [a] -> [a]
++[(Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
t) AssociationList m1 m2 -> m1 -> m2
forall a b. Eq a => AssociationList a b -> a -> b
!-! m1
m | m1
m <- (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
s))][m2] -> [m2] -> [m2]
forall a. [a] -> [a] -> [a]
++[o1 -> m2
c o1
o | o1
o <- (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
s))])
coneToDot :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
(NaturalTransformation c1 m1 o1 c2 m2 o2) -> String -> IO ()
coneToDot :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
coneToDot nt :: NaturalTransformation c1 m1 o1 c2 m2 o2
nt@NaturalTransformation{srcNT :: forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
srcNT=Diagram c1 m1 o1 c2 m2 o2
s,tgtNT :: forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
tgtNT=Diagram c1 m1 o1 c2 m2 o2
t,component :: forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2 -> o1 -> m2
component=o1 -> m2
c} [Char]
path = [Char] -> Text -> IO ()
createAndWriteFile [Char]
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ DotCode -> Text
renderDot (DotCode -> Text) -> DotCode -> Text
forall a b. (a -> b) -> a -> b
$ DotGraph Node -> DotCode
forall a. PrintDot a => a -> DotCode
toDot DotGraph Node
dot_file where
dot_file :: DotGraph Node
dot_file = GraphvizParams Node [Char] [Char] () [Char]
-> Gr [Char] [Char] -> DotGraph Node
forall cl (gr :: * -> * -> *) nl el l.
(Ord cl, Graph gr) =>
GraphvizParams Node nl el cl l -> gr nl el -> DotGraph Node
graphToDot GraphvizParams Node [Char] Any () [Char]
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode :: LNode [Char] -> Attributes
fmtNode= \(Node
n,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)), Node -> Attribute
colorNode Node
n],
fmtEdge :: LEdge [Char] -> Attributes
fmtEdge= \(Node
n1,Node
n2,[Char]
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel ([Char] -> Text
L.pack [Char]
label)), [Char] -> Attribute
colorEdge [Char]
label]} (FreeSubcategory c2 m2 o2 -> Gr [Char] [Char]
forall o m c.
(Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr [Char] [Char]
categoryToGraph (NaturalTransformation c1 m1 o1 c2 m2 o2 -> FreeSubcategory c2 m2 o2
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> FreeSubcategory c2 m2 o2
extractFromTarget NaturalTransformation c1 m1 o1 c2 m2 o2
nt))
where
colorNode :: Node -> Attribute
colorNode Node
n = case () of
()
_ | Bool
predNSrc Bool -> Bool -> Bool
&& Bool
predNTgt -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Turquoise
| Bool
predNSrc -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Green
| Bool
predNTgt -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Blue
| Bool
otherwise -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Black
where
predNSrc :: Bool
predNSrc = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(c2 -> o2 -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
s) ((Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap Diagram c1 m1 o1 c2 m2 o2
s) AssociationList o1 o2 -> o1 -> o2
forall a b. Eq a => AssociationList a b -> a -> b
!-! o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n | o1
o <- (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
s))]
predNTgt :: Bool
predNTgt = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(c2 -> o2 -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode (Diagram c1 m1 o1 c2 m2 o2 -> c2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram c1 m1 o1 c2 m2 o2
t) ((Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList o1 o2
omap Diagram c1 m1 o1 c2 m2 o2
t) AssociationList o1 o2 -> o1 -> o2
forall a b. Eq a => AssociationList a b -> a -> b
!-! o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n | o1
o <- (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
t))]
colorEdge :: [Char] -> Attribute
colorEdge [Char]
e = case () of
()
_ | Bool
predESrc Bool -> Bool -> Bool
&& Bool
predETgt Bool -> Bool -> Bool
&& Bool
predENat -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Beige
| Bool
predESrc Bool -> Bool -> Bool
&& Bool
predETgt -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Turquoise
| Bool
predESrc Bool -> Bool -> Bool
&& Bool
predENat -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Orange
| Bool
predETgt Bool -> Bool -> Bool
&& Bool
predENat -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
LightBlue
| Bool
predESrc -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Green
| Bool
predETgt -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Blue
| Bool
predENat -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Yellow
| Bool
otherwise -> X11Color -> Attribute
forall nc. NamedColor nc => nc -> Attribute
color X11Color
Black
where
predESrc :: Bool
predESrc = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint ((Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
s) AssociationList m1 m2 -> m1 -> m2
forall a b. Eq a => AssociationList a b -> a -> b
!-! m1
m)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
e | m1
m <- (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
s))]
predETgt :: Bool
predETgt = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint ((Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
forall c1 m1 o1 c2 m2 o2.
Diagram c1 m1 o1 c2 m2 o2 -> AssociationList m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
t) AssociationList m1 m2 -> m1 -> m2
forall a b. Eq a => AssociationList a b -> a -> b
!-! m1
m)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
e | m1
m <- (c1 -> [m1]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
t))]
predENat :: Bool
predENat = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> [Char]
forall a. PrettyPrintable a => a -> [Char]
pprint (o1 -> m2
c o1
o)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
e | o1
o <- (c1 -> [o1]
forall c m o. FiniteCategory c m o => c -> [o]
ob (Diagram c1 m1 o1 c2 m2 o2 -> c1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram c1 m1 o1 c2 m2 o2
s))]
coneToPdf :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
(NaturalTransformation c1 m1 o1 c2 m2 o2) -> String -> IO ()
coneToPdf :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
coneToPdf NaturalTransformation c1 m1 o1 c2 m2 o2
nt [Char]
path = IO () -> [Char] -> IO ()
dotToPdf (NaturalTransformation c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrintable m1, PrettyPrintable o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2,
PrettyPrintable o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> [Char] -> IO ()
coneToDot NaturalTransformation c1 m1 o1 c2 m2 o2
nt [Char]
path) [Char]
path