cmdline interface improvements
Getty Ritter
1 year, 11 months ago
| 12 | 12 | import qualified HsLua.Core as Lua |
| 13 | 13 | import qualified System.Console.GetOpt as Opt |
| 14 | 14 | import qualified System.Environment as Sys |
| 15 | import qualified System.Exit as Sys | |
| 15 | 16 | |
| 16 | 17 | -- | The main driver |
| 17 | 18 | main :: IO () |
| 23 | 24 | Nothing -> getContents |
| 24 | 25 | Just f -> readFile f |
| 25 | 26 | -- attempt to parse it |
| 26 | let telml = case TeLML.parse telmlSource of | |
| 27 | Right str -> str | |
| 28 |
|
|
| 27 | telml <- case TeLML.parse telmlSource of | |
| 28 | Right str -> return str | |
| 29 | Left err -> do | |
| 30 | putStrLn err | |
| 31 | Sys.exitFailure | |
| 29 | 32 | -- read the Lua source file, if provided |
| 30 | 33 | luaSource <- case optTagFile options of |
| 31 | 34 | Nothing -> return "" |
| 36 | 39 | -- either print the result or print the error nicely |
| 37 | 40 | case result of |
| 38 | 41 | Right msg -> Text.putStr msg |
| 39 |
Left err -> |
|
| 42 | Left err -> do | |
| 43 | putStrLn (Exn.displayException err) | |
| 44 | Sys.exitFailure | |
| 40 | 45 | |
| 41 | 46 | -- * Lua stuff |
| 42 | 47 | |
| 123 | 128 | |
| 124 | 129 | -- * Errors and error-handling |
| 125 | 130 | |
| 126 | -- We wrap the usual LuaHS error type in our own | |
| 127 | ||
| 131 | -- | We wrap the usual LuaHS error type in our own | |
| 128 | 132 | data Error |
| 129 | 133 | = LuaError Lua.Exception |
| 130 | 134 | | TeLMLError Exn.SomeException |
| 307 | 311 | Opt.Option |
| 308 | 312 | ['t'] |
| 309 | 313 | ["tags"] |
| 310 |
(Opt.ReqArg (\f o -> o {optTagFile = Just f}) "[ |
|
| 314 | (Opt.ReqArg (\f o -> o {optTagFile = Just f}) "[tagfile.lua]") | |
| 311 | 315 | "The file of tag definitions to use" |
| 312 | 316 | ] |
| 313 | 317 | |
| 325 | 329 | return (foldl (flip id) def flags) |
| 326 | 330 | (flags, [input], []) -> |
| 327 | 331 | return (foldl (flip id) def flags) {optInputFile = Just input} |
| 328 | (_, _, errors) -> | |
| 329 | error (unlines errors) | |
| 332 | (_, _, errors) -> do | |
| 333 | putStr (unlines errors) | |
| 334 | putStrLn (Opt.usageInfo "USAGE: telml [input.telml] [-n] [-t tagfile.lua]" optionDescriptions) | |
| 335 | Sys.exitFailure | |