quipper-language-0.9.0.0: programs/quipper-pp.hs

-- | The Quipper preprocessor. This is just a wrapper around an awk
-- script.

import System.Environment
import System.Exit
import System.Process
import System.IO
import System.IO.Error

-- The Paths_quipper_language module is automatically generated by Cabal.
import Paths_quipper_language

-- | Print usage information.
usage :: String -> IO ()
usage myname = do
  putStrLn $ myname ++ ": the Quipper preprocessor"
  putStrLn $ ""
  putStrLn $ "Usage: " ++ myname ++ " <sourcefile> <infile> <outfile>"
  putStrLn $ "       " ++ myname ++ " -f"
  putStrLn $ ""
  putStrLn $ "Arguments and options:"
  putStrLn $ " <sourcefile>  - the name of the original source file"
  putStrLn $ " <infile>      - the name of the file holding the input"
  putStrLn $ " <outfile>     - the name of the file to write the output to"
  putStrLn $ " -f            - act as a filter (for testing)"

-- | Escape backslash characters in a string.
escape :: String -> String
escape [] = []
escape ('\\' : t) = "\\\\" ++ escape t
escape (h : t) = h : escape t

-- | Run awk with the given arguments on the given input string.
runAWK :: [String] -> String -> IO (ExitCode, String, String)
runAWK args input = catchIOError body handler
  where
    body = do
      readProcessWithExitCode "awk" args input
    handler e = do
      name <- getProgName
      hPutStrLn stderr $ name ++ ": unable to run awk. Please ensure that awk is installed and on your PATH."
      exitFailure

-- | Check whether awk needs one or two rounds of character escaping.
-- For unknown reasons, the behavior of awk in Windows is different
-- from that in Linux. Maybe it differs from implementation to
-- implementation, so we better check it at runtime.
awk_needs_two_escapes :: IO Bool
awk_needs_two_escapes = do
  (r, out, err) <- runAWK ["-v", "var=x\\\\\\\\y", "--", "BEGIN { print var }"] ""
  case out of
    "x\\\\y\n" -> return False
    "x\\y\n" -> return True
    otherwise -> return False    

-- | Run the Quipper preprocessor on the given input string.
runPP :: String -> String -> IO (ExitCode, String, String)
runPP filename input = do
  b <- awk_needs_two_escapes
  let esc = if b then escape . escape else escape
  script <- getDataFileName "scripts/convert_template.awk"
  let args = ["-f", script, "-v", "haskell_filename=\"" ++ esc filename ++ "\""]
  runAWK args input

-- | Run the Quipper preprocessor on the given pair of files.
runPP_filter :: String -> Handle -> Handle -> IO ExitCode
runPP_filter filename fin fout = do
  input <- hGetContents fin
  (r, out, err) <- runPP filename input
  hPutStr fout out
  hPutStr stderr err
  hFlush fout
  hFlush stderr
  return r

main :: IO ()
main = do
  args <- getArgs
  myname <- getProgName
  case args of
   "-h" : _ -> do
     usage myname
     exitSuccess
   "--help" : _ -> do
     usage myname
     exitSuccess
   ["-f"] -> do
     r <- runPP_filter "stdin" stdin stdout
     exitWith r
   [filename, infile, outfile] -> do
     fin <- openFile infile ReadMode
     fout <- openFile outfile WriteMode
     r <- runPP_filter filename fin fout
     hClose fin
     hClose fout
     exitWith r
   _ -> do
     putStrLn $ myname ++ ": illegal command line"
     putStrLn $ "For usage information, try the `--help' option."
     exitFailure