diff options
| author | hallgren <hallgren@chalmers.se> | 2014-07-28 11:58:00 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2014-07-28 11:58:00 +0000 |
| commit | 7a91afc02a0a245bf9fea248e61421a75c22137d (patch) | |
| tree | e8c0466894f64a5a6cb98ef4d32dedcb9eeca879 /src/compiler/GF/Speech/JSGF.hs | |
| parent | 59172ce9c5baf593e3110036a14c910da80878f7 (diff) | |
Convert from Text.PrettyPrint to GF.Text.Pretty
All compiler modules now use GF.Text.Pretty instead of Text.PrettyPrint
Diffstat (limited to 'src/compiler/GF/Speech/JSGF.hs')
| -rw-r--r-- | src/compiler/GF/Speech/JSGF.hs | 34 |
1 files changed, 17 insertions, 17 deletions
diff --git a/src/compiler/GF/Speech/JSGF.hs b/src/compiler/GF/Speech/JSGF.hs index 2f4b4d96d..25168dbc8 100644 --- a/src/compiler/GF/Speech/JSGF.hs +++ b/src/compiler/GF/Speech/JSGF.hs @@ -23,7 +23,7 @@ import PGF import Data.Char import Data.List --import Data.Maybe -import Text.PrettyPrint.HughesPJ +import GF.Text.Pretty --import Debug.Trace width :: Int @@ -40,46 +40,46 @@ prJSGF :: Maybe SISRFormat -> SRG -> Doc prJSGF sisr srg = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg)) where - header = text "#JSGF" <+> text "V1.0" <+> text "UTF-8" <+> lang <> char ';' $$ + header = "#JSGF" <+> "V1.0" <+> "UTF-8" <+> lang <> ';' $$ comment ("JSGF speech recognition grammar for " ++ srgName srg) $$ comment "Generated by GF" $$ - text ("grammar " ++ srgName srg ++ ";") - lang = maybe empty text (srgLanguage srg) + ("grammar " ++ srgName srg ++ ";") + lang = maybe empty pp (srgLanguage srg) mainCat = rule True "MAIN" [prCat (srgStartCat srg)] prRule (SRGRule cat rhs) = rule (isExternalCat srg cat) cat (map prAlt rhs) prAlt (SRGAlt mp n rhs) = sep [initTag, p (prItem sisr n rhs), finalTag] where initTag | isEmpty t = empty - | otherwise = text "<NULL>" <+> t + | otherwise = "<NULL>" <+> t where t = tag sisr (profileInitSISR n) finalTag = tag sisr (profileFinalSISR n) p = if isEmpty initTag && isEmpty finalTag then id else parens prCat :: Cat -> Doc -prCat c = char '<' <> text c <> char '>' +prCat c = '<' <> c <> '>' prItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> Doc prItem sisr t = f 0 where - f _ (REUnion []) = text "<VOID>" + f _ (REUnion []) = pp "<VOID>" f p (REUnion xs) | not (null es) = brackets (f 0 (REUnion nes)) | otherwise = (if p >= 1 then parens else id) (alts (map (f 1) xs)) where (es,nes) = partition isEpsilon xs - f _ (REConcat []) = text "<NULL>" + f _ (REConcat []) = pp "<NULL>" f p (REConcat xs) = (if p >= 3 then parens else id) (fsep (map (f 2) xs)) - f p (RERepeat x) = f 3 x <> char '*' + f p (RERepeat x) = f 3 x <> '*' f _ (RESymbol s) = prSymbol sisr t s prSymbol :: Maybe SISRFormat -> CFTerm -> SRGSymbol -> Doc prSymbol sisr cn (NonTerminal n@(c,_)) = prCat c <+> tag sisr (catSISR cn n) prSymbol _ cn (Terminal t) | all isPunct t = empty -- removes punctuation - | otherwise = text t -- FIXME: quote if there is whitespace or odd chars + | otherwise = pp t -- FIXME: quote if there is whitespace or odd chars tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> Doc tag Nothing _ = empty tag (Just fmt) t = case t fmt of [] -> empty - ts -> char '{' <+> (text (e $ prSISR ts)) <+> char '}' + ts -> '{' <+> (e $ prSISR ts) <+> '}' where e [] = [] e ('}':xs) = '\\':'}':e xs e ('\n':xs) = ' ' : e (dropWhile isSpace xs) @@ -89,21 +89,21 @@ isPunct :: Char -> Bool isPunct c = c `elem` "-_.;.,?!" comment :: String -> Doc -comment s = text "//" <+> text s +comment s = "//" <+> s alts :: [Doc] -> Doc -alts = fsep . prepunctuate (text "| ") +alts = fsep . prepunctuate ("| ") rule :: Bool -> Cat -> [Doc] -> Doc -rule pub c xs = p <+> prCat c <+> char '=' <+> nest 2 (alts xs) <+> char ';' - where p = if pub then text "public" else empty +rule pub c xs = p <+> prCat c <+> '=' <+> nest 2 (alts xs) <+> ';' + where p = if pub then pp "public" else empty -- Pretty-printing utilities emptyLine :: Doc -emptyLine = text "" +emptyLine = pp "" -prepunctuate :: Doc -> [Doc] -> [Doc] +--prepunctuate :: Doc -> [Doc] -> [Doc] prepunctuate _ [] = [] prepunctuate p (x:xs) = x : map (p <>) xs |
