/usr/lib/hugs/programs/cpphs/Main.hs is in hugs 98.200609.21-5.3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | {-
-- The main program wrapper for cpphs, a simple C pre-processor
-- written in Haskell.
-- Author: Malcolm Wallace, 2004
-- This file is licensed under the GPL. Note however, that all other
-- modules used by it are either distributed under the LGPL, or are Haskell'98.
--
-- Thus, when compiled as a standalone executable, this program will fall
-- under the GPL.
-}
module Main where
import System ( getArgs, getProgName, exitWith, ExitCode(..) )
import Maybe
import Language.Preprocessor.Cpphs ( runCpphs, CpphsOption, parseOption )
import IO ( stdout, IOMode(WriteMode), openFile, hPutStr, hFlush, hClose )
import Monad ( when )
import List ( isPrefixOf )
version :: String
version = "1.2"
main :: IO ()
main = do
args <- getArgs
args <- return $ if "--cpp" `elem` args then convertArgs args else args
prog <- getProgName
when ("--version" `elem` args)
(do putStrLn (prog++" "++version)
exitWith ExitSuccess)
when ("--help" `elem` args)
(do putStrLn ("Usage: "++prog
++" [file ...] [ -Dsym | -Dsym=val | -Ipath ]* [-Ofile]\n"
++"\t\t[--nomacro] [--noline] [--text]"
++" [--strip] [--hashes] [--layout]"
++" [--unlit] [--cpp]")
exitWith ExitSuccess)
let parsedArgs = parseOptions args
Right (opts, ins, outs) = parsedArgs
out = listToMaybe outs
when (isLeft parsedArgs)
(do putStrLn $ "Unknown option, for valid options try "
++prog++" --help\n"++fromLeft parsedArgs
exitWith (ExitFailure 1))
when (length outs > 1)
(do putStrLn $ "At most one output file (-O) can be specified"
exitWith (ExitFailure 2))
if null ins then execute opts out Nothing
else mapM_ (execute opts out) (map Just ins)
isLeft (Left _) = True
isLeft _ = False
fromLeft (Left x) = x
-- | Parse the list of options
-- Return either Right (options, input files, output files)
-- or Left invalid flag
parseOptions :: [String] -> Either String ([CpphsOption], [FilePath], [FilePath])
parseOptions xs = f ([], [], []) xs
where
f (opts, ins, outs) (('-':'O':x):xs) = f (opts, ins, x:outs) xs
f (opts, ins, outs) (x@('-':_):xs) = case parseOption x of
Nothing -> Left x
Just a -> f (a:opts, ins, outs) xs
f (opts, ins, outs) (x:xs) = f (opts, x:ins, outs) xs
f (opts, ins, outs) [] = Right (reverse opts, reverse ins, reverse outs)
-- | Parse a list of options, remaining compatible with cpp if possible
-- Based on a shell script cpphs.compat
data ConvertArgs = ConvertArgs {traditional :: Bool, strip :: Bool, infile :: String, outfile :: String}
convertArgs :: [String] -> [String]
convertArgs xs = f (ConvertArgs False True "-" "-") xs
where
flg = "DUI"
f e (['-',r]:x:xs) | r `elem` flg = ('-':r:x) : f e xs
f e (x@('-':r:_):xs) | r `elem` flg = x : f e xs
f e ("-o":x:xs) = ('-':'O':x) : f e xs
f e (('-':'o':x):xs) = ('-':'O':drop 2 x) : f e xs
f e (('-':x):xs) | "ansi" `isPrefixOf` x = f e{traditional=False} xs
| "tranditional" `isPrefixOf` x = f e{traditional=True} xs
| "std" `isPrefixOf` x = f e xs -- ignore language spec
f e ("-x":x:xs) = f e xs -- ignore langauge spec
f e ("-include":x:xs) = x : f e xs
f e ("-P":xs) = "--noline" : f e xs
f e (x:xs) | x == "-C" || x == "-CC" = f e{strip=False} xs
f e ("-A":x:xs) = f e xs -- strip assertions
f e ("--help":xs) = "--help" : f e xs
f e ("--version":xs) = "--version" : f e xs
f e ("-version":xs) = "--version" : f e xs
f e (('-':x):xs) = f e xs -- strip all other flags
f e (x:xs) = f (if infile e == "-" then e{infile=x} else e{outfile=x}) xs
f e [] = ["--hashes" | not (traditional e)] ++
["--strip" | strip e] ++
[infile e] ++
["-O" ++ outfile e | outfile e /= "-"]
-- | Execute the preprocessor,
-- using the given options; an output path; and an input path.
-- If the filepath is Nothing then default to stdout\/stdin as appropriate.
execute :: [CpphsOption] -> Maybe FilePath -> Maybe FilePath -> IO ()
execute opts output input =
let (filename, action) =
case input of
Just x -> (x, readFile x)
Nothing -> ("stdin", getContents)
in
do contents <- action
result <- runCpphs opts filename contents
case output of
Nothing -> do putStr result
hFlush stdout
Just x -> do h <- openFile x WriteMode
hPutStr h result
hFlush h
hClose h
|