1-----------------------------------------------------------------------------
2-- |
3-- Module      :  Options
4-- Copyright   :  2006 Malcolm Wallace
5-- Licence     :  LGPL
6--
7-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
8-- Stability   :  experimental
9-- Portability :  All
10--
11-- This module deals with Cpphs options and parsing them
12-----------------------------------------------------------------------------
13
14module Language.Preprocessor.Cpphs.Options
15  ( CpphsOptions(..)
16  , BoolOptions(..)
17  , parseOptions
18  , defaultCpphsOptions
19  , defaultBoolOptions
20  , trailing
21  ) where
22
23import Data.Maybe
24import Data.List (isPrefixOf)
25
26-- | Cpphs options structure.
27data CpphsOptions = CpphsOptions
28    { infiles   :: [FilePath]
29    , outfiles  :: [FilePath]
30    , defines   :: [(String,String)]
31    , includes  :: [String]
32    , preInclude:: [FilePath]   -- ^ Files to \#include before anything else
33    , boolopts  :: BoolOptions
34    } deriving (Show)
35
36-- | Default options.
37defaultCpphsOptions :: CpphsOptions
38defaultCpphsOptions = CpphsOptions { infiles = [], outfiles = []
39                                   , defines = [], includes = []
40                                   , preInclude = []
41                                   , boolopts = defaultBoolOptions }
42
43-- | Options representable as Booleans.
44data BoolOptions = BoolOptions
45    { macros    :: Bool  -- ^ Leave \#define and \#undef in output of ifdef?
46    , locations :: Bool  -- ^ Place \#line droppings in output?
47    , hashline  :: Bool  -- ^ Write \#line or {-\# LINE \#-} ?
48    , pragma    :: Bool  -- ^ Keep \#pragma in final output?
49    , stripEol  :: Bool  -- ^ Remove C eol (\/\/) comments everywhere?
50    , stripC89  :: Bool  -- ^ Remove C inline (\/**\/) comments everywhere?
51    , lang      :: Bool  -- ^ Lex input as Haskell code?
52    , ansi      :: Bool  -- ^ Permit stringise \# and catenate \#\# operators?
53    , layout    :: Bool  -- ^ Retain newlines in macro expansions?
54    , literate  :: Bool  -- ^ Remove literate markup?
55    , warnings  :: Bool  -- ^ Issue warnings?
56    } deriving (Show)
57
58-- | Default settings of boolean options.
59defaultBoolOptions :: BoolOptions
60defaultBoolOptions = BoolOptions { macros   = True,   locations = True
61                                 , hashline = True,   pragma    = False
62                                 , stripEol = False,  stripC89  = False
63                                 , lang     = True,   ansi      = False
64                                 , layout   = False,  literate  = False
65                                 , warnings = True }
66
67-- | Raw command-line options.  This is an internal intermediate data
68--   structure, used during option parsing only.
69data RawOption
70    = NoMacro
71    | NoLine
72    | LinePragma
73    | Pragma
74    | Text
75    | Strip
76    | StripEol
77    | Ansi
78    | Layout
79    | Unlit
80    | SuppressWarnings
81    | Macro (String,String)
82    | Path String
83    | PreInclude FilePath
84    | IgnoredForCompatibility
85      deriving (Eq, Show)
86
87flags :: [(String, RawOption)]
88flags = [ ("--nomacro", NoMacro)
89        , ("--noline",  NoLine)
90        , ("--linepragma", LinePragma)
91        , ("--pragma",  Pragma)
92        , ("--text",    Text)
93        , ("--strip",   Strip)
94        , ("--strip-eol",  StripEol)
95        , ("--hashes",  Ansi)
96        , ("--layout",  Layout)
97        , ("--unlit",   Unlit)
98        , ("--nowarn",  SuppressWarnings)
99        ]
100
101-- | Parse a single raw command-line option.  Parse failure is indicated by
102--   result Nothing.
103rawOption :: String -> Maybe RawOption
104rawOption x | isJust a = a
105    where a = lookup x flags
106rawOption ('-':'D':xs) = Just $ Macro (s, if null d then "1" else tail d)
107    where (s,d) = break (=='=') xs
108rawOption ('-':'U':xs) = Just $ IgnoredForCompatibility
109rawOption ('-':'I':xs) = Just $ Path $ trailing "/\\" xs
110rawOption xs | "--include="`isPrefixOf`xs
111            = Just $ PreInclude (drop 10 xs)
112rawOption _ = Nothing
113
114-- | Trim trailing elements of the second list that match any from
115--   the first list.  Typically used to remove trailing forward\/back
116--   slashes from a directory path.
117trailing :: (Eq a) => [a] -> [a] -> [a]
118trailing xs = reverse . dropWhile (`elem`xs) . reverse
119
120-- | Convert a list of RawOption to a BoolOptions structure.
121boolOpts :: [RawOption] -> BoolOptions
122boolOpts opts =
123  BoolOptions
124    { macros    = not (NoMacro `elem` opts)
125    , locations = not (NoLine  `elem` opts)
126    , hashline  = not (LinePragma `elem` opts)
127    , pragma    =      Pragma  `elem` opts
128    , stripEol  =      StripEol`elem` opts
129    , stripC89  =      StripEol`elem` opts || Strip `elem` opts
130    , lang      = not (Text    `elem` opts)
131    , ansi      =      Ansi    `elem` opts
132    , layout    =      Layout  `elem` opts
133    , literate  =      Unlit   `elem` opts
134    , warnings  = not (SuppressWarnings `elem` opts)
135    }
136
137-- | Parse all command-line options.
138parseOptions :: [String] -> Either String CpphsOptions
139parseOptions xs = f ([], [], []) xs
140  where
141    f (opts, ins, outs) (('-':'O':x):xs) = f (opts, ins, x:outs) xs
142    f (opts, ins, outs) (x@('-':_):xs) = case rawOption x of
143                                           Nothing -> Left x
144                                           Just a  -> f (a:opts, ins, outs) xs
145    f (opts, ins, outs) (x:xs) = f (opts, normalise x:ins, outs) xs
146    f (opts, ins, outs) []     =
147        Right CpphsOptions { infiles  = reverse ins
148                           , outfiles = reverse outs
149                           , defines  = [ x | Macro x <- reverse opts ]
150                           , includes = [ x | Path x  <- reverse opts ]
151                           , preInclude=[ x | PreInclude x <- reverse opts ]
152                           , boolopts = boolOpts opts
153                           }
154    normalise ('/':'/':filepath) = normalise ('/':filepath)
155    normalise (x:filepath)       = x:normalise filepath
156    normalise []                 = []
157