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

import           Prelude ()
import           Prelude.Compat

import           Data.List.Compat
import           Data.Maybe

import qualified Paths_doctest
import           Data.Version (showVersion)
import           Config as GHC
import           Interpreter (ghc)

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

version :: String
version :: String
version = Version -> String
showVersion Version
Paths_doctest.version

ghcVersion :: String
ghcVersion :: String
ghcVersion = String
GHC.cProjectVersion

versionInfo :: String
versionInfo :: String
versionInfo = [String] -> String
unlines [
    "doctest version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
version
  , "using version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ghcVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ " of the GHC API"
  , "using " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ghc
  ]

info :: String
info :: String
info = "[ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n, " ([String] -> String)
-> ([(String, String)] -> [String]) -> [(String, String)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a. Show a => a -> String
show ([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$ [
    ("version", String
version)
  , ("ghc_version", String
ghcVersion)
  , ("ghc", String
ghc)
  ]) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n]\n"

data Result a = 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
/= :: Result a -> Result a -> Bool
$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
Eq, Int -> Result a -> String -> String
[Result a] -> String -> String
Result a -> String
(Int -> Result a -> String -> String)
-> (Result a -> String)
-> ([Result a] -> String -> String)
-> Show (Result a)
forall a. Show a => Int -> Result a -> String -> String
forall a. Show a => [Result a] -> String -> String
forall a. Show a => Result a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Result a] -> String -> String
$cshowList :: forall a. Show a => [Result a] -> String -> String
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Result a -> String -> String
Show, a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(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
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
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
/= :: Run -> Run -> Bool
$c/= :: Run -> Run -> Bool
== :: Run -> Run -> Bool
$c== :: Run -> Run -> Bool
Eq, Int -> Run -> String -> String
[Run] -> String -> String
Run -> String
(Int -> Run -> String -> String)
-> (Run -> String) -> ([Run] -> String -> String) -> Show Run
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Run] -> String -> String
$cshowList :: [Run] -> String -> String
show :: Run -> String
$cshow :: Run -> String
showsPrec :: Int -> Run -> String -> String
$cshowsPrec :: Int -> Run -> String -> String
Show)

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

parseOptions :: [String] -> Result Run
parseOptions :: [String] -> Result Run
parseOptions args :: [String]
args
  | "--help" String -> [String] -> 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
  | "--info" String -> [String] -> 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
  | "--version" String -> [String] -> 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  ((Bool, (Bool, [String]))
 -> (Bool, (Bool, (Maybe String, [String]))))
-> (Bool, (Bool, (Bool, [String])))
-> (Bool, (Bool, (Bool, (Maybe String, [String]))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Bool, [String]) -> (Bool, (Maybe String, [String])))
-> (Bool, (Bool, [String]))
-> (Bool, (Bool, (Maybe String, [String])))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([String] -> (Maybe String, [String]))
-> (Bool, [String]) -> (Bool, (Maybe String, [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> (Maybe String, [String])
stripOptGhc))
                   ((Bool, (Bool, (Bool, [String])))
 -> (Bool, (Bool, (Bool, (Maybe String, [String])))))
-> ([String] -> (Bool, (Bool, (Bool, [String]))))
-> [String]
-> (Bool, (Bool, (Bool, (Maybe String, [String]))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ((Bool, [String]) -> (Bool, (Bool, [String])))
-> (Bool, (Bool, [String])) -> (Bool, (Bool, (Bool, [String])))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([String] -> (Bool, [String]))
-> (Bool, [String]) -> (Bool, (Bool, [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> (Bool, [String])
stripVerbose)
                   ((Bool, (Bool, [String])) -> (Bool, (Bool, (Bool, [String]))))
-> ([String] -> (Bool, (Bool, [String])))
-> [String]
-> (Bool, (Bool, (Bool, [String])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ([String] -> (Bool, [String]))
-> (Bool, [String]) -> (Bool, (Bool, [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> (Bool, [String])
stripPreserveIt
                   ((Bool, [String]) -> (Bool, (Bool, [String])))
-> ([String] -> (Bool, [String]))
-> [String]
-> (Bool, (Bool, [String]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [String] -> (Bool, [String])
stripFast
                  ([String] -> (Bool, (Bool, (Bool, (Maybe String, [String])))))
-> (Bool, [String])
-> (Bool, (Bool, (Bool, (Bool, (Maybe String, [String])))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> (Bool, [String])
stripNoMagic [String]
args of
      (magicMode :: Bool
magicMode, (fastMode :: Bool
fastMode, (preserveIt :: Bool
preserveIt, (verbose :: Bool
verbose, (warning :: Maybe String
warning, xs :: [String]
xs))))) ->
        Run -> Result Run
forall a. a -> Result a
Result ([String] -> [String] -> Bool -> Bool -> Bool -> Bool -> Run
Run (Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
warning) [String]
xs Bool
magicMode Bool
fastMode Bool
preserveIt Bool
verbose)

stripNoMagic :: [String] -> (Bool, [String])
stripNoMagic :: [String] -> (Bool, [String])
stripNoMagic = Bool -> String -> [String] -> (Bool, [String])
stripFlag (Bool -> Bool
not Bool
defaultMagic) "--no-magic"

stripFast :: [String] -> (Bool, [String])
stripFast :: [String] -> (Bool, [String])
stripFast = Bool -> String -> [String] -> (Bool, [String])
stripFlag (Bool -> Bool
not Bool
defaultFastMode) "--fast"

stripPreserveIt :: [String] -> (Bool, [String])
stripPreserveIt :: [String] -> (Bool, [String])
stripPreserveIt = Bool -> String -> [String] -> (Bool, [String])
stripFlag (Bool -> Bool
not Bool
defaultPreserveIt) "--preserve-it"

stripVerbose :: [String] -> (Bool, [String])
stripVerbose :: [String] -> (Bool, [String])
stripVerbose = Bool -> String -> [String] -> (Bool, [String])
stripFlag (Bool -> Bool
not Bool
defaultVerbose) "--verbose"

stripFlag :: Bool -> String -> [String] -> (Bool, [String])
stripFlag :: Bool -> String -> [String] -> (Bool, [String])
stripFlag enableIt :: Bool
enableIt flag :: String
flag args :: [String]
args = ((String
flag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
enableIt, (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 :: [String] -> (Maybe Warning, [String])
stripOptGhc :: [String] -> (Maybe String, [String])
stripOptGhc = [String] -> (Maybe String, [String])
go
  where
    go :: [String] -> (Maybe String, [String])
go args :: [String]
args = case [String]
args of
      [] -> (Maybe String
forall a. Maybe a
Nothing, [])
      "--optghc" : opt :: String
opt : rest :: [String]
rest -> (String -> Maybe String
forall a. a -> Maybe a
Just String
warning, String
opt String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Maybe String, [String]) -> [String]
forall a b. (a, b) -> b
snd ([String] -> (Maybe String, [String])
go [String]
rest))
      opt :: String
opt : rest :: [String]
rest -> ((Maybe String, [String]) -> (Maybe String, [String]))
-> (String -> (Maybe String, [String]) -> (Maybe String, [String]))
-> Maybe String
-> (Maybe String, [String])
-> (Maybe String, [String])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([String] -> [String])
-> (Maybe String, [String]) -> (Maybe String, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
opt String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)) (\x :: String
x (_, xs :: [String]
xs) -> (String -> Maybe String
forall a. a -> Maybe a
Just String
warning, 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 "--optghc=" String
opt) ([String] -> (Maybe String, [String])
go [String]
rest)

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