1 module Main( main ) where

     2 

     3 import System.Console.GetOpt

     4 import System.Environment

     5 import System.Exit

     6 import System.IO

     7 import Data.Maybe( fromMaybe, isJust, fromJust )

     8 import Data.List (find, intercalate)

     9 import Control.Monad

    10 import Pas2C

    11 

    12 main = do

    13     args <- getArgs

    14     if length args == 0

    15     then do

    16         name <- getProgName

    17         hPutStrLn stderr $ usageInfo header options

    18         exitFailure

    19     else do

    20         case getOpt RequireOrder options args of

    21           (flags, [],      []) | enoughFlags flags -> do

    22                 let m = flag flags isName

    23                 let i = flag flags isInput

    24                 let o = flag flags isOutput

    25                 let a = fromMaybe o $ liftM extractString $ find isAlt flags

    26                 let symbols = ["PAS2C", "FPC"] ++ (map extractString $ filter isSymbol flags)

    27                 hPutStrLn stdout $ "--------Pas2C Config--------"

    28                 hPutStrLn stdout $ "Main module: " ++ m

    29                 hPutStrLn stdout $ "Input path : " ++ i

    30                 hPutStrLn stdout $ "Output path: " ++ o

    31                 hPutStrLn stdout $ "Altern path: " ++ a

    32                 hPutStrLn stdout $ "Symbols defined: " ++ (intercalate ", " symbols)

    33                 hPutStrLn stdout $ "----------------------------"

    34                 pas2C m (i++"/") (o++"/") (a++"/") symbols

    35                 hPutStrLn stdout $ "----------------------------"

    36                       | otherwise ->  error $ usageInfo header options

    37           (_,     nonOpts, [])     -> error $ "unrecognized arguments: " ++ unwords nonOpts

    38           (_,     _,       msgs)   -> error $ usageInfo header options

    39     where

    40         header = "Freepascal to C conversion! Please specify -n -i -o options.\n"

    41         enoughFlags f = and $ map (isJust . flip find f) [isName, isInput, isOutput]

    42         flag f = extractString . fromJust . flip find f

    43 

    44 

    45 data Flag = HelpMessage

    46           | Name String

    47           | Input String

    48           | Output String

    49           | Alternate String

    50           | Symbol String

    51 

    52 

    53 extractString :: Flag -> String

    54 extractString (Name s) = s

    55 extractString (Input s) = s

    56 extractString (Output s) = s

    57 extractString (Alternate s) = s

    58 extractString (Symbol s) = s

    59 extractString _ = undefined

    60 

    61 isName, isInput, isOutput, isAlt, isSymbol :: Flag -> Bool

    62 isName (Name _) = True

    63 isName _ = False

    64 isInput (Input _) = True

    65 isInput _ = False

    66 isOutput (Output _) = True

    67 isOutput _ = False

    68 isAlt (Alternate _) = True

    69 isAlt _ = False

    70 isSymbol (Symbol _) = True

    71 isSymbol _ = False

    72 

    73 options :: [OptDescr Flag]

    74 options = [

    75     Option ['h'] ["help"]      (NoArg HelpMessage)      "print this help message",

    76     Option ['n'] ["name"]      (ReqArg Name "MAIN")     "name of the main Pascal module",

    77     Option ['i'] ["input"]     (ReqArg Input "DIR")     "input directory, where .pas files will be read",

    78     Option ['o'] ["output"]    (ReqArg Output "DIR")    "output directory, where .c/.h files will be written",

    79     Option ['a'] ["alternate"] (ReqArg Alternate "DIR") "alternate input directory, for out of source builds",

    80     Option ['d'] ["define"]    (ReqArg Symbol "SYMBOL") "define symbol"

    81   ]

    82