diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs index 803fb6017..f442cfa22 100644 --- a/src-3.0/GF/Command/Commands.hs +++ b/src-3.0/GF/Command/Commands.hs @@ -441,7 +441,7 @@ allCommands pgf = Map.fromList [ unlines $ [unwords (la:":": map prCId cs) | la <- optLangs opts, let cs = missingLins pgf (mkCId la)] _ -> case valIdOpts "printer" "pgf" opts of - v -> prPGF noOptions (read v) pgf (prCId (absname pgf)) + v -> concatMap snd $ exportPGF noOptions (read v) pgf morphos opts s = [lookupMorpho (buildMorpho pgf (mkCId la)) s | la <- optLangs opts] diff --git a/src-3.0/GF/Compile/Export.hs b/src-3.0/GF/Compile/Export.hs index 9abdc6789..f88d6d7ba 100644 --- a/src-3.0/GF/Compile/Export.hs +++ b/src-3.0/GF/Compile/Export.hs @@ -15,26 +15,35 @@ import GF.Speech.GSL import GF.Speech.VoiceXML import GF.Text.UTF8 +import Data.Maybe +import System.FilePath + -- top-level access to code generation -prPGF :: Options - -> OutputFormat - -> PGF - -> String -- ^ Output name, for example used for generated Haskell - -- module name. - -> String -prPGF opts fmt gr name = case fmt of - FmtPGF -> printPGF gr - FmtJavaScript -> pgf2js gr - FmtHaskell -> grammar2haskell gr name - FmtHaskell_GADT -> grammar2haskellGADT gr name - FmtBNF -> prCFG $ pgfToCFG gr (outputConcr gr) - FmtSRGS_XML -> srgsXmlPrinter (flag optSISR opts) gr (outputConcr gr) - FmtJSGF -> jsgfPrinter (flag optSISR opts) gr (outputConcr gr) - FmtGSL -> gslPrinter gr (outputConcr gr) - FmtVoiceXML -> grammar2vxml gr (outputConcr gr) +exportPGF :: Options + -> OutputFormat + -> PGF + -> [(FilePath,String)] -- ^ List of recommended file names and contents. +exportPGF opts fmt pgf = + case fmt of + FmtPGF -> multi "pgf" printPGF + FmtJavaScript -> multi "js" pgf2js + FmtHaskell -> multi "hs" (grammar2haskell name) + FmtHaskell_GADT -> multi "hs" (grammar2haskellGADT name) + FmtBNF -> single "bnf" bnfPrinter + FmtSRGS_XML -> single "grxml" (srgsXmlPrinter sisr) + FmtJSGF -> single "jsgf" (jsgfPrinter sisr) + FmtGSL -> single "gsl" gslPrinter + FmtVoiceXML -> single "vxml" grammar2vxml + where + name = fromMaybe (prCId (absname pgf)) (moduleFlag optName opts) + sisr = flag optSISR opts + multi :: String -> (PGF -> String) -> [(FilePath,String)] + multi ext pr = [(name <.> ext, pr pgf)] + single :: String -> (PGF -> CId -> String) -> [(FilePath,String)] + single ext pr = [(prCId cnc <.> ext, pr pgf cnc) | cnc <- cncnames pgf] -- | Get the name of the concrete syntax to generate output from. -- FIXME: there should be an option to change this. diff --git a/src-3.0/GF/Compile/GFCCtoHaskell.hs b/src-3.0/GF/Compile/GFCCtoHaskell.hs index 31f1dc0b3..9d03aa490 100644 --- a/src-3.0/GF/Compile/GFCCtoHaskell.hs +++ b/src-3.0/GF/Compile/GFCCtoHaskell.hs @@ -27,15 +27,15 @@ import Data.List --(isPrefixOf, find, intersperse) import qualified Data.Map as Map -- | the main function -grammar2haskell :: PGF - -> String -- ^ Module name. +grammar2haskell :: String -- ^ Module name. + -> PGF -> String -grammar2haskell gr name = encodeUTF8 $ foldr (++++) [] $ +grammar2haskell name gr = encodeUTF8 $ foldr (++++) [] $ haskPreamble name ++ [datatypes gr', gfinstances gr'] where gr' = hSkeleton gr -grammar2haskellGADT :: PGF -> String -> String -grammar2haskellGADT gr name = encodeUTF8 $ foldr (++++) [] $ +grammar2haskellGADT :: String -> PGF -> String +grammar2haskellGADT name gr = encodeUTF8 $ foldr (++++) [] $ ["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++ haskPreamble name ++ [datatypesGADT gr', gfinstances gr'] where gr' = hSkeleton gr diff --git a/src-3.0/GF/Speech/PGFToCFG.hs b/src-3.0/GF/Speech/PGFToCFG.hs index 168591e6b..1f3ebaeb4 100644 --- a/src-3.0/GF/Speech/PGFToCFG.hs +++ b/src-3.0/GF/Speech/PGFToCFG.hs @@ -4,7 +4,7 @@ -- -- Approximates PGF grammars with context-free grammars. ---------------------------------------------------------------------- -module GF.Speech.PGFToCFG (pgfToCFG) where +module GF.Speech.PGFToCFG (bnfPrinter, pgfToCFG) where import PGF.CId import PGF.Data as PGF @@ -19,6 +19,8 @@ import Data.Maybe import Data.Set (Set) import qualified Data.Set as Set +bnfPrinter :: PGF -> CId -> String +bnfPrinter pgf cnc = prCFG $ pgfToCFG pgf cnc pgfToCFG :: PGF -> CId -- ^ Concrete syntax name diff --git a/src-3.0/GFC.hs b/src-3.0/GFC.hs index c663f46c9..17c95eb30 100644 --- a/src-3.0/GFC.hs +++ b/src-3.0/GFC.hs @@ -26,30 +26,17 @@ mainGFC opts fs = writeOutputs opts pgf writeOutputs :: Options -> PGF -> IOE () -writeOutputs opts pgf = mapM_ (\fmt -> writeOutput opts fmt pgf) (flag optOutputFormats opts) +writeOutputs opts pgf = + sequence_ [writeOutput opts name str + | fmt <- flag optOutputFormats opts, + (name,str) <- exportPGF opts fmt pgf] -writeOutput :: Options -> OutputFormat-> PGF -> IOE () -writeOutput opts fmt pgf = - do let name = fromMaybe (prCId (absname pgf)) (moduleFlag optName opts) - path = outputFilePath opts fmt name - s = prPGF opts fmt pgf name - writeOutputFile path s - -outputFilePath :: Options -> OutputFormat -> String -> FilePath -outputFilePath opts fmt name0 = addDir name <.> fmtExtension fmt - where name = fromMaybe name0 (moduleFlag optName opts) - addDir = maybe id () (flag optOutputDir opts) - -fmtExtension :: OutputFormat -> String -fmtExtension FmtPGF = "pgf" -fmtExtension FmtJavaScript = "js" -fmtExtension FmtHaskell = "hs" -fmtExtension FmtHaskell_GADT = "hs" -fmtExtension FmtBNF = "bnf" -fmtExtension FmtSRGS_XML = "grxml" -fmtExtension FmtJSGF = "jsgf" -fmtExtension FmtGSL = "gsl" -fmtExtension FmtVoiceXML = "vxml" +writeOutput :: Options -> FilePath-> String -> IOE () +writeOutput opts file str = + do let path = case flag optOutputDir opts of + Nothing -> file + Just dir -> dir file + writeOutputFile path str writeOutputFile :: FilePath -> String -> IOE () writeOutputFile outfile output = ioeIO $