    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveFunctor #-}
    module Options (
      Result(..)
    , Run(..)
    , defaultMagic
    , defaultFastMode
    , defaultPreserveIt
    , defaultVerbose
    , parseOptions
    #ifdef TEST
    , usage
    , info
    , versionInfo
    , nonInteractiveGhcOptions
    #endif
    ) where

    import           Prelude ()
    import           Prelude.Compat

    import           Control.Monad.Trans.RWS (RWS, execRWS)
    import qualified Control.Monad.Trans.RWS as RWS

    import           Control.Monad (when)
    import           Data.List.Compat (stripPrefix)
    import           Data.Monoid (Endo (Endo))

    import           Info

    usage :: String
    usage :: String
    usage = [String] -> String
    unlines [
        String
    "Usage:"
      , String
    "  doctest [ --fast | --preserve-it | --no-magic | --verbose | GHC OPTION | MODULE ]..."
      , String
    "  doctest --help"
      , String
    "  doctest --version"
      , String
    "  doctest --info"
      , String
    ""
      , String
    "Options:"
      , String
    "  --fast         disable :reload between example groups"
      , String
    "  --preserve-it  preserve the `it` variable between examples"
      , String
    "  --verbose      print each test as it is run"
      , String
    "  --help         display this help and exit"
      , String
    "  --version      output version information and exit"
      , String
    "  --info         output machine-readable version information and exit"
      ]

    data Result a = RunGhc [String] | Output String | Result a
      deriving (Result a -> Result a -> Bool
    (Result a -> Result a -> Bool)
    -> (Result a -> Result a -> Bool) -> Eq (Result a)
    forall a. Eq a => Result a -> Result a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => Result a -> Result a -> Bool
    == :: Result a -> Result a -> Bool
    $c/= :: forall a. Eq a => Result a -> Result a -> Bool
    /= :: Result a -> Result a -> Bool
    Eq, Int -> Result a -> ShowS
    [Result a] -> ShowS
    Result a -> String
    (Int -> Result a -> ShowS)
    -> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
    forall a. Show a => Int -> Result a -> ShowS
    forall a. Show a => [Result a] -> ShowS
    forall a. Show a => Result a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
    showsPrec :: Int -> Result a -> ShowS
    $cshow :: forall a. Show a => Result a -> String
    show :: Result a -> String
    $cshowList :: forall a. Show a => [Result a] -> ShowS
    showList :: [Result a] -> ShowS
    Show, (forall a b. (a -> b) -> Result a -> Result b)
    -> (forall a b. a -> Result b -> Result a) -> Functor Result
    forall a b. a -> Result b -> Result a
    forall a b. (a -> b) -> Result a -> Result b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Result a -> Result b
    fmap :: forall a b. (a -> b) -> Result a -> Result b
    $c<$ :: forall a b. a -> Result b -> Result a
    <$ :: forall a b. a -> Result b -> Result a
    Functor)

    type Warning = String

    data Run = Run {
      Run -> [String]
    runWarnings :: [Warning]
    , Run -> [String]
    runOptions :: [String]
    , Run -> Bool
    runMagicMode :: Bool
    , Run -> Bool
    runFastMode :: Bool
    , Run -> Bool
    runPreserveIt :: Bool
    , Run -> Bool
    runVerbose :: Bool
    } deriving (Run -> Run -> Bool
    (Run -> Run -> Bool) -> (Run -> Run -> Bool) -> Eq Run
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Run -> Run -> Bool
    == :: Run -> Run -> Bool
    $c/= :: Run -> Run -> Bool
    /= :: Run -> Run -> Bool
    Eq, Int -> Run -> ShowS
    [Run] -> ShowS
    Run -> String
    (Int -> Run -> ShowS)
    -> (Run -> String) -> ([Run] -> ShowS) -> Show Run
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Run -> ShowS
    showsPrec :: Int -> Run -> ShowS
    $cshow :: Run -> String
    show :: Run -> String
    $cshowList :: [Run] -> ShowS
    showList :: [Run] -> ShowS
    Show)

    nonInteractiveGhcOptions :: [String]
    nonInteractiveGhcOptions :: [String]
    nonInteractiveGhcOptions = [
        String
    "--numeric-version"
      , String
    "--supported-languages"
      , String
    "--info"
      , String
    "--print-global-package-db"
      , String
    "--print-libdir"
      , String
    "-c"
      , String
    "-o"
      , String
    "--make"
      , String
    "--abi-hash"
      ]

    defaultMagic :: Bool
    defaultMagic :: Bool
    defaultMagic = Bool
    True

    defaultFastMode :: Bool
    defaultFastMode :: Bool
    defaultFastMode = Bool
    False

    defaultPreserveIt :: Bool
    defaultPreserveIt :: Bool
    defaultPreserveIt = Bool
    False

    defaultVerbose :: Bool
    defaultVerbose :: Bool
    defaultVerbose = Bool
    False

    defaultRun :: Run
    defaultRun :: Run
    defaultRun = Run {
      runWarnings :: [String]
    runWarnings = []
    , runOptions :: [String]
    runOptions = []
    , runMagicMode :: Bool
    runMagicMode = Bool
    defaultMagic
    , runFastMode :: Bool
    runFastMode = Bool
    defaultFastMode
    , runPreserveIt :: Bool
    runPreserveIt = Bool
    defaultPreserveIt
    , runVerbose :: Bool
    runVerbose = Bool
    defaultVerbose
    }

    modifyWarnings :: ([String] -> [String]) -> Run -> Run
    modifyWarnings :: ([String] -> [String]) -> Run -> Run
    modifyWarnings [String] -> [String]
    f Run
    run = Run
    run { runWarnings :: [String]
    runWarnings = [String] -> [String]
    f (Run -> [String]
    runWarnings Run
    run) }

    setOptions :: [String] -> Run -> Run
    setOptions :: [String] -> Run -> Run
    setOptions [String]
    opts Run
    run = Run
    run { runOptions :: [String]
    runOptions = [String]
    opts }

    setMagicMode :: Bool -> Run -> Run
    setMagicMode :: Bool -> Run -> Run
    setMagicMode Bool
    magic Run
    run = Run
    run { runMagicMode :: Bool
    runMagicMode = Bool
    magic }

    setFastMode :: Bool -> Run -> Run
    setFastMode :: Bool -> Run -> Run
    setFastMode Bool
    fast Run
    run = Run
    run { runFastMode :: Bool
    runFastMode = Bool
    fast }

    setPreserveIt :: Bool -> Run -> Run
    setPreserveIt :: Bool -> Run -> Run
    setPreserveIt Bool
    preserveIt Run
    run = Run
    run { runPreserveIt :: Bool
    runPreserveIt = Bool
    preserveIt }

    setVerbose :: Bool -> Run -> Run
    setVerbose :: Bool -> Run -> Run
    setVerbose Bool
    verbose Run
    run = Run
    run { runVerbose :: Bool
    runVerbose = Bool
    verbose }

    parseOptions :: [String] -> Result Run
    parseOptions :: [String] -> Result Run
    parseOptions [String]
    args
      | String
    "--info" String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    args = String -> Result Run
    forall a. String -> Result a
    Output String
    info
      | String
    "--interactive" String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    args = Run -> Result Run
    forall a. a -> Result a
    Result Run {
            runWarnings :: [String]
    runWarnings = []
          , runOptions :: [String]
    runOptions = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "--interactive") [String]
    args
          , runMagicMode :: Bool
    runMagicMode = Bool
    False
          , runFastMode :: Bool
    runFastMode = Bool
    False
          , runPreserveIt :: Bool
    runPreserveIt = Bool
    False
          , runVerbose :: Bool
    runVerbose = Bool
    False
          }
      | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    nonInteractiveGhcOptions) [String]
    args = [String] -> Result Run
    forall a. [String] -> Result a
    RunGhc [String]
    args
      | String
    "--help" String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    args = String -> Result Run
    forall a. String -> Result a
    Output String
    usage
      | String
    "--version" String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    args = String -> Result Run
    forall a. String -> Result a
    Output String
    versionInfo
      | Bool
    otherwise = case RWS () (Endo Run) [String] ()
    -> () -> [String] -> ([String], Endo Run)
    forall r w s a. RWS r w s a -> r -> s -> (s, w)
    execRWS RWS () (Endo Run) [String] ()
    parse () [String]
    args of
          ([String]
    xs, Endo Run -> Run
    setter) ->
            Run -> Result Run
    forall a. a -> Result a
    Result ([String] -> Run -> Run
    setOptions [String]
    xs (Run -> Run) -> Run -> Run
    forall a b. (a -> b) -> a -> b
    $ Run -> Run
    setter Run
    defaultRun)
        where
          parse :: RWS () (Endo Run) [String] ()
          parse :: RWS () (Endo Run) [String] ()
    parse = do
            RWS () (Endo Run) [String] ()
    stripNoMagic
            RWS () (Endo Run) [String] ()
    stripFast
            RWS () (Endo Run) [String] ()
    stripPreserveIt
            RWS () (Endo Run) [String] ()
    stripVerbose
            RWS () (Endo Run) [String] ()
    stripOptGhc

    stripNoMagic :: RWS () (Endo Run) [String] ()
    stripNoMagic :: RWS () (Endo Run) [String] ()
    stripNoMagic = (Run -> Run) -> String -> RWS () (Endo Run) [String] ()
    stripFlag (Bool -> Run -> Run
    setMagicMode Bool
    False) String
    "--no-magic"

    stripFast :: RWS () (Endo Run) [String] ()
    stripFast :: RWS () (Endo Run) [String] ()
    stripFast = (Run -> Run) -> String -> RWS () (Endo Run) [String] ()
    stripFlag (Bool -> Run -> Run
    setFastMode Bool
    True) String
    "--fast"

    stripPreserveIt :: RWS () (Endo Run) [String] ()
    stripPreserveIt :: RWS () (Endo Run) [String] ()
    stripPreserveIt = (Run -> Run) -> String -> RWS () (Endo Run) [String] ()
    stripFlag (Bool -> Run -> Run
    setPreserveIt Bool
    True) String
    "--preserve-it"

    stripVerbose :: RWS () (Endo Run) [String] ()
    stripVerbose :: RWS () (Endo Run) [String] ()
    stripVerbose = (Run -> Run) -> String -> RWS () (Endo Run) [String] ()
    stripFlag (Bool -> Run -> Run
    setVerbose Bool
    True) String
    "--verbose"

    stripFlag :: (Run -> Run) -> String -> RWS () (Endo Run) [String] ()
    stripFlag :: (Run -> Run) -> String -> RWS () (Endo Run) [String] ()
    stripFlag Run -> Run
    setter String
    flag = do
      [String]
    args <- RWST () (Endo Run) [String] Identity [String]
    forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
    RWS.get
      Bool
    -> RWS () (Endo Run) [String] () -> RWS () (Endo Run) [String] ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String
    flag String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    args) (RWS () (Endo Run) [String] () -> RWS () (Endo Run) [String] ())
    -> RWS () (Endo Run) [String] () -> RWS () (Endo Run) [String] ()
    forall a b. (a -> b) -> a -> b
    $
        Endo Run -> RWS () (Endo Run) [String] ()
    forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
    RWS.tell ((Run -> Run) -> Endo Run
    forall a. (a -> a) -> Endo a
    Endo Run -> Run
    setter)
      [String] -> RWS () (Endo Run) [String] ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    s -> RWST r w s m ()
    RWS.put ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    flag) [String]
    args)

    stripOptGhc :: RWS () (Endo Run) [String] ()
    stripOptGhc :: RWS () (Endo Run) [String] ()
    stripOptGhc = do
      Bool
    issueWarning <- ([String] -> (Bool, [String]))
    -> RWST () (Endo Run) [String] Identity Bool
    forall w (m :: * -> *) s a r.
    (Monoid w, Monad m) =>
    (s -> (a, s)) -> RWST r w s m a
    RWS.state [String] -> (Bool, [String])
    go
      Bool
    -> RWS () (Endo Run) [String] () -> RWS () (Endo Run) [String] ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    issueWarning (RWS () (Endo Run) [String] () -> RWS () (Endo Run) [String] ())
    -> RWS () (Endo Run) [String] () -> RWS () (Endo Run) [String] ()
    forall a b. (a -> b) -> a -> b
    $
        Endo Run -> RWS () (Endo Run) [String] ()
    forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
    RWS.tell (Endo Run -> RWS () (Endo Run) [String] ())
    -> Endo Run -> RWS () (Endo Run) [String] ()
    forall a b. (a -> b) -> a -> b
    $ (Run -> Run) -> Endo Run
    forall a. (a -> a) -> Endo a
    Endo ((Run -> Run) -> Endo Run) -> (Run -> Run) -> Endo Run
    forall a b. (a -> b) -> a -> b
    $ ([String] -> [String]) -> Run -> Run
    modifyWarnings ([String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    warning])
      where
        go :: [String] -> (Bool, [String])
    go [String]
    args = case [String]
    args of
          [] -> (Bool
    False, [])
          String
    "--optghc" : String
    opt : [String]
    rest -> (Bool
    True, String
    opt String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (Bool, [String]) -> [String]
    forall a b. (a, b) -> b
    snd ([String] -> (Bool, [String])
    go [String]
    rest))
          String
    opt : [String]
    rest -> ((Bool, [String]) -> (Bool, [String]))
    -> (String -> (Bool, [String]) -> (Bool, [String]))
    -> Maybe String
    -> (Bool, [String])
    -> (Bool, [String])
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (([String] -> [String]) -> (Bool, [String]) -> (Bool, [String])
    forall a b. (a -> b) -> (Bool, a) -> (Bool, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String
    opt String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :)) (\String
    x (Bool
    _, [String]
    xs) -> (Bool
    True, String
    x String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    xs)) (String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    "--optghc=" String
    opt) ([String] -> (Bool, [String])
    go [String]
    rest)

        warning :: String
    warning = String
    "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."