> {-# OPTIONS_HADDOCK hide,show-extensions #-}
> {-|
> Module    : LTK.Porters.Dot
> Copyright : (c) 2017-2019,2023 Dakotah Lambert
> License   : MIT
> 
> This module provides methods to convert automata to the GraphViz
> Dot format.  At the moment, only export is supported.
> -}
> module LTK.Porters.Dot
>        ( -- *Exporting
>          exportDot
>        , exportDotWithName
>        -- *Miscellaneous
>        , formatSet
>        ) where

> import Data.List (intercalate)
> import Data.Set (Set)
> import qualified Data.Set as Set

> import LTK.FSA

> showish :: (Show a) => a -> String
> showish :: forall a. Show a => a -> [Char]
showish = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'"') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

> transitionClasses :: (Ord n, Ord e) => FSA n e -> Set (Set (Transition n e))
> transitionClasses :: forall n e. (Ord n, Ord e) => FSA n e -> Set (Set (Transition n e))
transitionClasses = forall a n.
(Ord a, Ord n) =>
(n -> a) -> Set (Set n) -> Set (Set n)
refinePartitionBy forall n e. Transition n e -> State n
destination forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a n. (Ord a, Ord n) => (n -> a) -> Set n -> Set (Set n)
partitionBy forall n e. Transition n e -> State n
source forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                     forall n e. FSA n e -> Set (Transition n e)
transitions

> -- |Return value is in the range \([0 .. n]\),
> -- where \(n\) is the size of the input.
> -- A value of \(n\) indicates that the element was
> -- not in the input.
> shortLabelIn :: (Collapsible s, Eq n) => s n -> n -> Int
> shortLabelIn :: forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn s n
xs n
x = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (\n
y Int
a -> if n
y forall a. Eq a => a -> a -> Bool
== n
x then Int
0 else Int
1 forall a. Num a => a -> a -> a
+ Int
a) Int
0 s n
xs

> dotifyTransitionSet :: (Collapsible c, Eq e, Show e) =>
>                        c (Symbol e, Int, Int) -> String
> dotifyTransitionSet :: forall (c :: * -> *) e.
(Collapsible c, Eq e, Show e) =>
c (Symbol e, Int, Int) -> [Char]
dotifyTransitionSet c (Symbol e, Int, Int)
ts
>     | forall (c :: * -> *) b. Collapsible c => c b -> Bool
zsize c (Symbol e, Int, Int)
ts   = [Char]
""
>     | Bool
otherwise  = forall a. Show a => a -> [Char]
show Int
src forall a. [a] -> [a] -> [a]
++ [Char]
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
dest
>                    forall a. [a] -> [a] -> [a]
++ [Char]
" [label=\"" forall a. [a] -> [a] -> [a]
++ [Char]
syms forall a. [a] -> [a] -> [a]
++ [Char]
"\"];"
>     where (Symbol e
_, Int
src, Int
dest)  = forall (l :: * -> *) a. Linearizable l => l a -> a
chooseOne c (Symbol e, Int, Int)
ts
>           first :: (a, b, c) -> a
first (a
a,b
_,c
_)   = a
a
>           list :: [(Symbol e, Int, Int)]
list            = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (:) [] c (Symbol e, Int, Int)
ts
>           syms :: [Char]
syms            = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Show a => Symbol a -> [Char]
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> a
first) [(Symbol e, Int, Int)]
list
>           sym :: Symbol a -> [Char]
sym (Symbol a
a)  = [Char] -> [Char]
deescape forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
showish a
a
>           sym Symbol a
Epsilon     = [Char]
"\x03B5" -- ε

> dotifyTransitions :: (Ord n, Ord e, Show n, Show e) => FSA n e -> [String]
> dotifyTransitions :: forall n e. (Ord n, Ord e, Show n, Show e) => FSA n e -> [[Char]]
dotifyTransitions FSA n e
f = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (:) [] forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                       forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                       (forall (c :: * -> *) e.
(Collapsible c, Eq e, Show e) =>
c (Symbol e, Int, Int) -> [Char]
dotifyTransitionSet forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                        forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap forall {e}. Transition n e -> (Symbol e, Int, Int)
remakeTransition
>                       ) forall a b. (a -> b) -> a -> b
$ forall n e. (Ord n, Ord e) => FSA n e -> Set (Set (Transition n e))
transitionClasses FSA n e
f
>     where remakeTransition :: Transition n e -> (Symbol e, Int, Int)
remakeTransition Transition n e
t
>               = ( forall n e. Transition n e -> Symbol e
edgeLabel Transition n e
t
>                 , forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn Set (State n)
sts (forall n e. Transition n e -> State n
source Transition n e
t)
>                 , forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn Set (State n)
sts (forall n e. Transition n e -> State n
destination Transition n e
t)
>                 )
>           sts :: Set (State n)
sts = forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states FSA n e
f

> dotifyInitial :: Int -> [String]
> dotifyInitial :: Int -> [[Char]]
dotifyInitial Int
n
>     = [ [Char]
fakeStart forall a. [a] -> [a] -> [a]
++
>         [Char]
" [style=\"invis\", width=\"0\", height=\"0\", label=\"\"];"
>       , [Char]
fakeStart forall a. [a] -> [a] -> [a]
++ [Char]
" -> " forall a. [a] -> [a] -> [a]
++ [Char]
realStart forall a. [a] -> [a] -> [a]
++ [Char]
";"
>       ]
>     where realStart :: [Char]
realStart  =  forall a. Show a => a -> [Char]
show Int
n
>           fakeStart :: [Char]
fakeStart  =  Char
'_' forall a. a -> [a] -> [a]
: [Char]
realStart forall a. [a] -> [a] -> [a]
++ [Char]
"_"

> dotifyFinal :: Int -> [String]
> dotifyFinal :: Int -> [[Char]]
dotifyFinal = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [Char]
" [peripheries=\"2\"];") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

> dotifyInitials :: (Ord e, Ord n, Show n) => FSA n e -> [String]
> dotifyInitials :: forall e n. (Ord e, Ord n, Show n) => FSA n e -> [[Char]]
dotifyInitials FSA n e
f = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse
>                    (forall c a. Container c a => c -> c -> c
union forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]]
dotifyInitial forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn (forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states FSA n e
f))
>                    forall c a. Container c a => c
empty forall a b. (a -> b) -> a -> b
$
>                    forall n e. FSA n e -> Set (State n)
initials FSA n e
f

> dotifyFinals :: (Ord e, Ord n, Show n) => FSA n e -> [String]
> dotifyFinals :: forall e n. (Ord e, Ord n, Show n) => FSA n e -> [[Char]]
dotifyFinals FSA n e
f = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse
>                  (forall c a. Container c a => c -> c -> c
union forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]]
dotifyFinal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn (forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states FSA n e
f))
>                  forall c a. Container c a => c
empty forall a b. (a -> b) -> a -> b
$
>                  forall n e. FSA n e -> Set (State n)
finals FSA n e
f

> dotifyStates :: (Ord e, Ord n, Show n) => FSA n e -> [String]
> dotifyStates :: forall e n. (Ord e, Ord n, Show n) => FSA n e -> [[Char]]
dotifyStates FSA n e
f = forall a b. (a -> b) -> [a] -> [b]
map State n -> [Char]
makeLabel forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) c a.
(Collapsible s, Container c a) =>
s a -> c
fromCollapsible Set (State n)
sts
>     where sts :: Set (State n)
sts          = forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states FSA n e
f
>           idOf :: State n -> Int
idOf         = forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn Set (State n)
sts
>           makeLabel :: State n -> [Char]
makeLabel State n
x  = forall a. Show a => a -> [Char]
show (State n -> Int
idOf State n
x) forall a. [a] -> [a] -> [a]
++ [Char]
" [label=\"" forall a. [a] -> [a] -> [a]
++
>                          ([Char] -> [Char]
deescape forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
showish forall a b. (a -> b) -> a -> b
$ forall n. State n -> n
nodeLabel State n
x) forall a. [a] -> [a] -> [a]
++ [Char]
"\"];"

> -- |Convert an 'FSA' to its representation in the GraphViz @dot@ format.
> exportDot :: (Ord e, Ord n, Show e, Show n) => FSA n e -> String
> exportDot :: forall e n. (Ord e, Ord n, Show e, Show n) => FSA n e -> [Char]
exportDot = forall e n.
(Ord e, Ord n, Show e, Show n) =>
[Char] -> FSA n e -> [Char]
exportDotWithName [Char]
""

> -- |Convert an 'FSA' to its representation in the GraphViz @dot@ format,
> -- with a provided name.
> exportDotWithName :: (Ord e, Ord n, Show e, Show n) =>
>                      String -> FSA n e -> String
> exportDotWithName :: forall e n.
(Ord e, Ord n, Show e, Show n) =>
[Char] -> FSA n e -> [Char]
exportDotWithName [Char]
name FSA n e
f
>     = [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$
>       [ [Char]
"digraph " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" {"
>       , [Char]
"graph [rankdir=\"LR\"];"
>       , [Char]
"node  [fixedsize=\"false\", fontsize=\"12.0\", " forall a. [a] -> [a] -> [a]
++
>             [Char]
"height=\"0.5\", width=\"0.5\"];"
>       , [Char]
"edge  [fontsize=\"12.0\", arrowsize=\"0.5\"];"
>       ] forall a. [a] -> [a] -> [a]
++
>       forall e n. (Ord e, Ord n, Show n) => FSA n e -> [[Char]]
dotifyInitials FSA n e
f     forall a. [a] -> [a] -> [a]
++
>       forall e n. (Ord e, Ord n, Show n) => FSA n e -> [[Char]]
dotifyStates FSA n e
f       forall a. [a] -> [a] -> [a]
++
>       forall e n. (Ord e, Ord n, Show n) => FSA n e -> [[Char]]
dotifyFinals FSA n e
f       forall a. [a] -> [a] -> [a]
++
>       forall n e. (Ord n, Ord e, Show n, Show e) => FSA n e -> [[Char]]
dotifyTransitions FSA n e
f  forall a. [a] -> [a] -> [a]
++
>       [[Char]
"}"]

> -- |Turn a 'Data.Set.Set' into a 'String':
> --
> -- >>> formatSet (fromList [1, 2, 3])
> -- "{1, 2, 3}"
> formatSet :: Show n => Set n -> String
> formatSet :: forall n. Show n => Set n -> [Char]
formatSet =  (forall a. [a] -> [a] -> [a]
++ [Char]
"}") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'{' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
showish forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>              forall a. Set a -> [a]
Set.toAscList

> deescape :: String -> String
> deescape :: [Char] -> [Char]
deescape (Char
'\\' : Char
'&' : [Char]
xs) = [Char] -> [Char]
deescape [Char]
xs
> deescape (Char
'\\' : Char
x : [Char]
xs)
>     | forall c a. Container c a => c -> Bool
isEmpty [Char]
digits = Char
x forall a. a -> [a] -> [a]
: [Char] -> [Char]
deescape [Char]
xs
>     | Bool
otherwise      = forall a. Enum a => Int -> a
toEnum (forall a. Read a => [Char] -> a
read [Char]
digits) forall a. a -> [a] -> [a]
: [Char] -> [Char]
deescape [Char]
others
>     where ([Char]
digits, [Char]
others) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn [Char]
"0123456789") (Char
xforall a. a -> [a] -> [a]
:[Char]
xs)
> deescape (Char
x:[Char]
xs) = Char
x forall a. a -> [a] -> [a]
: [Char] -> [Char]
deescape [Char]
xs
> deescape [Char]
_      = []