{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-} {-# LANGUAGE TypeOperators, DataKinds #-} {-# LANGUAGE TemplateHaskell #-} module Control.Eff.NdetEff.Test (testGroups, gen_testCA, gen_ifte_test) where import Test.HUnit hiding (State) import Control.Applicative import Control.Eff import Control.Eff.NdetEff import Control.Eff.Writer.Strict import Control.Monad (msum, guard, mzero, mplus) import Utils import Test.Framework.TH import Test.Framework.Providers.HUnit testGroups = [ $(testGroupGenerator) ] -- TODO: add quickcheck test to test conformance of different -- implementations of 'makeChoiceA' and 'msplit'. -- TODO: add benchmarks for different implementations of 'makeChoiceA' -- and 'msplit'. gen_testCA :: (Integral a) => a -> Eff (NdetEff ': r) a gen_testCA x = do i <- msum . fmap return $ [1..x] guard (i `mod` 2 == 0) return i case_NdetEff_testCA :: Assertion case_NdetEff_testCA = [2, 4..10] @=? (run $ makeChoiceA (gen_testCA 10)) gen_ifte_test x = do n <- gen x ifte (do d <- gen x guard $ d < n && n `mod` d == 0 -- _ <- trace ("d: " ++ show d) (return ()) ) (\_ -> mzero) (return n) where gen x = msum . fmap return $ [2..x] case_NdetEff_ifte :: Assertion case_NdetEff_ifte = let primes = ifte_test_run in assertEqual "NdetEff: test ifte using primes" [2,3,5,7,11,13,17,19,23,29] primes where ifte_test_run :: [Int] ifte_test_run = run . makeChoiceA $ (gen_ifte_test 30) -- called reflect in the LogicT paper case_NdetEff_reflect :: Assertion case_NdetEff_reflect = let tsplitr10 = run $ runListWriter $ makeChoiceA tsplit tsplitr11 = run $ runListWriter $ makeChoiceA (msplit tsplit >>= reflect) tsplitr20 = run $ makeChoiceA $ runListWriter tsplit tsplitr21 = run $ makeChoiceA $ runListWriter (msplit tsplit >>= reflect) in assertEqual "tsplitr10" expected1 tsplitr10 >> assertEqual "tsplitr11" expected1 tsplitr11 >> assertEqual "tsplitr20" expected2 tsplitr20 >> assertEqual "tsplitr21" expected21 tsplitr21 where expected1 = ([1, 2],["begin", "end"]) expected2 = [(1, ["begin"]), (2, ["end"])] expected21 = [(1, ["begin"]), (2, ["begin", "end"])] tsplit = (tell "begin" >> return 1) `mplus` (tell "end" >> return 2) case_NdetEff_monadBaseControl :: Assertion case_NdetEff_monadBaseControl = runLift (makeChoiceA $ doThing (return 1 <|> return 2)) @=? Just [1,2]