    {-# LANGUAGE Rank2Types, CPP #-}
    #if __GLASGOW_HASKELL__ >= 800
    {-# LANGUAGE TemplateHaskellQuotes #-}
    #else
    {-# LANGUAGE TemplateHaskell #-}
    #endif
    #ifndef NO_SAFE_HASKELL
    {-# LANGUAGE Trustworthy #-}
    #endif

    -- | __Note__: the contents of this module are re-exported by
    -- "Test.QuickCheck". You do not need to import it directly.
    --
    -- Test all properties in the current module, using Template Haskell.
    -- You need to have a @{-\# LANGUAGE TemplateHaskell \#-}@ pragma in
    -- your module for any of these to work.
    module Test.QuickCheck.All(
      -- ** Testing all properties in a module
      quickCheckAll,
      verboseCheckAll,
      forAllProperties,
      allProperties,
      -- ** Testing polymorphic properties
      polyQuickCheck,
      polyVerboseCheck,
      monomorphic) where

    import Language.Haskell.TH
    import Test.QuickCheck.Property hiding (Result)
    import Test.QuickCheck.Test
    import Data.Char
    import Data.List (isPrefixOf, nubBy)
    import Control.Monad

    import qualified System.IO as S

    -- | Test a polymorphic property, defaulting all type variables to 'Integer'.
    --
    -- Invoke as @$('polyQuickCheck' 'prop)@, where @prop@ is a property.
    -- Note that just evaluating @'quickCheck' prop@ in GHCi will seem to
    -- work, but will silently default all type variables to @()@!
    --
    -- @$('polyQuickCheck' \'prop)@ means the same as
    -- @'quickCheck' $('monomorphic' \'prop)@.
    -- If you want to supply custom arguments to 'polyQuickCheck',
    -- you will have to combine 'quickCheckWith' and 'monomorphic' yourself.
    --
    -- If you want to use 'polyQuickCheck' in the same file where you defined the
    -- property, the same scoping problems pop up as in 'quickCheckAll':
    -- see the note there about @return []@.
    polyQuickCheck :: Name -> ExpQ
    polyQuickCheck :: Name -> ExpQ
    polyQuickCheck Name
    x = [| quickCheck |] ExpQ -> ExpQ -> ExpQ
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> ExpQ
    monomorphic Name
    x

    -- | Test a polymorphic property, defaulting all type variables to 'Integer'.
    -- This is just a convenience function that combines 'verboseCheck' and 'monomorphic'.
    --
    -- If you want to use 'polyVerboseCheck' in the same file where you defined the
    -- property, the same scoping problems pop up as in 'quickCheckAll':
    -- see the note there about @return []@.
    polyVerboseCheck :: Name -> ExpQ
    polyVerboseCheck :: Name -> ExpQ
    polyVerboseCheck Name
    x = [| verboseCheck |] ExpQ -> ExpQ -> ExpQ
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> ExpQ
    monomorphic Name
    x

    type Error = forall a. String -> a

    -- | Monomorphise an arbitrary property by defaulting all type variables to 'Integer'.
    --
    -- For example, if @f@ has type @'Ord' a => [a] -> [a]@
    -- then @$('monomorphic' 'f)@ has type @['Integer'] -> ['Integer']@.
    --
    -- If you want to use 'monomorphic' in the same file where you defined the
    -- property, the same scoping problems pop up as in 'quickCheckAll':
    -- see the note there about @return []@.
    monomorphic :: Name -> ExpQ
    monomorphic :: Name -> ExpQ
    monomorphic Name
    t = do
      ty0 <- (Info -> Type) -> Q Info -> Q Type
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Info -> Type
    infoType (Name -> Q Info
    reify Name
    t)
      let err String
    msg = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    msg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    ty0
      (polys, ctx, ty) <- deconstructType err ty0
      case polys of
        [] -> Exp -> ExpQ
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Exp
    expName Name
    t)
        [Name]
    _ -> do
          integer <- [t| Integer |]
          ty' <- monomorphiseType err integer ty
          return (SigE (expName t) ty')

    expName :: Name -> Exp
    expName :: Name -> Exp
    expName Name
    n = if Name -> Bool
    isVar Name
    n then Name -> Exp
    VarE Name
    n else Name -> Exp
    ConE Name
    n

    -- See section 2.4 of the Haskell 2010 Language Report, plus support for "[]"
    isVar :: Name -> Bool
    isVar :: Name -> Bool
    isVar = let isVar' :: String -> Bool
    isVar' (Char
    c:String
    _) = Bool -> Bool
    not (Char -> Bool
    isUpper Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    ":[")
                isVar' String
    _     = Bool
    True
            in String -> Bool
    isVar' (String -> Bool) -> (Name -> String) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase

    infoType :: Info -> Type
    #if MIN_VERSION_template_haskell(2,11,0)
    infoType :: Info -> Type
    infoType (ClassOpI Name
    _ Type
    ty Name
    _) = Type
    ty
    infoType (DataConI Name
    _ Type
    ty Name
    _) = Type
    ty
    infoType (VarI Name
    _ Type
    ty Maybe Dec
    _) = Type
    ty
    #else
    infoType (ClassOpI _ ty _ _) = ty
    infoType (DataConI _ ty _ _) = ty
    infoType (VarI _ ty _ _) = ty
    #endif

    deconstructType :: Error -> Type -> Q ([Name], Cxt, Type)
    deconstructType :: Error -> Type -> Q ([Name], Cxt, Type)
    deconstructType Error
    err (ForallT [TyVarBndr Specificity]
    xs Cxt
    ctx Type
    ty) = do
    #if MIN_VERSION_template_haskell(2,17,0)
      let plain :: TyVarBndr flag -> m Name
    plain (PlainTV Name
    nm flag
    _)        = Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    nm
          plain (KindedTV Name
    nm flag
    _ Type
    StarT) = Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    nm
    #else
      let plain (PlainTV nm)          = return nm
    #  if MIN_VERSION_template_haskell(2,8,0)
          plain (KindedTV nm StarT)   = return nm
    #  else
          plain (KindedTV nm StarK)   = return nm
    #  endif
    #endif
          plain TyVarBndr flag
    _                     = String -> m Name
    Error
    err String
    "Higher-kinded type variables in type"
      xs' <- (TyVarBndr Specificity -> Q Name)
    -> [TyVarBndr Specificity] -> Q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TyVarBndr Specificity -> Q Name
    forall {m :: * -> *} {flag}. Monad m => TyVarBndr flag -> m Name
    plain [TyVarBndr Specificity]
    xs
      return (xs', ctx, ty)
    deconstructType Error
    _ Type
    ty = ([Name], Cxt, Type) -> Q ([Name], Cxt, Type)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [], Type
    ty)

    monomorphiseType :: Error -> Type -> Type -> TypeQ
    monomorphiseType :: Error -> Type -> Type -> Q Type
    monomorphiseType Error
    err Type
    mono ty :: Type
    ty@(VarT Name
    n) = Type -> Q Type
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    mono
    monomorphiseType Error
    err Type
    mono (AppT Type
    t1 Type
    t2) = (Type -> Type -> Type) -> Q Type -> Q Type -> Q Type
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 Type -> Type -> Type
    AppT (Error -> Type -> Type -> Q Type
    monomorphiseType String -> a
    Error
    err Type
    mono Type
    t1) (Error -> Type -> Type -> Q Type
    monomorphiseType String -> a
    Error
    err Type
    mono Type
    t2)
    monomorphiseType Error
    err Type
    mono ty :: Type
    ty@(ForallT [TyVarBndr Specificity]
    _ Cxt
    _ Type
    _) = String -> Q Type
    Error
    err (String -> Q Type) -> String -> Q Type
    forall a b. (a -> b) -> a -> b
    $ String
    "Higher-ranked type"
    monomorphiseType Error
    err Type
    mono Type
    ty = Type -> Q Type
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    ty

    -- | Test all properties in the current module, using a custom
    -- 'quickCheck' function. The same caveats as with 'quickCheckAll'
    -- apply.
    --
    -- @$'forAllProperties'@ has type @('Property' -> 'IO' 'Result') -> 'IO' 'Bool'@.
    -- An example invocation is @$'forAllProperties' 'quickCheckResult'@,
    -- which does the same thing as @$'quickCheckAll'@.
    --
    -- 'forAllProperties' has the same issue with scoping as 'quickCheckAll':
    -- see the note there about @return []@.
    forAllProperties :: Q Exp -- :: (Property -> IO Result) -> IO Bool
    forAllProperties :: ExpQ
    forAllProperties = [| runQuickCheckAll |] ExpQ -> ExpQ -> ExpQ
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` ExpQ
    allProperties

    -- | List all properties in the current module.
    --
    -- @$'allProperties'@ has type @[('String', 'Property')]@.
    --
    -- 'allProperties' has the same issue with scoping as 'quickCheckAll':
    -- see the note there about @return []@.
    allProperties :: Q Exp
    allProperties :: ExpQ
    allProperties = do
      Loc { loc_filename = filename } <- Q Loc
    location
      when (filename == "<interactive>") $ error "don't run this interactively"
      ls <- runIO (fmap lines (readUTF8File filename))
      let prefixes = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (\Char
    c -> Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\'') (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (\Char
    c -> Char -> Bool
    isSpace Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '>')) [String]
    ls
          idents = ((Int, String) -> (Int, String) -> Bool)
    -> [(Int, String)] -> [(Int, String)]
    forall a. (a -> a -> Bool) -> [a] -> [a]
    nubBy (\(Int, String)
    x (Int, String)
    y -> (Int, String) -> String
    forall a b. (a, b) -> b
    snd (Int, String)
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int, String) -> String
    forall a b. (a, b) -> b
    snd (Int, String)
    y) (((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((String
    "prop_" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) (String -> Bool)
    -> ((Int, String) -> String) -> (Int, String) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, String) -> String
    forall a b. (a, b) -> b
    snd) ([Int] -> [String] -> [(Int, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] [String]
    prefixes))
    #if MIN_VERSION_template_haskell(2,8,0)
          warning String
    x = String -> Q ()
    reportWarning (String
    "Name " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " found in source file but was not in scope")
    #else
          warning x = report False ("Name " ++ x ++ " found in source file but was not in scope")
    #endif
          quickCheckOne :: (Int, String) -> Q [Exp]
          quickCheckOne (Int
    l, String
    x) = do
            exists <- (String -> Q ()
    warning String
    x Q () -> Q Bool -> Q Bool
    forall a b. Q a -> Q b -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False) Q Bool -> Q Bool -> Q Bool
    forall a. Q a -> Q a -> Q a
    `recover` (Name -> Q Info
    reify (String -> Name
    mkName String
    x) Q Info -> Q Bool -> Q Bool
    forall a b. Q a -> Q b -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True)
            if exists
             then sequence
              [ tupE
                [ stringE $ x ++ " from " ++ filename ++ ":" ++ show l
                , [| property |] `appE` monomorphic (mkName x)
                ]
              ]
             else return []
      fmap (ListE . concat) (mapM quickCheckOne idents) `sigE` [t| [(String, Property)] |]

    readUTF8File :: String -> IO String
    readUTF8File String
    name = String -> IOMode -> IO Handle
    S.openFile String
    name IOMode
    S.ReadMode IO Handle -> (Handle -> IO Handle) -> IO Handle
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                        Handle -> IO Handle
    set_utf8_io_enc IO Handle -> (Handle -> IO String) -> IO String
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                        Handle -> IO String
    S.hGetContents

    -- Deal with UTF-8 input and output.
    set_utf8_io_enc :: S.Handle -> IO S.Handle
    #if __GLASGOW_HASKELL__ > 611
    -- possibly if MIN_VERSION_base(4,2,0)
    set_utf8_io_enc :: Handle -> IO Handle
    set_utf8_io_enc Handle
    h = do Handle -> TextEncoding -> IO ()
    S.hSetEncoding Handle
    h TextEncoding
    S.utf8; Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    h
    #else
    set_utf8_io_enc h = return h
    #endif

    -- | Test all properties in the current module.
    -- The name of the property must begin with @prop_@.
    -- Polymorphic properties will be defaulted to 'Integer'.
    -- Returns 'True' if all tests succeeded, 'False' otherwise.
    --
    -- To use 'quickCheckAll', add a definition to your module along
    -- the lines of
    --
    -- > return []
    -- > runTests = $quickCheckAll
    --
    -- and then execute @runTests@.
    --
    -- Note: the bizarre @return []@ in the example above is needed on
    -- GHC 7.8 and later; without it, 'quickCheckAll' will not be able to find
    -- any of the properties. For the curious, the @return []@ is a
    -- Template Haskell splice that makes GHC insert the empty list
    -- of declarations at that point in the program; GHC typechecks
    -- everything before the @return []@ before it starts on the rest
    -- of the module, which means that the later call to 'quickCheckAll'
    -- can see everything that was defined before the @return []@. Yikes!
    quickCheckAll :: Q Exp
    quickCheckAll :: ExpQ
    quickCheckAll = ExpQ
    forAllProperties ExpQ -> ExpQ -> ExpQ
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` [| quickCheckResult |]

    -- | Test all properties in the current module.
    -- This is just a convenience function that combines 'quickCheckAll' and 'verbose'.
    --
    -- 'verboseCheckAll' has the same issue with scoping as 'quickCheckAll':
    -- see the note there about @return []@.
    verboseCheckAll :: Q Exp
    verboseCheckAll :: ExpQ
    verboseCheckAll = ExpQ
    forAllProperties ExpQ -> ExpQ -> ExpQ
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` [| verboseCheckResult |]

    runQuickCheckAll :: [(String, Property)] -> (Property -> IO Result) -> IO Bool
    runQuickCheckAll :: [(String, Property)] -> (Property -> IO Result) -> IO Bool
    runQuickCheckAll [(String, Property)]
    ps Property -> IO Result
    qc =
      ([Bool] -> Bool) -> IO [Bool] -> IO Bool
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and (IO [Bool] -> IO Bool)
    -> (((String, Property) -> IO Bool) -> IO [Bool])
    -> ((String, Property) -> IO Bool)
    -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(String, Property)]
    -> ((String, Property) -> IO Bool) -> IO [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(String, Property)]
    ps (((String, Property) -> IO Bool) -> IO Bool)
    -> ((String, Property) -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \(String
    xs, Property
    p) -> do
        String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "=== " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    xs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " ==="
        r <- Property -> IO Result
    qc Property
    p
        putStrLn ""
        return $ case r of
          Success { } -> Bool
    True
          Failure { } -> Bool
    False
          NoExpectedFailure { } -> Bool
    False
          GaveUp { } -> Bool
    False