{-# 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 [ 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" ] 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 [ String "doctest version " String -> String -> String forall a. [a] -> [a] -> [a] ++ String version , String "using version " String -> String -> String forall a. [a] -> [a] -> [a] ++ String ghcVersion String -> String -> String forall a. [a] -> [a] -> [a] ++ String " of the GHC API" , String "using " String -> String -> String forall a. [a] -> [a] -> [a] ++ String ghc ] info :: String info :: String info = String "[ " String -> String -> String forall a. [a] -> [a] -> [a] ++ (String -> [String] -> String forall a. [a] -> [[a]] -> [a] intercalate String "\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 $ [ (String "version", String version) , (String "ghc_version", String ghcVersion) , (String "ghc", String ghc) ]) String -> String -> String forall a. [a] -> [a] -> [a] ++ String "\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 [String] args | String "--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 | String "--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 | String "--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 (Bool magicMode, (Bool fastMode, (Bool preserveIt, (Bool verbose, (Maybe String warning, [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) String "--no-magic" stripFast :: [String] -> (Bool, [String]) stripFast :: [String] -> (Bool, [String]) stripFast = Bool -> String -> [String] -> (Bool, [String]) stripFlag (Bool -> Bool not Bool defaultFastMode) String "--fast" stripPreserveIt :: [String] -> (Bool, [String]) stripPreserveIt :: [String] -> (Bool, [String]) stripPreserveIt = Bool -> String -> [String] -> (Bool, [String]) stripFlag (Bool -> Bool not Bool defaultPreserveIt) String "--preserve-it" stripVerbose :: [String] -> (Bool, [String]) stripVerbose :: [String] -> (Bool, [String]) stripVerbose = Bool -> String -> [String] -> (Bool, [String]) stripFlag (Bool -> Bool not Bool defaultVerbose) String "--verbose" stripFlag :: Bool -> String -> [String] -> (Bool, [String]) stripFlag :: Bool -> String -> [String] -> (Bool, [String]) stripFlag Bool enableIt String flag [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 [String] args = case [String] args of [] -> (Maybe String forall a. Maybe a Nothing, []) String "--optghc" : String opt : [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)) String opt : [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] :)) (\String x (Maybe String _, [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 String "--optghc=" String opt) ([String] -> (Maybe String, [String]) go [String] rest) warning :: String warning = String "WARNING: --optghc is deprecated, doctest now accepts arbitrary GHC options\ndirectly."