<commit_before>{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Ivory.HXStream.Test where

import Control.Monad (replicateM)
import Data.Word
import Data.String (fromString)

import Ivory.HXStream
import Ivory.Language
import Ivory.Stdlib
import Ivory.Compile.C.CmdlineFrontend

import qualified Test.QuickCheck as Q

--------------------------------------------------------------------------------

puts :: Def ('[IString] :-> ())
puts = importProc "printf" "stdio.h"

testReport :: Def ('[IBool] :-> ())
testReport = proc "testReport " $ \b -> body $
  ifte_ b (c "pass") (c "fail")
  where
  c msg = call_ puts (fromString (msg ++ "\n"))

instance Q.Arbitrary Uint8 where
  arbitrary = fmap fromIntegral (Q.arbitrary :: Q.Gen Word8)

-- List that is is 128 bytes or less and an index into the list.
sampleArrayIx :: Q.Gen [Uint8]
sampleArrayIx = do
  let item = Q.frequency [(1, return 0x7e), (1,return 0x7c) ,(8, Q.arbitrary) ]
  arr <- Q.vectorOf 128 item
  return arr

runTest :: (GetAlloc eff ~ Scope s)
        => [Uint8] -> Ivory eff ()
runTest ls = do
  input   <- local $ iarray (map ival ls)
  encoded <- local $ iarray (replicate 259 (ival 0))
  decoded <- local $ iarray (replicate 128 (ival 0))
  call_ encode (constRef input)   encoded
  call_ decode (constRef encoded) decoded

  b <- local (ival true)
  arrayMap $ \i -> do
    when ((decoded ! i) ==? (input ! i))
         (store b false)

  b' <- deref b
  call_ testReport b'

encode :: Def('[ ConstRef s (Array 128 (Stored Uint8))
               , Ref ss (Array 259 (Stored Uint8))
               ] :-> ())
encode = proc "hxstream_test_encode" $ \ pt framed -> body $ do
  writeix <- local (ival 0)
  let cb v = do
        ix <- deref writeix
        store (framed ! ix) v
        store writeix (ix + 1)
  noReturn $ encodeToBS 0 pt cb

decode :: Def('[ ConstRef s (Array 259 (Stored Uint8))
               , Ref ss (Array 128 (Stored Uint8))
               ] :-> ())
decode = proc "hxstream_test_decode" $ \ framed pt -> body $ do
  hx <- local hx_ival
  runs <- local (ival (0::Uint32))
  ends <- local (ival (0::Uint32))
  let handler = FrameHandler
        { fh_tag = 0
        , fh_begin = do<commit_msg>ivory hx stream: fix test (previously all tests were totally invalid)<commit_after>{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Ivory.HXStream.Test where

import Control.Monad (replicateM)
import Data.Word
import Data.String (fromString)

import Ivory.HXStream
import Ivory.Language
import Ivory.Stdlib
import Ivory.Compile.C.CmdlineFrontend

import qualified Test.QuickCheck as Q

--------------------------------------------------------------------------------

puts :: Def ('[IString] :-> ())
puts = importProc "printf" "stdio.h"

testReport :: Def ('[IBool] :-> ())
testReport = proc "testReport " $ \b -> body $
  ifte_ b (c "pass") (c "fail")
  where
  c msg = call_ puts (fromString (msg ++ "\n"))

instance Q.Arbitrary Uint8 where
  arbitrary = fmap fromIntegral (Q.arbitrary :: Q.Gen Word8)

-- List that is is 128 bytes or less and an index into the list.
sampleArrayIx :: Q.Gen [Uint8]
sampleArrayIx = do
  let item = Q.frequency [(1, return 0x7e), (1,return 0x7c) ,(8, Q.arbitrary) ]
  arr <- Q.vectorOf 128 item
  return arr

runTest :: (GetAlloc eff ~ Scope s)
        => [Uint8] -> Ivory eff ()
runTest ls = do
  input   <- local $ iarray (map ival ls)
  encoded <- local $ iarray (replicate 259 (ival 0))
  decoded <- local $ iarray (replicate 128 (ival 0))
  call_ encode (constRef input)   encoded
  call_ decode (constRef encoded) decoded

  b <- local (ival true)
  arrayMap $ \i -> do
    x <- deref (decoded ! i)
    y <- deref (input   ! i)
    when (x /=? y) $ store b false

  b' <- deref b
  call_ testReport b'

encode :: Def('[ ConstRef s (Array 128 (Stored Uint8))
               , Ref ss (Array 259 (Stored Uint8))
               ] :-> ())
encode = proc "hxstream_test_encode" $ \ pt framed -> body $ do
  writeix <- local (ival 0)
  let cb v = do
        ix <- deref writeix
        store (framed ! ix) v
        store writeix (ix + 1)
  noReturn $ encodeToBS 0 pt cb

decode :: Def('[ ConstRef s (Array 259 (Stored Uint8))
               , Ref ss (Array 128 (Stored Uint8))
               ] :-> ())
decode = proc "hxstream_test_decode" $ \ framed pt -> body $ do
  hx <- local hx_ival
  runs <- local (ival (0::Uint32))
  ends <- local (ival (0::Uint32))
  let handler = FrameHandler
        { fh_tag = 0
        , fh_begin = do
{'fraction_non_alphanumeric': 0.16258400173422935, 'fraction_numerical': 0.02211142423585519, 'mean_word_length': 2.4535928143712575, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 23, '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': '3009651', 'n_tokens_mistral': 1684, 'n_tokens_neox': 1564, 'n_words': 521}