content: {-
    Copyright (c) Meta Platforms, Inc. and affiliates.
    All rights reserved.
  
    This source code is licensed under the BSD-style license found in the
    LICENSE file in the root directory of this source tree.
  -}
  
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module ExceptionStackTests (tests) where
  
  import Prelude ()
  import Haxl.Core
  import Haxl.Prelude
  
  import Test.HUnit
  
  import qualified ExampleDataSource
  
  testEnv :: ReportFlags -> IO (Env () ())
  testEnv report = do
    exstate <- ExampleDataSource.initGlobalState
    let st = stateSet exstate stateEmpty
    env <- initEnv st ()
    return env{ flags = (flags env){ report = report } }
  
  reportFlags :: ReportFlags
  reportFlags = setReportFlag ReportExceptionLabelStack defaultReportFlags
  
  runHaxlTest
    :: ReportFlags
    -> String
    -> (Int -> Int -> GenHaxl () () Int)
    -> IO (Maybe [Text])
  runHaxlTest report str func = do
    env <- testEnv report
    result <- runHaxl env $
      withLabel "try" $ tryToHaxlException $ withLabel "test" $ do
        x <- withLabel "dummy" $ pure 1
        y <- withLabel "fetch" $ ExampleDataSource.countAardvarks str
        withLabel "func" $ func x y
    case result of
      Left (HaxlException stk _) -> return stk
      Right{} -> assertFailure "expected: HaxlException"
  
  fetchException :: Test
  fetchException = TestCase $ do
    result <- runHaxlTest reportFlags "BANG4" $ \i j -> return $ i + j
    assertEqual "stack" (Just ["fetch", "test", "try", "MAIN"]) result
  
  userException :: Test
  userException = TestCase $ do
    result <- runHaxlTest reportFlags "aaa" $ \_ _ -> withLabel "throw" $
      throw $ InvalidParameter "throw"
    assertEqual "stack" (Just ["throw", "func", "test", "try", "MAIN"]) result
  
  #ifndef PROFILING
  disabledExceptionStack :: Test
  disabledExceptionStack = TestCase $ do
    result <- runHaxlTest defaultReportFlags "BANG4" $ \i j -> return $ i + j
    assertEqual "stack" Nothing result
  #endif
  
  tests :: Test
  tests = TestList
    [ TestLabel "FetchException" fetchException
    , TestLabel "UserException" userException
  #ifndef PROFILING
    , TestLabel "DisabledExceptionStack"  disabledExceptionStack
  #endif
    ]
  