summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/GetGrammar.hs74
1 files changed, 61 insertions, 13 deletions
diff --git a/src/compiler/GF/Compile/GetGrammar.hs b/src/compiler/GF/Compile/GetGrammar.hs
index c85f9588f..c7fea11b0 100644
--- a/src/compiler/GF/Compile/GetGrammar.hs
+++ b/src/compiler/GF/Compile/GetGrammar.hs
@@ -30,23 +30,71 @@ import Data.List (nub)
import qualified Data.ByteString.Char8 as BS
import Control.Monad (foldM)
import System.Cmd (system)
+import System.Directory(removeFile)
getSourceModule :: Options -> FilePath -> IOE SourceModule
getSourceModule opts file0 = ioe $
- catch (do file <- foldM runPreprocessor file0 (flag optPreprocessors opts)
- content <- BS.readFile file
- case runP pModDef content of
- Left (Pn l c,msg) -> return (Bad (file++":"++show l++":"++show c++": "++msg))
- Right mo -> return (Ok (addOptionsToModule opts mo)))
- (\e -> return (Bad (show e)))
+ do tmp <- foldM runPreprocessor (Source file0) (flag optPreprocessors opts)
+ content <- keepTemp tmp
+ case runP pModDef content of
+ Left (Pn l c,msg) -> do file <- writeTemp tmp
+ let location = file++":"++show l++":"++show c
+ return (Bad (location++": "++msg))
+ Right mo -> do removeTemp tmp
+ return (Ok (addOptionsToModule opts mo))
+ `catch` (return . Bad . show)
addOptionsToModule :: Options -> SourceModule -> SourceModule
addOptionsToModule opts = mapSourceModule (\m -> m { flags = flags m `addOptions` opts })
--- FIXME: should use System.IO.openTempFile
-runPreprocessor :: FilePath -> String -> IO FilePath
-runPreprocessor file0 p = do
- let tmp = "_gf_preproc.tmp"
- cmd = p +++ file0 ++ ">" ++ tmp
- system cmd
- return tmp
+runPreprocessor :: Temporary -> String -> IO Temporary
+runPreprocessor tmp0 p =
+ maybe external internal (lookup p builtin_preprocessors)
+ where
+ internal preproc = (Internal . preproc) `fmap` readTemp tmp0
+ external =
+ do file0 <- writeTemp tmp0
+ -- FIXME: should use System.IO.openTempFile
+ let file1a = "_gf_preproc.tmp"
+ file1b = "_gf_preproc2.tmp"
+ -- file0 and file1 must be different
+ file1 = if file0==file1a then file1b else file1a
+ cmd = p +++ file0 ++ ">" ++ file1
+ system cmd
+ return (Temp file1)
+
+--------------------------------------------------------------------------------
+
+builtin_preprocessors = [("mkPresent",mkPresent),("mkMinimal",mkMinimal)]
+
+mkPresent = omit_lines "--# notpresent" -- grep -v "\-\-\# notpresent"
+mkMinimal = omit_lines "--# notminimal" -- grep -v "\-\-\# notminimal"
+
+omit_lines s = BS.unlines . filter (not . BS.isInfixOf bs) . BS.lines
+ where bs = BS.pack s
+
+--------------------------------------------------------------------------------
+
+data Temporary = Source FilePath | Temp FilePath | Internal BS.ByteString
+
+writeTemp tmp =
+ case tmp of
+ Source path -> return path
+ Temp path -> return path
+ Internal str -> do -- FIXME: should use System.IO.openTempFile
+ let tmp = "_gf_preproc.tmp"
+ BS.writeFile tmp str
+ return tmp
+
+readTemp tmp = do str <- keepTemp tmp
+ removeTemp tmp
+ return str
+
+keepTemp tmp =
+ case tmp of
+ Source path -> BS.readFile path
+ Temp path -> BS.readFile path
+ Internal str -> return str
+
+removeTemp (Temp path) = removeFile path
+removeTemp _ = return () \ No newline at end of file