forked from GitHub/gf-core
Added options to support SRG printing.
This commit is contained in:
@@ -1,11 +1,13 @@
|
||||
module GF.Compile.Export where
|
||||
|
||||
import PGF.Data (PGF)
|
||||
import PGF.CId
|
||||
import PGF.Data (PGF(..))
|
||||
import PGF.Raw.Print (printTree)
|
||||
import PGF.Raw.Convert (fromPGF)
|
||||
import GF.Compile.GFCCtoHaskell
|
||||
import GF.Compile.GFCCtoJS
|
||||
import GF.Infra.Option
|
||||
import GF.Speech.SRGS
|
||||
import GF.Text.UTF8
|
||||
|
||||
-- top-level access to code generation
|
||||
@@ -16,10 +18,18 @@ prPGF :: OutputFormat
|
||||
-- module name.
|
||||
-> String
|
||||
prPGF fmt gr name = case fmt of
|
||||
FmtPGF -> printPGF gr
|
||||
FmtJavaScript -> pgf2js gr
|
||||
FmtHaskell -> grammar2haskell gr name
|
||||
FmtHaskellGADT -> grammar2haskellGADT gr name
|
||||
FmtPGF -> printPGF gr
|
||||
FmtJavaScript -> pgf2js gr
|
||||
FmtHaskell -> grammar2haskell gr name
|
||||
FmtHaskell_GADT -> grammar2haskellGADT gr name
|
||||
FmtSRGS_XML -> srgsXmlPrinter Nothing gr (outputConcr gr)
|
||||
|
||||
-- | Get the name of the concrete syntax to generate output from.
|
||||
-- FIXME: there should be an option to change this.
|
||||
outputConcr :: PGF -> CId
|
||||
outputConcr pgf = case cncnames pgf of
|
||||
[] -> error "No concrete syntax."
|
||||
cnc:_ -> cnc
|
||||
|
||||
printPGF :: PGF -> String
|
||||
printPGF = encodeUTF8 . printTree . fromPGF
|
||||
|
||||
@@ -78,7 +78,18 @@ data Phase = Preproc | Convert | Compile | Link
|
||||
data Encoding = UTF_8 | ISO_8859_1
|
||||
deriving (Show,Eq,Ord)
|
||||
|
||||
data OutputFormat = FmtPGF | FmtJavaScript | FmtHaskell | FmtHaskellGADT
|
||||
data OutputFormat = FmtPGF
|
||||
| FmtJavaScript
|
||||
| FmtHaskell
|
||||
| FmtHaskell_GADT
|
||||
| FmtSRGS_XML
|
||||
| FmtSRGS_ABNF
|
||||
| FmtJSGF
|
||||
| FmtGSL
|
||||
| FmtVoiceXML
|
||||
| FmtSLF
|
||||
| FmtRegExp
|
||||
| FmtFA
|
||||
deriving (Eq,Ord)
|
||||
|
||||
data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues
|
||||
@@ -406,7 +417,16 @@ outputFormats =
|
||||
[("pgf", FmtPGF),
|
||||
("js", FmtJavaScript),
|
||||
("haskell", FmtHaskell),
|
||||
("haskell_gadt", FmtHaskellGADT)]
|
||||
("haskell_gadt", FmtHaskell_GADT),
|
||||
("srgs", FmtSRGS_XML),
|
||||
("srgs_xml", FmtSRGS_XML),
|
||||
("srgs_abnf", FmtSRGS_ABNF),
|
||||
("jsgf", FmtJSGF),
|
||||
("gsl", FmtGSL),
|
||||
("vxml", FmtVoiceXML),
|
||||
("slf", FmtSLF),
|
||||
("regexp", FmtRegExp),
|
||||
("fa", FmtFA)]
|
||||
|
||||
instance Show OutputFormat where
|
||||
show = lookupShow outputFormats
|
||||
|
||||
@@ -41,10 +41,11 @@ outputFilePath opts fmt name0 = addDir name <.> fmtExtension fmt
|
||||
addDir = maybe id (</>) (flag optOutputDir opts)
|
||||
|
||||
fmtExtension :: OutputFormat -> String
|
||||
fmtExtension FmtPGF = "pgf"
|
||||
fmtExtension FmtJavaScript = "js"
|
||||
fmtExtension FmtHaskell = "hs"
|
||||
fmtExtension FmtHaskellGADT = "hs"
|
||||
fmtExtension FmtPGF = "pgf"
|
||||
fmtExtension FmtJavaScript = "js"
|
||||
fmtExtension FmtHaskell = "hs"
|
||||
fmtExtension FmtHaskell_GADT = "hs"
|
||||
fmtExtension FmtSRGS_XML = "grxml"
|
||||
|
||||
writeOutputFile :: FilePath -> String -> IOE ()
|
||||
writeOutputFile outfile output = ioeIO $
|
||||
|
||||
Reference in New Issue
Block a user