clr-inline-0.2.0: test/InlineSpec.hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS -Wno-missing-signatures #-}
module InlineSpec where
import Control.Concurrent
import Control.Monad
import Control.Lens
import Clr.Inline
import Clr.Inline.Utils.Parse
import Data.Int
import Data.String
import Data.Text as Text (pack)
import Data.Word
import Test.Hspec
import System.Mem
import System.Mem.Weak
[csharp| using System;
using System.Collections.Generic;
|]
[fsharp|
open System
open System.Collections.Generic
|]
type DateTime = Clr "System.DateTime"
main = hspec spec
spec = do
describe "Parsing antiquotes" parseSpec
describe "QuasiQuoting" qqSpec
shouldParseTo program result = do
let p = view tokenized program
p `shouldBe` result
shouldRoundtripAndParseTo program result = do
let p = view tokenized program
p `shouldBe` result
review tokenized p `shouldBe` program
parseSpec :: Spec
parseSpec = do
it "$foo" $ "$foo" `shouldRoundtripAndParseTo` [Antiquote False "foo" Nothing]
it "$foo:int" $ "$foo:int" `shouldRoundtripAndParseTo` [Antiquote False "foo" (Just (Con "int"))]
it "$foo:unit" $ "$foo:unit" `shouldRoundtripAndParseTo` [Antiquote False "foo" (Just Unit)]
it "$(foo:unit)" $ "$(foo:unit)" `shouldRoundtripAndParseTo` [Antiquote True "foo" (Just Unit)]
it "($foo:unit)" $ "($foo:unit)" `shouldRoundtripAndParseTo` [Other "(", Antiquote False "foo" (Just Unit), Other ")"]
it "$$foo" $ "$$foo" `shouldParseTo` [Other "$foo"]
-- it "\"$foo\"" $ "\"$foo\"" `shouldRoundtripAndParseTo` [Other "\"$foo\""] TODO
it "1 $ 2" $ "1 $ 2" `shouldRoundtripAndParseTo` [Other "1 $ 2"]
it "1 $ 2" $ "1 $ 2" `shouldRoundtripAndParseTo` [Other "1 $ 2"]
it "a->b" $ "a->b" `shouldRoundtripAndParseTo` [Other "a->b"]
it "$a->b" $ "$a->b" `shouldRoundtripAndParseTo` [Antiquote False "a" Nothing, Other "->b"]
it "$foo:a->b" $ "$foo:a->b" `shouldRoundtripAndParseTo` [Antiquote False "foo" (Just (Fun [Con "a"] (Con "b")))]
it "$foo:unit->b" $ "$foo:unit->b" `shouldRoundtripAndParseTo` [Antiquote False "foo" (Just (Fun [Unit] (Con "b")))]
it "$foo:unit->unit" $ "$foo:unit->unit" `shouldRoundtripAndParseTo` [Antiquote False "foo" (Just (Fun [Unit] Unit))]
h_i = 2 :: Int
h_i16 = 2 :: Int16
h_i32 = 2 :: Int32
h_i64 = 2 :: Int64
h_w16 = 1 :: Word16
h_w32 = 1 :: Word32
h_w64 = 1 :: Word64
h_d = 2.2 :: Double
h_b = False
h_s = "Hello from Haskell"
h_t = Text.pack h_s
topHandler =
[csharp|
AppDomain currentDomain = default(AppDomain);
currentDomain = AppDomain.CurrentDomain;
currentDomain.UnhandledException += (sender, args) => {
Console.WriteLine(((Exception)args.ExceptionObject).GetBaseException().ToString());
if(((Exception)args.ExceptionObject).GetBaseException().StackTrace == null)
Console.WriteLine("Stack trace is null");
};
|]
qqSpec :: Spec
qqSpec = beforeAll_ (startClr >> topHandler) $ do
it "F# inlines pick up imports" $
[fsharp| ignore <| Dictionary<int,int>() |]
it "C# inlines pick up imports" $
[csharp| var foo = new Dictionary<int,int>(); return ;|]
it "F# inlines return all primitive types" $ do
[fsharp| int{2}|] `shouldReturn` 2
[fsharp| bool{false}|] `shouldReturn` False
[fsharp| double{2.2}|] `shouldReturn` 2.2
[fsharp| int16{2s}|] `shouldReturn` 2
[fsharp| int32{2}|] `shouldReturn` 2
[fsharp| int64{2L}|] `shouldReturn` 2
[fsharp| long{2L}|] `shouldReturn` 2
[fsharp| uint16{2us}|] `shouldReturn` 2
[fsharp| word16{2us}|] `shouldReturn` 2
[fsharp| uint32{2u}|] `shouldReturn` 2
[fsharp| word32{2u}|] `shouldReturn` 2
[fsharp| uint64{2UL}|] `shouldReturn` 2
[fsharp| word64{2UL}|] `shouldReturn` 2
[fsharp| text{"hello"}|] `shouldReturn` pack "hello"
[fsharp| string{"hello"}|] `shouldReturn` "hello"
it "F# inlines return reference types" $ do
date <- [fsharp| DateTime{ DateTime.Today}|]
return ()
it "F# supports antiquoting int" $
[fsharp|bool{$h_i:int = 2}|] `shouldReturn` True
it "F# supports antiquoting int16" $
[fsharp|bool{$h_i16:int16 = 2s}|] `shouldReturn` True
it "F# supports antiquoting int32" $
[fsharp|bool{$h_i32:int32 = 2}|] `shouldReturn` True
it "F# supports antiquoting int64" $
[fsharp|bool{$h_i64:int64 = 2L}|] `shouldReturn` True
it "F# supports antiquoting long" $
[fsharp|bool{$h_i64:long = 2L}|] `shouldReturn` True
it "F# supports antiquoting uint16" $
[fsharp|bool{$h_w16:uint16 = 1us}|] `shouldReturn` True
it "F# supports antiquoting uint32" $
[fsharp|bool{$h_w32:uint32 = 1u}|] `shouldReturn` True
it "F# supports antiquoting uint64" $
[fsharp|bool{$h_w64:uint64 = 1UL}|] `shouldReturn` True
it "F# supports antiquoting bool" $
[fsharp|bool{$h_b:bool = false}|] `shouldReturn` True
it "F# supports antiquoting double" $
[fsharp|bool{$h_d:double = 2.2}|] `shouldReturn` True
it "F# supports antiquoting string" $
[fsharp|bool{$h_s:string = "Hello from Haskell"}|] `shouldReturn` True
it "F# supports antiquoting text" $
[fsharp|bool{$h_t:text = "Hello from Haskell"}|] `shouldReturn` True
it "F# handles two antiquotations" $
[fsharp|bool{$h_i32:int32 + $h_i:int = 4}|] `shouldReturn` True
it "Types are optional in repeated occurrences of an antiquotation" $
[fsharp|bool{$h_i32:int32 = $h_i32}|] `shouldReturn` True
it "F# tuples are handled correctly" $ do
tuple <- [fsharp| int*bool{8,true}|]
[fsharp| bool{snd $tuple:int*bool}|] `shouldReturn` True
[fsharp| int {fst $tuple:int*bool}|] `shouldReturn` 8
it "Reference types are released when Haskell GCs them" $ do
!tuple <-
[fsharp|WeakReference*Object{
let d = obj()
let w = WeakReference(d)
(w,d)}|]
!w <- [fsharp|WeakReference{fst $tuple:WeakReference*Object}|]
gcUntil [fsharp|bool{System.GC.Collect(); not ($w:WeakReference).IsAlive}|]
it "But not any earlier" $ do
tuple <-
[fsharp|WeakReference*Object{
let d = Object()
let w = WeakReference(d)
if not (Object.ReferenceEquals(w.Target,d)) then
failwithf "This is not a good test(%O,%O)" w.Target d
(w,d)}|]
w <- [fsharp|WeakReference{fst $tuple:WeakReference*Object}|]
d <- [fsharp|Object{snd $tuple:WeakReference*Object}|]
performGC
threadDelay 50000
[fsharp|bool{
GC.Collect()
let res = ($w:WeakReference).IsAlive
GC.KeepAlive($d:Object)
res}
|] `shouldReturn` True
it "F# generics are handled" $ do
dict <- [fsharp| Map<int,string> {
[ 1,"Foo" ; 2, "bar" ] |> Map.ofSeq
}|]
[fsharp| string{ ($dict:Map<int,string>).[1] }|]
`shouldReturn` "Foo"
it "C# arrays are handled" $ do
i_array <- [csharp| int[] {
int[] a = new int[4]{0,0,0,0};
for(int i=0; i < 4; i++) {
a[i] = i;
}
return a;
}|]
[csharp|int{return ($i_array:int[])[2];}|] `shouldReturn` 2
it "F# lambdas over struct types are handled" $ do
let addOneDay (x :: DateTime) =
[fsharp| System.DateTime{ ($x:System.DateTime).AddDays(1.0)}|]
[fsharp| int{
let d = ($addOneDay:System.DateTime->System.DateTime) (DateTime(2017,1,1)) in d.Day
}|] `shouldReturn` 2
it "F# lambdas over value types are handled" $ do
let addOne x = x + 1
[fsharp| int{ ($addOne:int->int) 1}|] `shouldReturn` 2
it "F# lambdas over strings are handled" $ do
let addOne x = x ++ "1"
[fsharp| string{
match box ($addOne:string->string) with
| null -> "null"
| :? (string->string) as f -> f "success"
| other -> other.GetType().ToString()
}|] `shouldReturn` "success1"
it "Unit lambdas from monadic actions" $ do
let action :: IO String = return "hello"
[fsharp| string{ $action:unit->string ()}|] `shouldReturn` "hello"
it "Unit unit lambdas" $ do
let action :: IO () = return ()
[fsharp| void{ $action:unit->unit ()} |] `shouldReturn` ()
gcUntil cond = do
let loop 10 = error "gc: tried too many times"
loop i = do
performGC
threadDelay (i * 10000)
success <- cond
unless success $ loop (i+1)
loop 0