module Evoke.Options
( parse,
)
where
import qualified Control.Monad as Monad
import qualified Evoke.Hsc as Hsc
import qualified GHC.Plugins as Ghc
import qualified System.Console.GetOpt as Console
parse :: [Console.OptDescr a] -> [String] -> Ghc.SrcSpan -> Ghc.Hsc [a]
parse :: forall a. [OptDescr a] -> [String] -> SrcSpan -> Hsc [a]
parse [OptDescr a]
optDescrs [String]
strings SrcSpan
srcSpan = do
let ([a]
xs, [String]
args, [String]
opts, [String]
errs) = forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
Console.getOpt' forall a. ArgOrder a
Console.Permute [OptDescr a]
optDescrs [String]
strings
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Monad.forM_ [String]
opts forall a b. (a -> b) -> a -> b
$
SrcSpan -> SDoc -> Hsc ()
Hsc.addWarning SrcSpan
srcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
Ghc.text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend String
"unknown option: "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
quote
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Monad.forM_ [String]
args forall a b. (a -> b) -> a -> b
$
SrcSpan -> SDoc -> Hsc ()
Hsc.addWarning SrcSpan
srcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
Ghc.text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend String
"unexpected argument: "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
quote
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SrcSpan -> SDoc -> Hsc a
Hsc.throwError SrcSpan
srcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SDoc] -> SDoc
Ghc.vcat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> SDoc
Ghc.text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [String]
errs
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs
quote :: String -> String
quote :: String -> String
quote String
string = String
"`" forall a. Semigroup a => a -> a -> a
<> String
string forall a. Semigroup a => a -> a -> a
<> String
"'"