{-# 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 Control.Monad.Trans.RWS (RWS, execRWS) import qualified Control.Monad.Trans.RWS as RWS import Control.Monad (when) import Data.List.Compat (intercalate, stripPrefix) import Data.Monoid (Endo (Endo)) import qualified Paths_doctest import Data.Version (showVersion) #if __GLASGOW_HASKELL__ < 900 import Config as GHC #else import GHC.Settings.Config as GHC #endif 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, (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 <$ :: forall a b. a -> Result b -> Result a $c<$ :: forall a b. a -> Result b -> Result a fmap :: forall a b. (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 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 "--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 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 (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 (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."