> {-# 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 = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') ([Char] -> [Char]) -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
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 = (Transition n e -> State n)
-> Set (Set (Transition n e)) -> Set (Set (Transition n e))
forall a n.
(Ord a, Ord n) =>
(n -> a) -> Set (Set n) -> Set (Set n)
refinePartitionBy Transition n e -> State n
forall n e. Transition n e -> State n
destination (Set (Set (Transition n e)) -> Set (Set (Transition n e)))
-> (FSA n e -> Set (Set (Transition n e)))
-> FSA n e
-> Set (Set (Transition n e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transition n e -> State n)
-> Set (Transition n e) -> Set (Set (Transition n e))
forall a n. (Ord a, Ord n) => (n -> a) -> Set n -> Set (Set n)
partitionBy Transition n e -> State n
forall n e. Transition n e -> State n
source (Set (Transition n e) -> Set (Set (Transition n e)))
-> (FSA n e -> Set (Transition n e))
-> FSA n e
-> Set (Set (Transition n e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                     FSA n e -> Set (Transition n e)
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 = (n -> Int -> Int) -> Int -> s n -> Int
forall a b. (a -> b -> b) -> b -> s a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (\n
y Int
a -> if n
y n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
x then Int
0 else Int
1 Int -> Int -> Int
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
>     | c (Symbol e, Int, Int) -> Bool
forall (c :: * -> *) b. Collapsible c => c b -> Bool
zsize c (Symbol e, Int, Int)
ts   = [Char]
""
>     | Bool
otherwise  = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
src [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
dest
>                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [label=\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
syms [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\"];"
>     where (Symbol e
_, Int
src, Int
dest)  = c (Symbol e, Int, Int) -> (Symbol e, Int, Int)
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            = ((Symbol e, Int, Int)
 -> [(Symbol e, Int, Int)] -> [(Symbol e, Int, Int)])
-> [(Symbol e, Int, Int)]
-> c (Symbol e, Int, Int)
-> [(Symbol e, Int, Int)]
forall a b. (a -> b -> b) -> b -> c a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (:) [] c (Symbol e, Int, Int)
ts
>           syms :: [Char]
syms            = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Symbol e, Int, Int) -> [Char])
-> [(Symbol e, Int, Int)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol e -> [Char]
forall {a}. Show a => Symbol a -> [Char]
sym (Symbol e -> [Char])
-> ((Symbol e, Int, Int) -> Symbol e)
-> (Symbol e, Int, Int)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol e, Int, Int) -> Symbol e
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 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ a -> [Char]
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 = ([Char] -> [[Char]] -> [[Char]])
-> [[Char]] -> Set [Char] -> [[Char]]
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (:) [] (Set [Char] -> [[Char]])
-> (Set (Set (Transition n e)) -> Set [Char])
-> Set (Set (Transition n e))
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                       (Set (Transition n e) -> [Char])
-> Set (Set (Transition n e)) -> Set [Char]
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                       (Set (Symbol e, Int, Int) -> [Char]
forall (c :: * -> *) e.
(Collapsible c, Eq e, Show e) =>
c (Symbol e, Int, Int) -> [Char]
dotifyTransitionSet (Set (Symbol e, Int, Int) -> [Char])
-> (Set (Transition n e) -> Set (Symbol e, Int, Int))
-> Set (Transition n e)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                        (Transition n e -> (Symbol e, Int, Int))
-> Set (Transition n e) -> Set (Symbol e, Int, Int)
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap Transition n e -> (Symbol e, Int, Int)
forall {e}. Transition n e -> (Symbol e, Int, Int)
remakeTransition
>                       ) (Set (Set (Transition n e)) -> [[Char]])
-> Set (Set (Transition n e)) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ FSA n e -> Set (Set (Transition n e))
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
>               = ( Transition n e -> Symbol e
forall n e. Transition n e -> Symbol e
edgeLabel Transition n e
t
>                 , Set (State n) -> State n -> Int
forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn Set (State n)
sts (Transition n e -> State n
forall n e. Transition n e -> State n
source Transition n e
t)
>                 , Set (State n) -> State n -> Int
forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn Set (State n)
sts (Transition n e -> State n
forall n e. Transition n e -> State n
destination Transition n e
t)
>                 )
>           sts :: Set (State n)
sts = FSA n e -> Set (State n)
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 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
>         [Char]
" [style=\"invis\", width=\"0\", height=\"0\", label=\"\"];"
>       , [Char]
fakeStart [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
realStart [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"
>       ]
>     where realStart :: [Char]
realStart  =  Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
>           fakeStart :: [Char]
fakeStart  =  Char
'_' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
realStart [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_"

> dotifyFinal :: Int -> [String]
> dotifyFinal :: Int -> [[Char]]
dotifyFinal = ([Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[]) ([Char] -> [[Char]]) -> (Int -> [Char]) -> Int -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [peripheries=\"2\"];") ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
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 = (State n -> [[Char]] -> [[Char]])
-> [[Char]] -> Set (State n) -> [[Char]]
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse
>                    ([[Char]] -> [[Char]] -> [[Char]]
forall c a. Container c a => c -> c -> c
union ([[Char]] -> [[Char]] -> [[Char]])
-> (State n -> [[Char]]) -> State n -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]]
dotifyInitial (Int -> [[Char]]) -> (State n -> Int) -> State n -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (State n) -> State n -> Int
forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn (FSA n e -> Set (State n)
forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states FSA n e
f))
>                    [[Char]]
forall c a. Container c a => c
empty (Set (State n) -> [[Char]]) -> Set (State n) -> [[Char]]
forall a b. (a -> b) -> a -> b
$
>                    FSA n e -> Set (State n)
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 = (State n -> [[Char]] -> [[Char]])
-> [[Char]] -> Set (State n) -> [[Char]]
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse
>                  ([[Char]] -> [[Char]] -> [[Char]]
forall c a. Container c a => c -> c -> c
union ([[Char]] -> [[Char]] -> [[Char]])
-> (State n -> [[Char]]) -> State n -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]]
dotifyFinal (Int -> [[Char]]) -> (State n -> Int) -> State n -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (State n) -> State n -> Int
forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn (FSA n e -> Set (State n)
forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states FSA n e
f))
>                  [[Char]]
forall c a. Container c a => c
empty (Set (State n) -> [[Char]]) -> Set (State n) -> [[Char]]
forall a b. (a -> b) -> a -> b
$
>                  FSA n e -> Set (State n)
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 = (State n -> [Char]) -> [State n] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map State n -> [Char]
makeLabel ([State n] -> [[Char]]) -> [State n] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Set (State n) -> [State n]
forall (s :: * -> *) c a.
(Collapsible s, Container c a) =>
s a -> c
fromCollapsible Set (State n)
sts
>     where sts :: Set (State n)
sts          = FSA n e -> Set (State n)
forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states FSA n e
f
>           idOf :: State n -> Int
idOf         = Set (State n) -> State n -> Int
forall (s :: * -> *) n. (Collapsible s, Eq n) => s n -> n -> Int
shortLabelIn Set (State n)
sts
>           makeLabel :: State n -> [Char]
makeLabel State n
x  = Int -> [Char]
forall a. Show a => a -> [Char]
show (State n -> Int
idOf State n
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [label=\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
>                          ([Char] -> [Char]
deescape ([Char] -> [Char]) -> (n -> [Char]) -> n -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> [Char]
forall a. Show a => a -> [Char]
showish (n -> [Char]) -> n -> [Char]
forall a b. (a -> b) -> a -> b
$ State n -> n
forall n. State n -> n
nodeLabel State n
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\"];"

> -- |Convert an t'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 = [Char] -> FSA n e -> [Char]
forall e n.
(Ord e, Ord n, Show e, Show n) =>
[Char] -> FSA n e -> [Char]
exportDotWithName [Char]
""

> -- |Convert an t'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 ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
>       [ [Char]
"digraph " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" {"
>       , [Char]
"graph [rankdir=\"LR\"];"
>       , [Char]
"node  [fixedsize=\"false\", fontsize=\"12.0\", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
>             [Char]
"height=\"0.5\", width=\"0.5\"];"
>       , [Char]
"edge  [fontsize=\"12.0\", arrowsize=\"0.5\"];"
>       ] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
>       FSA n e -> [[Char]]
forall e n. (Ord e, Ord n, Show n) => FSA n e -> [[Char]]
dotifyInitials FSA n e
f     [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
>       FSA n e -> [[Char]]
forall e n. (Ord e, Ord n, Show n) => FSA n e -> [[Char]]
dotifyStates FSA n e
f       [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
>       FSA n e -> [[Char]]
forall e n. (Ord e, Ord n, Show n) => FSA n e -> [[Char]]
dotifyFinals FSA n e
f       [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
>       FSA n e -> [[Char]]
forall n e. (Ord n, Ord e, Show n, Show e) => FSA n e -> [[Char]]
dotifyTransitions FSA n e
f  [[Char]] -> [[Char]] -> [[Char]]
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 =  ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}") ([Char] -> [Char]) -> (Set n -> [Char]) -> Set n -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'{' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> (Set n -> [Char]) -> Set n -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [Char]) -> (Set n -> [[Char]]) -> Set n -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> [Char]) -> [n] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map n -> [Char]
forall a. Show a => a -> [Char]
showish ([n] -> [[Char]]) -> (Set n -> [n]) -> Set n -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>              Set n -> [n]
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)
>     | [Char] -> Bool
forall c a. Container c a => c -> Bool
isEmpty [Char]
digits = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
deescape [Char]
xs
>     | Bool
otherwise      = Int -> Char
forall a. Enum a => Int -> a
toEnum ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
digits) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
deescape [Char]
others
>     where ([Char]
digits, [Char]
others) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ([Char] -> Char -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn [Char]
"0123456789") (Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs)
> deescape (Char
x:[Char]
xs) = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
deescape [Char]
xs
> deescape [Char]
_      = []