> {-# OPTIONS_HADDOCK hide,show-extensions #-}
> {-|
> Module    : LTK.Porters.Dot
> Copyright : (c) 2017-2019 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 :: a -> String
showish = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

> transitionClasses :: (Ord n, Ord e) => FSA n e -> Set (Set (Transition n e))
> transitionClasses :: 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 :: s n -> n -> Int
shortLabelIn s n
xs n
x = (n -> Int -> Int) -> Int -> s n -> Int
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 :: c (Symbol e, Int, Int) -> String
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   = String
""
>     | Bool
otherwise  = (Int -> String
forall a. Show a => a -> String
show Int
src) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
dest) String -> String -> String
forall a. [a] -> [a] -> [a]
++
>                    String
" [label=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
syms String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"];"
>     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 (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (:) [] c (Symbol e, Int, Int)
ts
>           syms :: String
syms            = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Symbol e, Int, Int) -> String)
-> [(Symbol e, Int, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol e -> String
forall a. Show a => Symbol a -> String
sym (Symbol e -> String)
-> ((Symbol e, Int, Int) -> Symbol e)
-> (Symbol e, Int, Int)
-> String
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 -> String
sym (Symbol a
a)  = String -> String
deescape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
showish a
a
>           sym Symbol a
Epsilon     = String
"\x03B5" -- ε

> dotifyTransitions :: (Ord n, Ord e, Show n, Show e) => FSA n e -> [String]
> dotifyTransitions :: FSA n e -> [String]
dotifyTransitions FSA n e
f = (String -> [String] -> [String])
-> [String] -> Set String -> [String]
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (:) [] (Set String -> [String])
-> (Set (Set (Transition n e)) -> Set String)
-> Set (Set (Transition n e))
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                       (Set (Transition n e) -> String)
-> Set (Set (Transition n e)) -> Set String
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                       (Set (Symbol e, Int, Int) -> String
forall (c :: * -> *) e.
(Collapsible c, Eq e, Show e) =>
c (Symbol e, Int, Int) -> String
dotifyTransitionSet (Set (Symbol e, Int, Int) -> String)
-> (Set (Transition n e) -> Set (Symbol e, Int, Int))
-> Set (Transition n e)
-> String
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)) -> [String])
-> Set (Set (Transition n e)) -> [String]
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 -> [String]
dotifyInitial Int
n
>     = [ String
fakeStart String -> String -> String
forall a. [a] -> [a] -> [a]
++
>         String
" [style=\"invis\", width=\"0\", height=\"0\", label=\"\"];"
>       , String
fakeStart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
realStart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
>       ]
>     where realStart :: String
realStart  =  Int -> String
forall a. Show a => a -> String
show Int
n
>           fakeStart :: String
fakeStart  =  Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String
realStart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"

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

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

> -- |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 :: FSA n e -> String
exportDot = String -> FSA n e -> String
forall e n.
(Ord e, Ord n, Show e, Show n) =>
String -> FSA n e -> String
exportDotWithName String
""

> -- |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 :: String -> FSA n e -> String
exportDotWithName String
name FSA n e
f
>     = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
>       [ String
"digraph " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" {"
>       , String
"graph [rankdir=\"LR\"];"
>       , String
"node  [fixedsize=\"false\", fontsize=\"12.0\", " String -> String -> String
forall a. [a] -> [a] -> [a]
++
>             String
"height=\"0.5\", width=\"0.5\"];"
>       , String
"edge  [fontsize=\"12.0\", arrowsize=\"0.5\"];"
>       ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
>       FSA n e -> [String]
forall e n. (Ord e, Ord n, Show n) => FSA n e -> [String]
dotifyInitials FSA n e
f     [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
>       FSA n e -> [String]
forall e n. (Ord e, Ord n, Show n) => FSA n e -> [String]
dotifyStates FSA n e
f       [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
>       FSA n e -> [String]
forall e n. (Ord e, Ord n, Show n) => FSA n e -> [String]
dotifyFinals FSA n e
f       [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
>       FSA n e -> [String]
forall n e. (Ord n, Ord e, Show n, Show e) => FSA n e -> [String]
dotifyTransitions FSA n e
f  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
>       [String
"}"]

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

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