> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module : LTK.Porters.ATT
> Copyright : (c) 2019 Dakotah Lambert
> LICENSE : MIT
> 
> This module provides methods to convert automata to and from the
> AT&T FSM format.  Generally there will be up to three text files,
> the contents of which can be merged via 'embedSymbolsATT'.  When
> exporting, you should similarly use 'extractSymbolsATT' to unmerge
> the resulting files.
>
> @since 0.3
> -}
> module LTK.Porters.ATT
>        ( embedSymbolsATT
>        , extractSymbolsATT
>        , invertATT
>        -- *Importing
>        , readATT
>        -- *Exporting
>        , 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>"

> -- |Take three strings and merge them in such a way that @(from ATT)@
> -- can understand the result.
> -- The three strings should represent the transitions,
> -- input symbols, and output symbols, respectively.
> 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

> -- |Convert the output of @(to ATT)@ into strings suitable for inclusion.
> -- The result represents the transitions, input symbols, and output symbols
> -- in that order.
> extractSymbolsATT :: String -> (String, String, String)
> extractSymbolsATT :: String -> (String, String, String)
extractSymbolsATT = (\(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

> -- |Convert an AT&T format string into one where input and output symbols
> -- have been reversed.
> 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 -- swap in and out
>           maybeInvert [a]
xs  =  [a]
xs


Reading an AT&T format automaton
================================

> -- |Import an FSA from its representation in AT&T format.
> -- Note that this import is not perfect;
> -- it discards weights and returns only the input projection.
> 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)  -- transitions
>                    , Set String                      -- alphabet
>                    , State String                    -- initial state
>                    , Set (State String)              -- final states
>                    )
> 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 -- 0 is reserved for epsilon
>               | 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  -- if final state with cost
>               = [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 -- just ignore the cost
>           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 -- the first line updates this last in foldr
>                 , 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
=================================

> -- |Convert an 'FSA' into its AT&T format, with one caveat:
> -- The LTK internal format allows for symbols that the AT&T format
> -- does not understand, and no attempt is made to work around this.
> -- Nonnumeric symbols are exported as-is,
> -- while numeric symbols are necessarily mapped
> -- to their tags in the symbols file(s).
> 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 -- once for input, once for output
>     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
_      = []