content: {-# LANGUAGE OverloadedStrings #-}
  
  module Grisette.Lib.Control.ApplicativeTest
    ( applicativeFunctionTests,
    )
  where
  
  import Control.Applicative (Alternative (empty))
  import Control.Monad.State
    ( MonadState (get, put),
      MonadTrans (lift),
      StateT (runStateT),
    )
  import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
  import Grisette
    ( AsKey1,
      SymBranching (mrgIfPropagatedStrategy),
      Union,
      mrgAsum,
      mrgEmpty,
      mrgPure,
      mrgReturn,
      mrgSingle,
    )
  import Grisette.Lib.Control.Applicative
    ( mrgLiftA,
      mrgLiftA2,
      mrgLiftA3,
      mrgMany,
      mrgOptional,
      mrgSome,
      (.*>),
      (.<*),
      (.<**>),
      (.<*>),
      (.<|>),
    )
  import Grisette.TestUtil.NoMerge
    ( NoMerge (NoMerge),
      noMergeNotMerged,
      oneNotMerged,
    )
  import Grisette.TestUtil.SymbolicAssertion ((.@?=))
  import Test.Framework
    ( Test,
      TestOptions' (topt_timeout),
      plusTestOptions,
      testGroup,
    )
  import Test.Framework.Providers.HUnit (testCase)
  import Test.HUnit ((@?=))
  
  applicativeFunctionTests :: Test
  applicativeFunctionTests =
    testGroup
      "Applicative"
      [ testCase "mrgPure" $ (mrgPure 1 :: Union Integer) .@?= mrgSingle 1,
        testGroup
          ".<*>"
          [ testCase "merge result" $ do
              let actual =
                    (return (\x -> x * x))
                      .<*> mrgIfPropagatedStrategy "a" (return $ -1) (return 1)
              actual .@?= (mrgSingle 1 :: Union Integer),
            testCase "merge arguments" $ do
              let actual = (return (const NoMerge)) .<*> oneNotMerged
              actual @?= (mrgSingle NoMerge :: AsKey1 Union NoMerge)
          ],
        testGroup
          "mrgLiftA2"
          [ testCase "merge result" $ do
              let actual =
                    mrgLiftA2 (const $ const 1) noMergeNotMerged noMergeNotMerged
              let expected = mrgPure 1 :: AsKey1 Union Int
              actual .@?= expected,
            testCase "merge argument" $ do
              let actual =
                    mrgLiftA2 (const $ const NoMerge) oneNotMerged oneNotMerged
              let expected = mrgPure NoMerge
              actual @?= expected
          ],
        testGroup
          ".*>"
          [ testCase "merge result" $
              noMergeNotMerged .*> oneNotMerged .@?= mrgSingle 1,
            testCase "merge arguments" $
              oneNotMerged .*> return NoMerge @?= mrgSingle NoMerge
          ],
        testGroup
          ".<*"
          [ testCase "merge result" $
              oneNotMerged .<* noMergeNotMerged .@?= mrgSingle 1,
            testCase "merge arguments" $
              return NoMerge .<* oneNotMerged @?= mrgSingle NoMerge
          ],
        testCase "mrgEmpty" $
          (mrgEmpty :: MaybeT Union Integer) .@?= MaybeT (mrgReturn Nothing),
        testGroup
          ".<|>"
          [ testCase "merge result" $
              return 1 .<|> return 2 .@?= (mrgSingle 1 :: MaybeT Union Integer),
            testCase "merge lhs" $ do
              let lhs =
                    MaybeT $
                      mrgIfPropagatedStrategy "a" (return Nothing) (return Nothing)
              let expected = mrgSingle NoMerge :: MaybeT Union NoMerge
              lhs .<|> return NoMerge @?= expected
          ],
        plusTestOptions (mempty {topt_timeout = Just (Just 1000000)}) $
          testGroup
            "mrgSome"
            [ testCase "merge" $
                runStateT (mrgSome f) 100 .@?= (mrgSingle (replicate 100 (), 0)),
              testCase "single" $
                runStateT (mrgSome f) 1 .@?= (mrgSingle ([()], 0)),
              testCase "zero" $
                runStateT (mrgSome f) 0 .@?= MaybeT (mrgReturn Nothing)
            ],
        plusTestOptions (mempty {topt_timeout = Just (Just 1000000)}) $
          testGroup
            "mrgMany"
            [ testCase "merge" $
                runStateT (mrgMany f) 100 .@?= (mrgSingle (replicate 100 (), 0)),
              testCase "single" $
                runStateT (mrgMany f) 1 .@?= (mrgSingle ([()], 0)),
              testCase "zero" $
                runStateT (mrgMany f) 0 .@?= (mrgSingle ([], 0))
            ],
        testGroup
          ".<**>"
          [ testCase "merge result" $ do
              let actual =
                    mrgIfPropagatedStrategy "a" (return $ -1) (return 1)
                      .<**> (return (\x -> x * x))
              actual .@?= (mrgSingle 1 :: AsKey1 Union Integer),
            testCase "merge arguments" $ do
              let actual = oneNotMerged .<**> (return (const NoMerge))
              actual @?= (mrgSingle NoMerge :: AsKey1 Union NoMerge)
          ],
        testGroup
          "mrgLiftA"
          [ testCase "merge result" $ do
              let actual = mrgLiftA (const 1) noMergeNotMerged
              let expected = mrgReturn 1 :: AsKey1 Union Int
              actual .@?= expected,
            testCase "merge argument" $ do
              let actual = mrgLiftA (const NoMerge) oneNotMerged
              let expected = mrgReturn NoMerge
              actual @?= expected
          ],
        testGroup
          "mrgLiftA3"
          [ testCase "merge result" $ do
              let actual =
                    mrgLiftA3
                      (const $ const $ const 1)
                      noMergeNotMerged
                      noMergeNotMerged
                      noMergeNotMerged
              let expected = mrgReturn 1 :: AsKey1 Union Int
              actual .@?= expected,
            testCase "merge argument" $ do
              let actual =
                    mrgLiftA3
                      (const $ const $ const NoMerge)
                      oneNotMerged
                      oneNotMerged
                      oneNotMerged
              let expected = mrgReturn NoMerge
              actual @?= expected
          ],
        testGroup
          "mrgOptional"
          [ testCase "one" $ do
              let actual =
                    mrgOptional
                      ( MaybeT $
                          mrgIfPropagatedStrategy
                            "a"
                            (return $ Just 1)
                            (return $ Just 1)
                      )
              let expected = mrgSingle (Just 1) :: MaybeT Union (Maybe Int)
              actual .@?= expected,
            testCase "none" $ do
              let actual =
                    mrgOptional
                      ( MaybeT $
                          mrgIfPropagatedStrategy "a" (return Nothing) (return Nothing)
                      )
              let expected = mrgSingle Nothing :: MaybeT Union (Maybe Int)
              actual .@?= expected
          ],
        plusTestOptions (mempty {topt_timeout = Just (Just 1000000)}) $
          testGroup
            "mrgAsum"
            [ testCase "merge" $ do
                let none =
                      MaybeT $
                        mrgIfPropagatedStrategy "a" (return Nothing) (return Nothing)
                let expected =
                      MaybeT (mrgSingle Nothing) ::
                        MaybeT Union (Maybe Int)
                mrgAsum (replicate 100 none) .@?= expected,
              testCase "semantics" $ do
                (mrgAsum [mrgEmpty, mrgEmpty] :: MaybeT Union Integer)
                  .@?= mrgEmpty
                (mrgAsum [mrgPure 1, mrgEmpty] :: MaybeT Union Integer)
                  .@?= mrgPure 1
                (mrgAsum [mrgEmpty, mrgPure 1] :: MaybeT Union Integer)
                  .@?= mrgPure 1
                (mrgAsum [mrgPure 2, mrgPure 1] :: MaybeT Union Integer)
                  .@?= mrgPure 2
            ]
      ]
  
  f :: StateT Int (MaybeT Union) ()
  f = do
    i <- get
    if (i == 0)
      then empty
      else do
        put (i - 1)
        lift . lift $
          mrgIfPropagatedStrategy "a" (return ()) (return ())
  