module Options (Action(..),Settings(..),Format(..),helpMsg,getSettings) where
import Specialize.Architecture
import System.Console.GetOpt
import Data.Maybe
import My.Data.List
import Format
data Flag = Help | Version
| SourceDir FilePath
| Program FilePath
| LanguageDir FilePath
| Architecture Architecture
| Format Format
deriving Show
data Action = PrintHelp | PrintVersion | Compile
deriving Show
data Settings = Settings {
action :: Action,
sourceDirs :: [FilePath],
languageDir :: FilePath,
programs :: [(String,String)],
outputArch :: Architecture,
outputFmt :: Format
}
deriving Show
splitArg s = case break (==':') s of
(a,':':b) -> a:splitArg b
(a,"") -> [a]
options = map (\(Option a b c d) -> Option a b c (intercalate "\n" $ wrap words unwords 80 d))
[Option ['h','?'] ["help"] (NoArg Help)
"prints usage information"
,Option ['v'] ["version"] (NoArg Version)
"prints Alpha's version information"
,sep
,Option ['S'] ["source-dir"] (ReqArg SourceDir "
")
"adds to the list of directories searched for source files"
,Option ['L'] ["language-dir"] (ReqArg LanguageDir "")
"writes and seeks all language files in (defaults to the current directory)"
,sep
,Option ['a'] ["architecture"] (ReqArg (Architecture . str2arch) "")
$ "specializes for instead of the host architecture ( can be one of "++glue archNames++")"
,Option ['f'] ["format"] (ReqArg (Format . str2fmt) "")
$ "writes the output programs in the specified format ( can be one of "++glue fmtNames++")"
]
where sep = Option [] [] undefined "-----------------"
archNames = map archName architectures
str2arch s = fromMaybe err $ lookup s [(archName a,a) | a <- architectures]
where err = error $ "Invalid architecture name "++show s
fmtNames = map formatName formats++["raw: where is the start address"]
str2fmt s = case splitArg s of
["raw",n] -> raw (read n)
[s] -> fromMaybe err $ lookup s [(formatName f,f) | f <- formats]
_ -> err
where err = error $ "Invalid format argument "++show s
glue = foldr glue "" . tails
where glue [a] _ = a
glue [a,_] t = a++" or "++t
glue (a:_) t = a++", "++t
helpMsg = usageInfo "Usage: alpha