mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Honor the --name flag when generating output files. Set module name in generated Haskell modules correctly.
This commit is contained in:
@@ -153,5 +153,5 @@ allCommands pgf = Map.fromAscList [
|
||||
|
||||
prGrammar opts = case valIdOpts "printer" "" opts of
|
||||
"cats" -> unwords $ categories pgf
|
||||
v -> prPGF (read v) pgf
|
||||
v -> prPGF (read v) pgf (prCId (absname pgf))
|
||||
|
||||
|
||||
@@ -10,13 +10,16 @@ import GF.Text.UTF8
|
||||
|
||||
-- top-level access to code generation
|
||||
|
||||
prPGF :: OutputFormat -> PGF -> String
|
||||
prPGF fmt gr = case fmt of
|
||||
prPGF :: OutputFormat
|
||||
-> PGF
|
||||
-> String -- ^ Output name, for example used for generated Haskell
|
||||
-- module name.
|
||||
-> String
|
||||
prPGF fmt gr name = case fmt of
|
||||
FmtPGF -> printPGF gr
|
||||
FmtJavaScript -> pgf2js gr
|
||||
FmtHaskell -> grammar2haskell gr
|
||||
FmtHaskellGADT -> grammar2haskellGADT gr
|
||||
FmtHaskell -> grammar2haskell gr name
|
||||
FmtHaskellGADT -> grammar2haskellGADT gr name
|
||||
|
||||
printPGF :: PGF -> String
|
||||
printPGF = encodeUTF8 . printTree . fromPGF
|
||||
|
||||
|
||||
@@ -27,24 +27,26 @@ import Data.List --(isPrefixOf, find, intersperse)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
-- | the main function
|
||||
grammar2haskell :: PGF -> String
|
||||
grammar2haskell gr = encodeUTF8 $ foldr (++++) [] $
|
||||
haskPreamble ++ [datatypes gr', gfinstances gr']
|
||||
grammar2haskell :: PGF
|
||||
-> String -- ^ Module name.
|
||||
-> String
|
||||
grammar2haskell gr name = encodeUTF8 $ foldr (++++) [] $
|
||||
haskPreamble name ++ [datatypes gr', gfinstances gr']
|
||||
where gr' = hSkeleton gr
|
||||
|
||||
grammar2haskellGADT :: PGF -> String
|
||||
grammar2haskellGADT gr = encodeUTF8 $ foldr (++++) [] $
|
||||
grammar2haskellGADT :: PGF -> String -> String
|
||||
grammar2haskellGADT gr name = encodeUTF8 $ foldr (++++) [] $
|
||||
["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++
|
||||
haskPreamble ++ [datatypesGADT gr', gfinstances gr']
|
||||
haskPreamble name ++ [datatypesGADT gr', gfinstances gr']
|
||||
where gr' = hSkeleton gr
|
||||
|
||||
-- | by this you can prefix all identifiers with stg; the default is 'G'
|
||||
gId :: OIdent -> OIdent
|
||||
gId i = 'G':i
|
||||
|
||||
haskPreamble =
|
||||
haskPreamble name =
|
||||
[
|
||||
"module GSyntax where",
|
||||
"module " ++ name ++ " where",
|
||||
"",
|
||||
"import PGF.CId",
|
||||
"import PGF.Data",
|
||||
|
||||
@@ -30,8 +30,9 @@ writeOutputs opts pgf = mapM_ (\fmt -> writeOutput opts fmt pgf) (flag optOutput
|
||||
|
||||
writeOutput :: Options -> OutputFormat-> PGF -> IOE ()
|
||||
writeOutput opts fmt pgf =
|
||||
do let path = outputFilePath opts fmt (prCId (absname pgf))
|
||||
s = prPGF fmt pgf
|
||||
do let name = fromMaybe (prCId (absname pgf)) (moduleFlag optName opts)
|
||||
path = outputFilePath opts fmt name
|
||||
s = prPGF fmt pgf name
|
||||
writeOutputFile path s
|
||||
|
||||
outputFilePath :: Options -> OutputFormat -> String -> FilePath
|
||||
|
||||
Reference in New Issue
Block a user