mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -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
|
prGrammar opts = case valIdOpts "printer" "" opts of
|
||||||
"cats" -> unwords $ categories pgf
|
"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
|
-- top-level access to code generation
|
||||||
|
|
||||||
prPGF :: OutputFormat -> PGF -> String
|
prPGF :: OutputFormat
|
||||||
prPGF fmt gr = case fmt of
|
-> PGF
|
||||||
|
-> String -- ^ Output name, for example used for generated Haskell
|
||||||
|
-- module name.
|
||||||
|
-> String
|
||||||
|
prPGF fmt gr name = case fmt of
|
||||||
FmtPGF -> printPGF gr
|
FmtPGF -> printPGF gr
|
||||||
FmtJavaScript -> pgf2js gr
|
FmtJavaScript -> pgf2js gr
|
||||||
FmtHaskell -> grammar2haskell gr
|
FmtHaskell -> grammar2haskell gr name
|
||||||
FmtHaskellGADT -> grammar2haskellGADT gr
|
FmtHaskellGADT -> grammar2haskellGADT gr name
|
||||||
|
|
||||||
printPGF :: PGF -> String
|
printPGF :: PGF -> String
|
||||||
printPGF = encodeUTF8 . printTree . fromPGF
|
printPGF = encodeUTF8 . printTree . fromPGF
|
||||||
|
|
||||||
|
|||||||
@@ -27,24 +27,26 @@ import Data.List --(isPrefixOf, find, intersperse)
|
|||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
-- | the main function
|
-- | the main function
|
||||||
grammar2haskell :: PGF -> String
|
grammar2haskell :: PGF
|
||||||
grammar2haskell gr = encodeUTF8 $ foldr (++++) [] $
|
-> String -- ^ Module name.
|
||||||
haskPreamble ++ [datatypes gr', gfinstances gr']
|
-> String
|
||||||
|
grammar2haskell gr name = encodeUTF8 $ foldr (++++) [] $
|
||||||
|
haskPreamble name ++ [datatypes gr', gfinstances gr']
|
||||||
where gr' = hSkeleton gr
|
where gr' = hSkeleton gr
|
||||||
|
|
||||||
grammar2haskellGADT :: PGF -> String
|
grammar2haskellGADT :: PGF -> String -> String
|
||||||
grammar2haskellGADT gr = encodeUTF8 $ foldr (++++) [] $
|
grammar2haskellGADT gr name = encodeUTF8 $ foldr (++++) [] $
|
||||||
["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++
|
["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++
|
||||||
haskPreamble ++ [datatypesGADT gr', gfinstances gr']
|
haskPreamble name ++ [datatypesGADT gr', gfinstances gr']
|
||||||
where gr' = hSkeleton gr
|
where gr' = hSkeleton gr
|
||||||
|
|
||||||
-- | by this you can prefix all identifiers with stg; the default is 'G'
|
-- | by this you can prefix all identifiers with stg; the default is 'G'
|
||||||
gId :: OIdent -> OIdent
|
gId :: OIdent -> OIdent
|
||||||
gId i = 'G':i
|
gId i = 'G':i
|
||||||
|
|
||||||
haskPreamble =
|
haskPreamble name =
|
||||||
[
|
[
|
||||||
"module GSyntax where",
|
"module " ++ name ++ " where",
|
||||||
"",
|
"",
|
||||||
"import PGF.CId",
|
"import PGF.CId",
|
||||||
"import PGF.Data",
|
"import PGF.Data",
|
||||||
|
|||||||
@@ -30,8 +30,9 @@ writeOutputs opts pgf = mapM_ (\fmt -> writeOutput opts fmt pgf) (flag optOutput
|
|||||||
|
|
||||||
writeOutput :: Options -> OutputFormat-> PGF -> IOE ()
|
writeOutput :: Options -> OutputFormat-> PGF -> IOE ()
|
||||||
writeOutput opts fmt pgf =
|
writeOutput opts fmt pgf =
|
||||||
do let path = outputFilePath opts fmt (prCId (absname pgf))
|
do let name = fromMaybe (prCId (absname pgf)) (moduleFlag optName opts)
|
||||||
s = prPGF fmt pgf
|
path = outputFilePath opts fmt name
|
||||||
|
s = prPGF fmt pgf name
|
||||||
writeOutputFile path s
|
writeOutputFile path s
|
||||||
|
|
||||||
outputFilePath :: Options -> OutputFormat -> String -> FilePath
|
outputFilePath :: Options -> OutputFormat -> String -> FilePath
|
||||||
|
|||||||
Reference in New Issue
Block a user