    {-# LANGUAGE DeriveDataTypeable, CPP #-}
    -- | A lightweight implementation of a subset of Hspec's API.
    module Test.Hspec (
    -- * Types
      SpecM
    , Spec

    -- * Defining a spec
    , describe
    , context
    , it

    -- ** Setting expectations
    , Expectation
    , expect
    , shouldBe
    , shouldReturn

    -- * Running a spec
    , hspec

    #ifdef TEST
    -- * Internal stuff
    , evaluateExpectation
    , Result (..)
    #endif
    ) where

    #if !(MIN_VERSION_base(4,8,0))
    import           Control.Applicative
    import           Data.Monoid
    #endif

    import           Control.Monad
    import           Data.List (intercalate)
    import           Data.Typeable
    import qualified Control.Exception as E
    import           System.Exit

    -- a writer monad
    data SpecM a = SpecM a [SpecTree]

    add :: SpecTree -> SpecM ()
    add :: SpecTree -> SpecM ()
    add s :: SpecTree
    s = () -> [SpecTree] -> SpecM ()
    forall a. a -> [SpecTree] -> SpecM a
    SpecM () [SpecTree
    s]

    instance Functor SpecM where
      fmap :: (a -> b) -> SpecM a -> SpecM b
    fmap = (a -> b) -> SpecM a -> SpecM b
    forall a. HasCallStack => a
    undefined

    instance Applicative SpecM where
      pure :: a -> SpecM a
    pure a :: a
    a = a -> [SpecTree] -> SpecM a
    forall a. a -> [SpecTree] -> SpecM a
    SpecM a
    a []
      <*> :: SpecM (a -> b) -> SpecM a -> SpecM b
    (<*>) = SpecM (a -> b) -> SpecM a -> SpecM b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad SpecM where
      return :: a -> SpecM a
    return = a -> SpecM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      SpecM a :: a
    a xs :: [SpecTree]
    xs >>= :: SpecM a -> (a -> SpecM b) -> SpecM b
    >>= f :: a -> SpecM b
    f = case a -> SpecM b
    f a
    a of
        SpecM b :: b
    b ys :: [SpecTree]
    ys -> b -> [SpecTree] -> SpecM b
    forall a. a -> [SpecTree] -> SpecM a
    SpecM b
    b ([SpecTree]
    xs [SpecTree] -> [SpecTree] -> [SpecTree]
    forall a. [a] -> [a] -> [a]
    ++ [SpecTree]
    ys)

    data SpecTree = SpecGroup String Spec
                  | SpecExample String (IO Result)

    data Result = Success | Failure String
      deriving (Result -> Result -> Bool
    (Result -> Result -> Bool)
    -> (Result -> Result -> Bool) -> Eq Result
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Result -> Result -> Bool
    $c/= :: Result -> Result -> Bool
    == :: Result -> Result -> Bool
    $c== :: Result -> Result -> Bool
    Eq, Int -> Result -> ShowS
    [Result] -> ShowS
    Result -> String
    (Int -> Result -> ShowS)
    -> (Result -> String) -> ([Result] -> ShowS) -> Show Result
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Result] -> ShowS
    $cshowList :: [Result] -> ShowS
    show :: Result -> String
    $cshow :: Result -> String
    showsPrec :: Int -> Result -> ShowS
    $cshowsPrec :: Int -> Result -> ShowS
    Show)

    type Spec = SpecM ()

    describe :: String -> Spec -> Spec
    describe :: String -> SpecM () -> SpecM ()
    describe label :: String
    label = SpecTree -> SpecM ()
    add (SpecTree -> SpecM ())
    -> (SpecM () -> SpecTree) -> SpecM () -> SpecM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> SpecM () -> SpecTree
    SpecGroup String
    label

    context :: String -> Spec -> Spec
    context :: String -> SpecM () -> SpecM ()
    context = String -> SpecM () -> SpecM ()
    describe

    it :: String -> Expectation -> Spec
    it :: String -> Expectation -> SpecM ()
    it label :: String
    label = SpecTree -> SpecM ()
    add (SpecTree -> SpecM ())
    -> (Expectation -> SpecTree) -> Expectation -> SpecM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO Result -> SpecTree
    SpecExample String
    label (IO Result -> SpecTree)
    -> (Expectation -> IO Result) -> Expectation -> SpecTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Expectation -> IO Result
    evaluateExpectation

    -- | Summary of a test run.
    data Summary = Summary Int Int

    instance Monoid Summary where
      mempty :: Summary
    mempty = Int -> Int -> Summary
    Summary 0 0
    #if !MIN_VERSION_base(4,11,0)
      (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2)
    #else
    instance Semigroup Summary where
      (Summary x1 :: Int
    x1 x2 :: Int
    x2) <> :: Summary -> Summary -> Summary
    <> (Summary y1 :: Int
    y1 y2 :: Int
    y2) = Int -> Int -> Summary
    Summary (Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y1) (Int
    x2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y2)
    #endif

    runSpec :: Spec -> IO Summary
    runSpec :: SpecM () -> IO Summary
    runSpec = [String] -> SpecM () -> IO Summary
    runForrest []
      where
        runForrest :: [String] -> Spec -> IO Summary
        runForrest :: [String] -> SpecM () -> IO Summary
    runForrest labels :: [String]
    labels (SpecM () xs :: [SpecTree]
    xs) = [Summary] -> Summary
    forall a. Monoid a => [a] -> a
    mconcat ([Summary] -> Summary) -> IO [Summary] -> IO Summary
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (SpecTree -> IO Summary) -> [SpecTree] -> IO [Summary]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ([String] -> SpecTree -> IO Summary
    runTree [String]
    labels) [SpecTree]
    xs

        runTree :: [String] -> SpecTree -> IO Summary
        runTree :: [String] -> SpecTree -> IO Summary
    runTree labels :: [String]
    labels spec :: SpecTree
    spec = case SpecTree
    spec of
          SpecExample label :: String
    label x :: IO Result
    x -> do
            String -> Expectation
    putStr (String -> Expectation) -> String -> Expectation
    forall a b. (a -> b) -> a -> b
    $ "/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "/" ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. [a] -> [a]
    reverse) (String
    labelString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    labels) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "/ "
            Result
    r <- IO Result
    x
            case Result
    r of
              Success   -> do
                String -> Expectation
    putStrLn "OK"
                Summary -> IO Summary
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Int -> Summary
    Summary 1 0)
              Failure err :: String
    err -> do
                String -> Expectation
    putStrLn "FAILED"
                String -> Expectation
    putStrLn String
    err
                Summary -> IO Summary
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Int -> Summary
    Summary 1 1)
          SpecGroup label :: String
    label xs :: SpecM ()
    xs  -> do
            [String] -> SpecM () -> IO Summary
    runForrest (String
    labelString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    labels) SpecM ()
    xs

    hspec :: Spec -> IO ()
    hspec :: SpecM () -> Expectation
    hspec spec :: SpecM ()
    spec = do
      Summary total :: Int
    total failures :: Int
    failures <- SpecM () -> IO Summary
    runSpec SpecM ()
    spec
      String -> Expectation
    putStrLn (Int -> String
    forall a. Show a => a -> String
    show Int
    total String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " example(s), " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    failures String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " failure(s)")
      Bool -> Expectation -> Expectation
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    failures Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 0) Expectation
    forall a. IO a
    exitFailure

    type Expectation = IO ()

    infix 1 `shouldBe`, `shouldReturn`

    shouldBe :: (Show a, Eq a) => a -> a -> Expectation
    actual :: a
    actual shouldBe :: a -> a -> Expectation
    `shouldBe` expected :: a
    expected =
      String -> Bool -> Expectation
    expect ("expected: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    expected String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "\n but got: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    actual) (a
    actual a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    expected)

    shouldReturn :: (Show a, Eq a) => IO a -> a -> Expectation
    action :: IO a
    action shouldReturn :: IO a -> a -> Expectation
    `shouldReturn` expected :: a
    expected = IO a
    action IO a -> (a -> Expectation) -> Expectation
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (a -> a -> Expectation
    forall a. (Show a, Eq a) => a -> a -> Expectation
    `shouldBe` a
    expected)

    expect :: String -> Bool -> Expectation
    expect :: String -> Bool -> Expectation
    expect label :: String
    label f :: Bool
    f
      | Bool
    f         = () -> Expectation
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise = ExpectationFailure -> Expectation
    forall e a. Exception e => e -> IO a
    E.throwIO (String -> ExpectationFailure
    ExpectationFailure String
    label)

    data ExpectationFailure = ExpectationFailure String
      deriving (Int -> ExpectationFailure -> ShowS
    [ExpectationFailure] -> ShowS
    ExpectationFailure -> String
    (Int -> ExpectationFailure -> ShowS)
    -> (ExpectationFailure -> String)
    -> ([ExpectationFailure] -> ShowS)
    -> Show ExpectationFailure
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [ExpectationFailure] -> ShowS
    $cshowList :: [ExpectationFailure] -> ShowS
    show :: ExpectationFailure -> String
    $cshow :: ExpectationFailure -> String
    showsPrec :: Int -> ExpectationFailure -> ShowS
    $cshowsPrec :: Int -> ExpectationFailure -> ShowS
    Show, ExpectationFailure -> ExpectationFailure -> Bool
    (ExpectationFailure -> ExpectationFailure -> Bool)
    -> (ExpectationFailure -> ExpectationFailure -> Bool)
    -> Eq ExpectationFailure
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: ExpectationFailure -> ExpectationFailure -> Bool
    $c/= :: ExpectationFailure -> ExpectationFailure -> Bool
    == :: ExpectationFailure -> ExpectationFailure -> Bool
    $c== :: ExpectationFailure -> ExpectationFailure -> Bool
    Eq, Typeable)

    instance E.Exception ExpectationFailure

    evaluateExpectation :: Expectation -> IO Result
    evaluateExpectation :: Expectation -> IO Result
    evaluateExpectation action :: Expectation
    action = (Expectation
    action Expectation -> IO Result -> IO Result
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Result -> IO Result
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    Success)
      IO Result -> [Handler Result] -> IO Result
    forall a. IO a -> [Handler a] -> IO a
    `E.catches` [
      -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT
      -- (ctrl-c).  All AsyncExceptions are re-thrown (not just UserInterrupt)
      -- because all of them indicate severe conditions and should not occur during
      -- normal operation.
        (AsyncException -> IO Result) -> Handler Result
    forall a e. Exception e => (e -> IO a) -> Handler a
    E.Handler ((AsyncException -> IO Result) -> Handler Result)
    -> (AsyncException -> IO Result) -> Handler Result
    forall a b. (a -> b) -> a -> b
    $ \e :: AsyncException
    e -> AsyncException -> IO Result
    forall a e. Exception e => e -> a
    E.throw (AsyncException
    e :: E.AsyncException)

      , (ExpectationFailure -> IO Result) -> Handler Result
    forall a e. Exception e => (e -> IO a) -> Handler a
    E.Handler ((ExpectationFailure -> IO Result) -> Handler Result)
    -> (ExpectationFailure -> IO Result) -> Handler Result
    forall a b. (a -> b) -> a -> b
    $ \(ExpectationFailure err :: String
    err) -> Result -> IO Result
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Result
    Failure String
    err)
      , (SomeException -> IO Result) -> Handler Result
    forall a e. Exception e => (e -> IO a) -> Handler a
    E.Handler ((SomeException -> IO Result) -> Handler Result)
    -> (SomeException -> IO Result) -> Handler Result
    forall a b. (a -> b) -> a -> b
    $ \e :: SomeException
    e -> (Result -> IO Result
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> (String -> Result) -> String -> IO Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Result
    Failure) ("*** Exception: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> String
    forall a. Show a => a -> String
    show (SomeException
    e :: E.SomeException))
      ]