~jojo/Carth

ref: ebd61e146dcfc2ff4105be3199c8d63efe0b6f00 Carth/app/GetConfig.hs -rw-r--r-- 4.2 KiB
ebd61e14JoJo Remove transmute size checking from Gen 6 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
{-# LANGUAGE TupleSections, TemplateHaskell, RankNTypes #-}

-- | Read all the different kinds of configurtion options for Carth. Command
--   line options, config files, environment variables, etc.
module GetConfig (getConfig, Conf(..)) where

import System.Console.GetOpt
import System.Environment
import System.Exit
import System.FilePath
import Data.List
import Data.Function
import Control.Monad

import Conf
import Prebaked


getConfig :: IO Conf
getConfig = do
    as <- getArgs
    let subCompile a = a == "c" || a == "compile"
    let subRun a = a == "r" || a == "run"
    case as of
        a : as' | subCompile a -> compileCfg as'
                | subRun a -> runCfg as'
        a : _ | a == "-h" || a == "--help" -> do
            putStrLn usageSubs
            exitFailure
        "help" : [] -> do
            putStrLn usageSubs
            exitFailure
        "help" : a : _ | subCompile a -> usageCompile
                       | subRun a -> usageRun
        "version" : _ -> printVersion >> exitSuccess
        a : _ -> do
            putStrLn ("Error: `" ++ a ++ "` is not a valid subcommand\n")
            putStrLn usageSubs
            exitFailure
        [] -> do
            putStrLn "Error: No subcommand given\n"
            putStrLn usageSubs
            exitFailure

usageSubs :: String
usageSubs = unlines
    [ "Usage: carth SUBCOMMAND ..."
    , ""
    , "Available subcommands are:"
    , "  c, compile       Compile a source file"
    , "  r, run           JIT run a source file"
    , "     version       Show version information"
    , ""
    , "See `carth help SUBCOMMAND` for help on a specific subcommand"
    ]

compileCfg :: [String] -> IO Conf
compileCfg args = do
    (fs, inf) <- get args compileOpts usageCompile
    let outf = dropExtension inf
    when (inf == outf) $ do
        putStrLn
            $ ("Error: Input file \"" ++ inf ++ "\" ")
            ++ "would be overwritten by the generated executable"
        exitFailure
    let defaultCfg = defaultCompileConfig inf outf
        cfg = foldl (&) defaultCfg fs
    pure (CompileConf cfg)

runCfg :: [String] -> IO Conf
runCfg args = do
    (fs, inf) <- get args runOpts usageRun
    let defaultCfg = defaultRunConfig inf
        cfg = foldl (&) defaultCfg fs
    pure (RunConf cfg)

get
    :: [String]
    -> [OptDescr (cfg -> cfg)]
    -> (forall a . IO a)
    -> IO ([cfg -> cfg], FilePath)
get args opts usage = do
    let (fs, extras, errs) = getOpt Permute opts args
    when (not (null errs)) $ putStrLn (concat errs) *> usage
    inf <- case extras of
        f : [] -> pure f
        _ : es -> do
            putStrLn ("Unexpected extra arguments: " ++ intercalate ", " es)
            usage
        [] -> putStrLn "Missing input source file" *> usage
    pure (fs, inf)

usageCompile :: IO a
usageCompile = do
    putStrLn $ unlines
        [ "Carth compile"
        , "Compile a Carth program to an executable"
        , ""
        , usageInfo "Usage: carth c [OPTIONS] SOURCE-FILE" compileOpts
        ]
    exitFailure

usageRun :: IO a
usageRun = do
    putStrLn $ unlines
        [ "Carth run"
        , "JIT run Carth program"
        , ""
        , usageInfo "Usage: carth r [OPTIONS] SOURCE-FILE" runOpts
        ]
    exitFailure

compileOpts :: [OptDescr (CompileConfig -> CompileConfig)]
compileOpts =
    [ Option []
             ["cc"]
             (ReqArg (\cc' c -> c { cCompiler = cc' }) "PROGRAM")
             "C compiler to use for linking"
    , Option ['o']
             ["outfile"]
             (ReqArg (\f c -> c { cOutfile = f }) "FILE")
             "Output filepath"
    , Option [] ["debug"] (NoArg (\c -> c { cDebug = True })) "Enable debugging"
    , Option ['v'] ["verbose"] (NoArg (\c -> c { cVerbose = True })) "Verbose output"
    ]

runOpts :: [OptDescr (RunConfig -> RunConfig)]
runOpts =
    [ Option [] ["debug"] (NoArg (\c -> c { rDebug = True })) "Enable debugging"
    , Option ['v'] ["verbose"] (NoArg (\c -> c { rVerbose = True })) "Verbose output"
    ]

printVersion :: IO ()
printVersion = do
    let (major, minor, patch) = version
    let versionStr = concat [show major, ".", show minor, ".", show patch]
    putStrLn ("Carth " ++ versionStr)

version :: (Int, Int, Int)
version = $(readCompilerVersion)