{-# LANGUAGE MonadComprehensions #-}
module Math.IO.FiniteCategories.ExportGraphViz
(
categoryToGraph,
catToDot,
catToPdf,
genToDot,
genToPdf,
categoryToGraphFormat,
catToDotFormat,
catToPdfFormat,
diagToDotCluster,
diagToPdfCluster,
diagToDot,
diagToPdf,
diagToDot2,
diagToPdf2,
diagToDot2Format,
diagToPdf2Format,
natToDot,
natToPdf,
natToDotFormat,
natToPdfFormat,
)
where
import Math.FiniteCategory
import Math.FiniteCategories
import Math.IO.PrettyPrint
import qualified Data.Text.Lazy as L (pack, Text)
import qualified Data.Text.Lazy.IO as IO (putStrLn, writeFile)
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.GraphViz.Attributes (X11Color(..), color)
import Data.GraphViz.Printing (renderDot, toDot)
import Data.Maybe (fromJust)
import Data.List (elemIndex,intercalate)
import Data.WeakSet.Safe
import qualified Data.WeakSet as Set
import Data.WeakMap.Safe
import System.Process (callCommand)
import System.Directory (createDirectoryIfMissing)
import System.FilePath.Posix (takeDirectory)
createAndWriteFile :: FilePath -> L.Text -> IO ()
createAndWriteFile :: FilePath -> Text -> IO ()
createAndWriteFile FilePath
path Text
content = do
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
path
FilePath -> Text -> IO ()
IO.writeFile FilePath
path Text
content
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 = FilePath -> Node
forall a. HasCallStack => FilePath -> a
error(FilePath
"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 (Set o -> [o]
forall a. Eq a => Set a -> [a]
setToList(Set o -> [o]) -> (c -> Set o) -> c -> [o]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob (c -> [o]) -> c -> [o]
forall a b. (a -> b) -> a -> b
$ c
c)
objToLNode :: (Eq o, PrettyPrint o, FiniteCategory c m o) => c -> o -> LNode String
objToLNode :: forall o c m.
(Eq o, PrettyPrint o, FiniteCategory c m o) =>
c -> o -> LNode FilePath
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 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint o
o)
objToLNodeFormat :: (Eq o, FiniteCategory c m o) => c -> (o -> String) -> o -> LNode String
objToLNodeFormat :: forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> (o -> FilePath) -> o -> LNode FilePath
objToLNodeFormat c
c o -> FilePath
formatObj o
o = (c -> o -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c
c o
o, o -> FilePath
formatObj 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, PrettyPrint o, PrettyPrint m, Morphism m o, FiniteCategory c m o) => c -> m -> LEdge String
arToLEdge :: forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> m -> LEdge FilePath
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 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint m
m)
arToLEdgeFormat :: (Eq o, Morphism m o, FiniteCategory c m o) => c -> (m -> String) -> m -> LEdge String
arToLEdgeFormat :: forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> (m -> FilePath) -> m -> LEdge FilePath
arToLEdgeFormat c
c m -> FilePath
formatMorph 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 -> FilePath
formatMorph m
m)
categoryToGraph :: (Eq o, PrettyPrint o, PrettyPrint m, Morphism m o, FiniteCategory c m o) => c -> Gr String String
categoryToGraph :: forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr FilePath FilePath
categoryToGraph c
c = [LNode FilePath] -> [LEdge FilePath] -> Gr FilePath FilePath
forall a b. [LNode a] -> [LEdge b] -> Gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph (Set (LNode FilePath) -> [LNode FilePath]
forall a. Eq a => Set a -> [a]
setToList (c -> o -> LNode FilePath
forall o c m.
(Eq o, PrettyPrint o, FiniteCategory c m o) =>
c -> o -> LNode FilePath
objToLNode c
c (o -> LNode FilePath) -> Set o -> Set (LNode FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
c))) (Set (LEdge FilePath) -> [LEdge FilePath]
forall a. Eq a => Set a -> [a]
setToList (c -> m -> LEdge FilePath
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> m -> LEdge FilePath
arToLEdge c
c (m -> LEdge FilePath) -> Set m -> Set (LEdge FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> Set m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
arrows c
c)))
categoryToGraphFormat :: (Eq o, Morphism m o, FiniteCategory c m o) => c -> (o -> String) -> (m -> String) -> Gr String String
categoryToGraphFormat :: forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> (o -> FilePath) -> (m -> FilePath) -> Gr FilePath FilePath
categoryToGraphFormat c
c o -> FilePath
formatObj m -> FilePath
formatMorph = [LNode FilePath] -> [LEdge FilePath] -> Gr FilePath FilePath
forall a b. [LNode a] -> [LEdge b] -> Gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph (Set (LNode FilePath) -> [LNode FilePath]
forall a. Eq a => Set a -> [a]
setToList (c -> (o -> FilePath) -> o -> LNode FilePath
forall o c m.
(Eq o, FiniteCategory c m o) =>
c -> (o -> FilePath) -> o -> LNode FilePath
objToLNodeFormat c
c o -> FilePath
formatObj (o -> LNode FilePath) -> Set o -> Set (LNode FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
c))) (Set (LEdge FilePath) -> [LEdge FilePath]
forall a. Eq a => Set a -> [a]
setToList (c -> (m -> FilePath) -> m -> LEdge FilePath
forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> (m -> FilePath) -> m -> LEdge FilePath
arToLEdgeFormat c
c m -> FilePath
formatMorph (m -> LEdge FilePath) -> Set m -> Set (LEdge FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> Set m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
arrows c
c)))
dotToPdf :: IO () -> String -> IO ()
dotToPdf :: IO () -> FilePath -> IO ()
dotToPdf IO ()
dot FilePath
path = IO ()
dot IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
callCommand (FilePath
"dot "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
pathFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
" -o "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
pathFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
".pdf -T pdf")
catToDot :: (Eq o, PrettyPrint o, PrettyPrint m, Morphism m o, FiniteCategory c m o) => c -> String -> IO ()
catToDot :: forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> FilePath -> IO ()
catToDot c
c FilePath
path = FilePath -> Text -> IO ()
createAndWriteFile FilePath
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 FilePath FilePath () FilePath
-> Gr FilePath FilePath -> 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 FilePath Any () FilePath
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode= \(Node
n,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label))],
fmtEdge= \(Node
n1,Node
n2,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)),
if FilePath
label FilePath -> Set FilePath -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` Set FilePath
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 FilePath FilePath
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr FilePath FilePath
categoryToGraph c
c)
generators :: Set m
generators = c -> Set m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
genArrows c
c
generatorsLabels :: Set FilePath
generatorsLabels = m -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint (m -> FilePath) -> Set m -> Set FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set m
generators
catToDotFormat :: (Eq o, Morphism m o, FiniteCategory c m o) => c -> (o -> String) -> (m -> String) -> String -> IO ()
catToDotFormat :: forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> (o -> FilePath) -> (m -> FilePath) -> FilePath -> IO ()
catToDotFormat c
c o -> FilePath
formatObj m -> FilePath
formatMorph FilePath
path = FilePath -> Text -> IO ()
createAndWriteFile FilePath
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 FilePath FilePath () FilePath
-> Gr FilePath FilePath -> 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 FilePath Any () FilePath
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode= \(Node
n,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label))],
fmtEdge= \(Node
n1,Node
n2,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)),
if FilePath
label FilePath -> Set FilePath -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` Set FilePath
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 -> (o -> FilePath) -> (m -> FilePath) -> Gr FilePath FilePath
forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> (o -> FilePath) -> (m -> FilePath) -> Gr FilePath FilePath
categoryToGraphFormat c
c o -> FilePath
formatObj m -> FilePath
formatMorph)
generators :: Set m
generators = c -> Set m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
genArrows c
c
generatorsLabels :: Set FilePath
generatorsLabels = m -> FilePath
formatMorph (m -> FilePath) -> Set m -> Set FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set m
generators
catToPdf :: (Eq o, PrettyPrint o, PrettyPrint m, Morphism m o, FiniteCategory c m o) => c -> String -> IO ()
catToPdf :: forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> FilePath -> IO ()
catToPdf c
c FilePath
path = IO () -> FilePath -> IO ()
dotToPdf (c -> FilePath -> IO ()
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> FilePath -> IO ()
catToDot c
c FilePath
path) FilePath
path
catToPdfFormat :: (Eq o, Morphism m o, FiniteCategory c m o) => c -> (o -> String) -> (m -> String) -> String -> IO ()
catToPdfFormat :: forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> (o -> FilePath) -> (m -> FilePath) -> FilePath -> IO ()
catToPdfFormat c
c o -> FilePath
formatObj m -> FilePath
formatMorph FilePath
path = IO () -> FilePath -> IO ()
dotToPdf (c -> (o -> FilePath) -> (m -> FilePath) -> FilePath -> IO ()
forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> (o -> FilePath) -> (m -> FilePath) -> FilePath -> IO ()
catToDotFormat c
c o -> FilePath
formatObj m -> FilePath
formatMorph FilePath
path) FilePath
path
categoryToGeneratorGraph :: (Eq o, PrettyPrint o, PrettyPrint m, Morphism m o, FiniteCategory c m o) => c -> Gr String String
categoryToGeneratorGraph :: forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr FilePath FilePath
categoryToGeneratorGraph c
c = [LNode FilePath] -> [LEdge FilePath] -> Gr FilePath FilePath
forall a b. [LNode a] -> [LEdge b] -> Gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph (Set (LNode FilePath) -> [LNode FilePath]
forall a. Eq a => Set a -> [a]
setToList (c -> o -> LNode FilePath
forall o c m.
(Eq o, PrettyPrint o, FiniteCategory c m o) =>
c -> o -> LNode FilePath
objToLNode c
c (o -> LNode FilePath) -> Set o -> Set (LNode FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
c))) (Set (LEdge FilePath) -> [LEdge FilePath]
forall a. Eq a => Set a -> [a]
setToList (c -> m -> LEdge FilePath
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> m -> LEdge FilePath
arToLEdge c
c (m -> LEdge FilePath) -> Set m -> Set (LEdge FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> Set m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
genArrows c
c)))
genToDot :: (Eq o, PrettyPrint o, PrettyPrint m, Morphism m o, FiniteCategory c m o) => c -> String -> IO ()
genToDot :: forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> FilePath -> IO ()
genToDot c
c FilePath
path = FilePath -> Text -> IO ()
createAndWriteFile FilePath
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 FilePath FilePath () FilePath
-> Gr FilePath FilePath -> 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 FilePath Any () FilePath
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode= \(Node
n,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label))],
fmtEdge= \(Node
n1,Node
n2,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label))]} (c -> Gr FilePath FilePath
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr FilePath FilePath
categoryToGeneratorGraph c
c)
genToPdf :: (Eq o, PrettyPrint o, PrettyPrint m, Morphism m o, FiniteCategory c m o) => c -> String -> IO ()
genToPdf :: forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> FilePath -> IO ()
genToPdf c
c FilePath
path = IO () -> FilePath -> IO ()
dotToPdf (c -> FilePath -> IO ()
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> FilePath -> IO ()
genToDot c
c FilePath
path) FilePath
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 = FilePath -> Node
forall a. HasCallStack => FilePath -> a
error(FilePath
"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 (Set o -> [o]
forall a. Eq a => Set a -> [a]
setToList (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
c))
diagObjToLNodeCluster :: (Eq o, PrettyPrint o, FiniteCategory c m o) => c -> Bool -> o -> LNode String
diagObjToLNodeCluster :: forall o c m.
(Eq o, PrettyPrint o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode FilePath
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 -> FilePath
forall a. PrettyPrint a => a -> FilePath
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, PrettyPrint o, PrettyPrint m, Morphism m o, FiniteCategory c m o) => c -> Bool -> m -> LEdge String
diagArToLEdgeCluster :: forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> Bool -> m -> LEdge FilePath
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 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint m
m)
diagToGraphCluster :: (Eq c1, Eq o1, PrettyPrint o1, PrettyPrint m1, Morphism m1 o1, FiniteCategory c1 m1 o1,
Eq c2, Eq o2, PrettyPrint o2, PrettyPrint m2, Morphism m2 o2, FiniteCategory 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, PrettyPrint o1, PrettyPrint m1, Morphism m1 o1,
FiniteCategory c1 m1 o1, Eq c2, Eq o2, PrettyPrint o2,
PrettyPrint m2, Morphism m2 o2, FiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Gr FilePath FilePath
diagToGraphCluster Diagram c1 m1 o1 c2 m2 o2
f = [LNode FilePath] -> [LEdge FilePath] -> Gr FilePath FilePath
forall a b. [LNode a] -> [LEdge b] -> Gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph (Set (LNode FilePath) -> [LNode FilePath]
forall a. Eq a => Set a -> [a]
setToList ((c1 -> Bool -> o1 -> LNode FilePath
forall o c m.
(Eq o, PrettyPrint o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode FilePath
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 FilePath) -> Set o1 -> Set (LNode FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set 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 FilePath] -> [LNode FilePath] -> [LNode FilePath]
forall a. [a] -> [a] -> [a]
++(Set (LNode FilePath) -> [LNode FilePath]
forall a. Eq a => Set a -> [a]
setToList (c2 -> Bool -> o2 -> LNode FilePath
forall o c m.
(Eq o, PrettyPrint o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode FilePath
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 FilePath) -> Set o2 -> Set (LNode FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c2 -> Set o2
forall c m o. FiniteCategory c m o => c -> Set 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))))) (Set (LEdge FilePath) -> [LEdge FilePath]
forall a. Eq a => Set a -> [a]
setToList ((c1 -> Bool -> m1 -> LEdge FilePath
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> Bool -> m -> LEdge FilePath
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 FilePath) -> Set m1 -> Set (LEdge FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 FilePath] -> [LEdge FilePath] -> [LEdge FilePath]
forall a. [a] -> [a] -> [a]
++(Set (LEdge FilePath) -> [LEdge FilePath]
forall a. Eq a => Set a -> [a]
setToList (c2 -> Bool -> m2 -> LEdge FilePath
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> Bool -> m -> LEdge FilePath
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 FilePath) -> Set m2 -> Set (LEdge FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c2 -> Set m2
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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, PrettyPrint o1, PrettyPrint m1, Morphism m1 o1, FiniteCategory c1 m1 o1,
Eq c2, Eq o2, PrettyPrint o2, PrettyPrint m2, Morphism m2 o2, FiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> String -> IO ()
diagToDotCluster :: forall c1 o1 m1 c2 o2 m2.
(Eq c1, Eq o1, PrettyPrint o1, PrettyPrint m1, Morphism m1 o1,
FiniteCategory c1 m1 o1, Eq c2, Eq o2, PrettyPrint o2,
PrettyPrint m2, Morphism m2 o2, FiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> 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 -> Map o1 o2
omap=Map o1 o2
om,mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map m1 m2
fm} FilePath
path = FilePath -> Text -> IO ()
createAndWriteFile FilePath
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 FilePath FilePath Node FilePath
-> Gr FilePath FilePath -> 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 {
isDirected :: Bool
isDirected = Bool
True
,globalAttributes :: [GlobalAttributes]
globalAttributes = []
,clusterBy :: LNode FilePath -> NodeCluster Node (LNode FilePath)
clusterBy = (\(Node
n,FilePath
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 FilePath)
-> NodeCluster Node (LNode FilePath)
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 (Map o1 o2
om Map o1 o2 -> o1 -> o2
forall k v. Eq k => Map k v -> k -> v
|!| ((Set o1 -> [o1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set o
ob c1
s)) [o1] -> Node -> o1
forall a. HasCallStack => [a] -> Node -> a
!! (Node
n Node -> Node -> Node
forall a. Integral a => a -> a -> a
`div` Node
2))) (Set o2 -> [o2]
forall a. Eq a => Set a -> [a]
setToList (c2 -> Set o2
forall c m o. FiniteCategory c m o => c -> Set o
ob c2
t))))) (NodeCluster Node (LNode FilePath)
-> NodeCluster Node (LNode FilePath))
-> NodeCluster Node (LNode FilePath)
-> NodeCluster Node (LNode FilePath)
forall a b. (a -> b) -> a -> b
$ LNode FilePath -> NodeCluster Node (LNode FilePath)
forall c a. a -> NodeCluster c a
N (Node
n,FilePath
nl)) else (Node
-> NodeCluster Node (LNode FilePath)
-> NodeCluster Node (LNode FilePath)
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 ((Set o2 -> [o2]
forall a. Eq a => Set a -> [a]
setToList (c2 -> Set o2
forall c m o. FiniteCategory c m o => c -> Set o
ob c2
t)) [o2] -> Node -> o2
forall a. HasCallStack => [a] -> Node -> a
!! (Node
n Node -> Node -> Node
forall a. Integral a => a -> a -> a
`div` Node
2)) (Set o2 -> [o2]
forall a. Eq a => Set a -> [a]
setToList (c2 -> Set o2
forall c m o. FiniteCategory c m o => c -> Set o
ob c2
t)))) (NodeCluster Node (LNode FilePath)
-> NodeCluster Node (LNode FilePath))
-> NodeCluster Node (LNode FilePath)
-> NodeCluster Node (LNode FilePath)
forall a b. (a -> b) -> a -> b
$ LNode FilePath -> NodeCluster Node (LNode FilePath)
forall c a. a -> NodeCluster c a
N (Node
n,FilePath
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 FilePath -> Attributes
fmtNode = \(Node
n,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
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 FilePath -> Attributes
fmtEdge= \(Node
n1,Node
n2,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label))]
} (Diagram c1 m1 o1 c2 m2 o2 -> Gr FilePath FilePath
forall c1 o1 m1 c2 o2 m2.
(Eq c1, Eq o1, PrettyPrint o1, PrettyPrint m1, Morphism m1 o1,
FiniteCategory c1 m1 o1, Eq c2, Eq o2, PrettyPrint o2,
PrettyPrint m2, Morphism m2 o2, FiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Gr FilePath FilePath
diagToGraphCluster Diagram c1 m1 o1 c2 m2 o2
f)
diagToPdfCluster :: (Eq c1, Eq o1, PrettyPrint o1, PrettyPrint m1, Morphism m1 o1, FiniteCategory c1 m1 o1,
Eq c2, Eq o2, PrettyPrint o2, PrettyPrint m2, Morphism m2 o2, FiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> String -> IO ()
diagToPdfCluster :: forall c1 o1 m1 c2 o2 m2.
(Eq c1, Eq o1, PrettyPrint o1, PrettyPrint m1, Morphism m1 o1,
FiniteCategory c1 m1 o1, Eq c2, Eq o2, PrettyPrint o2,
PrettyPrint m2, Morphism m2 o2, FiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
diagToPdfCluster Diagram c1 m1 o1 c2 m2 o2
f FilePath
path = IO () -> FilePath -> IO ()
dotToPdf (Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
forall c1 o1 m1 c2 o2 m2.
(Eq c1, Eq o1, PrettyPrint o1, PrettyPrint m1, Morphism m1 o1,
FiniteCategory c1 m1 o1, Eq c2, Eq o2, PrettyPrint o2,
PrettyPrint m2, Morphism m2 o2, FiniteCategory c2 m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
diagToDotCluster Diagram c1 m1 o1 c2 m2 o2
f FilePath
path) FilePath
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 -> Set m -> Bool
forall a. Eq a => a -> Set a -> Bool
isIn m
m (c -> Set m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 (Set m -> [m]
forall a. Eq a => Set a -> [a]
setToList (c -> Set m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
arrows c
c))
| Bool
otherwise = FilePath -> Node
forall a. HasCallStack => FilePath -> a
error FilePath
"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 -> Set o -> Bool
forall a. Eq a => a -> Set a -> Bool
isIn o
o (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set 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 (Set o -> [o]
forall a. Eq a => Set a -> [a]
setToList (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
c))
| Bool
otherwise = FilePath -> Node
forall a. HasCallStack => FilePath -> a
error FilePath
"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 = FilePath -> Node
forall a. HasCallStack => FilePath -> a
error(FilePath
"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 (Set o -> [o]
forall a. Eq a => Set a -> [a]
setToList (c -> Set o
forall c m o. FiniteCategory c m o => c -> Set o
ob c
c))
diagObjToLNode :: (Eq o, PrettyPrint o, FiniteCategory c m o) => c -> Bool -> o -> LNode String
diagObjToLNode :: forall o c m.
(Eq o, PrettyPrint o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode FilePath
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 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint o
o)
invisNodeSrc :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint 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,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode FilePath
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 -> Map m1 m2
mmap=Map m1 m2
_,omap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap=Map 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 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint m1
m)
invisNodeTgt :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint 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,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode FilePath
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 -> Map m1 m2
mmap=Map m1 m2
_,omap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap=Map 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 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint m2
m)
diagArToLEdges :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint 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,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge FilePath]
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 -> Map o1 o2
omap=Map o1 o2
_,mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map 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 FilePath -> Node
forall a b. (a, b) -> a
fst(LNode FilePath -> Node) -> (m1 -> LNode FilePath) -> m1 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode FilePath
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode FilePath
invisNodeSrc Diagram c1 m1 o1 c2 m2 o2
f) (m1 -> Node) -> m1 -> Node
forall a b. (a -> b) -> a -> b
$ m1
m, FilePath
""),(LNode FilePath -> Node
forall a b. (a, b) -> a
fst(LNode FilePath -> Node) -> (m1 -> LNode FilePath) -> m1 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode FilePath
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode FilePath
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, FilePath
"")]
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 -> Map o1 o2
omap=Map o1 o2
_,mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map 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 FilePath -> Node
forall a b. (a, b) -> a
fst(LNode FilePath -> Node) -> (m2 -> LNode FilePath) -> m2 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode FilePath
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode FilePath
invisNodeTgt Diagram c1 m1 o1 c2 m2 o2
f) (m2 -> Node) -> m2 -> Node
forall a b. (a -> b) -> a -> b
$ m2
m, FilePath
""),(LNode FilePath -> Node
forall a b. (a, b) -> a
fst(LNode FilePath -> Node) -> (m2 -> LNode FilePath) -> m2 -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode FilePath
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode FilePath
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, FilePath
"")]
linkArrows :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint 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,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [LEdge FilePath]
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 -> Map o1 o2
omap=Map o1 o2
_,mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map m1 m2
fm} = (\m1
m->(LNode FilePath -> Node
forall a b. (a, b) -> a
fst(Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode FilePath
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode FilePath
invisNodeSrc Diagram c1 m1 o1 c2 m2 o2
f m1
m),LNode FilePath -> Node
forall a b. (a, b) -> a
fst(Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode FilePath
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode FilePath
invisNodeTgt Diagram c1 m1 o1 c2 m2 o2
f (Map m1 m2
fm Map m1 m2 -> m1 -> m2
forall k v. Eq k => Map k v -> k -> v
|!| m1
m)),FilePath
"")) (m1 -> LEdge FilePath) -> [m1] -> [LEdge FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set m1 -> [m1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
arrows c1
s))
linkObjects :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint 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,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [LEdge FilePath]
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 -> Map o1 o2
omap=Map o1 o2
om,mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map 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 (Map o1 o2
om Map o1 o2 -> o1 -> o2
forall k v. Eq k => Map k v -> k -> v
|!| o1
o),FilePath
"")) (o1 -> LEdge FilePath) -> [o1] -> [LEdge FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set o1 -> [o1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set o
ob c1
s))
diagToGraph :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2, PrettyPrint 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,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Gr FilePath FilePath
diagToGraph Diagram c1 m1 o1 c2 m2 o2
f = [LNode FilePath] -> [LEdge FilePath] -> Gr FilePath FilePath
forall a b. [LNode a] -> [LEdge b] -> Gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph ((c1 -> Bool -> o1 -> LNode FilePath
forall o c m.
(Eq o, PrettyPrint o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode FilePath
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 FilePath) -> [o1] -> [LNode FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set o1 -> [o1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set 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 FilePath] -> [LNode FilePath] -> [LNode FilePath]
forall a. [a] -> [a] -> [a]
++(c2 -> Bool -> o2 -> LNode FilePath
forall o c m.
(Eq o, PrettyPrint o, FiniteCategory c m o) =>
c -> Bool -> o -> LNode FilePath
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 FilePath) -> [o2] -> [LNode FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set o2 -> [o2]
forall a. Eq a => Set a -> [a]
setToList (c2 -> Set o2
forall c m o. FiniteCategory c m o => c -> Set 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 FilePath] -> [LNode FilePath] -> [LNode FilePath]
forall a. [a] -> [a] -> [a]
++((Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode FilePath
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> LNode FilePath
invisNodeSrc Diagram c1 m1 o1 c2 m2 o2
f) (m1 -> LNode FilePath) -> [m1] -> [LNode FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set m1 -> [m1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 FilePath] -> [LNode FilePath] -> [LNode FilePath]
forall a. [a] -> [a] -> [a]
++((Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode FilePath
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> m2 -> LNode FilePath
invisNodeTgt Diagram c1 m1 o1 c2 m2 o2
f) (m2 -> LNode FilePath) -> [m2] -> [LNode FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set m2 -> [m2]
forall a. Eq a => Set a -> [a]
setToList (c2 -> Set m2
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 FilePath]] -> [LEdge FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Prelude.concat ((Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge FilePath]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge FilePath]
diagArToLEdges Diagram c1 m1 o1 c2 m2 o2
f (Either m1 m2 -> [LEdge FilePath])
-> [Either m1 m2] -> [[LEdge FilePath]]
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
<$> (Set m1 -> [m1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 FilePath]] -> [[LEdge FilePath]] -> [[LEdge FilePath]]
forall a. [a] -> [a] -> [a]
++(Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge FilePath]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Either m1 m2 -> [LEdge FilePath]
diagArToLEdges Diagram c1 m1 o1 c2 m2 o2
f (Either m1 m2 -> [LEdge FilePath])
-> [Either m1 m2] -> [[LEdge FilePath]]
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
<$> (Set m2 -> [m2]
forall a. Eq a => Set a -> [a]
setToList (c2 -> Set m2
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 FilePath] -> [LEdge FilePath] -> [LEdge FilePath]
forall a. [a] -> [a] -> [a]
++(Diagram c1 m1 o1 c2 m2 o2 -> [LEdge FilePath]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [LEdge FilePath]
linkArrows Diagram c1 m1 o1 c2 m2 o2
f)[LEdge FilePath] -> [LEdge FilePath] -> [LEdge FilePath]
forall a. [a] -> [a] -> [a]
++(Diagram c1 m1 o1 c2 m2 o2 -> [LEdge FilePath]
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2,
Eq m2, PrettyPrint m2) =>
Diagram c1 m1 o1 c2 m2 o2 -> [LEdge FilePath]
linkObjects Diagram c1 m1 o1 c2 m2 o2
f))
diagToDot :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2, PrettyPrint 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,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> 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 -> Map o1 o2
omap=Map o1 o2
om,mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map m1 m2
fm} FilePath
path = FilePath -> Text -> IO ()
createAndWriteFile FilePath
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 FilePath FilePath Node FilePath
-> Gr FilePath FilePath -> 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 {
isDirected :: Bool
isDirected = Bool
True
,globalAttributes :: [GlobalAttributes]
globalAttributes = []
,clusterBy :: LNode FilePath -> NodeCluster Node (LNode FilePath)
clusterBy = (\(Node
n,FilePath
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 FilePath)
-> NodeCluster Node (LNode FilePath)
forall c a. c -> NodeCluster c a -> NodeCluster c a
C Node
0 (NodeCluster Node (LNode FilePath)
-> NodeCluster Node (LNode FilePath))
-> NodeCluster Node (LNode FilePath)
-> NodeCluster Node (LNode FilePath)
forall a b. (a -> b) -> a -> b
$ LNode FilePath -> NodeCluster Node (LNode FilePath)
forall c a. a -> NodeCluster c a
N (Node
n,FilePath
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 FilePath)
-> NodeCluster Node (LNode FilePath)
forall c a. c -> NodeCluster c a -> NodeCluster c a
C Node
1 (NodeCluster Node (LNode FilePath)
-> NodeCluster Node (LNode FilePath))
-> NodeCluster Node (LNode FilePath)
-> NodeCluster Node (LNode FilePath)
forall a b. (a -> b) -> a -> b
$ LNode FilePath -> NodeCluster Node (LNode FilePath)
forall c a. a -> NodeCluster c a
N (Node
n,FilePath
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 FilePath -> Attributes
fmtNode = \(Node
n,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), Node -> Attribute
forall {a}. Integral a => a -> Attribute
fmtColorN Node
n]
,fmtEdge :: LEdge FilePath -> Attributes
fmtEdge= \e :: LEdge FilePath
e@(Node
n1,Node
n2,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), LEdge FilePath -> Attribute
forall {a} {a} {c}.
(Integral a, Integral a) =>
(a, a, c) -> Attribute
fmtColorE LEdge FilePath
e]
} (Diagram c1 m1 o1 c2 m2 o2 -> Gr FilePath FilePath
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Gr FilePath FilePath
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, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2, PrettyPrint 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,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
diagToPdf Diagram c1 m1 o1 c2 m2 o2
f FilePath
path = IO () -> FilePath -> IO ()
dotToPdf (Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
diagToDot Diagram c1 m1 o1 c2 m2 o2
f FilePath
path) FilePath
path
diagToDot2 :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2, PrettyPrint 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,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> 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 -> Map o1 o2
omap=Map o1 o2
om,mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map m1 m2
fm} FilePath
path = FilePath -> Text -> IO ()
createAndWriteFile FilePath
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 FilePath FilePath () FilePath
-> Gr FilePath FilePath -> 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 FilePath Any () FilePath
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode= \(Node
n,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), Node -> Attribute
colorNode Node
n],
fmtEdge= \(Node
n1,Node
n2,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), FilePath -> Attribute
colorEdge FilePath
label]} (c2 -> Gr FilePath FilePath
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr FilePath FilePath
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 a. [a] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
Prelude.length [Integer
1 | o1
o <- (Set o1 -> [o1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set o
ob c1
s)), (c2 -> o2 -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c2
t (Map o1 o2
om Map o1 o2 -> o1 -> o2
forall k v. Eq k => Map k v -> k -> v
|!| o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n]
colorEdge :: FilePath -> Attribute
colorEdge FilePath
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 a. [a] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
Prelude.length [Integer
1 | m1
m <- (Set m1 -> [m1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
arrows c1
s)), (m2 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint (Map m1 m2
fm Map m1 m2 -> m1 -> m2
forall k v. Eq k => Map k v -> k -> v
|!| m1
m)) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e]
diagToPdf2 :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2, PrettyPrint 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,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
diagToPdf2 Diagram c1 m1 o1 c2 m2 o2
f FilePath
path = IO () -> FilePath -> IO ()
dotToPdf (Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
diagToDot2 Diagram c1 m1 o1 c2 m2 o2
f FilePath
path) FilePath
path
diagToDot2Format :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2, PrettyPrint o2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> (o2 -> String) -> (m2 -> String) -> String -> IO ()
diagToDot2Format :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2
-> (o2 -> FilePath) -> (m2 -> FilePath) -> FilePath -> IO ()
diagToDot2Format 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 -> Map o1 o2
omap=Map o1 o2
om,mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map m1 m2
fm} o2 -> FilePath
formatObj m2 -> FilePath
formatMorph FilePath
path = FilePath -> Text -> IO ()
createAndWriteFile FilePath
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 FilePath FilePath () FilePath
-> Gr FilePath FilePath -> 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 FilePath Any () FilePath
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode= \(Node
n,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), Node -> Attribute
colorNode Node
n],
fmtEdge= \(Node
n1,Node
n2,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), FilePath -> Attribute
colorEdge FilePath
label]} (c2 -> (o2 -> FilePath) -> (m2 -> FilePath) -> Gr FilePath FilePath
forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> (o -> FilePath) -> (m -> FilePath) -> Gr FilePath FilePath
categoryToGraphFormat c2
t o2 -> FilePath
formatObj m2 -> FilePath
formatMorph)
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 a. [a] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
Prelude.length [Integer
1 | o1
o <- (Set o1 -> [o1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set o
ob c1
s)), (c2 -> o2 -> Node
forall o c m. (Eq o, FiniteCategory c m o) => c -> o -> Node
objToNode c2
t (Map o1 o2
om Map o1 o2 -> o1 -> o2
forall k v. Eq k => Map k v -> k -> v
|!| o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n]
colorEdge :: FilePath -> Attribute
colorEdge FilePath
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 a. [a] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
Prelude.length [Integer
1 | m1
m <- (Set m1 -> [m1]
forall a. Eq a => Set a -> [a]
setToList (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
arrows c1
s)), (m2 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint (Map m1 m2
fm Map m1 m2 -> m1 -> m2
forall k v. Eq k => Map k v -> k -> v
|!| m1
m)) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e]
diagToPdf2Format :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2, PrettyPrint o2) =>
(Diagram c1 m1 o1 c2 m2 o2) -> (o2 -> String) -> (m2 -> String) -> String -> IO ()
diagToPdf2Format :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2
-> (o2 -> FilePath) -> (m2 -> FilePath) -> FilePath -> IO ()
diagToPdf2Format Diagram c1 m1 o1 c2 m2 o2
f o2 -> FilePath
formatObj m2 -> FilePath
formatMorph FilePath
path = IO () -> FilePath -> IO ()
dotToPdf (Diagram c1 m1 o1 c2 m2 o2
-> (o2 -> FilePath) -> (m2 -> FilePath) -> FilePath -> IO ()
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrint m2,
PrettyPrint o2) =>
Diagram c1 m1 o1 c2 m2 o2
-> (o2 -> FilePath) -> (m2 -> FilePath) -> FilePath -> IO ()
diagToDot2Format Diagram c1 m1 o1 c2 m2 o2
f o2 -> FilePath
formatObj m2 -> FilePath
formatMorph FilePath
path) FilePath
path
natToDot :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, Eq c1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2, PrettyPrint 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, Eq c1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2,
PrettyPrint o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
natToDot NaturalTransformation c1 m1 o1 c2 m2 o2
nt FilePath
path = FilePath -> Text -> IO ()
createAndWriteFile FilePath
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
s :: Diagram c1 m1 o1 c2 m2 o2
s = NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
forall m o. Morphism m o => m -> o
source NaturalTransformation c1 m1 o1 c2 m2 o2
nt
t :: Diagram c1 m1 o1 c2 m2 o2
t = NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
forall m o. Morphism m o => m -> o
target NaturalTransformation c1 m1 o1 c2 m2 o2
nt
c :: Map o1 m2
c = NaturalTransformation c1 m1 o1 c2 m2 o2 -> Map o1 m2
forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2 -> Map o1 m2
components NaturalTransformation c1 m1 o1 c2 m2 o2
nt
dot_file :: DotGraph Node
dot_file = GraphvizParams Node FilePath FilePath () FilePath
-> Gr FilePath FilePath -> 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 FilePath Any () FilePath
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode= \(Node
n,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), Node -> Attribute
colorNode Node
n],
fmtEdge= \(Node
n1,Node
n2,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), FilePath -> Attribute
colorEdge FilePath
label]} (c2 -> Gr FilePath FilePath
forall o m c.
(Eq o, PrettyPrint o, PrettyPrint m, Morphism m o,
FiniteCategory c m o) =>
c -> Gr FilePath FilePath
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 = Set Bool -> Bool
Set.or [(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 -> Map o1 o2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap Diagram c1 m1 o1 c2 m2 o2
s) Map o1 o2 -> o1 -> o2
forall k v. Eq k => Map k v -> k -> v
|!| o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n | o1
o <- (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set 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 = Set Bool -> Bool
Set.or [(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 -> Map o1 o2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap Diagram c1 m1 o1 c2 m2 o2
t) Map o1 o2 -> o1 -> o2
forall k v. Eq k => Map k v -> k -> v
|!| o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n | o1
o <- (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set 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 :: FilePath -> Attribute
colorEdge FilePath
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 -> Set Bool -> Bool
forall a b. Eq a => (a -> b -> b) -> b -> Set a -> b
Set.foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint ((Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
s) Map m1 m2 -> m1 -> m2
forall k v. Eq k => Map k v -> k -> v
|!| m1
m)) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e | m1
m <- (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 -> Set Bool -> Bool
forall a b. Eq a => (a -> b -> b) -> b -> Set a -> b
Set.foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint ((Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
t) Map m1 m2 -> m1 -> m2
forall k v. Eq k => Map k v -> k -> v
|!| m1
m)) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e | m1
m <- (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 -> Set Bool -> Bool
forall a b. Eq a => (a -> b -> b) -> b -> Set a -> b
Set.foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint (Map o1 m2
c Map o1 m2 -> o1 -> m2
forall k v. Eq k => Map k v -> k -> v
|!| o1
o)) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e | o1
o <- (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set 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, Eq c1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2, PrettyPrint 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, Eq c1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2,
PrettyPrint o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
natToPdf NaturalTransformation c1 m1 o1 c2 m2 o2
nt FilePath
path = IO () -> FilePath -> IO ()
dotToPdf (NaturalTransformation c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, Eq c1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2,
PrettyPrint o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2 -> FilePath -> IO ()
natToDot NaturalTransformation c1 m1 o1 c2 m2 o2
nt FilePath
path) FilePath
path
natToDotFormat :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, Eq c1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2, PrettyPrint o2) =>
(NaturalTransformation c1 m1 o1 c2 m2 o2) -> (o2 -> String) -> (m2 -> String) -> String -> IO ()
natToDotFormat :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, Eq c1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2,
PrettyPrint o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2
-> (o2 -> FilePath) -> (m2 -> FilePath) -> FilePath -> IO ()
natToDotFormat NaturalTransformation c1 m1 o1 c2 m2 o2
nt o2 -> FilePath
formatObj m2 -> FilePath
formatMorph FilePath
path = FilePath -> Text -> IO ()
createAndWriteFile FilePath
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
s :: Diagram c1 m1 o1 c2 m2 o2
s = NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
forall m o. Morphism m o => m -> o
source NaturalTransformation c1 m1 o1 c2 m2 o2
nt
t :: Diagram c1 m1 o1 c2 m2 o2
t = NaturalTransformation c1 m1 o1 c2 m2 o2
-> Diagram c1 m1 o1 c2 m2 o2
forall m o. Morphism m o => m -> o
target NaturalTransformation c1 m1 o1 c2 m2 o2
nt
c :: Map o1 m2
c = NaturalTransformation c1 m1 o1 c2 m2 o2 -> Map o1 m2
forall c1 m1 o1 c2 m2 o2.
NaturalTransformation c1 m1 o1 c2 m2 o2 -> Map o1 m2
components NaturalTransformation c1 m1 o1 c2 m2 o2
nt
dot_file :: DotGraph Node
dot_file = GraphvizParams Node FilePath FilePath () FilePath
-> Gr FilePath FilePath -> 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 FilePath Any () FilePath
forall n nl el. GraphvizParams n nl el () nl
nonClusteredParams { fmtNode= \(Node
n,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), Node -> Attribute
colorNode Node
n],
fmtEdge= \(Node
n1,Node
n2,FilePath
label)-> [Label -> Attribute
Label (Text -> Label
StrLabel (FilePath -> Text
L.pack FilePath
label)), FilePath -> Attribute
colorEdge FilePath
label]} (c2 -> (o2 -> FilePath) -> (m2 -> FilePath) -> Gr FilePath FilePath
forall o m c.
(Eq o, Morphism m o, FiniteCategory c m o) =>
c -> (o -> FilePath) -> (m -> FilePath) -> Gr FilePath FilePath
categoryToGraphFormat (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) o2 -> FilePath
formatObj m2 -> FilePath
formatMorph)
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 = Set Bool -> Bool
Set.or [(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 -> Map o1 o2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap Diagram c1 m1 o1 c2 m2 o2
s) Map o1 o2 -> o1 -> o2
forall k v. Eq k => Map k v -> k -> v
|!| o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n | o1
o <- (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set 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 = Set Bool -> Bool
Set.or [(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 -> Map o1 o2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap Diagram c1 m1 o1 c2 m2 o2
t) Map o1 o2 -> o1 -> o2
forall k v. Eq k => Map k v -> k -> v
|!| o1
o)) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n | o1
o <- (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set 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 :: FilePath -> Attribute
colorEdge FilePath
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 -> Set Bool -> Bool
forall a b. Eq a => (a -> b -> b) -> b -> Set a -> b
Set.foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint ((Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
s) Map m1 m2 -> m1 -> m2
forall k v. Eq k => Map k v -> k -> v
|!| m1
m)) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e | m1
m <- (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 -> Set Bool -> Bool
forall a b. Eq a => (a -> b -> b) -> b -> Set a -> b
Set.foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint ((Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap Diagram c1 m1 o1 c2 m2 o2
t) Map m1 m2 -> m1 -> m2
forall k v. Eq k => Map k v -> k -> v
|!| m1
m)) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e | m1
m <- (c1 -> Set m1
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set 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 -> Set Bool -> Bool
forall a b. Eq a => (a -> b -> b) -> b -> Set a -> b
Set.foldr Bool -> Bool -> Bool
(||) Bool
False [(m2 -> FilePath
forall a. PrettyPrint a => a -> FilePath
pprint (Map o1 m2
c Map o1 m2 -> o1 -> m2
forall k v. Eq k => Map k v -> k -> v
|!| o1
o)) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
e | o1
o <- (c1 -> Set o1
forall c m o. FiniteCategory c m o => c -> Set 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))]
natToPdfFormat :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, Eq c1, PrettyPrint m1, PrettyPrint o1,
Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2, PrettyPrint o2) =>
(NaturalTransformation c1 m1 o1 c2 m2 o2) -> (o2 -> String) -> (m2 -> String) -> String -> IO ()
natToPdfFormat :: forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, Eq c1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2,
PrettyPrint o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2
-> (o2 -> FilePath) -> (m2 -> FilePath) -> FilePath -> IO ()
natToPdfFormat NaturalTransformation c1 m1 o1 c2 m2 o2
nt o2 -> FilePath
formatObj m2 -> FilePath
formatMorph FilePath
path = IO () -> FilePath -> IO ()
dotToPdf (NaturalTransformation c1 m1 o1 c2 m2 o2
-> (o2 -> FilePath) -> (m2 -> FilePath) -> FilePath -> IO ()
forall m1 o1 c1 m2 o2 c2.
(Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, Eq c1,
PrettyPrint m1, PrettyPrint o1, Morphism m2 o2,
FiniteCategory c2 m2 o2, Eq o2, Eq m2, Eq c2, PrettyPrint m2,
PrettyPrint o2) =>
NaturalTransformation c1 m1 o1 c2 m2 o2
-> (o2 -> FilePath) -> (m2 -> FilePath) -> FilePath -> IO ()
natToDotFormat NaturalTransformation c1 m1 o1 c2 m2 o2
nt o2 -> FilePath
formatObj m2 -> FilePath
formatMorph FilePath
path) FilePath
path