Rlang-QQ-0.3.0.0: examples/tests.hs

{-# OPTIONS_GHC -F -pgmF HListPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE DataKinds, PolyKinds, FlexibleContexts, TemplateHaskell, QuasiQuotes #-}
module Main where
import Test.Hspec

import System.Directory
import RlangQQ
import GHC.TypeLits
import Control.Lens

import Control.Monad
import qualified Data.Vector as V

inRec = [pun| x y z |] where
    x = "xlabel"
    y,z :: [Double]
    y = [1,2,3]
    z = [3,2,1]


main = hspec $ describe "rlangqq" $ do
  it "can read a tsv file" $ do
      [pun| x@(a b) s |] <- [r|
        fname <- c(Sys.glob('*.tsv'), Sys.glob('examples/*.tsv'))[1]
        hs_x <- as.list(read.delim(fname, sep=' '))
        hs_s <- as.numeric(with(hs_x, t(a) %*% b))
        |]
      (V.sum (V.zipWith (*) a b) :: Double, s :: Double)
        `shouldBe` (93.783, 93.783)

  it "does the same as zipWith" $ do

      o <- [r| print(hs_inRec) # should be unnecessary
               hs_inRec <- within(hs_inRec, y <- y + z) |]
      (o ^. `inRec . `y) `shouldBe` zipWith (+) (inRec^.`y) (inRec^.`z)
  
  it "accumulates when variables are ch_" $ do
        w <- newRChan
        [r|
            print(hs_inRec) # this shouldn't be necessary to force INOUT
            hs_inRec <- within(hs_inRec, y <- y + z + ch_w) |]

        out <- forM [1,2,3,4 :: Double] $ \n -> do
                sendRcv w n <&> view (`inRec . `y)
        out `shouldBe`
          tail (scanl
                    (\ accum n -> map (+n) $ zipWith (+) (inRec^. `z) accum)
                    (inRec^. `y)
                    [1 .. 4])

  it "repeats when variables are not ch_" $ do
      out <- forM [1,2,3,4 :: Double] $ \n -> do
          [r| print(hs_inRec) # this shouldn't be necessary to force INOUT
              hs_inRec <- within(hs_inRec, y <- y + z + hs_n) |]
            <&> view (`inRec . `y)
      out `shouldBe`
       map (\n -> map (+n) (zipWith (+) (inRec^.`y) (inRec^.`z))) [1 .. 4]
    
  it "interpolates haskell expressions" $ do
        ys <- forM [1,2,3,4 :: Double] $ \n -> do
            [pun| inRec{y} |] <- [r| # this shouldn't be necessary to force INOUT
                        print(hs_inRec)
                        hs_inRec <- within(hs_inRec, y <- y + z + $(n+1)  ) |]
            return y
        ys `shouldBe` map (\n -> map (+(1+n)) (zipWith (+) (inRec^.`y) (inRec^.`z))) [1 .. 4]

  it "can make a plot where you ask it to" $ do
      let x = [0 .. 10  :: Double]
          y = map (sin . (*pi) . (/10)) x
      b <- doesFileExist "testplot.png"
      when b (removeFile "testplot.png")
      -- normally you would just call qplot, and find a plot in Rtmp/figN/...
      [r| library(ggplot2)
          print('blahh')
          png(file='testplot.png')
          plot(qplot( hs_x, hs_y ))
          dev.off()
          |]
      doesFileExist "testplot.png" `shouldReturn` True


  it "does positional arguments" $ do
      let n, m :: Integer
          n = 5
          m = 6
      nm <- [r| hs_x <- hs_1 * $(2)  |] n m
      nm `shouldBe` (`x .==. (n*m) .*. emptyRecord)

      mm <- [r| hs_x <- hs_2 * hs_2 |] n m
      mm `shouldBe` (`x .==. (m*m) .*. emptyRecord)