-----------------------------------------------------------------------------
-- |
-- Module      :  Options
-- Copyright   :  2006 Malcolm Wallace
-- Licence     :  LGPL
--
-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
-- Stability   :  experimental
-- Portability :  All
--
-- This module deals with Cpphs options and parsing them
-----------------------------------------------------------------------------

module Language.Preprocessor.Cpphs.Options
  ( CpphsOptions(..)
  , BoolOptions(..)
  , parseOptions
  , defaultCpphsOptions
  , defaultBoolOptions
  , trailing
  ) where

import Data.Maybe
import Data.List (isPrefixOf)

-- | Cpphs options structure.
data CpphsOptions = CpphsOptions 
    { CpphsOptions -> [FilePath]
infiles   :: [FilePath]
    , CpphsOptions -> [FilePath]
outfiles  :: [FilePath]
    , CpphsOptions -> [(FilePath, FilePath)]
defines   :: [(String,String)]
    , CpphsOptions -> [FilePath]
includes  :: [String]
    , CpphsOptions -> [FilePath]
preInclude:: [FilePath]   -- ^ Files to \#include before anything else
    , CpphsOptions -> BoolOptions
boolopts  :: BoolOptions
    } deriving (Int -> CpphsOptions -> ShowS
[CpphsOptions] -> ShowS
CpphsOptions -> FilePath
(Int -> CpphsOptions -> ShowS)
-> (CpphsOptions -> FilePath)
-> ([CpphsOptions] -> ShowS)
-> Show CpphsOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CpphsOptions] -> ShowS
$cshowList :: [CpphsOptions] -> ShowS
show :: CpphsOptions -> FilePath
$cshow :: CpphsOptions -> FilePath
showsPrec :: Int -> CpphsOptions -> ShowS
$cshowsPrec :: Int -> CpphsOptions -> ShowS
Show)

-- | Default options.
defaultCpphsOptions :: CpphsOptions
defaultCpphsOptions :: CpphsOptions
defaultCpphsOptions = CpphsOptions :: [FilePath]
-> [FilePath]
-> [(FilePath, FilePath)]
-> [FilePath]
-> [FilePath]
-> BoolOptions
-> CpphsOptions
CpphsOptions { infiles :: [FilePath]
infiles = [], outfiles :: [FilePath]
outfiles = []
                                   , defines :: [(FilePath, FilePath)]
defines = [], includes :: [FilePath]
includes = []
                                   , preInclude :: [FilePath]
preInclude = []
                                   , boolopts :: BoolOptions
boolopts = BoolOptions
defaultBoolOptions }

-- | Options representable as Booleans.
data BoolOptions = BoolOptions
    { BoolOptions -> Bool
macros    :: Bool  -- ^ Leave \#define and \#undef in output of ifdef?
    , BoolOptions -> Bool
locations :: Bool  -- ^ Place \#line droppings in output?
    , BoolOptions -> Bool
hashline  :: Bool  -- ^ Write \#line or {-\# LINE \#-} ?
    , BoolOptions -> Bool
pragma    :: Bool  -- ^ Keep \#pragma in final output?
    , BoolOptions -> Bool
stripEol  :: Bool  -- ^ Remove C eol (\/\/) comments everywhere?
    , BoolOptions -> Bool
stripC89  :: Bool  -- ^ Remove C inline (\/**\/) comments everywhere?
    , BoolOptions -> Bool
lang      :: Bool  -- ^ Lex input as Haskell code?
    , BoolOptions -> Bool
ansi      :: Bool  -- ^ Permit stringise \# and catenate \#\# operators?
    , BoolOptions -> Bool
layout    :: Bool  -- ^ Retain newlines in macro expansions?
    , BoolOptions -> Bool
literate  :: Bool  -- ^ Remove literate markup?
    , BoolOptions -> Bool
warnings  :: Bool  -- ^ Issue warnings?
    } deriving (Int -> BoolOptions -> ShowS
[BoolOptions] -> ShowS
BoolOptions -> FilePath
(Int -> BoolOptions -> ShowS)
-> (BoolOptions -> FilePath)
-> ([BoolOptions] -> ShowS)
-> Show BoolOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BoolOptions] -> ShowS
$cshowList :: [BoolOptions] -> ShowS
show :: BoolOptions -> FilePath
$cshow :: BoolOptions -> FilePath
showsPrec :: Int -> BoolOptions -> ShowS
$cshowsPrec :: Int -> BoolOptions -> ShowS
Show)

-- | Default settings of boolean options.
defaultBoolOptions :: BoolOptions
defaultBoolOptions :: BoolOptions
defaultBoolOptions = BoolOptions :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> BoolOptions
BoolOptions { macros :: Bool
macros   = Bool
True,   locations :: Bool
locations = Bool
True
                                 , hashline :: Bool
hashline = Bool
True,   pragma :: Bool
pragma    = Bool
False
                                 , stripEol :: Bool
stripEol = Bool
False,  stripC89 :: Bool
stripC89  = Bool
False
                                 , lang :: Bool
lang     = Bool
True,   ansi :: Bool
ansi      = Bool
False
                                 , layout :: Bool
layout   = Bool
False,  literate :: Bool
literate  = Bool
False
                                 , warnings :: Bool
warnings = Bool
True }

-- | Raw command-line options.  This is an internal intermediate data
--   structure, used during option parsing only.
data RawOption
    = NoMacro
    | NoLine
    | LinePragma
    | Pragma
    | Text
    | Strip
    | StripEol
    | Ansi
    | Layout
    | Unlit
    | SuppressWarnings
    | Macro (String,String)
    | Path String
    | PreInclude FilePath
    | IgnoredForCompatibility
      deriving (RawOption -> RawOption -> Bool
(RawOption -> RawOption -> Bool)
-> (RawOption -> RawOption -> Bool) -> Eq RawOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawOption -> RawOption -> Bool
$c/= :: RawOption -> RawOption -> Bool
== :: RawOption -> RawOption -> Bool
$c== :: RawOption -> RawOption -> Bool
Eq, Int -> RawOption -> ShowS
[RawOption] -> ShowS
RawOption -> FilePath
(Int -> RawOption -> ShowS)
-> (RawOption -> FilePath)
-> ([RawOption] -> ShowS)
-> Show RawOption
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RawOption] -> ShowS
$cshowList :: [RawOption] -> ShowS
show :: RawOption -> FilePath
$cshow :: RawOption -> FilePath
showsPrec :: Int -> RawOption -> ShowS
$cshowsPrec :: Int -> RawOption -> ShowS
Show)

flags :: [(String, RawOption)]
flags :: [(FilePath, RawOption)]
flags = [ (FilePath
"--nomacro", RawOption
NoMacro)
        , (FilePath
"--noline",  RawOption
NoLine)
        , (FilePath
"--linepragma", RawOption
LinePragma)
        , (FilePath
"--pragma",  RawOption
Pragma)
        , (FilePath
"--text",    RawOption
Text)
        , (FilePath
"--strip",   RawOption
Strip)
        , (FilePath
"--strip-eol",  RawOption
StripEol)
        , (FilePath
"--hashes",  RawOption
Ansi)
        , (FilePath
"--layout",  RawOption
Layout)
        , (FilePath
"--unlit",   RawOption
Unlit)
        , (FilePath
"--nowarn",  RawOption
SuppressWarnings)
        ]

-- | Parse a single raw command-line option.  Parse failure is indicated by
--   result Nothing.
rawOption :: String -> Maybe RawOption
rawOption :: FilePath -> Maybe RawOption
rawOption FilePath
x | Maybe RawOption -> Bool
forall a. Maybe a -> Bool
isJust Maybe RawOption
a = Maybe RawOption
a
    where a :: Maybe RawOption
a = FilePath -> [(FilePath, RawOption)] -> Maybe RawOption
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
x [(FilePath, RawOption)]
flags
rawOption (Char
'-':Char
'D':FilePath
xs) = RawOption -> Maybe RawOption
forall a. a -> Maybe a
Just (RawOption -> Maybe RawOption) -> RawOption -> Maybe RawOption
forall a b. (a -> b) -> a -> b
$ (FilePath, FilePath) -> RawOption
Macro (FilePath
s, if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
d then FilePath
"1" else ShowS
forall a. [a] -> [a]
tail FilePath
d)
    where (FilePath
s,FilePath
d) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'=') FilePath
xs
rawOption (Char
'-':Char
'U':FilePath
xs) = RawOption -> Maybe RawOption
forall a. a -> Maybe a
Just (RawOption -> Maybe RawOption) -> RawOption -> Maybe RawOption
forall a b. (a -> b) -> a -> b
$ RawOption
IgnoredForCompatibility
rawOption (Char
'-':Char
'I':FilePath
xs) = RawOption -> Maybe RawOption
forall a. a -> Maybe a
Just (RawOption -> Maybe RawOption) -> RawOption -> Maybe RawOption
forall a b. (a -> b) -> a -> b
$ FilePath -> RawOption
Path (FilePath -> RawOption) -> FilePath -> RawOption
forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
trailing FilePath
"/\\" FilePath
xs
rawOption FilePath
xs | FilePath
"--include="FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`FilePath
xs
            = RawOption -> Maybe RawOption
forall a. a -> Maybe a
Just (RawOption -> Maybe RawOption) -> RawOption -> Maybe RawOption
forall a b. (a -> b) -> a -> b
$ FilePath -> RawOption
PreInclude (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
10 FilePath
xs)
rawOption FilePath
_ = Maybe RawOption
forall a. Maybe a
Nothing

-- | Trim trailing elements of the second list that match any from
--   the first list.  Typically used to remove trailing forward\/back
--   slashes from a directory path.
trailing :: (Eq a) => [a] -> [a] -> [a]
trailing :: [a] -> [a] -> [a]
trailing [a]
xs = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`[a]
xs) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

-- | Convert a list of RawOption to a BoolOptions structure.
boolOpts :: [RawOption] -> BoolOptions
boolOpts :: [RawOption] -> BoolOptions
boolOpts [RawOption]
opts =
  BoolOptions :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> BoolOptions
BoolOptions
    { macros :: Bool
macros    = Bool -> Bool
not (RawOption
NoMacro RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts)
    , locations :: Bool
locations = Bool -> Bool
not (RawOption
NoLine  RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts)
    , hashline :: Bool
hashline  = Bool -> Bool
not (RawOption
LinePragma RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts)
    , pragma :: Bool
pragma    =      RawOption
Pragma  RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts
    , stripEol :: Bool
stripEol  =      RawOption
StripEolRawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts
    , stripC89 :: Bool
stripC89  =      RawOption
StripEolRawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts Bool -> Bool -> Bool
|| RawOption
Strip RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts
    , lang :: Bool
lang      = Bool -> Bool
not (RawOption
Text    RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts)
    , ansi :: Bool
ansi      =      RawOption
Ansi    RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts
    , layout :: Bool
layout    =      RawOption
Layout  RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts
    , literate :: Bool
literate  =      RawOption
Unlit   RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts
    , warnings :: Bool
warnings  = Bool -> Bool
not (RawOption
SuppressWarnings RawOption -> [RawOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RawOption]
opts)
    }

-- | Parse all command-line options.
parseOptions :: [String] -> Either String CpphsOptions
parseOptions :: [FilePath] -> Either FilePath CpphsOptions
parseOptions [FilePath]
xs = ([RawOption], [FilePath], [FilePath])
-> [FilePath] -> Either FilePath CpphsOptions
f ([], [], []) [FilePath]
xs
  where
    f :: ([RawOption], [FilePath], [FilePath])
-> [FilePath] -> Either FilePath CpphsOptions
f ([RawOption]
opts, [FilePath]
ins, [FilePath]
outs) ((Char
'-':Char
'O':FilePath
x):[FilePath]
xs) = ([RawOption], [FilePath], [FilePath])
-> [FilePath] -> Either FilePath CpphsOptions
f ([RawOption]
opts, [FilePath]
ins, FilePath
xFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
outs) [FilePath]
xs
    f ([RawOption]
opts, [FilePath]
ins, [FilePath]
outs) (x :: FilePath
x@(Char
'-':FilePath
_):[FilePath]
xs) = case FilePath -> Maybe RawOption
rawOption FilePath
x of
                                           Maybe RawOption
Nothing -> FilePath -> Either FilePath CpphsOptions
forall a b. a -> Either a b
Left FilePath
x
                                           Just RawOption
a  -> ([RawOption], [FilePath], [FilePath])
-> [FilePath] -> Either FilePath CpphsOptions
f (RawOption
aRawOption -> [RawOption] -> [RawOption]
forall a. a -> [a] -> [a]
:[RawOption]
opts, [FilePath]
ins, [FilePath]
outs) [FilePath]
xs
    f ([RawOption]
opts, [FilePath]
ins, [FilePath]
outs) (FilePath
x:[FilePath]
xs) = ([RawOption], [FilePath], [FilePath])
-> [FilePath] -> Either FilePath CpphsOptions
f ([RawOption]
opts, ShowS
normalise FilePath
xFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
ins, [FilePath]
outs) [FilePath]
xs
    f ([RawOption]
opts, [FilePath]
ins, [FilePath]
outs) []     =
        CpphsOptions -> Either FilePath CpphsOptions
forall a b. b -> Either a b
Right CpphsOptions :: [FilePath]
-> [FilePath]
-> [(FilePath, FilePath)]
-> [FilePath]
-> [FilePath]
-> BoolOptions
-> CpphsOptions
CpphsOptions { infiles :: [FilePath]
infiles  = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
ins
                           , outfiles :: [FilePath]
outfiles = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
outs
                           , defines :: [(FilePath, FilePath)]
defines  = [ (FilePath, FilePath)
x | Macro (FilePath, FilePath)
x <- [RawOption] -> [RawOption]
forall a. [a] -> [a]
reverse [RawOption]
opts ]
                           , includes :: [FilePath]
includes = [ FilePath
x | Path FilePath
x  <- [RawOption] -> [RawOption]
forall a. [a] -> [a]
reverse [RawOption]
opts ]
                           , preInclude :: [FilePath]
preInclude=[ FilePath
x | PreInclude FilePath
x <- [RawOption] -> [RawOption]
forall a. [a] -> [a]
reverse [RawOption]
opts ]
                           , boolopts :: BoolOptions
boolopts = [RawOption] -> BoolOptions
boolOpts [RawOption]
opts
                           }
    normalise :: ShowS
normalise (Char
'/':Char
'/':FilePath
filepath) = ShowS
normalise (Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
:FilePath
filepath)
    normalise (Char
x:FilePath
filepath)       = Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
normalise FilePath
filepath
    normalise []                 = []