<commit_before>{-# LANGUAGE OverloadedStrings
           , DataKinds
           , FlexibleContexts
           #-}

module Tests.Simplify where

import Language.Hakaru.Types.DataKind
import Language.Hakaru.Types.Sing
import Language.Hakaru.Types.Coercion
import Language.Hakaru.Types.HClasses
import Language.Hakaru.Syntax.ABT
import Language.Hakaru.Syntax.AST
import Language.Hakaru.Simplify

import Language.Hakaru.Syntax.AST.Eq()

import Test.HUnit

v :: (ABT Term abt) => abt '[] 'HNat
v = var (Variable "x" 0 SNat)

freevar :: TrivialABT Term '[] 'HNat
freevar = v

normal01T :: TrivialABT Term '[] ('HMeasure 'HReal)
normal01T = syn (MeasureOp_ Normal
                 :$ syn (CoerceTo_ (CCons (Continuous HContinuous_Real) CNil) :$
                           (syn (Literal_ (LInt (-2))) :* End))
                 :* syn (CoerceTo_ (CCons (Continuous HContinuous_Prob) CNil) :$
                           (syn (Literal_ (LNat 1)) :* End))
                 :* End)

testSimplify :: ( ABT Term abt
                , Show (abt '[] a)
                , Eq   (abt '[] a))
               => abt '[] a -> abt '[] a -> Assertion
testSimplify x y = do
  x' <- simplify x
  assertEqual "" x' y 

allTests :: Test
allTests = test
   [ testSimplify freevar freevar
   , testSimplify normal01T normal01T
   ]<commit_msg>Adding failing tests<commit_after>{-# LANGUAGE OverloadedStrings
           , DataKinds
           , FlexibleContexts
           #-}

module Tests.Simplify where

import Prelude hiding ((>>=))

import Language.Hakaru.Types.DataKind
import Language.Hakaru.Types.Sing
import Language.Hakaru.Types.Coercion
import Language.Hakaru.Types.HClasses
import Language.Hakaru.Syntax.ABT
import Language.Hakaru.Syntax.AST
import Language.Hakaru.Syntax.Prelude
import Language.Hakaru.Simplify

import Language.Hakaru.Syntax.AST.Eq()

import Test.HUnit

v :: (ABT Term abt) => abt '[] 'HNat
v = var (Variable "x" 0 SNat)

freevar :: TrivialABT Term '[] 'HNat
freevar = v

normal01T :: TrivialABT Term '[] ('HMeasure 'HReal)
normal01T = syn (MeasureOp_ Normal
                 :$ syn (CoerceTo_ (CCons (Continuous HContinuous_Real) CNil) :$
                           (syn (Literal_ (LInt (-2))) :* End))
                 :* syn (CoerceTo_ (CCons (Continuous HContinuous_Prob) CNil) :$
                           (syn (Literal_ (LNat 1)) :* End))
                 :* End)

realpair :: TrivialABT Term '[] ('HMeasure (HPair 'HReal 'HReal))
realpair = ann_ (SMeasure $ sPair SReal SReal)
                (dirac (pair (real_ 1) (real_ 2)))

unifprob :: TrivialABT Term '[] ('HMeasure 'HProb)
unifprob = uniform (real_ 1) (real_ 2) >>= \x -> dirac (unsafeProb x)

testSimplify :: ( ABT Term abt
                , Show (abt '[] a)
                , Eq   (abt '[] a))
               => abt '[] a -> abt '[] a -> Assertion
testSimplify x y = do
  x' <- simplify x
  assertEqual "" x' y 

allTests :: Test
allTests = test
   [ testSimplify freevar freevar
   , testSimplify normal01T normal01T
   , testSimplify realpair realpair
   , testSimplify unifprob unifprob
   ]
{'fraction_non_alphanumeric': 0.12030075187969924, 'fraction_numerical': 0.008499509643674403, 'mean_word_length': 2.5091743119266057, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 16, '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': '3679091', 'n_tokens_mistral': 1087, 'n_tokens_neox': 1004, 'n_words': 269}