> {-# OPTIONS_HADDOCK hide,show-extensions #-}
> {-# Language CPP #-}

#if !defined(MIN_VERSION_base)
# define MIN_VERSION_base(a,b,c) 0
#endif

> {-|
> Module : LTK.Porters.Jeff
> Copyright : (c) 2016-2019,2021,2023 Dakotah Lambert
> LICENSE : MIT
> 
> This module provides methods to convert automata to and from
> Jeff's format.
> -}
> module LTK.Porters.Jeff
>        ( -- *Importing
>          readJeff
>        , transliterate
>        , transliterateString
>        -- *Exporting
>        , exportJeff
>        , untransliterate
>        , untransliterateString
>        ) where

#if !MIN_VERSION_base(4,8,0)
> import Control.Applicative ((<*>))
> import Data.Functor ((<$>))
#endif
> import Data.List (intercalate)
> import Data.Set (Set)
> import qualified Data.Set as Set

> import LTK.FSA


Reading from Jeff's format
==========================

An FSA in Jeff's format consists of three parts separated by `!':

* Initial states: a line of comma-separated names
* Transitions: lines of state,state,symbol
* Final states: a line of comma-separated names

To start, we'll define a function to split a string on a delimiter

> splitOn :: Eq a => a -> [a] -> [[a]]
> splitOn :: forall a. Eq a => a -> [a] -> [[a]]
splitOn a
_ [] = [[]]
> splitOn a
b (a
a:[a]
as)
>     | a
a forall a. Eq a => a -> a -> Bool
== a
b = []forall a. a -> [a] -> [a]
:[[a]]
x
>     | Bool
otherwise = (a
aforall a. a -> [a] -> [a]
:forall a. [a] -> a
head [[a]]
x)forall a. a -> [a] -> [a]
:forall a. [a] -> [a]
tail [[a]]
x
>     where x :: [[a]]
x = forall a. Eq a => a -> [a] -> [[a]]
splitOn a
b [a]
as

Then use that to parse a string in Jeff format and generate an FSA

> -- |Import an 'FSA' from its representation in Jeff's format.
> -- The resulting @Int@ node labels may have nothing to do with the
> -- node labels in the source.
> readJeff :: String -> Either String (FSA Int String)
> readJeff :: String -> Either String (FSA Int String)
readJeff String
s = forall n. Ord n => FSA n String -> FSA n String
transliterate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates
>              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String (FSA String String)
readJeffWithoutRelabeling String
s

> readJeffStateList :: [String] -> Either String (Set (State String))
> readJeffStateList :: [String] -> Either String (Set (State String))
readJeffStateList [] = forall a b. b -> Either a b
Right forall c a. Container c a => c
empty
> readJeffStateList (String
x:[String]
xs)
>     | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs)  =  forall a b. Show a => String -> a -> String -> Either String b
parseFail String
"state list" (String
xforall a. a -> [a] -> [a]
:[String]
xs) String
"Invalid separator"
>     | Bool
otherwise      =  forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap forall n. n -> State n
State forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
',' String
x

> readJeffTransitionList :: [String] ->
>                           Either String (Set (Transition String String))
> readJeffTransitionList :: [String] -> Either String (Set (Transition String String))
readJeffTransitionList
>     = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\String
a -> forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (forall c a. Container c a => a -> c -> c
insert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String (Transition String String)
readJeffTransition String
a))
>             (forall a b. b -> Either a b
Right forall c a. Container c a => c
empty)

> readJeffTransition :: String -> Either String (Transition String String)
> readJeffTransition :: String -> Either String (Transition String String)
readJeffTransition String
s 
>     | forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs forall a. Ord a => a -> a -> Bool
< Int
3  = forall a b. Show a => String -> a -> String -> Either String b
parseFail String
"Transition" String
s String
"Not enough components"
>     | forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs forall a. Ord a => a -> a -> Bool
> Int
3  = forall a b. Show a => String -> a -> String -> Either String b
parseFail String
"Transition" String
s String
"Too many components"
>     | Bool
otherwise      = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
>                        forall n e. Symbol e -> State n -> State n -> Transition n e
Transition (forall e. e -> Symbol e
Symbol ([String]
xsforall a. [a] -> Int -> a
!!Int
2))
>                        (forall n. n -> State n
State forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [String]
xs) (forall n. n -> State n
State ([String]
xsforall a. [a] -> Int -> a
!!Int
1))
>     where xs :: [String]
xs = forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
',' String
s

> readJeffWithoutRelabeling :: String -> Either String (FSA String String)
> readJeffWithoutRelabeling :: String -> Either String (FSA String String)
readJeffWithoutRelabeling String
s 
>     | forall (t :: * -> *) a. Foldable t => t a -> Int
length [[String]]
initialParse forall a. Eq a => a -> a -> Bool
/= Int
3  = forall a b. Show a => String -> a -> String -> Either String b
parseFail String
"FSA" String
s String
"Not a Jeff"
>     | Bool
otherwise                 = forall n e.
Set e
-> Set (Transition n e)
-> Set (State n)
-> Set (State n)
-> Bool
-> FSA n e
FSA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Set String)
alpha forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
>                                   Either String (Set (Transition String String))
trans forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String (Set (State String))
inits forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String (Set (State String))
fins forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. b -> Either a b
Right Bool
False
>     where initialParse :: [[String]]
initialParse  = forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
'\n') forall a b. (a -> b) -> a -> b
$
>                           forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
'!' String
s
>           alpha :: Either String (Set String)
alpha         = forall (s :: * -> *) c e.
(Collapsible s, Container c e, Monoid c) =>
s (Symbol e) -> c
unsymbols forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap forall n e. Transition n e -> Symbol e
edgeLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Set (Transition String String))
trans
>           trans :: Either String (Set (Transition String String))
trans         = [String] -> Either String (Set (Transition String String))
readJeffTransitionList forall a b. (a -> b) -> a -> b
$ [[String]]
initialParseforall a. [a] -> Int -> a
!!Int
1
>           inits :: Either String (Set (State String))
inits         = [String] -> Either String (Set (State String))
readJeffStateList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [[String]]
initialParse
>           fins :: Either String (Set (State String))
fins          = [String] -> Either String (Set (State String))
readJeffStateList forall a b. (a -> b) -> a -> b
$ [[String]]
initialParseforall a. [a] -> Int -> a
!!Int
2

Sometimes users give us input that is not what we expect.  Tell them
that, and what we think may have gone wrong:

> parseFail :: Show a => String -> a -> String -> Either String b
> parseFail :: forall a b. Show a => String -> a -> String -> Either String b
parseFail String
target a
input String
reason = forall a b. a -> Either a b
Left String
message
>     where message :: String
message = String
"Failed to parse " forall a. [a] -> [a] -> [a]
++ String
target forall a. [a] -> [a] -> [a]
++ String
": "
>                     forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
input forall a. [a] -> [a] -> [a]
++ String
".  " forall a. [a] -> [a] -> [a]
++ String
reason forall a. [a] -> [a] -> [a]
++ String
"."

Transliterating Jeff's FSAs into the form used by my compiler:

> makeStress :: String -> String
> makeStress :: String -> String
makeStress String
str = case String
digits
>                  of String
"0" -> String
""
>                     String
"1" -> String
"`"
>                     String
"2" -> String
"'"
>                     String
_   -> String
str
>     where digits :: String
digits = forall a. (a -> Bool) -> [a] -> [a]
filter (forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn String
"0123456789") String
str

> makeWeight :: String -> String
> makeWeight :: String -> String
makeWeight String
str = case String
digits
>                  of String
"0" -> String
"L"
>                     String
"1" -> String
"H"
>                     String
"2" -> String
"S"
>                     String
"3" -> String
"X"
>                     String
"4" -> String
"Y"
>                     String
_   -> String
str
>     where digits :: String
digits = forall a. (a -> Bool) -> [a] -> [a]
filter (forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn String
"0123456789") String
str

> mapEvenOdd :: (a -> b) -> (a -> b) -> [a] -> [b]
> mapEvenOdd :: forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
mapEvenOdd a -> b
f a -> b
g (a
a1:a
a2:[a]
xs)  =  a -> b
f a
a1 forall a. a -> [a] -> [a]
: a -> b
g a
a2 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
mapEvenOdd a -> b
f a -> b
g [a]
xs
> mapEvenOdd a -> b
f a -> b
_ [a
a1]        =  [a -> b
f a
a1]
> mapEvenOdd a -> b
_ a -> b
_ []          =  []

> -- |See 'transliterate'.  This function operates directly on the
> -- representation of the edge label.
> transliterateString :: String -> String
> transliterateString :: String -> String
transliterateString = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
mapEvenOdd String -> String
makeWeight String -> String
makeStress forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
'.'

> -- |Automata in Jeff's format use edge labels of the form
> -- &#x201c;w0.s1&#x201d;.
> -- This function converts the edge labels of an automaton from this
> -- form to the
> -- &#x201c;L\`&#x201d;
> -- form that we tend to use.
> transliterate :: (Ord n) => FSA n String -> FSA n String
> transliterate :: forall n. Ord n => FSA n String -> FSA n String
transliterate = forall e e1 n.
(Ord e, Ord e1, Ord n) =>
(e -> e1) -> FSA n e -> FSA n e1
renameSymbolsBy String -> String
transliterateString


Writing to Jeff's format
========================

> -- |Convert an 'FSA' to its representation in Jeff's format.
> exportJeff :: (Ord e, Ord n, Show e) => FSA n e -> String
> exportJeff :: forall e n. (Ord e, Ord n, Show e) => FSA n e -> String
exportJeff FSA n e
f = [String] -> String
unlines (String
inits forall a. a -> [a] -> [a]
: [String]
trans forall a. [a] -> [a] -> [a]
++ [String
fins])
>     where list :: Set (State Integer) -> String
list   =  forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep (forall a. Eq a => a -> a -> Bool
/= Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                     forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. State n -> n
nodeLabel)
>           fins :: String
fins   =  Set (State Integer) -> String
list (forall n e. FSA n e -> Set (State n)
finals FSA Integer e
f')
>           inits :: String
inits  =  Set (State Integer) -> String
list (forall n e. FSA n e -> Set (State n)
initials FSA Integer e
f') forall a. [a] -> [a] -> [a]
++ String
"!"
>           trans :: [String]
trans  =  [String] -> [String]
bangTerminate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                     forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap forall e n. (Show e, Show n) => Transition n e -> String
exportJeffTransition forall a b. (a -> b) -> a -> b
$ forall n e. FSA n e -> Set (Transition n e)
transitions FSA Integer e
f'
>           f' :: FSA Integer e
f'     =  forall e n. (Ord e, Ord n) => FSA n e -> FSA Integer e
normalize FSA n e
f

> bangTerminate :: [String] -> [String]
> bangTerminate :: [String] -> [String]
bangTerminate []      =  []
> bangTerminate [String
x]     =  [String
x forall a. [a] -> [a] -> [a]
++ String
"!"]
> bangTerminate (String
x:[String]
xs)  =  String
x forall a. a -> [a] -> [a]
: [String] -> [String]
bangTerminate [String]
xs

> exportJeffTransition :: (Show e, Show n) => Transition n e -> String
> exportJeffTransition :: forall e n. (Show e, Show n) => Transition n e -> String
exportJeffTransition Transition n e
t = State n -> String
nl (forall n e. Transition n e -> State n
source Transition n e
t) forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++
>                          State n -> String
nl (forall n e. Transition n e -> State n
destination Transition n e
t) forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++
>                          forall {a}. Show a => Symbol a -> String
el (forall n e. Transition n e -> Symbol e
edgeLabel Transition n e
t)
>     where nl :: State n -> String
nl = String -> String
nq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. State n -> n
nodeLabel
>           el :: Symbol a -> String
el (Symbol a
a) = String -> String
untransliterateString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nq forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
a
>           el Symbol a
Epsilon    = String
"\x03B5"
>           nq :: String -> String
nq = forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep (forall a. Eq a => a -> a -> Bool
/= Char
'"')

> -- |The inverse of 'transliterate'.
> untransliterate :: (Ord n) => FSA n String -> FSA n String
> untransliterate :: forall n. Ord n => FSA n String -> FSA n String
untransliterate = forall e e1 n.
(Ord e, Ord e1, Ord n) =>
(e -> e1) -> FSA n e -> FSA n e1
renameSymbolsBy String -> String
untransliterateString

> -- |The inverse of 'transliterateString'.
> untransliterateString :: String -> String
> untransliterateString :: String -> String
untransliterateString (Char
'L':String
xs)  =  String
"w0." forall a. [a] -> [a] -> [a]
++ String -> String
untransliterateStress String
xs
> untransliterateString (Char
'H':String
xs)  =  String
"w1." forall a. [a] -> [a] -> [a]
++ String -> String
untransliterateStress String
xs
> untransliterateString (Char
'S':String
xs)  =  String
"w2." forall a. [a] -> [a] -> [a]
++ String -> String
untransliterateStress String
xs
> untransliterateString (Char
'X':String
xs)  =  String
"w3." forall a. [a] -> [a] -> [a]
++ String -> String
untransliterateStress String
xs
> untransliterateString (Char
'Y':String
xs)  =  String
"w4." forall a. [a] -> [a] -> [a]
++ String -> String
untransliterateStress String
xs
> untransliterateString String
xs        =  String
xs

> untransliterateStress :: String -> String
> untransliterateStress :: String -> String
untransliterateStress []   =  String
"s0"
> untransliterateStress String
"`"  =  String
"s1"
> untransliterateStress String
"'"  =  String
"s2"
> untransliterateStress String
xs   =  String
xs