GetDataTest.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

{- HLINT ignore "Unused LANGUAGE pragma" -}

module Grisette.Unified.GetDataTest (getDataTest) where

import Data.Functor.Identity (Identity (Identity))
import Grisette
  ( DeriveConfig (evalModeConfig),
    EvalModeConfig (EvalModeConstraints),
    Union,
    basicClasses0,
    deriveWith,
  )
import Grisette.TestUtil.SymbolicAssertion ((.@?=))
import Grisette.Unified (EvalModeBase, EvalModeInteger, EvalModeTag (S), GetBool, GetData, GetInteger, mrgIf, mrgIte)
import Grisette.Unified.Lib.Control.Monad (mrgReturn)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit ((@?=))

#if MIN_VERSION_base(4,16,0)
data A mode = A (GetData mode Integer) (GetInteger mode)

deriveWith
  mempty
    { evalModeConfig =
        [(0, EvalModeConstraints [''EvalModeBase, ''EvalModeInteger])]
    }
  [''A]
  basicClasses0

mrgIfFunc ::
  (EvalModeBase mode, EvalModeInteger mode) =>
  GetBool mode ->
  GetData mode (A mode) ->
  GetData mode (A mode) ->
  GetData mode (A mode)
mrgIfFunc = mrgIf

getDataTest :: Test
getDataTest =
  testGroup
    "GetData"
    [ testCase "mrgIf C" $ do
        let a = Identity (A (Identity 1) 2)
        let b = Identity (A (Identity 2) 3)
        mrgIfFunc True a b @?= a,
      testCase "mrgIf S" $ do
        let a = mrgReturn (A (mrgReturn 1) "a") :: Union (A 'S)
        let b = mrgReturn (A (mrgReturn 2) "b") :: Union (A 'S)
        mrgIfFunc @'S "x" a b
          .@?= mrgReturn
            ( A
                (mrgIf @'S "x" 1 2)
                (mrgIte @'S "x" "a" "b")
            )
    ]
#else
getDataTest = testGroup "GetData" []
#endif