----------------------------------------------------------------------
-- |
-- Module      : GF.Speech.SLF
--
-- This module converts a CFG to an SLF finite-state network
-- for use with the ATK recognizer. The SLF format is described
-- in the HTK manual, and an example for use in ATK is shown
-- in the ATK manual.
--
-----------------------------------------------------------------------------

{-# LANGUAGE FlexibleContexts #-}
module GF.Speech.SLF (slfPrinter,slfGraphvizPrinter,
                        slfSubPrinter,slfSubGraphvizPrinter) where

import GF.Data.Utilities
import GF.Grammar.CFG
import GF.Speech.FiniteState
--import GF.Speech.CFG
import GF.Speech.CFGToFA
import GF.Speech.PGFToCFG
import qualified GF.Data.Graphviz as Dot
import PGF
--import PGF.CId

import Control.Monad
import qualified Control.Monad.State as STM
import Data.Char (toUpper)
--import Data.List
import Data.Maybe

data SLFs = SLFs [(String,SLF)] SLF

data SLF = SLF { SLF -> [SLFNode]
slfNodes :: [SLFNode], SLF -> [SLFEdge]
slfEdges :: [SLFEdge] }

data SLFNode = SLFNode { SLFNode -> Int
nId :: Int, SLFNode -> SLFWord
nWord :: SLFWord, SLFNode -> SLFWord
nTag :: Maybe String }
             | SLFSubLat { nId :: Int, SLFNode -> String
nLat :: String }

-- | An SLF word is a word, or the empty string.
type SLFWord = Maybe String

data SLFEdge = SLFEdge { SLFEdge -> Int
eId :: Int, SLFEdge -> Int
eStart :: Int, SLFEdge -> Int
eEnd :: Int }

type SLF_FA = FA State (Maybe CFSymbol) ()

mkFAs :: PGF -> CId -> (SLF_FA, [(String,SLF_FA)])
mkFAs :: PGF -> CId -> (SLF_FA, [(String, SLF_FA)])
mkFAs PGF
pgf CId
cnc = (DFA (Symbol String String) -> SLF_FA
forall a. Eq a => DFA a -> FA Int (Maybe a) ()
slfStyleFA DFA (Symbol String String)
forall t. FA Int () (Symbol String t)
main, [(String
c,DFA (Symbol String String) -> SLF_FA
forall a. Eq a => DFA a -> FA Int (Maybe a) ()
slfStyleFA DFA (Symbol String String)
n) | (String
c,DFA (Symbol String String)
n) <- [(String, DFA (Symbol String String))]
subs])
  where MFA String
start [(String, DFA (Symbol String String))]
subs = {- renameSubs $ -} CFG -> MFA
cfgToMFA (CFG -> MFA) -> CFG -> MFA
forall a b. (a -> b) -> a -> b
$ PGF -> CId -> CFG
pgfToCFG PGF
pgf CId
cnc
        main :: FA Int () (Symbol String t)
main = let (FA Int () b
fa,Int
s,Int
f) = (FA Int () b, Int, Int)
forall n b. Enum n => (FA n () b, n, n)
newFA_ in Int
-> Int
-> Symbol String t
-> FA Int () (Symbol String t)
-> FA Int () (Symbol String t)
forall n b a. n -> n -> b -> FA n a b -> FA n a b
newTransition Int
s Int
f (String -> Symbol String t
forall c t. c -> Symbol c t
NonTerminal String
start) FA Int () (Symbol String t)
forall b. FA Int () b
fa

slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) ()
slfStyleFA :: DFA a -> FA Int (Maybe a) ()
slfStyleFA = [Int] -> FA Int (Maybe a) () -> FA Int (Maybe a) ()
forall x y a b. Ord x => [y] -> FA x a b -> FA y a b
renameStates [Int
0..] (FA Int (Maybe a) () -> FA Int (Maybe a) ())
-> (DFA a -> FA Int (Maybe a) ()) -> DFA a -> FA Int (Maybe a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FA Int (Maybe a) () -> FA Int (Maybe a) ()
forall a n. (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) ()
removeTrivialEmptyNodes (FA Int (Maybe a) () -> FA Int (Maybe a) ())
-> (DFA a -> FA Int (Maybe a) ()) -> DFA a -> FA Int (Maybe a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> () -> FA Int (Maybe a) () -> FA Int (Maybe a) ()
forall a b n. a -> b -> FA n a b -> FA n a b
oneFinalState Maybe a
forall a. Maybe a
Nothing ()
             (FA Int (Maybe a) () -> FA Int (Maybe a) ())
-> (DFA a -> FA Int (Maybe a) ()) -> DFA a -> FA Int (Maybe a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FA Int () (Maybe a) -> FA Int (Maybe a) ()
forall n a. (Ord n, Eq a) => FA n () (Maybe a) -> FA n (Maybe a) ()
moveLabelsToNodes (FA Int () (Maybe a) -> FA Int (Maybe a) ())
-> (DFA a -> FA Int () (Maybe a)) -> DFA a -> FA Int (Maybe a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DFA a -> FA Int () (Maybe a)
forall a. DFA a -> NFA a
dfa2nfa
{-
-- | Give sequential names to subnetworks.
renameSubs :: MFA -> MFA
renameSubs (MFA start subs) = MFA (newName start) subs'
  where newNames = zip (map fst subs) ["sub"++show n | n <- [0..]]
        newName s = lookup' s newNames
        subs' = [(newName s,renameLabels n) | (s,n) <- subs]
        renameLabels = mapTransitions (mapSymbol newName id)
-}
--
-- * SLF graphviz printing (without sub-networks)
--

slfGraphvizPrinter :: PGF -> CId -> String
slfGraphvizPrinter :: PGF -> CId -> String
slfGraphvizPrinter PGF
pgf CId
cnc
    = FA Int String String -> String
forall n. (Eq n, Show n) => FA n String String -> String
prFAGraphviz (FA Int String String -> String) -> FA Int String String -> String
forall a b. (a -> b) -> a -> b
$ FA Int SLFWord () -> FA Int String String
forall n b. FA n SLFWord b -> FA n String String
gvFA (FA Int SLFWord () -> FA Int String String)
-> FA Int SLFWord () -> FA Int String String
forall a b. (a -> b) -> a -> b
$ DFA String -> FA Int SLFWord ()
forall a. Eq a => DFA a -> FA Int (Maybe a) ()
slfStyleFA (DFA String -> FA Int SLFWord ())
-> DFA String -> FA Int SLFWord ()
forall a b. (a -> b) -> a -> b
$ CFG -> DFA String
cfgToFA' (CFG -> DFA String) -> CFG -> DFA String
forall a b. (a -> b) -> a -> b
$ PGF -> CId -> CFG
pgfToCFG PGF
pgf CId
cnc
  where 
  gvFA :: FA n SLFWord b -> FA n String String
gvFA = (SLFWord -> String) -> FA n SLFWord String -> FA n String String
forall a c n b. (a -> c) -> FA n a b -> FA n c b
mapStates (String -> SLFWord -> String
forall a. a -> Maybe a -> a
fromMaybe String
"") (FA n SLFWord String -> FA n String String)
-> (FA n SLFWord b -> FA n SLFWord String)
-> FA n SLFWord b
-> FA n String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> String) -> FA n SLFWord b -> FA n SLFWord String
forall b c n a. (b -> c) -> FA n a b -> FA n a c
mapTransitions (String -> b -> String
forall a b. a -> b -> a
const String
"")

--
-- * SLF graphviz printing (with sub-networks)
--

slfSubGraphvizPrinter :: PGF -> CId -> String
slfSubGraphvizPrinter :: PGF -> CId -> String
slfSubGraphvizPrinter PGF
pgf CId
cnc = Graph -> String
Dot.prGraphviz Graph
g
  where (SLF_FA
main, [(String, SLF_FA)]
subs) = PGF -> CId -> (SLF_FA, [(String, SLF_FA)])
mkFAs PGF
pgf CId
cnc
        g :: Graph
g = State [Int] Graph -> [Int] -> Graph
forall s a. State s a -> s -> a
STM.evalState (([Graph] -> Graph -> Graph)
-> StateT [Int] Identity [Graph]
-> State [Int] Graph
-> State [Int] Graph
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [Graph] -> Graph -> Graph
Dot.addSubGraphs StateT [Int] Identity [Graph]
ss State [Int] Graph
m) [Int
0..] 
        ss :: StateT [Int] Identity [Graph]
ss = ((String, SLF_FA) -> State [Int] Graph)
-> [(String, SLF_FA)] -> StateT [Int] Identity [Graph]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ (String
c,SLF_FA
f) -> SLFWord -> SLF_FA -> State [Int] Graph
gvSLFFA (String -> SLFWord
forall a. a -> Maybe a
Just String
c) SLF_FA
f) [(String, SLF_FA)]
subs
        m :: State [Int] Graph
m = SLFWord -> SLF_FA -> State [Int] Graph
gvSLFFA SLFWord
forall a. Maybe a
Nothing SLF_FA
main

gvSLFFA :: Maybe String -> SLF_FA -> STM.State [State] Dot.Graph
gvSLFFA :: SLFWord -> SLF_FA -> State [Int] Graph
gvSLFFA SLFWord
n SLF_FA
fa = 
    (SLF_FA -> Graph)
-> StateT [Int] Identity SLF_FA -> State [Int] Graph
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SLFWord -> Graph -> Graph
mkCluster SLFWord
n (Graph -> Graph) -> (SLF_FA -> Graph) -> SLF_FA -> Graph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FA Int String String -> Graph
forall n. (Eq n, Show n) => FA n String String -> Graph
faToGraphviz (FA Int String String -> Graph)
-> (SLF_FA -> FA Int String String) -> SLF_FA -> Graph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Symbol String String) -> String)
-> FA Int (Maybe (Symbol String String)) String
-> FA Int String String
forall a c n b. (a -> c) -> FA n a b -> FA n c b
mapStates (String
-> (Symbol String String -> String)
-> Maybe (Symbol String String)
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Symbol String String -> String
mfaLabelToGv) 
            (FA Int (Maybe (Symbol String String)) String
 -> FA Int String String)
-> (SLF_FA -> FA Int (Maybe (Symbol String String)) String)
-> SLF_FA
-> FA Int String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> String)
-> SLF_FA -> FA Int (Maybe (Symbol String String)) String
forall b c n a. (b -> c) -> FA n a b -> FA n a c
mapTransitions (String -> () -> String
forall a b. a -> b -> a
const String
"")) (SLF_FA -> StateT [Int] Identity SLF_FA
forall y (m :: * -> *) x a b.
(MonadState [y] m, Ord x) =>
FA x a b -> m (FA y a b)
rename SLF_FA
fa)
  where mfaLabelToGv :: Symbol String String -> String
mfaLabelToGv = (String -> String)
-> (String -> String) -> Symbol String String -> String
forall c a t. (c -> a) -> (t -> a) -> Symbol c t -> a
symbol (String
"#"String -> String -> String
forall a. [a] -> [a] -> [a]
++) String -> String
forall a. a -> a
id
        mkCluster :: SLFWord -> Graph -> Graph
mkCluster SLFWord
Nothing = Graph -> Graph
forall a. a -> a
id
        mkCluster (Just String
x) 
            = String -> Graph -> Graph
Dot.setName (String
"cluster_"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
x) (Graph -> Graph) -> (Graph -> Graph) -> Graph -> Graph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Graph -> Graph
Dot.setAttr String
"label" String
x
        rename :: FA x a b -> m (FA y a b)
rename FA x a b
fa = do
                    [y]
names <- m [y]
forall s (m :: * -> *). MonadState s m => m s
STM.get
                    let fa' :: FA y a b
fa' = [y] -> FA x a b -> FA y a b
forall x y a b. Ord x => [y] -> FA x a b -> FA y a b
renameStates [y]
names FA x a b
fa
                        names' :: [y]
names' = FA y a b -> [y]
forall n a b. FA n a b -> [n]
unusedNames FA y a b
fa'
                    [y] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
STM.put [y]
names'
                    FA y a b -> m (FA y a b)
forall (m :: * -> *) a. Monad m => a -> m a
return FA y a b
fa'

--
-- * SLF printing (without sub-networks)
--

slfPrinter :: PGF -> CId -> String
slfPrinter :: PGF -> CId -> String
slfPrinter PGF
pgf CId
cnc
    = SLF -> String
prSLF (SLF -> String) -> SLF -> String
forall a b. (a -> b) -> a -> b
$ (Int -> SLFWord -> SLFNode) -> FA Int SLFWord () -> SLF
forall a. (Int -> a -> SLFNode) -> FA Int a () -> SLF
automatonToSLF Int -> SLFWord -> SLFNode
mkSLFNode (FA Int SLFWord () -> SLF) -> FA Int SLFWord () -> SLF
forall a b. (a -> b) -> a -> b
$ DFA String -> FA Int SLFWord ()
forall a. Eq a => DFA a -> FA Int (Maybe a) ()
slfStyleFA (DFA String -> FA Int SLFWord ())
-> DFA String -> FA Int SLFWord ()
forall a b. (a -> b) -> a -> b
$ CFG -> DFA String
cfgToFA' (CFG -> DFA String) -> CFG -> DFA String
forall a b. (a -> b) -> a -> b
$ PGF -> CId -> CFG
pgfToCFG PGF
pgf CId
cnc

--
-- * SLF printing (with sub-networks)
--

-- | Make a network with subnetworks in SLF
slfSubPrinter :: PGF -> CId -> String
slfSubPrinter :: PGF -> CId -> String
slfSubPrinter PGF
pgf CId
cnc = SLFs -> String
prSLFs SLFs
slfs
  where 
  (SLF_FA
main,[(String, SLF_FA)]
subs) = PGF -> CId -> (SLF_FA, [(String, SLF_FA)])
mkFAs PGF
pgf CId
cnc
  slfs :: SLFs
slfs = [(String, SLF)] -> SLF -> SLFs
SLFs [(String
c, SLF_FA -> SLF
faToSLF SLF_FA
fa) | (String
c,SLF_FA
fa) <- [(String, SLF_FA)]
subs] (SLF_FA -> SLF
faToSLF SLF_FA
main)
  faToSLF :: SLF_FA -> SLF
faToSLF = (Int -> Maybe (Symbol String String) -> SLFNode) -> SLF_FA -> SLF
forall a. (Int -> a -> SLFNode) -> FA Int a () -> SLF
automatonToSLF Int -> Maybe (Symbol String String) -> SLFNode
mfaNodeToSLFNode

automatonToSLF :: (Int -> a -> SLFNode) -> FA State a () -> SLF
automatonToSLF :: (Int -> a -> SLFNode) -> FA Int a () -> SLF
automatonToSLF Int -> a -> SLFNode
mkNode FA Int a ()
fa = SLF :: [SLFNode] -> [SLFEdge] -> SLF
SLF { slfNodes :: [SLFNode]
slfNodes = [SLFNode]
ns, slfEdges :: [SLFEdge]
slfEdges = [SLFEdge]
es }
  where ns :: [SLFNode]
ns = ((Int, a) -> SLFNode) -> [(Int, a)] -> [SLFNode]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> a -> SLFNode) -> (Int, a) -> SLFNode
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> a -> SLFNode
mkNode) (FA Int a () -> [(Int, a)]
forall n a b. FA n a b -> [(n, a)]
states FA Int a ()
fa)
        es :: [SLFEdge]
es = (Int -> (Int, Int, ()) -> SLFEdge)
-> [Int] -> [(Int, Int, ())] -> [SLFEdge]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i (Int
f,Int
t,()) -> Int -> (Int, Int) -> SLFEdge
mkSLFEdge Int
i (Int
f,Int
t)) [Int
0..] (FA Int a () -> [(Int, Int, ())]
forall n a b. FA n a b -> [(n, n, b)]
transitions FA Int a ()
fa)

mfaNodeToSLFNode :: Int -> Maybe CFSymbol -> SLFNode
mfaNodeToSLFNode :: Int -> Maybe (Symbol String String) -> SLFNode
mfaNodeToSLFNode Int
i Maybe (Symbol String String)
l = case Maybe (Symbol String String)
l of
                              Maybe (Symbol String String)
Nothing -> Int -> SLFWord -> SLFNode
mkSLFNode Int
i SLFWord
forall a. Maybe a
Nothing
                              Just (Terminal String
x) -> Int -> SLFWord -> SLFNode
mkSLFNode Int
i (String -> SLFWord
forall a. a -> Maybe a
Just String
x)
                              Just (NonTerminal String
s) -> Int -> String -> SLFNode
mkSLFSubLat Int
i String
s

mkSLFNode :: Int -> Maybe String -> SLFNode
mkSLFNode :: Int -> SLFWord -> SLFNode
mkSLFNode Int
i SLFWord
Nothing = SLFNode :: Int -> SLFWord -> SLFWord -> SLFNode
SLFNode { nId :: Int
nId = Int
i, nWord :: SLFWord
nWord = SLFWord
forall a. Maybe a
Nothing, nTag :: SLFWord
nTag = SLFWord
forall a. Maybe a
Nothing }
mkSLFNode Int
i (Just String
w)
    | String -> Bool
isNonWord String
w = SLFNode :: Int -> SLFWord -> SLFWord -> SLFNode
SLFNode { nId :: Int
nId = Int
i, 
                              nWord :: SLFWord
nWord = SLFWord
forall a. Maybe a
Nothing, 
                              nTag :: SLFWord
nTag = String -> SLFWord
forall a. a -> Maybe a
Just String
w }
    | Bool
otherwise = SLFNode :: Int -> SLFWord -> SLFWord -> SLFNode
SLFNode { nId :: Int
nId = Int
i, 
                            nWord :: SLFWord
nWord = String -> SLFWord
forall a. a -> Maybe a
Just ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
w), 
                            nTag :: SLFWord
nTag = String -> SLFWord
forall a. a -> Maybe a
Just String
w }

mkSLFSubLat :: Int -> String -> SLFNode
mkSLFSubLat :: Int -> String -> SLFNode
mkSLFSubLat Int
i String
sub = SLFSubLat :: Int -> String -> SLFNode
SLFSubLat { nId :: Int
nId = Int
i, nLat :: String
nLat = String
sub }

mkSLFEdge :: Int -> (Int,Int) -> SLFEdge
mkSLFEdge :: Int -> (Int, Int) -> SLFEdge
mkSLFEdge Int
i (Int
f,Int
t) = SLFEdge :: Int -> Int -> Int -> SLFEdge
SLFEdge { eId :: Int
eId = Int
i, eStart :: Int
eStart = Int
f, eEnd :: Int
eEnd = Int
t }

prSLFs :: SLFs -> String
prSLFs :: SLFs -> String
prSLFs (SLFs [(String, SLF)]
subs SLF
main) = [String -> String] -> String -> String
unlinesS (((String, SLF) -> String -> String)
-> [(String, SLF)] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SLF) -> String -> String
forall a. Show a => (a, SLF) -> String -> String
prSub [(String, SLF)]
subs [String -> String] -> [String -> String] -> [String -> String]
forall a. [a] -> [a] -> [a]
++ [SLF -> String -> String
prOneSLF SLF
main]) String
""
  where prSub :: (a, SLF) -> String -> String
prSub (a
n,SLF
s) = String -> String -> String
showString String
"SUBLAT=" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String -> String
forall a. Show a => a -> String -> String
shows a
n 
                      (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SLF -> String -> String
prOneSLF SLF
s (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"." (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl

prSLF :: SLF -> String
prSLF :: SLF -> String
prSLF SLF
slf = SLF -> String -> String
prOneSLF SLF
slf String
""

prOneSLF :: SLF -> ShowS
prOneSLF :: SLF -> String -> String
prOneSLF (SLF { slfNodes :: SLF -> [SLFNode]
slfNodes = [SLFNode]
ns, slfEdges :: SLF -> [SLFEdge]
slfEdges = [SLFEdge]
es}) 
    = String -> String
header (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String -> String] -> String -> String
unlinesS ((SLFNode -> String -> String) -> [SLFNode] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map SLFNode -> String -> String
prNode [SLFNode]
ns) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String -> String] -> String -> String
unlinesS ((SLFEdge -> String -> String) -> [SLFEdge] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map SLFEdge -> String -> String
prEdge [SLFEdge]
es) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
    where
    header :: String -> String
header = [(String, String)] -> String -> String
prFields [(String
"N",Int -> String
forall a. Show a => a -> String
show ([SLFNode] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SLFNode]
ns)),(String
"L", Int -> String
forall a. Show a => a -> String
show ([SLFEdge] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SLFEdge]
es))] (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nl
    prNode :: SLFNode -> String -> String
prNode (SLFNode { nId :: SLFNode -> Int
nId = Int
i, nWord :: SLFNode -> SLFWord
nWord = SLFWord
w, nTag :: SLFNode -> SLFWord
nTag = SLFWord
t })
            = [(String, String)] -> String -> String
prFields ([(String, String)] -> String -> String)
-> [(String, String)] -> String -> String
forall a b. (a -> b) -> a -> b
$ [(String
"I",Int -> String
forall a. Show a => a -> String
show Int
i),(String
"W",SLFWord -> String
showWord SLFWord
w)] 
                         [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
-> (String -> [(String, String)]) -> SLFWord -> [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
t -> [(String
"s",String
t)]) SLFWord
t
    prNode (SLFSubLat { nId :: SLFNode -> Int
nId = Int
i, nLat :: SLFNode -> String
nLat = String
l }) 
            = [(String, String)] -> String -> String
prFields [(String
"I",Int -> String
forall a. Show a => a -> String
show Int
i),(String
"L",String -> String
forall a. Show a => a -> String
show String
l)]
    prEdge :: SLFEdge -> String -> String
prEdge SLFEdge
e = [(String, String)] -> String -> String
prFields [(String
"J",Int -> String
forall a. Show a => a -> String
show (SLFEdge -> Int
eId SLFEdge
e)),(String
"S",Int -> String
forall a. Show a => a -> String
show (SLFEdge -> Int
eStart SLFEdge
e)),(String
"E",Int -> String
forall a. Show a => a -> String
show (SLFEdge -> Int
eEnd SLFEdge
e))]

-- | Check if a word should not correspond to a word in the SLF file.
isNonWord :: String -> Bool
isNonWord :: String -> Bool
isNonWord = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isPunct

isPunct :: Char -> Bool
isPunct :: Char -> Bool
isPunct Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"-_.;.,?!()[]{}"

showWord :: SLFWord -> String
showWord :: SLFWord -> String
showWord SLFWord
Nothing = String
"!NULL"
showWord (Just String
w) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
w = String
"!NULL"
                  | Bool
otherwise = String
w

prFields :: [(String,String)] -> ShowS
prFields :: [(String, String)] -> String -> String
prFields [(String, String)]
fs = [String -> String] -> String -> String
unwordsS [ String -> String -> String
showString String
l (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
'=' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
v | (String
l,String
v) <- [(String, String)]
fs ]