> {-# OPTIONS_HADDOCK hide,show-extensions #-}
>
> module LTK.Porters.Dot
> (
> exportDot
> , exportDotWithName
>
> , 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
>
>
>
>
> 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]
"\"];"
>
> 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]
""
>
>
> 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]
"}"]
>
>
>
>
> 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]
_ = []