Matcher.hs

{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.Matcher
  ( tests )
  where

import Control.Applicative
import Data.Int
import H.Prelude
import qualified Foreign.R as R
import Language.R.Matcher as P

import Test.Tasty hiding (defaultMain)
import Test.Tasty.HUnit

tests :: TestTree
tests = testGroup "matcher"
  [ testCase "null" $ ((True @=?) =<<) $ do
       runRegion $ do
         s <- [r| NULL |]
         Right t <- matchOnly (P.null *> pure True <|> pure False) s
         return t
  , testCase "s3: pass non s3" $ ((True @=?) =<<) $ do
     runRegion  $ do
       s <- [r| c(1:10) |]
       Right t <- matchOnly (P.s3 ["matrix"] *> pure False <|> pure True) s
       return t
  , testCase "s3: matches matrix" $ ((True @=?) =<<) $ do
     runRegion  $ do
       s <- [r| x <- matrix(c(1:10)); class(x) <- "shmatrix"; x |]
       Right t <- matchOnly (P.s3 ["shmatrix"] *> pure True <|> pure False) s
       return t
  , testCase "typeOf: reads type" $ ((R.Int @=?) =<<) $ do
     runRegion $ do
       s <- [r| matrix(c(1:10)) |]
       Right t <- matchOnly P.typeOf s
       return t
  , testCase "guardType: proceeds" $ ((True @=?) =<<) $ do
     runRegion $ do
       s <- [r| matrix(c(1:10)) |]
       Right t <- matchOnly (P.guardType R.Int *> pure True <|> pure False) s
       return t
  , testCase "guardType: fails" $ ((True @=?) =<<) $ do
     runRegion $ do
       s <- [r| 1.0 |]
       Right t <- matchOnly (P.guardType R.Int *> pure False <|> pure True ) s
       return t
  , testCase "someAttribute" $ (([2,3::Int32] @=?) =<<) $ do
     runRegion $ do
       s <- [r| matrix(c(1:6), 2,3) |]
       Right t <- matchOnly (P.someAttribute "dim") s
       return (fromSEXP (R.cast SInt t))
  , testCase "someAttribute" $ (([2,3::Int32] @=?) =<<) $ do
     runRegion $ do
       s <- [r| matrix(c(1:6), 2,3) |]
       Right t <- matchOnly (P.attribute SInt "dim") s
       return (fromSEXP t)
  , testCase "getS3Class" $ ((["shmatrix"] @=?) =<<) $ do
     runRegion $ do
       s <- [r| x <- matrix(c(1:10),2,3); class(x) <- "shmatrix"; x |]
       Right t <- matchOnly P.getS3Class s
       return t
  ]