    {-# LANGUAGE CPP #-}
    module Options (
      Result(..)
    , Run(..)
    , Config(..)
    , defaultConfig
    , parseOptions
    #ifdef TEST
    , defaultRun
    , usage
    , info
    , versionInfo
    , nonInteractiveGhcOptions
    #endif
    ) where

    import           Imports

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

    import           Data.List (stripPrefix)

    import           GHC.Paths (ghc)

    import           Info

    usage :: String
    usage :: String
    usage = [String] -> String
    unlines [
        String
    "Usage:"
      , String
    "  doctest [ --fast | --preserve-it | --fail-fast | --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
    "  --fail-fast    abort on first failure"
      , String
    "  --no-magic     disable magic mode"
      , 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 = ProxyToGhc [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 -> Bool
    runMagicMode :: Bool
    , Run -> Config
    runConfig :: Config
    } 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)

    data Config = Config {
      Config -> [String]
    ghcOptions :: [String]
    , Config -> Bool
    fastMode :: Bool
    , Config -> Bool
    preserveIt :: Bool
    , Config -> Bool
    failFast :: Bool
    , Config -> Bool
    verbose :: Bool
    , Config -> (String, [String])
    repl :: (String, [String])
    } deriving (Config -> Config -> Bool
    (Config -> Config -> Bool)
    -> (Config -> Config -> Bool) -> Eq Config
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Config -> Config -> Bool
    == :: Config -> Config -> Bool
    $c/= :: Config -> Config -> Bool
    /= :: Config -> Config -> Bool
    Eq, Int -> Config -> ShowS
    [Config] -> ShowS
    Config -> String
    (Int -> Config -> ShowS)
    -> (Config -> String) -> ([Config] -> ShowS) -> Show Config
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Config -> ShowS
    showsPrec :: Int -> Config -> ShowS
    $cshow :: Config -> String
    show :: Config -> String
    $cshowList :: [Config] -> ShowS
    showList :: [Config] -> ShowS
    Show)

    defaultConfig :: Config
    defaultConfig :: Config
    defaultConfig = Config {
      ghcOptions :: [String]
    ghcOptions = []
    , fastMode :: Bool
    fastMode = Bool
    False
    , preserveIt :: Bool
    preserveIt = Bool
    False
    , failFast :: Bool
    failFast = Bool
    False
    , verbose :: Bool
    verbose = Bool
    False
    , repl :: (String, [String])
    repl = (String
    ghc, [String
    "--interactive"])
    }

    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"
      ]

    defaultRun :: Run
    defaultRun :: Run
    defaultRun = Run {
      runWarnings :: [String]
    runWarnings = []
    , runMagicMode :: Bool
    runMagicMode = Bool
    False
    , runConfig :: Config
    runConfig = Config
    defaultConfig
    }

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

    setOptions :: [String] -> Run -> Run
    setOptions :: [String] -> Run -> Run
    setOptions [String]
    ghcOptions run :: Run
    run@Run{Bool
    [String]
    Config
    runWarnings :: Run -> [String]
    runMagicMode :: Run -> Bool
    runConfig :: Run -> Config
    runWarnings :: [String]
    runMagicMode :: Bool
    runConfig :: Config
    ..} = Run
    run { runConfig = runConfig { ghcOptions } }

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

    setFastMode :: Bool -> Run -> Run
    setFastMode :: Bool -> Run -> Run
    setFastMode Bool
    fastMode run :: Run
    run@Run{Bool
    [String]
    Config
    runWarnings :: Run -> [String]
    runMagicMode :: Run -> Bool
    runConfig :: Run -> Config
    runWarnings :: [String]
    runMagicMode :: Bool
    runConfig :: Config
    ..} = Run
    run { runConfig = runConfig { fastMode } }

    setPreserveIt :: Bool -> Run -> Run
    setPreserveIt :: Bool -> Run -> Run
    setPreserveIt Bool
    preserveIt run :: Run
    run@Run{Bool
    [String]
    Config
    runWarnings :: Run -> [String]
    runMagicMode :: Run -> Bool
    runConfig :: Run -> Config
    runWarnings :: [String]
    runMagicMode :: Bool
    runConfig :: Config
    ..} = Run
    run { runConfig = runConfig { preserveIt } }

    setFailFastMode :: Bool -> Run -> Run
    setFailFastMode :: Bool -> Run -> Run
    setFailFastMode Bool
    failFast run :: Run
    run@Run{Bool
    [String]
    Config
    runWarnings :: Run -> [String]
    runMagicMode :: Run -> Bool
    runConfig :: Run -> Config
    runWarnings :: [String]
    runMagicMode :: Bool
    runConfig :: Config
    ..} = Run
    run { runConfig = runConfig { failFast } }

    setVerbose :: Bool -> Run -> Run
    setVerbose :: Bool -> Run -> Run
    setVerbose Bool
    verbose run :: Run
    run@Run{Bool
    [String]
    Config
    runWarnings :: Run -> [String]
    runMagicMode :: Run -> Bool
    runConfig :: Run -> Config
    runWarnings :: [String]
    runMagicMode :: Bool
    runConfig :: Config
    ..} = Run
    run { runConfig = runConfig { verbose } }

    parseOptions :: [String] -> Result Run
    parseOptions :: [String] -> Result Run
    parseOptions [String]
    args
      | String -> Bool
    on String
    "--info" = String -> Result Run
    forall a. String -> Result a
    Output String
    info
      | String -> Bool
    on String
    "--interactive" = [String] -> Run -> RunOptionsParser -> Result Run
    runRunOptionsParser (String -> [String] -> [String]
    discard String
    "--interactive" [String]
    args) Run
    defaultRun (RunOptionsParser -> Result Run) -> RunOptionsParser -> Result Run
    forall a b. (a -> b) -> a -> b
    $ do
          commonRunOptions
      | String -> Bool
    on (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    `any` [String]
    nonInteractiveGhcOptions = [String] -> Result Run
    forall a. [String] -> Result a
    ProxyToGhc [String]
    args
      | String -> Bool
    on String
    "--help" = String -> Result Run
    forall a. String -> Result a
    Output String
    usage
      | String -> Bool
    on String
    "--version" = String -> Result Run
    forall a. String -> Result a
    Output String
    versionInfo
      | Bool
    otherwise = [String] -> Run -> RunOptionsParser -> Result Run
    runRunOptionsParser [String]
    args Run
    defaultRun {runMagicMode = True} (RunOptionsParser -> Result Run) -> RunOptionsParser -> Result Run
    forall a b. (a -> b) -> a -> b
    $ do
          RunOptionsParser
    commonRunOptions
          String -> (Run -> Run) -> RunOptionsParser
    parseFlag String
    "--no-magic" (Bool -> Run -> Run
    setMagicMode Bool
    False)
          RunOptionsParser
    parseOptGhc
      where
        on :: String -> Bool
    on String
    option = String
    option String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    args

    type RunOptionsParser = RWS () (Endo Run) [String] ()

    runRunOptionsParser :: [String] -> Run -> RunOptionsParser -> Result Run
    runRunOptionsParser :: [String] -> Run -> RunOptionsParser -> Result Run
    runRunOptionsParser [String]
    args Run
    def RunOptionsParser
    parse = case RunOptionsParser -> () -> [String] -> ([String], Endo Run)
    forall r w s a. RWS r w s a -> r -> s -> (s, w)
    execRWS RunOptionsParser
    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
    def)

    commonRunOptions :: RunOptionsParser
    commonRunOptions :: RunOptionsParser
    commonRunOptions = do
      String -> (Run -> Run) -> RunOptionsParser
    parseFlag String
    "--fast" (Bool -> Run -> Run
    setFastMode Bool
    True)
      String -> (Run -> Run) -> RunOptionsParser
    parseFlag String
    "--preserve-it" (Bool -> Run -> Run
    setPreserveIt Bool
    True)
      String -> (Run -> Run) -> RunOptionsParser
    parseFlag String
    "--fail-fast" (Bool -> Run -> Run
    setFailFastMode Bool
    True)
      String -> (Run -> Run) -> RunOptionsParser
    parseFlag String
    "--verbose" (Bool -> Run -> Run
    setVerbose Bool
    True)

    parseFlag :: String -> (Run -> Run) -> RunOptionsParser
    parseFlag :: String -> (Run -> Run) -> RunOptionsParser
    parseFlag String
    flag Run -> Run
    setter = do
      args <- RWST () (Endo Run) [String] Identity [String]
    forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
    RWS.get
      when (flag `elem` args) $
        RWS.tell (Endo setter)
      RWS.put (discard flag args)

    parseOptGhc :: RunOptionsParser
    parseOptGhc :: RunOptionsParser
    parseOptGhc = do
      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
      when issueWarning $
        RWS.tell $ Endo $ modifyWarnings (++ [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."

    discard :: String -> [String] -> [String]
    discard :: String -> [String] -> [String]
    discard String
    flag = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    flag)