<commit_before>{-# LANGUAGE PatternGuards, FlexibleContexts, TypeFamilies, ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

module Test.Oracle(main) where

import Development.Shake
import Development.Shake.Classes
import General.GetOpt
import Test.Type hiding (RandomType)
import qualified Test.Type as T
import Control.Monad

type instance RuleResult String = Bool
type instance RuleResult Bool = String
type instance RuleResult Int = String
type instance RuleResult () = String

newtype RandomType = RandomType (BinarySentinel String)
    deriving (Eq,Show,NFData,Typeable,Hashable,Binary)

type instance RuleResult RandomType = ()
type instance RuleResult T.RandomType = ()

data Opt = Plus String | Star String | At String | Perc String | Bang String
opts = [f "plus" Plus, f "star" Star, f "at" At, f "perc" Perc, f "bang" Bang]
    where f s con = Option "" [s] (ReqArg (Right . con) "") ""

main = shakeTest test opts $ \args -> do
    addOracle $ \(T.RandomType _) -> return ()
    addOracle $ \(RandomType _) -> return ()
    action $ do
        askOracle $ T.RandomType $ BinarySentinel ()
        askOracle $ RandomType $ BinarySentinel ()

    let f :: (ShakeValue q, ShakeValue (RuleResult q)) => String -> q -> RuleResult q -> (String, (Rules (), Rules ()))
        f name lhs rhs = (,) name
            (do addOracle $ \k -> let _ = k `asTypeOf` lhs in return rhs; return ()
            ,let o = name ++ ".txt" in do want [o]; o %> \_ -> do v <- askOracleWith lhs rhs; writeFile' o $ show v)
    let tbl = [f "str-bool" "" True
              -- ,f "str-int" "" (0::Int)
              ,f "bool-str" True ""
              ,f "int-str" (0::Int) ""]

    forM_ args $ \a -> case a of
        Plus x | Just (add,_) <- lookup x tbl -> add
        Star x | Just (_,use) <- lookup x tbl -> use
        At key -> do addOracle $ \() -> return key; return ()
        Perc name -> let o = "unit.txt" in do want [o]; o %> \_ -> do {askOracleWith () ""; writeFile' o name}
        Bang name -> do want ["rerun"]; "rerun" %> \out -> do alwaysRerun; writeFile' out name

test build = do
    build ["clean"]

    -- check it rebuilds when it should
    build ["--at=key","--perc=name"]
    assertContents "unit.txt" "name"
    build ["--at=key","--perc=test"]
    assertContents "unit.txt" "name"
    build ["--at=foo","--perc=test"]
    assertContents "unit.txt" "test"

    -- check adding/removing redundant oracles does not trigger a rebuild
    build ["--at=foo","--perc=newer","--plus=str-bool"]
    assertContents "unit.txt" "test"
    build ["--at=foo","--perc=newer","--plus=int-str"]
    assertContents "unit.txt" "test"
    build ["--at=foo","--perc=newer"]
    assertContents "unit.txt" "test"

    -- check always run works
    build ["--bang=foo"]
    assertContents "rerun" "foo"
    build ["--bang=bar"]
    assertContents "rerun" "bar"

    -- check error messages are good
    let errors args err = assertException [err] $ build $ "--quiet" : args

    build ["--plus=str-bool","--star=str-bool"]
    errors ["--star=str-bool"] -- Building with an an Oracle that has been removed
        "missing a call to addOracle"

    errors ["--star=bool-str"] -- Building with an Oracle that I know nothing about
        "missing a call to addOracle"
<commit_msg>Delete the Oracle Bang test - had nothing to do with Oracle, now moved to basic<commit_after>{-# LANGUAGE PatternGuards, FlexibleContexts, TypeFamilies, ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

module Test.Oracle(main) where

import Development.Shake
import Development.Shake.Classes
import General.GetOpt
import Test.Type hiding (RandomType)
import qualified Test.Type as T
import Control.Monad

type instance RuleResult String = Bool
type instance RuleResult Bool = String
type instance RuleResult Int = String
type instance RuleResult () = String

newtype RandomType = RandomType (BinarySentinel String)
    deriving (Eq,Show,NFData,Typeable,Hashable,Binary)

type instance RuleResult RandomType = ()
type instance RuleResult T.RandomType = ()

data Opt = Plus String | Star String | At String | Perc String
opts = [f "plus" Plus, f "star" Star, f "at" At, f "perc" Perc]
    where f s con = Option "" [s] (ReqArg (Right . con) "") ""

main = shakeTest test opts $ \args -> do
    addOracle $ \(T.RandomType _) -> return ()
    addOracle $ \(RandomType _) -> return ()
    action $ do
        askOracle $ T.RandomType $ BinarySentinel ()
        askOracle $ RandomType $ BinarySentinel ()

    let f :: (ShakeValue q, ShakeValue (RuleResult q)) => String -> q -> RuleResult q -> (String, (Rules (), Rules ()))
        f name lhs rhs = (,) name
            (do addOracle $ \k -> let _ = k `asTypeOf` lhs in return rhs; return ()
            ,let o = name ++ ".txt" in do want [o]; o %> \_ -> do v <- askOracleWith lhs rhs; writeFile' o $ show v)
    let tbl = [f "str-bool" "" True
              -- ,f "str-int" "" (0::Int)
              ,f "bool-str" True ""
              ,f "int-str" (0::Int) ""]

    forM_ args $ \a -> case a of
        Plus x | Just (add,_) <- lookup x tbl -> add
        Star x | Just (_,use) <- lookup x tbl -> use
        At key -> do addOracle $ \() -> return key; return ()
        Perc name -> let o = "unit.txt" in do want [o]; o %> \_ -> do {askOracleWith () ""; writeFile' o name}

test build = do
    build ["clean"]

    -- check it rebuilds when it should
    build ["--at=key","--perc=name"]
    assertContents "unit.txt" "name"
    build ["--at=key","--perc=test"]
    assertContents "unit.txt" "name"
    build ["--at=foo","--perc=test"]
    assertContents "unit.txt" "test"

    -- check adding/removing redundant oracles does not trigger a rebuild
    build ["--at=foo","--perc=newer","--plus=str-bool"]
    assertContents "unit.txt" "test"
    build ["--at=foo","--perc=newer","--plus=int-str"]
    assertContents "unit.txt" "test"
    build ["--at=foo","--perc=newer"]
    assertContents "unit.txt" "test"

    -- check error messages are good
    let errors args err = assertException [err] $ build $ "--quiet" : args

    build ["--plus=str-bool","--star=str-bool"]
    errors ["--star=str-bool"] -- Building with an an Oracle that has been removed
        "missing a call to addOracle"

    errors ["--star=bool-str"] -- Building with an Oracle that I know nothing about
        "missing a call to addOracle"

{'fraction_non_alphanumeric': 0.14800936768149883, 'fraction_numerical': 0.000624512099921936, 'mean_word_length': 2.819916517590936, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 42, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '763940', 'n_tokens_mistral': 2068, 'n_tokens_neox': 2002, 'n_words': 683}