content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  module Clash.Tests.MaybeX where
  
  import Clash.XException (errorX)
  import Clash.XException.MaybeX (MaybeX(IsX, IsDefined), toMaybeX)
  
  #if !MIN_VERSION_base(4,18,0)
  import Control.Applicative (liftA2)
  #endif
  import Test.Tasty
  import Test.Tasty.HUnit
  import Test.Tasty.TH
  
  data ABC = A | B Int deriving Show
  
  x :: MaybeX a
  x = errorX "X"
  
  isX :: MaybeX a -> Bool
  isX = \case
    IsDefined {} -> False
    IsX {} -> True
  
  isDefined :: MaybeX a -> Bool
  isDefined = not . isX
  
  case_showNoParens :: Assertion
  case_showNoParens = show (toMaybeX A) @?= "IsDefined A"
  
  case_showParens :: Assertion
  case_showParens = show (toMaybeX (B 0)) @?= "IsDefined (B 0)"
  
  case_pureDefined :: Assertion
  case_pureDefined = assertBool "defined value resolves to IsDefined" (isDefined (pure 'a'))
  
  case_pureX :: Assertion
  case_pureX = assertBool "pure catches X" (isX (pure x))
  
  case_Fmap :: Assertion
  case_Fmap = assertBool "fmap" (isDefined (const () <$> pure 'a'))
  
  case_strictFmap :: Assertion
  case_strictFmap = assertBool "fmap is strict in X" (isX (const () <$> pure x))
  
  case_liftA2 :: Assertion
  case_liftA2 = assertBool "liftA2"  (isDefined (liftA2 (\_ _ -> ()) (pure 'a') (pure 'b')))
  
  case_strictLiftA2 :: Assertion
  case_strictLiftA2 = do
    assertBool "liftA2 is strict in X (left)"  (isX (liftA2 (\_ _ -> ()) (pure x) (pure 'b')))
    assertBool "liftA2 is strict in X (right)" (isX (liftA2 (\_ _ -> ()) (pure 'a') (pure x)))
    assertBool "liftA2 is strict in X (both)"  (isX (liftA2 (\_ _ -> ()) (pure x) (pure x)))
  
  tests :: TestTree
  tests = $(testGroupGenerator)
  