quickjs-hs-0.1.2.3: test/Spec.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Test.Tasty              (TestTree, testGroup, defaultMain, after, DependencyType(..))
import           Test.Tasty.HUnit        (testCase)
import           Test.Tasty.QuickCheck   (testProperty, QuickCheckTests(..), QuickCheckVerbose(..))
import           Test.HUnit              (Assertion, (@?=))
import qualified Test.QuickCheck         as QC
import qualified Test.QuickCheck.Monadic as QC
import           Data.Aeson              (Value(..))
import           Control.Monad.IO.Class  (liftIO)
import           Control.Monad.Catch     (try, SomeException, MonadCatch(..))
import           Data.Text               (pack)
import qualified Data.HashMap.Strict            as HM
import qualified Data.Vector             as V
import           Quickjs
import Test.HUnit (assertFailure)
import Quickjs.Error (SomeJSRuntimeException)


eval_1_plus_2 :: Assertion
eval_1_plus_2 = quickjsMultithreaded $ do
  v <- eval "1 + 2;"
  liftIO $ v @?= Number 3


eval_throw :: Assertion
eval_throw = quickjsMultithreaded $
  try (eval "throw 'Error'") >>= \case
    Left (_ :: SomeJSRuntimeException) -> return ()
    Right _ -> liftIO $ assertFailure "should fail with an Exception..."

genText = do 
  k <- QC.choose (0,200) 
  pack <$> QC.vectorOf k (QC.oneof $ map pure $ ['0'..'~'])

genVal 0 = QC.oneof
  [ 
    String <$> genText
  , Number . fromInteger <$> QC.arbitrary
  , Bool <$> QC.arbitrary
  , pure Null
  ]
genVal n | n > 0 = QC.oneof
  [ 
    do { k <- QC.choose (0,n) ; Object . HM.fromList <$> (zip <$> QC.vectorOf k genText <*> QC.vectorOf k genVal') }      
  , do { k <- QC.choose (0,n) ; Array . V.fromList <$> QC.vectorOf k genVal' }
  , String <$> genText
  , Number . fromInteger <$> QC.arbitrary
  , Bool <$> QC.arbitrary
  , pure Null
  ]
  where genVal' = genVal (n `div` 2)

instance QC.Arbitrary Value where
  arbitrary = QC.sized genVal




marshall_to_from_JSValue :: Value -> QC.Property    
marshall_to_from_JSValue val = QC.monadicIO $ do
  val' <- QC.run $ quickjsMultithreaded $ withJSValue val $ \jsval ->
    fromJSValue_ jsval
  QC.assert $ val == val'

tests :: TestTree
tests = 
  -- adjustOption (\_ -> QuickCheckTests 10) $
  -- adjustOption (\_ -> QuickCheckVerbose True) $  
  testGroup "Quickjs"
    [ testCase "empty quickjs call" (quickjsMultithreaded $ pure ())
    , testCase "eval '1 + 2;'" eval_1_plus_2
    , testCase "eval throw" eval_throw
    , testProperty "marshalling Value to JSValue and back" marshall_to_from_JSValue
    ]

main = defaultMain tests