> {-# OPTIONS_HADDOCK show-extensions #-}
>
> module LTK.Porters.ATT
> ( embedSymbolsATT
> , extractSymbolsATT
> , invertATT
>
> , readATT
>
> , exportATT
> ) where
> import Data.Char (isDigit)
> import Data.List (intercalate)
> import Data.Set (Set)
> import Data.Map (Map)
> import qualified Data.Map.Strict as Map
> import qualified Data.Set as Set
> import LTK.FSA
> separator :: String
> separator :: String
separator = String
"* * *"
> defaultEpsilon :: String
> defaultEpsilon :: String
defaultEpsilon = String
"<EPS>"
>
>
>
>
> embedSymbolsATT :: String -> Maybe String -> Maybe String -> String
> embedSymbolsATT :: String -> Maybe String -> Maybe String -> String
embedSymbolsATT String
x Maybe String
mi Maybe String
mo
> = [String] -> String
unlines ([String] -> String)
-> (Maybe [String] -> [String]) -> Maybe [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) (String -> [String]
lines String
x) ([String] -> [String])
-> (Maybe [String] -> [String]) -> Maybe [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ([String] -> [String]) -> Maybe [String] -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [String] -> [String]
forall a. a -> a
id (Maybe [String] -> [String])
-> (Maybe [String] -> Maybe [String]) -> Maybe [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Maybe [String] -> Maybe [String]
m Maybe String
mi (Maybe [String] -> String) -> Maybe [String] -> String
forall a b. (a -> b) -> a -> b
$ Maybe String -> Maybe [String] -> Maybe [String]
m Maybe String
mo Maybe [String]
forall a. Maybe a
Nothing
> where presep :: [String] -> [String]
presep = (:) String
separator
> multisep :: Maybe [String] -> Maybe [String] -> Maybe [String]
multisep = (Maybe [String] -> Maybe [String])
-> ([String] -> Maybe [String] -> Maybe [String])
-> Maybe [String]
-> Maybe [String]
-> Maybe [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
> (([String] -> [String]) -> Maybe [String] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
presep)
> (\[String]
a ->
> Maybe [String]
-> ([String] -> Maybe [String]) -> Maybe [String] -> Maybe [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
presep [String]
a) ([String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String])
-> ([String] -> [String]) -> [String] -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) ([String] -> [String]
presep [String]
a))
> )
> m :: Maybe String -> Maybe [String] -> Maybe [String]
m = Maybe [String] -> Maybe [String] -> Maybe [String]
multisep (Maybe [String] -> Maybe [String] -> Maybe [String])
-> (Maybe String -> Maybe [String])
-> Maybe String
-> Maybe [String]
-> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> Maybe String -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> [String]
lines
>
>
>
> extractSymbolsATT :: String -> (String, String, String)
> = (\(String
a:String
b:String
c:[String]
_) -> (String
a, String
b, String
c)) ([String] -> (String, String, String))
-> (String -> [String]) -> String -> (String, String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String] -> [String])
-> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) [[],[],[]] ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
> ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [[String]]
forall a. Eq a => a -> [a] -> [[a]]
splitOn String
separator ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
>
>
> invertATT :: String -> String
> invertATT :: String -> String
invertATT String
s = String -> Maybe String -> Maybe String -> String
embedSymbolsATT String
ts' (String -> Maybe String
forall a. a -> Maybe a
Just String
o) (String -> Maybe String
forall a. a -> Maybe a
Just String
i)
> where (String
ts, String
i, String
o) = String -> (String, String, String)
extractSymbolsATT String
s
> ts' :: String
ts' = [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
invertSingle ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
ts
> invertSingle :: String -> String
invertSingle String
t = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\t" ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
maybeInvert ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
t
> maybeInvert :: [a] -> [a]
maybeInvert (a
a:a
b:a
c:a
d:[a]
xs)
> = a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
> maybeInvert [a]
xs = [a]
xs
Reading an AT&T format automaton
================================
>
>
>
> readATT :: String -> FSA Integer String
> readATT :: String -> FSA Integer String
readATT String
x = FSA String String -> FSA Integer String
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA String String -> FSA Integer String)
-> FSA String String -> FSA Integer String
forall a b. (a -> b) -> a -> b
$
> FSA :: forall n e.
Set e
-> Set (Transition n e)
-> Set (State n)
-> Set (State n)
-> Bool
-> FSA n e
FSA { sigma :: Set String
sigma = Set String -> Set String -> Set String
forall c a. Container c a => c -> c -> c
union Set String
al' Set String
as
> , transitions :: Set (Transition String String)
transitions = Set (Transition String String)
ts
> , initials :: Set (State String)
initials = State String -> Set (State String)
forall c a. Container c a => a -> c
singleton State String
qi
> , finals :: Set (State String)
finals = Set (State String)
fs
> , isDeterministic :: Bool
isDeterministic = Bool
False
> }
> where (String
es, String
i, String
_) = String -> (String, String, String)
extractSymbolsATT String
x
> (Map String String
al, Maybe String
eps) = [String] -> (Map String String, Maybe String)
makeAlphabet (String -> [String]
lines String
i)
> al' :: Set String
al' = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ Map String String -> [String]
forall k a. Map k a -> [a]
Map.elems Map String String
al
> (Set (Transition String String)
ts,Set String
as,State String
qi,Set (State String)
fs) = [String]
-> Map String String
-> Maybe String
-> (Set (Transition String String), Set String, State String,
Set (State String))
makeTransitions (String -> [String]
lines String
es) Map String String
al Maybe String
eps
> makeAlphabet :: [String] -> (Map String String, Maybe String)
> makeAlphabet :: [String] -> (Map String String, Maybe String)
makeAlphabet [String]
ss = (Map String String, Maybe String)
-> [(String, String)] -> (Map String String, Maybe String)
forall a.
(Map String a, Maybe a) -> [(a, String)] -> (Map String a, Maybe a)
findEps (Map String String
forall k a. Map k a
Map.empty, Maybe String
forall a. Maybe a
Nothing) [(String, String)]
ps
> where ps :: [(String, String)]
ps = ([String] -> [(String, String)] -> [(String, String)])
-> [(String, String)] -> [[String]] -> [(String, String)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [String] -> [(String, String)] -> [(String, String)]
forall b. [b] -> [(b, b)] -> [(b, b)]
maybeInsert [] ((String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
words [String]
ss)
> maybeInsert :: [b] -> [(b, b)] -> [(b, b)]
maybeInsert (b
a:b
b:[b]
_) = (:) (b
a, b
b)
> maybeInsert [b]
_ = [(b, b)] -> [(b, b)]
forall a. a -> a
id
> findEps :: (Map String a, Maybe a) -> [(a, String)] -> (Map String a, Maybe a)
findEps (Map String a
l, Maybe a
x) [] = (Map String a
l, Maybe a
x)
> findEps (Map String a
l, Maybe a
x) ((a
s, String
t):[(a, String)]
as)
> = ((Map String a, Maybe a)
-> [(a, String)] -> (Map String a, Maybe a))
-> [(a, String)]
-> (Map String a, Maybe a)
-> (Map String a, Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Map String a, Maybe a) -> [(a, String)] -> (Map String a, Maybe a)
findEps [(a, String)]
as ((Map String a, Maybe a) -> (Map String a, Maybe a))
-> (Map String a, Maybe a) -> (Map String a, Maybe a)
forall a b. (a -> b) -> a -> b
$
> if String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" then (Map String a
l, a -> Maybe a
forall a. a -> Maybe a
Just a
s) else (String -> a -> Map String a -> Map String a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
t a
s Map String a
l, Maybe a
x)
> makeTransitions :: [String] -> Map String String -> Maybe String ->
> ( Set (Transition String String)
> , Set String
> , State String
> , Set (State String)
> )
> makeTransitions :: [String]
-> Map String String
-> Maybe String
-> (Set (Transition String String), Set String, State String,
Set (State String))
makeTransitions [String]
ss Map String String
tags Maybe String
meps
> = ([String]
-> (Set (Transition String String), Set String, State String,
Set (State String))
-> (Set (Transition String String), Set String, State String,
Set (State String)))
-> (Set (Transition String String), Set String, State String,
Set (State String))
-> [[String]]
-> (Set (Transition String String), Set String, State String,
Set (State String))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [String]
-> (Set (Transition String String), Set String, State String,
Set (State String))
-> (Set (Transition String String), Set String, State String,
Set (State String))
update
> (Set (Transition String String)
forall a. Set a
Set.empty, Set String
forall a. Set a
Set.empty, String -> State String
forall n. n -> State n
State String
"", Set (State String)
forall a. Set a
Set.empty) ([[String]]
-> (Set (Transition String String), Set String, State String,
Set (State String)))
-> [[String]]
-> (Set (Transition String String), Set String, State String,
Set (State String))
forall a b. (a -> b) -> a -> b
$
> (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
words [String]
ss
> where symbolify :: String -> Maybe String
symbolify String
x
> | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" = Maybe String
forall a. Maybe a
Nothing
> | String -> Maybe String
forall a. a -> Maybe a
Just String
x Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
meps = Maybe String
forall a. Maybe a
Nothing
> | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Maybe String -> String) -> Maybe String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
x String -> String
forall a. a -> a
id (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
x Map String String
tags
> update :: [String]
-> (Set (Transition String String), Set String, State String,
Set (State String))
-> (Set (Transition String String), Set String, State String,
Set (State String))
update (String
a:[]) (Set (Transition String String)
ts, Set String
as, State String
qi, Set (State String)
fs)
> = (Set (Transition String String)
ts, Set String
as, State String
qi, State String -> Set (State String) -> Set (State String)
forall a. Ord a => a -> Set a -> Set a
Set.insert (String -> State String
forall n. n -> State n
State String
a) Set (State String)
fs)
> update (String
a:String
_:[]) (Set (Transition String String), Set String, State String,
Set (State String))
partial
> = [String]
-> (Set (Transition String String), Set String, State String,
Set (State String))
-> (Set (Transition String String), Set String, State String,
Set (State String))
update [String
a] (Set (Transition String String), Set String, State String,
Set (State String))
partial
> update (String
s:String
d:String
l:[String]
_) (Set (Transition String String)
ts, Set String
as, State String
_, Set (State String)
fs)
> = ( (Transition String String
-> Set (Transition String String)
-> Set (Transition String String))
-> Set (Transition String String)
-> Transition String String
-> Set (Transition String String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Transition String String
-> Set (Transition String String) -> Set (Transition String String)
forall a. Ord a => a -> Set a -> Set a
Set.insert Set (Transition String String)
ts (Transition String String -> Set (Transition String String))
-> Transition String String -> Set (Transition String String)
forall a b. (a -> b) -> a -> b
$
> Transition :: forall n e. Symbol e -> State n -> State n -> Transition n e
Transition
> { source :: State String
source = String -> State String
forall n. n -> State n
State String
s
> , destination :: State String
destination = String -> State String
forall n. n -> State n
State String
d
> , edgeLabel :: Symbol String
edgeLabel = Symbol String
-> (String -> Symbol String) -> Maybe String -> Symbol String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Symbol String
forall e. Symbol e
Epsilon String -> Symbol String
forall e. e -> Symbol e
Symbol (Maybe String -> Symbol String) -> Maybe String -> Symbol String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
symbolify String
l
> }
> , Set String -> (String -> Set String) -> Maybe String -> Set String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set String
as ((String -> Set String -> Set String)
-> Set String -> String -> Set String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert Set String
as) (Maybe String -> Set String) -> Maybe String -> Set String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
symbolify String
l
> , String -> State String
forall n. n -> State n
State String
s
> , Set (State String)
fs
> )
> update [String]
_ (Set (Transition String String), Set String, State String,
Set (State String))
partial = (Set (Transition String String), Set String, State String,
Set (State String))
partial
Creating an AT&T format automaton
=================================
>
>
>
>
>
>
> exportATT :: (Ord n, Ord e, Show e) => FSA n e -> String
> exportATT :: FSA n e -> String
exportATT FSA n e
f = [String] -> String
unlines
> ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [(e, Int)] -> Set (State Integer) -> [String]
forall n e.
(Ord n, Ord e, Show n, Show e, Num n) =>
[(e, Int)] -> Set (State n) -> [String]
dumpInitials [(e, Int)]
tags (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
initials FSA Integer e
f')
> [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [(e, Int)]
-> Set (State Integer, State Integer, Symbol e)
-> Set (State Integer)
-> [String]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)]
-> Set (State n, State n, Symbol e) -> Set (State n) -> [String]
dumpTransitions [(e, Int)]
tags Set (State Integer, State Integer, Symbol e)
ts (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
initials FSA Integer e
f')
> [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [(e, Int)]
-> Set (State Integer, State Integer, Symbol e)
-> Set (State Integer)
-> [String]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)]
-> Set (State n, State n, Symbol e) -> Set (State n) -> [String]
dumpTransitions [(e, Int)]
tags Set (State Integer, State Integer, Symbol e)
ts (Set (State Integer) -> Set (State Integer) -> Set (State Integer)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (FSA Integer e -> Set (State Integer)
forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states FSA Integer e
f')
> (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
initials FSA Integer e
f'))
> [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Set (State Integer) -> [String]
forall n. (Ord n, Show n) => Set (State n) -> [String]
dumpFinals (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
finals FSA Integer e
f')
> [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
syms [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
syms
> where tags :: [(e, Int)]
tags = ([e] -> [Int] -> [(e, Int)]) -> [Int] -> [e] -> [(e, Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [e] -> [Int] -> [(e, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([e] -> [(e, Int)]) -> (Set e -> [e]) -> Set e -> [(e, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set e -> [e]
forall a. Set a -> [a]
Set.toAscList (Set e -> [(e, Int)]) -> Set e -> [(e, Int)]
forall a b. (a -> b) -> a -> b
$ FSA Integer e -> Set e
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet FSA Integer e
f'
> syms :: [String]
syms = String
separator String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [(e, Int)] -> [String]
forall e. (Ord e, Show e) => [(e, Int)] -> [String]
dumpAlphabet [(e, Int)]
tags
> f' :: FSA Integer e
f' = if (Set (State n) -> Int
forall a. Set a -> Int
Set.size (FSA n e -> Set (State n)
forall n e. FSA n e -> Set (State n)
initials FSA n e
f) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)
> then (Integer -> Integer) -> FSA Integer e -> FSA Integer e
forall e n n1.
(Ord e, Ord n, Ord n1) =>
(n -> n1) -> FSA n e -> FSA n1 e
renameStatesBy (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
subtract (Integer
1::Integer)) (FSA Integer e -> FSA Integer e) -> FSA Integer e -> FSA Integer e
forall a b. (a -> b) -> a -> b
$
> FSA n e -> FSA Integer e
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates FSA n e
f
> else FSA n e -> FSA Integer e
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates FSA n e
f
> ts :: Set (State Integer, State Integer, Symbol e)
ts = (Transition Integer e -> (State Integer, State Integer, Symbol e))
-> Set (Transition Integer e)
-> Set (State Integer, State Integer, Symbol e)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Transition Integer e
t -> (Transition Integer e -> State Integer
forall n e. Transition n e -> State n
source Transition Integer e
t, Transition Integer e -> State Integer
forall n e. Transition n e -> State n
destination Transition Integer e
t, Transition Integer e -> Symbol e
forall n e. Transition n e -> Symbol e
edgeLabel Transition Integer e
t)) (Set (Transition Integer e)
-> Set (State Integer, State Integer, Symbol e))
-> Set (Transition Integer e)
-> Set (State Integer, State Integer, Symbol e)
forall a b. (a -> b) -> a -> b
$
> FSA Integer e -> Set (Transition Integer e)
forall n e. FSA n e -> Set (Transition n e)
transitions FSA Integer e
f'
> dumpAlphabet :: (Ord e, Show e) => [(e, Int)] -> [String]
> dumpAlphabet :: [(e, Int)] -> [String]
dumpAlphabet [(e, Int)]
tags = String -> Int -> String
forall a. Show a => a -> Int -> String
p String
defaultEpsilon Int
0 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (((e, Int) -> String) -> [(e, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((e -> Int -> String) -> (e, Int) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry e -> Int -> String
forall a. Show a => a -> Int -> String
p) [(e, Int)]
tags)
> where p :: a -> Int -> String
p a
a Int
t = String -> String
deescape (a -> String
forall a. Show a => a -> String
showish a
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
0 :: Int))
> dumpInitials :: (Ord n, Ord e, Show n, Show e, Num n) =>
> [(e, Int)] -> Set (State n) -> [String]
> dumpInitials :: [(e, Int)] -> Set (State n) -> [String]
dumpInitials [(e, Int)]
tags Set (State n)
qis
> | Set (State n) -> Int
forall a. Set a -> Int
Set.size Set (State n)
qis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = []
> | Bool
otherwise = (State n -> String) -> [State n] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\State n
q -> [(e, Int)] -> (State n, State n, Symbol e) -> String
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)] -> (State n, State n, Symbol e) -> String
dumpTr [(e, Int)]
tags (n -> State n
forall n. n -> State n
State n
0, State n
q, Symbol e
forall e. Symbol e
eps))
> ([State n] -> [String]) -> [State n] -> [String]
forall a b. (a -> b) -> a -> b
$ Set (State n) -> [State n]
forall a. Set a -> [a]
Set.toAscList Set (State n)
qis
> where eps :: Symbol e
eps = Symbol e
forall e. Symbol e
Epsilon
> dumpTransitions :: (Ord n, Ord e, Show n, Show e) =>
> [(e, Int)] -> Set (State n, State n, Symbol e) ->
> Set (State n) ->
> [String]
> dumpTransitions :: [(e, Int)]
-> Set (State n, State n, Symbol e) -> Set (State n) -> [String]
dumpTransitions [(e, Int)]
tags Set (State n, State n, Symbol e)
ts Set (State n)
qs = ((State n, State n, Symbol e) -> String)
-> [(State n, State n, Symbol e)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([(e, Int)] -> (State n, State n, Symbol e) -> String
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)] -> (State n, State n, Symbol e) -> String
dumpTr [(e, Int)]
tags) ([(State n, State n, Symbol e)] -> [String])
-> [(State n, State n, Symbol e)] -> [String]
forall a b. (a -> b) -> a -> b
$ Set (State n, State n, Symbol e) -> [(State n, State n, Symbol e)]
forall a. Set a -> [a]
Set.toAscList Set (State n, State n, Symbol e)
ts'
> where ts' :: Set (State n, State n, Symbol e)
ts' = ((State n, State n, Symbol e) -> Bool)
-> Set (State n, State n, Symbol e)
-> Set (State n, State n, Symbol e)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\(State n
a,State n
_,Symbol e
_) -> Set (State n) -> State n -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn Set (State n)
qs State n
a) Set (State n, State n, Symbol e)
ts
> dumpTr :: (Ord n, Ord e, Show n, Show e) =>
> [(e, Int)] -> (State n, State n, Symbol e) -> String
> dumpTr :: [(e, Int)] -> (State n, State n, Symbol e) -> String
dumpTr [(e, Int)]
tags (State n
s, State n
d, Symbol e
l)
> = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\t" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
> [n -> String
forall a. Show a => a -> String
show (n -> String) -> n -> String
forall a b. (a -> b) -> a -> b
$ State n -> n
forall n. State n -> n
nodeLabel State n
s, n -> String
forall a. Show a => a -> String
show (n -> String) -> n -> String
forall a b. (a -> b) -> a -> b
$ State n -> n
forall n. State n -> n
nodeLabel State n
d, String
l', String
l']
> where l' :: String
l' = case Symbol e
l
> of Symbol e
e -> e -> String
f e
e
> Symbol e
_ -> String
defaultEpsilon
> f :: e -> String
f e
e
> | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit (e -> String
forall a. Show a => a -> String
showish e
e)
> = [String] -> String
forall a. [a] -> a
head
> ([String] -> String)
-> ([(e, Int)] -> [String]) -> [(e, Int)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [e -> String
forall a. Show a => a -> String
showish e
e]) ([String] -> [String])
-> ([(e, Int)] -> [String]) -> [(e, Int)] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((e, Int) -> String) -> [(e, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String
forall a. Show a => a -> String
showish (Int -> String) -> ((e, Int) -> Int) -> (e, Int) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, Int) -> Int
forall a b. (a, b) -> b
snd)
> ([(e, Int)] -> String) -> [(e, Int)] -> String
forall a b. (a -> b) -> a -> b
$ ((e, Int) -> Bool) -> [(e, Int)] -> [(e, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
e) (e -> Bool) -> ((e, Int) -> e) -> (e, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, Int) -> e
forall a b. (a, b) -> a
fst) [(e, Int)]
tags
> | Bool
otherwise = String -> String
deescape (e -> String
forall a. Show a => a -> String
showish e
e)
> dumpFinals :: (Ord n, Show n) => Set (State n) -> [String]
> dumpFinals :: Set (State n) -> [String]
dumpFinals = (State n -> String) -> [State n] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (n -> String
forall a. Show a => a -> String
show (n -> String) -> (State n -> n) -> State n -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State n -> n
forall n. State n -> n
nodeLabel) ([State n] -> [String])
-> (Set (State n) -> [State n]) -> Set (State n) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (State n) -> [State n]
forall a. Set a -> [a]
Set.toAscList
Helpers
=======
> splitOn :: Eq a => a -> [a] -> [[a]]
> splitOn :: a -> [a] -> [[a]]
splitOn a
_ [] = [[]]
> splitOn a
b (a
a:[a]
as)
> | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = [][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
x
> | Bool
otherwise = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[[a]] -> [a]
forall a. [a] -> a
head [[a]]
x)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]] -> [[a]]
forall a. [a] -> [a]
tail [[a]]
x
> where x :: [[a]]
x = a -> [a] -> [[a]]
forall a. Eq a => a -> [a] -> [[a]]
splitOn a
b [a]
as
> showish :: Show a => a -> String
> showish :: a -> String
showish = String -> String
f (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
> where f :: String -> String
f String
xs = if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"\"" then String -> String
f' (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
xs) else String
xs
> f' :: String -> String
f' String
"" = String
""
> f' String
"\"" = String
""
> f' (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
f' String
xs
> 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
_ = []