{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
import           Control.Monad (void)
import           Data.Monoid ((<>))
import qualified Data.Vector.Storable.Mutable as V
import           Foreign.C.Types
import           Foreign.ForeignPtr (mallocForeignPtrBytes)
import           Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import qualified Language.Haskell.TH as TH
import           Prelude
import qualified Test.Hspec as Hspec
import           Text.RawString.QQ (r)

import qualified Language.C.Inline as C
import qualified Language.C.Inline.Unsafe as CU
import qualified Language.C.Inline.Interruptible as CI
import qualified Language.C.Inline.Internal as C
import qualified Language.C.Inline.ContextSpec
import qualified Language.C.Inline.ParseSpec
import qualified Language.C.Types as C
import qualified Language.C.Types.ParseSpec

import           Dummy

C.context (C.baseCtx <> C.fptrCtx <> C.funCtx <> C.vecCtx <> C.bsCtx)

C.include "<math.h>"
C.include "<stddef.h>"
C.include "<stdint.h>"
C.include "<stdio.h>"

C.verbatim [r|
int francescos_mul(int x, int y) {
  return x * y;
}
|]

foreign import ccall "francescos_mul" francescos_mul :: Int -> Int -> Int

main :: IO ()
main = Hspec.hspec $ do
  Hspec.describe "Language.C.Types.Parse" Language.C.Types.ParseSpec.spec
  Hspec.describe "Language.C.Inline.Context" Language.C.Inline.ContextSpec.spec
  Hspec.describe "Language.C.Inline.Parse" Language.C.Inline.ParseSpec.spec
  Hspec.describe "TH integration" $ do
    Hspec.it "inlineCode" $ do
      let c_add = $(C.inlineCode $ C.Code
            TH.Unsafe                   -- Call safety
            [t| Int -> Int -> Int |]    -- Call type
            "francescos_add"            -- Call name
            -- C Code
            [r| int francescos_add(int x, int y) { int z = x + y; return z; } |])
      c_add 3 4 `Hspec.shouldBe` 7
    Hspec.it "inlineItems" $ do
      let c_add3 = $(C.inlineItems
            TH.Unsafe
            [t| CInt -> CInt |]
            (C.quickCParser_ "int" C.parseType)
            [("x", C.quickCParser_ "int" C.parseType)]
            [r| return x + 3; |])
      c_add3 1 `Hspec.shouldBe` 1 + 3
    Hspec.it "inlineExp" $ do
      let x = $(C.inlineExp
            TH.Safe
            [t| CInt |]
            (C.quickCParser_ "int" C.parseType)
            []
            [r| 1 + 4 |])
      x `Hspec.shouldBe` 1 + 4
    Hspec.it "inlineCode" $ do
      francescos_mul 3 4 `Hspec.shouldBe` 12
    Hspec.it "exp" $ do
      let x = 3
      let y = 4
      z <- [C.exp| int{ $(int x) + $(int y) + 5 } |]
      z `Hspec.shouldBe` x + y + 5
    Hspec.it "pure" $ do
      let x = 2
      let y = 10
      let z = [C.pure| int{ $(int x) + 10 + $(int y) } |]
      z `Hspec.shouldBe` x + y + 10
    Hspec.it "unsafe exp" $ do
      let x = 2
      let y = 10
      z <- [CU.exp| int{ 7 + $(int x) + $(int y) } |]
      z `Hspec.shouldBe` x + y + 7
    Hspec.it "interruptible exp" $ do
      let x = 2
      let y = 10
      z <- [CI.exp| int{ 7 + $(int x) + $(int y) } |]
      z `Hspec.shouldBe` x + y + 7
    Hspec.it "void exp" $ do
      [C.exp| void { printf("Hello\n") } |]
    Hspec.it "Foreign.C.Types library types" $ do
      let x = 1
      pd <- [C.block| ptrdiff_t { char a[2]; return &a[1] - &a[0] + $(ptrdiff_t x); } |]
      pd `Hspec.shouldBe` 2
      sz <- [C.exp| size_t { sizeof (char) } |]
      sz `Hspec.shouldBe` 1
      um <- [C.exp| uintmax_t { UINTMAX_MAX } |]
      um `Hspec.shouldBe` maxBound
    Hspec.it "stdint.h types" $ do
      let x = 2
      i16 <- [C.exp| int16_t { 1 + $(int16_t x) } |]
      i16 `Hspec.shouldBe` 3
      let y = 9
      u32 <- [C.exp| uint32_t { $(uint32_t y) * 7 } |]
      u32 `Hspec.shouldBe` 63
    Hspec.it "foreign pointer argument" $ do
      fptr <- mallocForeignPtrBytes 32
      ptr <- [C.exp| int* { $fptr-ptr:(int *fptr) } |]
      ptr `Hspec.shouldBe` unsafeForeignPtrToPtr fptr
    Hspec.it "function pointer argument" $ do
      let ackermann m n
            | m == 0 = n + 1
            | m > 0 && n == 0 = ackermann (m - 1) 1
            | m > 0 && n > 0 = ackermann (m - 1) (ackermann m (n - 1))
            | otherwise = error "ackermann"
      ackermannPtr <- $(C.mkFunPtr [t| CInt -> CInt -> IO CInt |]) $ \m n -> return $ ackermann m n
      let x = 3
      let y = 4
      z <- [C.exp| int { $(int (*ackermannPtr)(int, int))($(int x), $(int y)) } |]
      z `Hspec.shouldBe` ackermann x y
    Hspec.it "function pointer result" $ do
      c_add <- [C.exp| int (*)(int, int) { &francescos_add } |]
      x <- $(C.peekFunPtr [t| CInt -> CInt -> IO CInt |]) c_add 1 2
      x `Hspec.shouldBe` 1 + 2
    Hspec.it "quick function pointer argument" $ do
      let ackermann m n
            | m == 0 = n + 1
            | m > 0 && n == 0 = ackermann (m - 1) 1
            | m > 0 && n > 0 = ackermann (m - 1) (ackermann m (n - 1))
            | otherwise = error "ackermann"
      let ackermann_ m n = return $ ackermann m n
      let x = 3
      let y = 4
      z <- [C.exp| int { $fun:(int (*ackermann_)(int, int))($(int x), $(int y)) } |]
      z `Hspec.shouldBe` ackermann x y
    Hspec.it "function pointer argument (pure)" $ do
      let ackermann m n
            | m == 0 = n + 1
            | m > 0 && n == 0 = ackermann (m - 1) 1
            | m > 0 && n > 0 = ackermann (m - 1) (ackermann m (n - 1))
            | otherwise = error "ackermann"
      ackermannPtr <- $(C.mkFunPtr [t| CInt -> CInt -> CInt |]) ackermann
      let x = 3
      let y = 4
      let z = [C.pure| int { $(int (*ackermannPtr)(int, int))($(int x), $(int y)) } |]
      z `Hspec.shouldBe` ackermann x y
    Hspec.it "quick function pointer argument (pure)" $ do
      let ackermann m n
            | m == 0 = n + 1
            | m > 0 && n == 0 = ackermann (m - 1) 1
            | m > 0 && n > 0 = ackermann (m - 1) (ackermann m (n - 1))
            | otherwise = error "ackermann"
      let x = 3
      let y = 4
      let z = [C.pure| int { $fun:(int (*ackermann)(int, int))($(int x), $(int y)) } |]
      z `Hspec.shouldBe` ackermann x y
    Hspec.it "test mkFunPtrFromName" $ do
      fun <- $(C.mkFunPtrFromName 'dummyFun)
      z <- [C.exp| double { $(double (*fun)(double))(3.0) } |]
      z' <- dummyFun 3.0
      z `Hspec.shouldBe` z'
    Hspec.it "vectors" $ do
      let n = 10
      vec <- V.replicate (fromIntegral n) 3
      sum' <- V.unsafeWith vec $ \ptr -> [C.block| int {
        int i;
        int x = 0;
        for (i = 0; i < $(int n); i++) {
          x += $(int *ptr)[i];
        }
        return x;
      } |]
      sum' `Hspec.shouldBe` 3 * 10
    Hspec.it "quick vectors" $ do
      vec <- V.replicate 10 3
      sum' <- [C.block| int {
        int i;
        int x = 0;
        for (i = 0; i < $vec-len:vec; i++) {
          x += $vec-ptr:(int *vec)[i];
        }
        return x;
      } |]
      sum' `Hspec.shouldBe` 3 * 10
    Hspec.it "bytestrings" $ do
      let bs = "foo"
      bits <- [C.block| int {
          int i, bits = 0;
          for (i = 0; i < $bs-len:bs; i++) {
            char ch = $bs-ptr:bs[i];
            bits += (ch * 01001001001ULL & 042104210421ULL) % 017;
          }
          return bits;
        } |]
      bits `Hspec.shouldBe` 16
    Hspec.it "Haskell identifiers" $ do
      let x' = 3
      void $ [C.exp| int { $(int x') } |]
      let ä = 3
      void $ [C.exp| int { $(int ä) } |]
      void $ [C.exp| int { $(int Prelude.maxBound) } |]