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

-- | Parses command line options. Adds warnings and throws errors as
-- appropriate. Returns the list of parsed options.
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

-- | Quotes a string using GHC's weird quoting format.
--
-- >>> quote "thing"
-- "`thing'"
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
"'"