> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module : LTK.Porters.ATT
> Copyright : (c) 2019-2023 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.List.NonEmpty (NonEmpty(..))
> import Data.Maybe (fromMaybe)
> import Data.Set (Set)
> import Data.Map (Map)
> import qualified Data.List.NonEmpty as NE
> import qualified Data.Map.Strict as Map
> import qualified Data.Set as Set

> import LTK.FSA

> separator :: String
> separator :: [Char]
separator = [Char]
"* * *"

> defaultEpsilon :: String
> defaultEpsilon :: [Char]
defaultEpsilon = [Char]
"<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 :: [Char] -> Maybe [Char] -> Maybe [Char] -> [Char]
embedSymbolsATT [Char]
x Maybe [Char]
mi Maybe [Char]
mo
>     = [[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> (Maybe [[Char]] -> [[Char]]) -> Maybe [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
(++) ([Char] -> [[Char]]
lines [Char]
x) ([[Char]] -> [[Char]])
-> (Maybe [[Char]] -> [[Char]]) -> Maybe [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Maybe [[Char]] -> [[Char]]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [[Char]] -> [[Char]])
-> (Maybe [[Char]] -> Maybe [[Char]]) -> Maybe [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> Maybe [[Char]] -> Maybe [[Char]]
m Maybe [Char]
mi (Maybe [[Char]] -> [Char]) -> Maybe [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> Maybe [[Char]] -> Maybe [[Char]]
m Maybe [Char]
mo Maybe [[Char]]
forall a. Maybe a
Nothing
>     where presep :: [[Char]] -> [[Char]]
presep   = (:) [Char]
separator
>           multisep :: Maybe [[Char]] -> Maybe [[Char]] -> Maybe [[Char]]
multisep = (Maybe [[Char]] -> Maybe [[Char]])
-> ([[Char]] -> Maybe [[Char]] -> Maybe [[Char]])
-> Maybe [[Char]]
-> Maybe [[Char]]
-> Maybe [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
>                      (([[Char]] -> [[Char]]) -> Maybe [[Char]] -> Maybe [[Char]]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Char]] -> [[Char]]
presep)
>                      (\[[Char]]
a ->
>                       Maybe [[Char]]
-> ([[Char]] -> Maybe [[Char]]) -> Maybe [[Char]] -> Maybe [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just ([[Char]] -> Maybe [[Char]]) -> [[Char]] -> Maybe [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
presep [[Char]]
a) ([[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just ([[Char]] -> Maybe [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Maybe [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
(++) ([[Char]] -> [[Char]]
presep [[Char]]
a))
>                      )
>           m :: Maybe [Char] -> Maybe [[Char]] -> Maybe [[Char]]
m = Maybe [[Char]] -> Maybe [[Char]] -> Maybe [[Char]]
multisep (Maybe [[Char]] -> Maybe [[Char]] -> Maybe [[Char]])
-> (Maybe [Char] -> Maybe [[Char]])
-> Maybe [Char]
-> Maybe [[Char]]
-> Maybe [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [[Char]]) -> Maybe [Char] -> Maybe [[Char]]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> [[Char]]
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 :: [Char] -> ([Char], [Char], [Char])
extractSymbolsATT
>     = [[Char]] -> ([Char], [Char], [Char])
forall {a}. [[a]] -> ([a], [a], [a])
f ([[Char]] -> ([Char], [Char], [Char]))
-> ([Char] -> [[Char]]) -> [Char] -> ([Char], [Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> [Char]
unlines ([[[Char]]] -> [[Char]])
-> ([Char] -> [[[Char]]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [[Char]] -> [[[Char]]]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty [[Char]] -> [[[Char]]])
-> ([Char] -> NonEmpty [[Char]]) -> [Char] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> NonEmpty [[Char]]
forall a. Eq a => a -> [a] -> NonEmpty [a]
splitOn [Char]
separator ([[Char]] -> NonEmpty [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> NonEmpty [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
>     where f :: [[a]] -> ([a], [a], [a])
f ([a]
x:[a]
y:[a]
z:[[a]]
_)  =  ([a]
x, [a]
y, [a]
z)
>           f ([a]
x:[a]
y:[[a]]
_)    =  ([a]
x, [a]
y, [])
>           f ([a]
x:[[a]]
_)      =  ([a]
x, [], [])
>           f [[a]]
_          =  ([], [], [])

> -- |Convert an AT&T format string into one where input and output symbols
> -- have been reversed.
> invertATT :: String -> String
> invertATT :: [Char] -> [Char]
invertATT [Char]
s = [Char] -> Maybe [Char] -> Maybe [Char] -> [Char]
embedSymbolsATT [Char]
ts' ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
o) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
i)
>     where ([Char]
ts, [Char]
i, [Char]
o)      =  [Char] -> ([Char], [Char], [Char])
extractSymbolsATT [Char]
s
>           ts' :: [Char]
ts'             =  [[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
invertSingle ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
ts
>           invertSingle :: [Char] -> [Char]
invertSingle [Char]
t  =  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall {a}. [a] -> [a]
maybeInvert ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words [Char]
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 :: [Char] -> FSA Integer [Char]
readATT [Char]
x = FSA [Char] [Char] -> FSA Integer [Char]
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA [Char] [Char] -> FSA Integer [Char])
-> FSA [Char] [Char] -> FSA Integer [Char]
forall a b. (a -> b) -> a -> b
$
>             FSA { sigma :: Set [Char]
sigma            =  Set [Char]
al' Set [Char] -> Set [Char] -> Set [Char]
forall c a. Container c a => c -> c -> c
`union` Set [Char]
as
>                 , transitions :: Set (Transition [Char] [Char])
transitions      =  Set (Transition [Char] [Char])
ts
>                 , initials :: Set (State [Char])
initials         =  State [Char] -> Set (State [Char])
forall c a. Container c a => a -> c
singleton State [Char]
qi
>                 , finals :: Set (State [Char])
finals           =  Set (State [Char])
fs
>                 , isDeterministic :: Bool
isDeterministic  =  Bool
False
>                 }
>     where ([Char]
es, [Char]
i, [Char]
_)     =  [Char] -> ([Char], [Char], [Char])
extractSymbolsATT [Char]
x
>           (Map [Char] [Char]
al, Maybe [Char]
eps)      =  [[Char]] -> (Map [Char] [Char], Maybe [Char])
makeAlphabet ([Char] -> [[Char]]
lines [Char]
i)
>           al' :: Set [Char]
al'            =  [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList ([[Char]] -> Set [Char]) -> [[Char]] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ Map [Char] [Char] -> [[Char]]
forall k a. Map k a -> [a]
Map.elems Map [Char] [Char]
al
>           (Set (Transition [Char] [Char])
ts,Set [Char]
as,State [Char]
qi,Set (State [Char])
fs)  =  [[Char]]
-> Map [Char] [Char]
-> Maybe [Char]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
makeTransitions ([Char] -> [[Char]]
lines [Char]
es) Map [Char] [Char]
al Maybe [Char]
eps

> makeAlphabet :: [String] -> (Map String String, Maybe String)
> makeAlphabet :: [[Char]] -> (Map [Char] [Char], Maybe [Char])
makeAlphabet [[Char]]
ss = (Map [Char] [Char], Maybe [Char])
-> [([Char], [Char])] -> (Map [Char] [Char], Maybe [Char])
forall {a}.
(Map [Char] a, Maybe a) -> [(a, [Char])] -> (Map [Char] a, Maybe a)
findEps (Map [Char] [Char]
forall k a. Map k a
Map.empty, Maybe [Char]
forall a. Maybe a
Nothing) [([Char], [Char])]
ps
>     where ps :: [([Char], [Char])]
ps = ([Char] -> [([Char], [Char])] -> [([Char], [Char])])
-> [([Char], [Char])] -> [[Char]] -> [([Char], [Char])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[Char]] -> [([Char], [Char])] -> [([Char], [Char])]
forall {b}. [b] -> [(b, b)] -> [(b, b)]
maybeInsert ([[Char]] -> [([Char], [Char])] -> [([Char], [Char])])
-> ([Char] -> [[Char]])
-> [Char]
-> [([Char], [Char])]
-> [([Char], [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words) [] [[Char]]
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 [Char] a, Maybe a) -> [(a, [Char])] -> (Map [Char] a, Maybe a)
findEps (Map [Char] a
l, Maybe a
x) []    =  (Map [Char] a
l, Maybe a
x)
>           findEps (Map [Char] a
l, Maybe a
x) ((a
s, [Char]
t):[(a, [Char])]
as)
>               = ((Map [Char] a, Maybe a)
 -> [(a, [Char])] -> (Map [Char] a, Maybe a))
-> [(a, [Char])]
-> (Map [Char] a, Maybe a)
-> (Map [Char] a, Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Map [Char] a, Maybe a) -> [(a, [Char])] -> (Map [Char] a, Maybe a)
findEps [(a, [Char])]
as ((Map [Char] a, Maybe a) -> (Map [Char] a, Maybe a))
-> (Map [Char] a, Maybe a) -> (Map [Char] a, Maybe a)
forall a b. (a -> b) -> a -> b
$
>                 if [Char]
t [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"0" then (Map [Char] a
l, a -> Maybe a
forall a. a -> Maybe a
Just a
s) else ([Char] -> a -> Map [Char] a -> Map [Char] a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
t a
s Map [Char] 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 :: [[Char]]
-> Map [Char] [Char]
-> Maybe [Char]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
makeTransitions [[Char]]
ss Map [Char] [Char]
tags Maybe [Char]
meps
>     = ([Char]
 -> (Set (Transition [Char] [Char]), Set [Char], State [Char],
     Set (State [Char]))
 -> (Set (Transition [Char] [Char]), Set [Char], State [Char],
     Set (State [Char])))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
-> [[Char]]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[Char]]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
update ([[Char]]
 -> (Set (Transition [Char] [Char]), Set [Char], State [Char],
     Set (State [Char]))
 -> (Set (Transition [Char] [Char]), Set [Char], State [Char],
     Set (State [Char])))
-> ([Char] -> [[Char]])
-> [Char]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words)
>       (Set (Transition [Char] [Char])
forall a. Set a
Set.empty, Set [Char]
forall a. Set a
Set.empty, [Char] -> State [Char]
forall n. n -> State n
State [Char]
"", Set (State [Char])
forall a. Set a
Set.empty)
>       [[Char]]
ss
>     where symbolify :: [Char] -> Maybe [Char]
symbolify [Char]
x
>               | [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"0" = Maybe [Char]
forall a. Maybe a
Nothing -- 0 is reserved for epsilon
>               | [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
x Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [Char]
meps = Maybe [Char]
forall a. Maybe a
Nothing
>               | Bool
otherwise = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> (Maybe [Char] -> [Char]) -> Maybe [Char] -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
x (Maybe [Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Map [Char] [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
x Map [Char] [Char]
tags
>           update :: [[Char]]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
update [[Char]
a] (Set (Transition [Char] [Char])
ts, Set [Char]
as, State [Char]
qi, Set (State [Char])
fs)
>               = (Set (Transition [Char] [Char])
ts, Set [Char]
as, State [Char]
qi, State [Char] -> Set (State [Char]) -> Set (State [Char])
forall a. Ord a => a -> Set a -> Set a
Set.insert ([Char] -> State [Char]
forall n. n -> State n
State [Char]
a) Set (State [Char])
fs)
>           update [[Char]
a,[Char]
_] (Set (Transition [Char] [Char]), Set [Char], State [Char],
 Set (State [Char]))
partial  -- if final state with cost
>               = [[Char]]
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
-> (Set (Transition [Char] [Char]), Set [Char], State [Char],
    Set (State [Char]))
update [[Char]
a] (Set (Transition [Char] [Char]), Set [Char], State [Char],
 Set (State [Char]))
partial -- just ignore the cost
>           update ([Char]
s:[Char]
d:[Char]
l:[[Char]]
_) (Set (Transition [Char] [Char])
ts, Set [Char]
as, State [Char]
_, Set (State [Char])
fs)
>               = ( (Transition [Char] [Char]
 -> Set (Transition [Char] [Char])
 -> Set (Transition [Char] [Char]))
-> Set (Transition [Char] [Char])
-> Transition [Char] [Char]
-> Set (Transition [Char] [Char])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Transition [Char] [Char]
-> Set (Transition [Char] [Char]) -> Set (Transition [Char] [Char])
forall a. Ord a => a -> Set a -> Set a
Set.insert Set (Transition [Char] [Char])
ts (Transition [Char] [Char] -> Set (Transition [Char] [Char]))
-> Transition [Char] [Char] -> Set (Transition [Char] [Char])
forall a b. (a -> b) -> a -> b
$
>                   Transition
>                   { source :: State [Char]
source      = [Char] -> State [Char]
forall n. n -> State n
State [Char]
s
>                   , destination :: State [Char]
destination = [Char] -> State [Char]
forall n. n -> State n
State [Char]
d
>                   , edgeLabel :: Symbol [Char]
edgeLabel   = Symbol [Char]
-> ([Char] -> Symbol [Char]) -> Maybe [Char] -> Symbol [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Symbol [Char]
forall e. Symbol e
Epsilon [Char] -> Symbol [Char]
forall e. e -> Symbol e
Symbol (Maybe [Char] -> Symbol [Char]) -> Maybe [Char] -> Symbol [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
symbolify [Char]
l
>                   }
>                 , Set [Char] -> ([Char] -> Set [Char]) -> Maybe [Char] -> Set [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set [Char]
as ([Char] -> Set [Char] -> Set [Char]
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set [Char]
as) (Maybe [Char] -> Set [Char]) -> Maybe [Char] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
symbolify [Char]
l
>                 , [Char] -> State [Char]
forall n. n -> State n
State [Char]
s -- the first line updates this last in foldr
>                 , Set (State [Char])
fs
>                 )
>           update [[Char]]
_ (Set (Transition [Char] [Char]), Set [Char], State [Char],
 Set (State [Char]))
partial = (Set (Transition [Char] [Char]), Set [Char], State [Char],
 Set (State [Char]))
partial


Creating an AT&T format automaton
=================================

> -- |Convert an t'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 :: forall n e. (Ord n, Ord e, Show e) => FSA n e -> [Char]
exportATT FSA n e
f = [[Char]] -> [Char]
unlines
>               ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [(e, Int)] -> Set (State Integer) -> [[Char]]
forall n e.
(Ord n, Ord e, Show n, Show e, Num n) =>
[(e, Int)] -> Set (State n) -> [[Char]]
dumpInitials [(e, Int)]
tags (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
initials FSA Integer e
f')
>               [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [(e, Int)]
-> Set (State Integer, State Integer, Symbol e)
-> Set (State Integer)
-> [[Char]]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)]
-> Set (State n, State n, Symbol e) -> Set (State n) -> [[Char]]
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')
>               [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [(e, Int)]
-> Set (State Integer, State Integer, Symbol e)
-> Set (State Integer)
-> [[Char]]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)]
-> Set (State n, State n, Symbol e) -> Set (State n) -> [[Char]]
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'))
>               [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Set (State Integer) -> [[Char]]
forall n. (Ord n, Show n) => Set (State n) -> [[Char]]
dumpFinals (FSA Integer e -> Set (State Integer)
forall n e. FSA n e -> Set (State n)
finals FSA Integer e
f')
>               [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
syms [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
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 e. FSA Integer e -> Set e
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet FSA Integer e
f'
>           syms :: [[Char]]
syms = [Char]
separator [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [(e, Int)] -> [[Char]]
forall e. (Ord e, Show e) => [(e, Int)] -> [[Char]]
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 :: forall e. (Ord e, Show e) => [(e, Int)] -> [[Char]]
dumpAlphabet [(e, Int)]
tags = [Char] -> Int -> [Char]
forall {a}. Show a => a -> Int -> [Char]
p [Char]
defaultEpsilon Int
0 [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ((e, Int) -> [Char]) -> [(e, Int)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((e -> Int -> [Char]) -> (e, Int) -> [Char]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry e -> Int -> [Char]
forall {a}. Show a => a -> Int -> [Char]
p) [(e, Int)]
tags
>     where p :: a -> Int -> [Char]
p a
a Int
t = [Char] -> [Char]
deescape (a -> [Char]
forall a. Show a => a -> [Char]
showish a
a) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\t" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
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 :: forall n e.
(Ord n, Ord e, Show n, Show e, Num n) =>
[(e, Int)] -> Set (State n) -> [[Char]]
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 -> [Char]) -> [State n] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\State n
q -> [(e, Int)] -> (State n, State n, Symbol e) -> [Char]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)] -> (State n, State n, Symbol e) -> [Char]
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] -> [[Char]]) -> [State n] -> [[Char]]
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 :: forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)]
-> Set (State n, State n, Symbol e) -> Set (State n) -> [[Char]]
dumpTransitions [(e, Int)]
tags Set (State n, State n, Symbol e)
ts Set (State n)
qs = ((State n, State n, Symbol e) -> [Char])
-> [(State n, State n, Symbol e)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([(e, Int)] -> (State n, State n, Symbol e) -> [Char]
forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)] -> (State n, State n, Symbol e) -> [Char]
dumpTr [(e, Int)]
tags) ([(State n, State n, Symbol e)] -> [[Char]])
-> [(State n, State n, Symbol e)] -> [[Char]]
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 :: forall n e.
(Ord n, Ord e, Show n, Show e) =>
[(e, Int)] -> (State n, State n, Symbol e) -> [Char]
dumpTr [(e, Int)]
tags (State n
s, State n
d, Symbol e
l)
>     = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t"
>       [n -> [Char]
forall a. Show a => a -> [Char]
show (n -> [Char]) -> n -> [Char]
forall a b. (a -> b) -> a -> b
$ State n -> n
forall n. State n -> n
nodeLabel State n
s, n -> [Char]
forall a. Show a => a -> [Char]
show (n -> [Char]) -> n -> [Char]
forall a b. (a -> b) -> a -> b
$ State n -> n
forall n. State n -> n
nodeLabel State n
d, [Char]
l', [Char]
l']
>     where l' :: [Char]
l' = case Symbol e
l
>                of Symbol e
e -> e -> [Char]
f e
e
>                   Symbol e
_        -> [Char]
defaultEpsilon
>           f :: e -> [Char]
f e
e
>               | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit (e -> [Char]
forall a. Show a => a -> [Char]
showish e
e)
>                   = [Char] -> [[Char]] -> [Char]
forall {a}. a -> [a] -> a
h (e -> [Char]
forall a. Show a => a -> [Char]
showish e
e) ([[Char]] -> [Char])
-> ([(e, Int)] -> [[Char]]) -> [(e, Int)] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((e, Int) -> [Char]) -> [(e, Int)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Char]
forall a. Show a => a -> [Char]
showish (Int -> [Char]) -> ((e, Int) -> Int) -> (e, Int) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, Int) -> Int
forall a b. (a, b) -> b
snd)
>                     ([(e, Int)] -> [Char]) -> [(e, Int)] -> [Char]
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 = [Char] -> [Char]
deescape (e -> [Char]
forall a. Show a => a -> [Char]
showish e
e)
>               where h :: a -> [a] -> a
h a
_ (a
x:[a]
_) = a
x
>                     h a
x [] = a
x

> dumpFinals :: (Ord n, Show n) => Set (State n) -> [String]
> dumpFinals :: forall n. (Ord n, Show n) => Set (State n) -> [[Char]]
dumpFinals = (State n -> [Char]) -> [State n] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (n -> [Char]
forall a. Show a => a -> [Char]
show (n -> [Char]) -> (State n -> n) -> State n -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State n -> n
forall n. State n -> n
nodeLabel) ([State n] -> [[Char]])
-> (Set (State n) -> [State n]) -> Set (State n) -> [[Char]]
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] -> NonEmpty [a]
> splitOn :: forall a. Eq a => a -> [a] -> NonEmpty [a]
splitOn a
_ [] = [] [a] -> [[a]] -> NonEmpty [a]
forall a. a -> [a] -> NonEmpty a
:| []
> splitOn a
b (a
a:[a]
as)
>     | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = [] [a] -> [[a]] -> NonEmpty [a]
forall a. a -> [a] -> NonEmpty a
:| NonEmpty [a] -> [[a]]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty [a]
x
>     | Bool
otherwise = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:NonEmpty [a] -> [a]
forall a. NonEmpty a -> a
NE.head NonEmpty [a]
x) [a] -> [[a]] -> NonEmpty [a]
forall a. a -> [a] -> NonEmpty a
:| NonEmpty [a] -> [[a]]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty [a]
x
>     where x :: NonEmpty [a]
x = a -> [a] -> NonEmpty [a]
forall a. Eq a => a -> [a] -> NonEmpty [a]
splitOn a
b [a]
as

> showish :: Show a => a -> String
> showish :: forall a. Show a => a -> [Char]
showish = [Char] -> [Char]
f ([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
>     where f :: [Char] -> [Char]
f  [Char]
xs     = if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
xs [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"\"" then [Char] -> [Char]
f' (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
xs) else [Char]
xs
>           f' :: [Char] -> [Char]
f' [Char]
""     = [Char]
""
>           f' [Char]
"\""   = [Char]
""
>           f' (Char
x:[Char]
xs) = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
f' [Char]
xs

> 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]
_      = []