{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
module GHC.Driver.CmdLine
(
processArgs, OptKind(..), GhcFlagMode(..),
CmdLineP(..), getCmdLineState, putCmdLineState,
Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag,
errorsToGhcException,
Err(..), Warn(..), WarnReason(..),
EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM,
deprecate
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.Bag
import GHC.Types.SrcLoc
import GHC.Utils.Json
import Data.Function
import Data.List (sortBy, intercalate, stripPrefix)
import Control.Monad (liftM, ap)
data Flag m = Flag
{ forall (m :: * -> *). Flag m -> String
flagName :: String,
forall (m :: * -> *). Flag m -> OptKind m
flagOptKind :: OptKind m,
forall (m :: * -> *). Flag m -> GhcFlagMode
flagGhcMode :: GhcFlagMode
}
defFlag :: String -> OptKind m -> Flag m
defFlag :: forall (m :: * -> *). String -> OptKind m -> Flag m
defFlag String
name OptKind m
optKind = forall (m :: * -> *). String -> OptKind m -> GhcFlagMode -> Flag m
Flag String
name OptKind m
optKind GhcFlagMode
AllModes
defGhcFlag :: String -> OptKind m -> Flag m
defGhcFlag :: forall (m :: * -> *). String -> OptKind m -> Flag m
defGhcFlag String
name OptKind m
optKind = forall (m :: * -> *). String -> OptKind m -> GhcFlagMode -> Flag m
Flag String
name OptKind m
optKind GhcFlagMode
OnlyGhc
defGhciFlag :: String -> OptKind m -> Flag m
defGhciFlag :: forall (m :: * -> *). String -> OptKind m -> Flag m
defGhciFlag String
name OptKind m
optKind = forall (m :: * -> *). String -> OptKind m -> GhcFlagMode -> Flag m
Flag String
name OptKind m
optKind GhcFlagMode
OnlyGhci
defHiddenFlag :: String -> OptKind m -> Flag m
defHiddenFlag :: forall (m :: * -> *). String -> OptKind m -> Flag m
defHiddenFlag String
name OptKind m
optKind = forall (m :: * -> *). String -> OptKind m -> GhcFlagMode -> Flag m
Flag String
name OptKind m
optKind GhcFlagMode
HiddenFlag
data GhcFlagMode
= OnlyGhc
| OnlyGhci
| AllModes
| HiddenFlag
data OptKind m
= NoArg (EwM m ())
| HasArg (String -> EwM m ())
| SepArg (String -> EwM m ())
| Prefix (String -> EwM m ())
| OptPrefix (String -> EwM m ())
| OptIntSuffix (Maybe Int -> EwM m ())
| IntSuffix (Int -> EwM m ())
| WordSuffix (Word -> EwM m ())
| FloatSuffix (Float -> EwM m ())
| PassFlag (String -> EwM m ())
| AnySuffix (String -> EwM m ())
data WarnReason
= NoReason
| ReasonDeprecatedFlag
| ReasonUnrecognisedFlag
deriving (WarnReason -> WarnReason -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WarnReason -> WarnReason -> Bool
$c/= :: WarnReason -> WarnReason -> Bool
== :: WarnReason -> WarnReason -> Bool
$c== :: WarnReason -> WarnReason -> Bool
Eq, Int -> WarnReason -> ShowS
[WarnReason] -> ShowS
WarnReason -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WarnReason] -> ShowS
$cshowList :: [WarnReason] -> ShowS
show :: WarnReason -> String
$cshow :: WarnReason -> String
showsPrec :: Int -> WarnReason -> ShowS
$cshowsPrec :: Int -> WarnReason -> ShowS
Show)
instance Outputable WarnReason where
ppr :: WarnReason -> SDoc
ppr = String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance ToJson WarnReason where
json :: WarnReason -> JsonDoc
json WarnReason
NoReason = JsonDoc
JSNull
json WarnReason
reason = String -> JsonDoc
JSString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show WarnReason
reason
newtype Err = Err { Err -> Located String
errMsg :: Located String }
data Warn = Warn
{ Warn -> WarnReason
warnReason :: WarnReason,
Warn -> Located String
warnMsg :: Located String
}
type Errs = Bag Err
type Warns = Bag Warn
newtype EwM m a = EwM { forall (m :: * -> *) a.
EwM m a -> Located String -> Errs -> Warns -> m (Errs, Warns, a)
unEwM :: Located String
-> Errs -> Warns
-> m (Errs, Warns, a) }
instance Monad m => Functor (EwM m) where
fmap :: forall a b. (a -> b) -> EwM m a -> EwM m b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Monad m => Applicative (EwM m) where
pure :: forall a. a -> EwM m a
pure a
v = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\Located String
_ Errs
e Warns
w -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
e, Warns
w, a
v))
<*> :: forall a b. EwM m (a -> b) -> EwM m a -> EwM m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad m => Monad (EwM m) where
(EwM Located String -> Errs -> Warns -> m (Errs, Warns, a)
f) >>= :: forall a b. EwM m a -> (a -> EwM m b) -> EwM m b
>>= a -> EwM m b
k = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\Located String
l Errs
e Warns
w -> do (Errs
e', Warns
w', a
r) <- Located String -> Errs -> Warns -> m (Errs, Warns, a)
f Located String
l Errs
e Warns
w
forall (m :: * -> *) a.
EwM m a -> Located String -> Errs -> Warns -> m (Errs, Warns, a)
unEwM (a -> EwM m b
k a
r) Located String
l Errs
e' Warns
w')
runEwM :: EwM m a -> m (Errs, Warns, a)
runEwM :: forall (m :: * -> *) a. EwM m a -> m (Errs, Warns, a)
runEwM EwM m a
action = forall (m :: * -> *) a.
EwM m a -> Located String -> Errs -> Warns -> m (Errs, Warns, a)
unEwM EwM m a
action (forall a. String -> a
panic String
"processArgs: no arg yet") forall a. Bag a
emptyBag forall a. Bag a
emptyBag
setArg :: Located String -> EwM m () -> EwM m ()
setArg :: forall (m :: * -> *). Located String -> EwM m () -> EwM m ()
setArg Located String
l (EwM Located String -> Errs -> Warns -> m (Errs, Warns, ())
f) = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\Located String
_ Errs
es Warns
ws -> Located String -> Errs -> Warns -> m (Errs, Warns, ())
f Located String
l Errs
es Warns
ws)
addErr :: Monad m => String -> EwM m ()
addErr :: forall (m :: * -> *). Monad m => String -> EwM m ()
addErr String
e = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\(L SrcSpan
loc String
_) Errs
es Warns
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es forall a. Bag a -> a -> Bag a
`snocBag` Located String -> Err
Err (forall l e. l -> e -> GenLocated l e
L SrcSpan
loc String
e), Warns
ws, ()))
addWarn :: Monad m => String -> EwM m ()
addWarn :: forall (m :: * -> *). Monad m => String -> EwM m ()
addWarn = forall (m :: * -> *). Monad m => WarnReason -> String -> EwM m ()
addFlagWarn WarnReason
NoReason
addFlagWarn :: Monad m => WarnReason -> String -> EwM m ()
addFlagWarn :: forall (m :: * -> *). Monad m => WarnReason -> String -> EwM m ()
addFlagWarn WarnReason
reason String
msg = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM forall a b. (a -> b) -> a -> b
$
(\(L SrcSpan
loc String
_) Errs
es Warns
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es, Warns
ws forall a. Bag a -> a -> Bag a
`snocBag` WarnReason -> Located String -> Warn
Warn WarnReason
reason (forall l e. l -> e -> GenLocated l e
L SrcSpan
loc String
msg), ()))
deprecate :: Monad m => String -> EwM m ()
deprecate :: forall (m :: * -> *). Monad m => String -> EwM m ()
deprecate String
s = do
String
arg <- forall (m :: * -> *). Monad m => EwM m String
getArg
forall (m :: * -> *). Monad m => WarnReason -> String -> EwM m ()
addFlagWarn WarnReason
ReasonDeprecatedFlag (String
arg forall a. [a] -> [a] -> [a]
++ String
" is deprecated: " forall a. [a] -> [a] -> [a]
++ String
s)
getArg :: Monad m => EwM m String
getArg :: forall (m :: * -> *). Monad m => EwM m String
getArg = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\(L SrcSpan
_ String
arg) Errs
es Warns
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es, Warns
ws, String
arg))
getCurLoc :: Monad m => EwM m SrcSpan
getCurLoc :: forall (m :: * -> *). Monad m => EwM m SrcSpan
getCurLoc = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\(L SrcSpan
loc String
_) Errs
es Warns
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es, Warns
ws, SrcSpan
loc))
liftEwM :: Monad m => m a -> EwM m a
liftEwM :: forall (m :: * -> *) a. Monad m => m a -> EwM m a
liftEwM m a
action = forall (m :: * -> *) a.
(Located String -> Errs -> Warns -> m (Errs, Warns, a)) -> EwM m a
EwM (\Located String
_ Errs
es Warns
ws -> do { a
r <- m a
action; forall (m :: * -> *) a. Monad m => a -> m a
return (Errs
es, Warns
ws, a
r) })
newtype CmdLineP s a = CmdLineP { forall s a. CmdLineP s a -> s -> (a, s)
runCmdLine :: s -> (a, s) }
deriving (forall a b. a -> CmdLineP s b -> CmdLineP s a
forall a b. (a -> b) -> CmdLineP s a -> CmdLineP s b
forall s a b. a -> CmdLineP s b -> CmdLineP s a
forall s a b. (a -> b) -> CmdLineP s a -> CmdLineP s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CmdLineP s b -> CmdLineP s a
$c<$ :: forall s a b. a -> CmdLineP s b -> CmdLineP s a
fmap :: forall a b. (a -> b) -> CmdLineP s a -> CmdLineP s b
$cfmap :: forall s a b. (a -> b) -> CmdLineP s a -> CmdLineP s b
Functor)
instance Applicative (CmdLineP s) where
pure :: forall a. a -> CmdLineP s a
pure a
a = forall s a. (s -> (a, s)) -> CmdLineP s a
CmdLineP forall a b. (a -> b) -> a -> b
$ \s
s -> (a
a, s
s)
<*> :: forall a b. CmdLineP s (a -> b) -> CmdLineP s a -> CmdLineP s b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (CmdLineP s) where
CmdLineP s a
m >>= :: forall a b. CmdLineP s a -> (a -> CmdLineP s b) -> CmdLineP s b
>>= a -> CmdLineP s b
k = forall s a. (s -> (a, s)) -> CmdLineP s a
CmdLineP forall a b. (a -> b) -> a -> b
$ \s
s ->
let (a
a, s
s') = forall s a. CmdLineP s a -> s -> (a, s)
runCmdLine CmdLineP s a
m s
s
in forall s a. CmdLineP s a -> s -> (a, s)
runCmdLine (a -> CmdLineP s b
k a
a) s
s'
getCmdLineState :: CmdLineP s s
getCmdLineState :: forall s. CmdLineP s s
getCmdLineState = forall s a. (s -> (a, s)) -> CmdLineP s a
CmdLineP forall a b. (a -> b) -> a -> b
$ \s
s -> (s
s,s
s)
putCmdLineState :: s -> CmdLineP s ()
putCmdLineState :: forall s. s -> CmdLineP s ()
putCmdLineState s
s = forall s a. (s -> (a, s)) -> CmdLineP s a
CmdLineP forall a b. (a -> b) -> a -> b
$ \s
_ -> ((),s
s)
processArgs :: Monad m
=> [Flag m]
-> [Located String]
-> m ( [Located String],
[Err],
[Warn] )
processArgs :: forall (m :: * -> *).
Monad m =>
[Flag m] -> [Located String] -> m ([Located String], [Err], [Warn])
processArgs [Flag m]
spec [Located String]
args = do
(Errs
errs, Warns
warns, [Located String]
spare) <- forall (m :: * -> *) a. EwM m a -> m (Errs, Warns, a)
runEwM EwM m [Located String]
action
forall (m :: * -> *) a. Monad m => a -> m a
return ([Located String]
spare, forall a. Bag a -> [a]
bagToList Errs
errs, forall a. Bag a -> [a]
bagToList Warns
warns)
where
action :: EwM m [Located String]
action = [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
args []
process :: [Located String] -> [Located String] -> EwM m [Located String]
process [] [Located String]
spare = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [Located String]
spare)
process (locArg :: Located String
locArg@(L SrcSpan
_ (Char
'-' : String
arg)) : [Located String]
args) [Located String]
spare =
case forall (m :: * -> *).
[Flag m] -> String -> Maybe (String, OptKind m)
findArg [Flag m]
spec String
arg of
Just (String
rest, OptKind m
opt_kind) ->
case forall (m :: * -> *).
OptKind m
-> String
-> String
-> [Located String]
-> Either String (EwM m (), [Located String])
processOneArg OptKind m
opt_kind String
rest String
arg [Located String]
args of
Left String
err ->
let b :: EwM m [Located String]
b = [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
args [Located String]
spare
in (forall (m :: * -> *). Located String -> EwM m () -> EwM m ()
setArg Located String
locArg forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => String -> EwM m ()
addErr String
err) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EwM m [Located String]
b
Right (EwM m ()
action,[Located String]
rest) ->
let b :: EwM m [Located String]
b = [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
rest [Located String]
spare
in (forall (m :: * -> *). Located String -> EwM m () -> EwM m ()
setArg Located String
locArg forall a b. (a -> b) -> a -> b
$ EwM m ()
action) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EwM m [Located String]
b
Maybe (String, OptKind m)
Nothing -> [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
args (Located String
locArg forall a. a -> [a] -> [a]
: [Located String]
spare)
process (Located String
arg : [Located String]
args) [Located String]
spare = [Located String] -> [Located String] -> EwM m [Located String]
process [Located String]
args (Located String
arg forall a. a -> [a] -> [a]
: [Located String]
spare)
processOneArg :: OptKind m -> String -> String -> [Located String]
-> Either String (EwM m (), [Located String])
processOneArg :: forall (m :: * -> *).
OptKind m
-> String
-> String
-> [Located String]
-> Either String (EwM m (), [Located String])
processOneArg OptKind m
opt_kind String
rest String
arg [Located String]
args
= let dash_arg :: String
dash_arg = Char
'-' forall a. a -> [a] -> [a]
: String
arg
rest_no_eq :: String
rest_no_eq = ShowS
dropEq String
rest
in case OptKind m
opt_kind of
NoArg EwM m ()
a -> ASSERT(null rest) Right (a, args)
HasArg String -> EwM m ()
f | forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull String
rest_no_eq -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
rest_no_eq, [Located String]
args)
| Bool
otherwise -> case [Located String]
args of
[] -> forall a. String -> Either String a
missingArgErr String
dash_arg
(L SrcSpan
_ String
arg1:[Located String]
args1) -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
arg1, [Located String]
args1)
SepArg String -> EwM m ()
f -> case [Located String]
args of
[] -> forall a. String -> Either String a
missingArgErr String
dash_arg
(L SrcSpan
_ String
arg1:[Located String]
args1) -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
arg1, [Located String]
args1)
Prefix String -> EwM m ()
f | forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull String
rest_no_eq -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
rest_no_eq, [Located String]
args)
| Bool
otherwise -> forall a. String -> Either String a
missingArgErr String
dash_arg
PassFlag String -> EwM m ()
f | forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull String
rest -> forall a. String -> Either String a
unknownFlagErr String
dash_arg
| Bool
otherwise -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
dash_arg, [Located String]
args)
OptIntSuffix Maybe Int -> EwM m ()
f | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest -> forall a b. b -> Either a b
Right (Maybe Int -> EwM m ()
f forall a. Maybe a
Nothing, [Located String]
args)
| Just Int
n <- String -> Maybe Int
parseInt String
rest_no_eq -> forall a b. b -> Either a b
Right (Maybe Int -> EwM m ()
f (forall a. a -> Maybe a
Just Int
n), [Located String]
args)
| Bool
otherwise -> forall a b. a -> Either a b
Left (String
"malformed integer argument in " forall a. [a] -> [a] -> [a]
++ String
dash_arg)
IntSuffix Int -> EwM m ()
f | Just Int
n <- String -> Maybe Int
parseInt String
rest_no_eq -> forall a b. b -> Either a b
Right (Int -> EwM m ()
f Int
n, [Located String]
args)
| Bool
otherwise -> forall a b. a -> Either a b
Left (String
"malformed integer argument in " forall a. [a] -> [a] -> [a]
++ String
dash_arg)
WordSuffix Word -> EwM m ()
f | Just Word
n <- String -> Maybe Word
parseWord String
rest_no_eq -> forall a b. b -> Either a b
Right (Word -> EwM m ()
f Word
n, [Located String]
args)
| Bool
otherwise -> forall a b. a -> Either a b
Left (String
"malformed natural argument in " forall a. [a] -> [a] -> [a]
++ String
dash_arg)
FloatSuffix Float -> EwM m ()
f | Just Float
n <- String -> Maybe Float
parseFloat String
rest_no_eq -> forall a b. b -> Either a b
Right (Float -> EwM m ()
f Float
n, [Located String]
args)
| Bool
otherwise -> forall a b. a -> Either a b
Left (String
"malformed float argument in " forall a. [a] -> [a] -> [a]
++ String
dash_arg)
OptPrefix String -> EwM m ()
f -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
rest_no_eq, [Located String]
args)
AnySuffix String -> EwM m ()
f -> forall a b. b -> Either a b
Right (String -> EwM m ()
f String
dash_arg, [Located String]
args)
findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
findArg :: forall (m :: * -> *).
[Flag m] -> String -> Maybe (String, OptKind m)
findArg [Flag m]
spec String
arg =
case forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))
[ (ShowS
removeSpaces String
rest, OptKind m
optKind)
| Flag m
flag <- [Flag m]
spec,
let optKind :: OptKind m
optKind = forall (m :: * -> *). Flag m -> OptKind m
flagOptKind Flag m
flag,
Just String
rest <- [forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (forall (m :: * -> *). Flag m -> String
flagName Flag m
flag) String
arg],
forall (t :: * -> *). OptKind t -> String -> String -> Bool
arg_ok OptKind m
optKind String
rest String
arg ]
of
[] -> forall a. Maybe a
Nothing
((String, OptKind m)
one:[(String, OptKind m)]
_) -> forall a. a -> Maybe a
Just (String, OptKind m)
one
arg_ok :: OptKind t -> [Char] -> String -> Bool
arg_ok :: forall (t :: * -> *). OptKind t -> String -> String -> Bool
arg_ok (NoArg EwM t ()
_) String
rest String
_ = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
arg_ok (HasArg String -> EwM t ()
_) String
_ String
_ = Bool
True
arg_ok (SepArg String -> EwM t ()
_) String
rest String
_ = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
arg_ok (Prefix String -> EwM t ()
_) String
_ String
_ = Bool
True
arg_ok (OptIntSuffix Maybe Int -> EwM t ()
_) String
_ String
_ = Bool
True
arg_ok (IntSuffix Int -> EwM t ()
_) String
_ String
_ = Bool
True
arg_ok (WordSuffix Word -> EwM t ()
_) String
_ String
_ = Bool
True
arg_ok (FloatSuffix Float -> EwM t ()
_) String
_ String
_ = Bool
True
arg_ok (OptPrefix String -> EwM t ()
_) String
_ String
_ = Bool
True
arg_ok (PassFlag String -> EwM t ()
_) String
rest String
_ = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
arg_ok (AnySuffix String -> EwM t ()
_) String
_ String
_ = Bool
True
parseInt :: String -> Maybe Int
parseInt :: String -> Maybe Int
parseInt String
s = case forall a. Read a => ReadS a
reads String
s of
((Int
n,String
""):[(Int, String)]
_) -> forall a. a -> Maybe a
Just Int
n
[(Int, String)]
_ -> forall a. Maybe a
Nothing
parseWord :: String -> Maybe Word
parseWord :: String -> Maybe Word
parseWord String
s = case forall a. Read a => ReadS a
reads String
s of
((Word
n,String
""):[(Word, String)]
_) -> forall a. a -> Maybe a
Just Word
n
[(Word, String)]
_ -> forall a. Maybe a
Nothing
parseFloat :: String -> Maybe Float
parseFloat :: String -> Maybe Float
parseFloat String
s = case forall a. Read a => ReadS a
reads String
s of
((Float
n,String
""):[(Float, String)]
_) -> forall a. a -> Maybe a
Just Float
n
[(Float, String)]
_ -> forall a. Maybe a
Nothing
dropEq :: String -> String
dropEq :: ShowS
dropEq (Char
'=' : String
s) = String
s
dropEq String
s = String
s
unknownFlagErr :: String -> Either String a
unknownFlagErr :: forall a. String -> Either String a
unknownFlagErr String
f = forall a b. a -> Either a b
Left (String
"unrecognised flag: " forall a. [a] -> [a] -> [a]
++ String
f)
missingArgErr :: String -> Either String a
missingArgErr :: forall a. String -> Either String a
missingArgErr String
f = forall a b. a -> Either a b
Left (String
"missing argument for flag: " forall a. [a] -> [a] -> [a]
++ String
f)
errorsToGhcException :: [(String,
String)]
-> GhcException
errorsToGhcException :: [(String, String)] -> GhcException
errorsToGhcException [(String, String)]
errs =
String -> GhcException
UsageError forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ [ String
l forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
e | (String
l, String
e) <- [(String, String)]
errs ]