pnToDot :: Monad m => Maybe (Marking value) -> String -> PN m value -> DotGraph
    pnToDot maybeMarking name pn = DotGraph name
        [("size", "7x10"), {- ("ratio", "0.7"), -} ("pagedir", "TL"), ("fontname", "Helvetica")] ([
            DotNode "node" [("fontname", "Helvetica")],
            DotNode "edge" [("fontname", "Helvetica"), ("fontsize", "8")]] ++
            mapMaybe (uncurry makePlaceNode) (DM.assocs allPlaces) ++
            map (uncurry makeTransNode) (DM.assocs allTrans)
            )
        edges []
        where
            marking = if isJust maybeMarking
                then fromJust maybeMarking
                else pnInitialMarking pn

            showPlace placeNo = "P" ++ show placeNo
            showTrans transNo = "T" ++ show transNo

            isReducablePlace placeNo = fromMaybe False $ do
                (ins, outs) <- DM.lookup placeNo placesToTrans
                return $ case (ins, outs) of
                    ([_], [_]) -> null $ marking DM.! placeNo
                    _ -> False

            makePlaceNode placeNo place
                | isReducablePlace placeNo = Nothing
                | otherwise = Just $ DotNode (showPlace placeNo) [
                    ("label", joinLabel (placeLabel place) ++ (case initialMarking of
                        0 -> ""
                        1 -> ""
                        _ -> " " ++ show initialMarking)),
                    ("style", if initialMarking > 0
                        then "solid"
                        else case DM.lookup placeNo placesToTrans of
                            Just ([], _) -> "dotted"
                            Just (_, []) -> "dotted"
                            Nothing -> "dotted"
                            Just _ -> "solid"),
                    ("shape", "ellipse"),
                    ("penwidth", case initialMarking of
                        1 -> "3"
                        _ -> "1")]
                     where
                        initialMarking = length $ marking DM.! placeNo

            escapeLabel = escapeString "|{}<>"

            makeTransNode transNo trans = DotNode (showTrans transNo)
                [("label", escapeLabel label), ("shape", "rectangle")]
                where
                    label
                        | null exprLabels = joinLabel $ transLabel trans
                        | otherwise = joinLabel (transLabel trans) ++ ": " ++ exprLabels

                    exprLabels = (case transCondition trans of
                        Just cond -> "if " ++ showPNExpr 0 cond "" ++
                            (if null assignments then "" else " then ")
                        _ -> "")
                        ++ showListWithSep (showString ",") id assignments ""

                    assignments = mapMaybe showExpr $ zip [(0::Int)..] $ transExprs trans

                    showExpr (_, PNLiteral NoSimValue) = Nothing
                    showExpr (i, expr) = Just $ showChar 'o' . shows i . showString "=" . showPNExpr 0 expr

            allPlaces = pnPlaces pn
            allTrans = pnTrans pn

            placesToTrans = pnPlacesToTrans pn

            edges = concatMap makeEdge $ DM.assocs placesToTrans
                where
                    getPlaceArcIndex getPlaces placeNo transNo = fromJust $ findIndex (== placeNo) $
                        getPlaces (allTrans DM.! transNo)
                    inLabel placeNo transNo = "i" ++ show (getPlaceArcIndex transInPlaces placeNo transNo)
                    outLabel placeNo transNo = "o" ++ show (getPlaceArcIndex transOutPlaces placeNo transNo)

                    colour placeNo = case placeType (allPlaces DM.! placeNo) of
                        BlackPlaceType -> colourToRGB black
                        NumericPlaceType width -> colourToRGB $ colours !! (min (intWidth width) 9)

                    colourToRGB (r, g, b) = "#" ++ component r ++ component g ++ component b
                        where component c = numberToString (Bits 8) (floor (c * 0xFF)) 16 0 True

                    makeEdge (placeNo, (inTrans, outTrans))
                        | isReducablePlace placeNo = [DotEdge
                            (showTrans (head inTrans)) (showTrans (head outTrans))
                            [("label", joinLabel (placeLabel (allPlaces DM.! placeNo))),
                             ("headlabel", inLabel placeNo (head outTrans)),
                             ("taillabel", outLabel placeNo (head inTrans)),
                             ("color", colour placeNo)]]
                        | otherwise =
                            (map (\from -> DotEdge (showTrans from) (showPlace placeNo)
                                [("taillabel", outLabel placeNo from), ("color", colour placeNo)])
                                inTrans) ++
                            (map (\to -> DotEdge (showPlace placeNo) (showTrans to)
                                [("headlabel", inLabel placeNo to), ("color", colour placeNo)])
                                outTrans)
pnToDot :: Monad m => Maybe (Marking value) -> String -> PN m value -> DotGraph
pnToDot maybeMarking name pn = DotGraph name
        [("size", "7x10"), {- ("ratio", "0.7"), -} ("pagedir", "TL"), ("fontname", "Helvetica")] ([
            DotNode "node" [("fontname", "Helvetica")],
            DotNode "edge" [("fontname", "Helvetica"), ("fontsize", "8")]] ++
            mapMaybe (uncurry makePlaceNode) (DM.assocs allPlaces) ++
            map (uncurry makeTransNode) (DM.assocs allTrans)
            )
        edges []
        where
            marking = if isJust maybeMarking
                then fromJust maybeMarking
                else pnInitialMarking pn

            showPlace placeNo = "P" ++ show placeNo
            showTrans transNo = "T" ++ show transNo

            isReducablePlace placeNo = fromMaybe False $ do
                (ins, outs) <- DM.lookup placeNo placesToTrans
                return $ case (ins, outs) of
                    ([_], [_]) -> null $ marking DM.! placeNo
                    _ -> False

            makePlaceNode placeNo place
                | isReducablePlace placeNo = Nothing
                | otherwise = Just $ DotNode (showPlace placeNo) [
                    ("label", joinLabel (placeLabel place) ++ (case initialMarking of
                        0 -> ""
                        1 -> ""
                        _ -> " " ++ show initialMarking)),
                    ("style", if initialMarking > 0
                        then "solid"
                        else case DM.lookup placeNo placesToTrans of
                            Just ([], _) -> "dotted"
                            Just (_, []) -> "dotted"
                            Nothing -> "dotted"
                            Just _ -> "solid"),
                    ("shape", "ellipse"),
                    ("penwidth", case initialMarking of
                        1 -> "3"
                        _ -> "1")]
                     where
                        initialMarking = length $ marking DM.! placeNo

            escapeLabel = escapeString "|{}<>"

            makeTransNode transNo trans = DotNode (showTrans transNo)
                [("label", escapeLabel label), ("shape", "rectangle")]
                where
                    label
                        | null exprLabels = joinLabel $ transLabel trans
                        | otherwise = joinLabel (transLabel trans) ++ ": " ++ exprLabels

                    exprLabels = (case transCondition trans of
                        Just cond -> "if " ++ showPNExpr 0 cond "" ++
                            (if null assignments then "" else " then ")
                        _ -> "")
                        ++ showListWithSep (showString ",") id assignments ""

                    assignments = mapMaybe showExpr $ zip [(0::Int)..] $ transExprs trans

                    showExpr (_, PNLiteral NoSimValue) = Nothing
                    showExpr (i, expr) = Just $ showChar 'o' . shows i . showString "=" . showPNExpr 0 expr

            allPlaces = pnPlaces pn
            allTrans = pnTrans pn

            placesToTrans = pnPlacesToTrans pn

            edges = concatMap makeEdge $ DM.assocs placesToTrans
                where
                    getPlaceArcIndex getPlaces placeNo transNo = fromJust $ findIndex (== placeNo) $
                        getPlaces (allTrans DM.! transNo)
                    inLabel placeNo transNo = "i" ++ show (getPlaceArcIndex transInPlaces placeNo transNo)
                    outLabel placeNo transNo = "o" ++ show (getPlaceArcIndex transOutPlaces placeNo transNo)

                    colour placeNo = case placeType (allPlaces DM.! placeNo) of
                        BlackPlaceType -> colourToRGB black
                        NumericPlaceType width -> colourToRGB $ colours !! (min (intWidth width) 9)

                    colourToRGB (r, g, b) = "#" ++ component r ++ component g ++ component b
                        where component c = numberToString (Bits 8) (floor (c * 0xFF)) 16 0 True

                    makeEdge (placeNo, (inTrans, outTrans))
                        | isReducablePlace placeNo = [DotEdge
                            (showTrans (head inTrans)) (showTrans (head outTrans))
                            [("label", joinLabel (placeLabel (allPlaces DM.! placeNo))),
                             ("headlabel", inLabel placeNo (head outTrans)),
                             ("taillabel", outLabel placeNo (head inTrans)),
                             ("color", colour placeNo)]]
                        | otherwise =
                            (map (\from -> DotEdge (showTrans from) (showPlace placeNo)
                                [("taillabel", outLabel placeNo from), ("color", colour placeNo)])
                                inTrans) ++
                            (map (\to -> DotEdge (showPlace placeNo) (showTrans to)
                                [("headlabel", inLabel placeNo to), ("color", colour placeNo)])
                                outTrans)
pnToDot maybeMarking name pn = DotGraph name
        [("size", "7x10"), {- ("ratio", "0.7"), -} ("pagedir", "TL"), ("fontname", "Helvetica")] ([
            DotNode "node" [("fontname", "Helvetica")],
            DotNode "edge" [("fontname", "Helvetica"), ("fontsize", "8")]] ++
            mapMaybe (uncurry makePlaceNode) (DM.assocs allPlaces) ++
            map (uncurry makeTransNode) (DM.assocs allTrans)
            )
        edges []
        where
            marking = if isJust maybeMarking
                then fromJust maybeMarking
                else pnInitialMarking pn

            showPlace placeNo = "P" ++ show placeNo
            showTrans transNo = "T" ++ show transNo

            isReducablePlace placeNo = fromMaybe False $ do
                (ins, outs) <- DM.lookup placeNo placesToTrans
                return $ case (ins, outs) of
                    ([_], [_]) -> null $ marking DM.! placeNo
                    _ -> False

            makePlaceNode placeNo place
                | isReducablePlace placeNo = Nothing
                | otherwise = Just $ DotNode (showPlace placeNo) [
                    ("label", joinLabel (placeLabel place) ++ (case initialMarking of
                        0 -> ""
                        1 -> ""
                        _ -> " " ++ show initialMarking)),
                    ("style", if initialMarking > 0
                        then "solid"
                        else case DM.lookup placeNo placesToTrans of
                            Just ([], _) -> "dotted"
                            Just (_, []) -> "dotted"
                            Nothing -> "dotted"
                            Just _ -> "solid"),
                    ("shape", "ellipse"),
                    ("penwidth", case initialMarking of
                        1 -> "3"
                        _ -> "1")]
                     where
                        initialMarking = length $ marking DM.! placeNo

            escapeLabel = escapeString "|{}<>"

            makeTransNode transNo trans = DotNode (showTrans transNo)
                [("label", escapeLabel label), ("shape", "rectangle")]
                where
                    label
                        | null exprLabels = joinLabel $ transLabel trans
                        | otherwise = joinLabel (transLabel trans) ++ ": " ++ exprLabels

                    exprLabels = (case transCondition trans of
                        Just cond -> "if " ++ showPNExpr 0 cond "" ++
                            (if null assignments then "" else " then ")
                        _ -> "")
                        ++ showListWithSep (showString ",") id assignments ""

                    assignments = mapMaybe showExpr $ zip [(0::Int)..] $ transExprs trans

                    showExpr (_, PNLiteral NoSimValue) = Nothing
                    showExpr (i, expr) = Just $ showChar 'o' . shows i . showString "=" . showPNExpr 0 expr

            allPlaces = pnPlaces pn
            allTrans = pnTrans pn

            placesToTrans = pnPlacesToTrans pn

            edges = concatMap makeEdge $ DM.assocs placesToTrans
                where
                    getPlaceArcIndex getPlaces placeNo transNo = fromJust $ findIndex (== placeNo) $
                        getPlaces (allTrans DM.! transNo)
                    inLabel placeNo transNo = "i" ++ show (getPlaceArcIndex transInPlaces placeNo transNo)
                    outLabel placeNo transNo = "o" ++ show (getPlaceArcIndex transOutPlaces placeNo transNo)

                    colour placeNo = case placeType (allPlaces DM.! placeNo) of
                        BlackPlaceType -> colourToRGB black
                        NumericPlaceType width -> colourToRGB $ colours !! (min (intWidth width) 9)

                    colourToRGB (r, g, b) = "#" ++ component r ++ component g ++ component b
                        where component c = numberToString (Bits 8) (floor (c * 0xFF)) 16 0 True

                    makeEdge (placeNo, (inTrans, outTrans))
                        | isReducablePlace placeNo = [DotEdge
                            (showTrans (head inTrans)) (showTrans (head outTrans))
                            [("label", joinLabel (placeLabel (allPlaces DM.! placeNo))),
                             ("headlabel", inLabel placeNo (head outTrans)),
                             ("taillabel", outLabel placeNo (head inTrans)),
                             ("color", colour placeNo)]]
                        | otherwise =
                            (map (\from -> DotEdge (showTrans from) (showPlace placeNo)
                                [("taillabel", outLabel placeNo from), ("color", colour placeNo)])
                                inTrans) ++
                            (map (\to -> DotEdge (showPlace placeNo) (showTrans to)
                                [("headlabel", inLabel placeNo to), ("color", colour placeNo)])
                                outTrans)