<commit_before>{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module UnitTests.Distribution.Solver.Modular.RetryLog (
  tests
  ) where

import Distribution.Solver.Modular.Message
import Distribution.Solver.Modular.RetryLog
import Distribution.Solver.Types.Progress

import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase, (@?=))

type Log a = Progress a String String

tests :: [TestTree]
tests = [
    testCase "convert to and from RetryLog ending in failure" $
        let lg = Step 1 (Step 2 (Step 3 (Fail "Error")))
        in toProgress (fromProgress lg) @?= (lg :: Log Int)

  , testCase "convert to and from RetryLog ending in success" $
        let lg = Step 1 (Step 2 (Step 3 (Done "Result")))
        in toProgress (fromProgress lg) @?= (lg :: Log Int)

  , testCase "retry with failure" $
        let log1 = fromProgress $ Step 1 (Step 2 (Fail "Error 1"))
            log2 = fromProgress $ Step 3 (Step 4 (Fail "Error 2"))
        in toProgress (retry log1 (const log2))
           @?= (Step 1 (Step 2 (Step 3 (Step 4 (Fail "Error 2")))) :: Log Int)

  , testCase "retry with success" $
        let lg1 = fromProgress $ Step 1 (Step 2 (Done "Done"))
            lg2 = fromProgress $ Step 3 (Step 4 (Fail "Error"))
        in toProgress (retry lg1 (const lg2))
           @?= (Step 1 (Step 2 (Done "Done")) :: Log Int)

  , testCase "failWith" $
        toProgress (failWith 1 "Error") @?= (Step 1 (Fail "Error") :: Log Int)

  , testCase "succeedWith" $
        toProgress (succeedWith 1 "Result")
        @?= (Step 1 (Done "Result") :: Log Int)

  , testCase "continueWith" $
        let failure = Fail "Error"
        in toProgress (continueWith 1 $ fromProgress failure)
           @?= (Step 1 failure :: Log Int)

  , testCase "tryWith with failure" $
        let failure = Fail "Error"
            s = Step Success
        in toProgress (tryWith Success $ fromProgress (s (s failure)))
           @?= (s (Step Enter (s (s (Step Leave failure)))) :: Log Message)

  , testCase "tryWith with success" $
        let done = Done "Done"
            s = Step Success
        in toProgress (tryWith Success $ fromProgress (s (s done)))
           @?= (s (Step Enter (s (s done))) :: Log Message)
  ]

deriving instance (Eq step, Eq fail, Eq done) => Eq (Progress step fail done)

deriving instance (Show step, Show fail, Show done)
    => Show (Progress step fail done)
<commit_msg>Convert some tests to QuickCheck properties.<commit_after>{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module UnitTests.Distribution.Solver.Modular.RetryLog (
  tests
  ) where

import Distribution.Solver.Modular.Message
import Distribution.Solver.Modular.RetryLog
import Distribution.Solver.Types.Progress

import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase, (@?=))
import Test.Tasty.QuickCheck
         ( Arbitrary(..), Blind(..), listOf, oneof, testProperty, (===))

type Log a = Progress a String String

tests :: [TestTree]
tests = [
    testProperty "'toProgress . fromProgress' is identity" $ \p ->
        toProgress (fromProgress p) === (p :: Log Int)

  , testProperty "'mapFailure f' is like 'foldProgress Step (Fail . f) Done'" $
        let mapFailureProgress f = foldProgress Step (Fail . f) Done
        in \(Blind f) p ->
               toProgress (mapFailure f (fromProgress p))
               === mapFailureProgress (f :: String -> Int) (p :: Log Int)

  , testProperty "'retry p f' is like 'foldProgress Step f Done p'" $
      \p (Blind f) ->
        toProgress (retry (fromProgress p) (fromProgress . f))
        === (foldProgress Step f Done (p :: Log Int) :: Log Int)

  , testProperty "failWith" $ \step failure ->
        toProgress (failWith step failure)
        === (Step step (Fail failure) :: Log Int)

  , testProperty "succeedWith" $ \step success ->
        toProgress (succeedWith step success)
        === (Step step (Done success) :: Log Int)

  , testProperty "continueWith" $ \step p ->
        toProgress (continueWith step (fromProgress p))
        === (Step step p :: Log Int)

  , testCase "tryWith with failure" $
        let failure = Fail "Error"
            s = Step Success
        in toProgress (tryWith Success $ fromProgress (s (s failure)))
           @?= (s (Step Enter (s (s (Step Leave failure)))) :: Log Message)

  , testCase "tryWith with success" $
        let done = Done "Done"
            s = Step Success
        in toProgress (tryWith Success $ fromProgress (s (s done)))
           @?= (s (Step Enter (s (s done))) :: Log Message)
  ]

instance (Arbitrary step, Arbitrary fail, Arbitrary done)
    => Arbitrary (Progress step fail done) where
  arbitrary = do
    steps <- listOf arbitrary
    end <- oneof [Fail `fmap` arbitrary, Done `fmap` arbitrary]
    return $ foldr Step end steps

deriving instance (Eq step, Eq fail, Eq done) => Eq (Progress step fail done)

deriving instance (Show step, Show fail, Show done)
    => Show (Progress step fail done)

{'fraction_non_alphanumeric': 0.12344689378757515, 'fraction_numerical': 0.007414829659318637, 'mean_word_length': 2.7810606060606062, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 15, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1219721', 'n_tokens_mistral': 1556, 'n_tokens_neox': 1502, 'n_words': 556}