{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}

module Main where

import Test.Framework
import Test.Framework.Providers.HUnit
import Test.HUnit ((@=?))

import Data.Loc (SrcLoc, noLoc)
import Language.C.Quote.C
import qualified Language.C.Syntax as C
import System.Exit (exitFailure, exitSuccess)

#if !MIN_VERSION_template_haskell(2,7,0)
import qualified Data.Loc
import qualified Data.Symbol
import qualified Language.C.Syntax
#endif /* !MIN_VERSION_template_haskell(2,7,0) */

main :: IO ()
main = defaultMain tests

tests :: [Test]
tests = [exp_id, exp_int, exp_float, exp_char, exp_string,
         exp_exp, exp_func, exp_args, exp_decl, exp_sdecl,
         exp_enum, exp_edecl, exp_stm, exp_param, exp_ty,
         pat_args, exp_hexp,
         exp_init, exp_inits, exp_item]

exp_id :: Test
exp_id = testCase "exp id" $ [cexp|$id:f($id:x, $id:y)|] @=? [cexp|f(x, y)|]
  where
    f :: String
    f = "f"

    x :: SrcLoc -> C.Id
    x = C.Id "x"

    y :: C.Id
    y = C.Id "y" noLoc

exp_int :: Test
exp_int = testCase "exp int" $
    [cexp|$int:one + $uint:one + $lint:one + $ulint:one|]
      @=? [cexp|1 + 1U + 1L + 1UL|]
  where
    one = 1

exp_float :: Test
exp_float = testCase "exp float" $
    [cexp|$float:one + $double:one + $ldouble:one|]
      @=? [cexp|1.0F + 1.0 + 1.0L|]
  where
    one = 1

exp_char :: Test
exp_char = testCase "exp char" $ [cexp|$char:a|] @=?  [cexp|'a'|]
    where
      a = 'a'

exp_string :: Test
exp_string =
    testCase "exp string" $ [cexp|$string:hello|] @=?  [cexp|"Hello, world\n"|]
  where
    hello = "Hello, world\n"

exp_exp :: Test
exp_exp =
    testCase "exp expression" $ [cexp|$exp:e1 + $exp:e2|] @=?  [cexp|1 + 2|]
  where
    e1 = [cexp|1|]
    e2 = [cexp|2|]

exp_func :: Test
exp_func = testCase "exp function" $
    [cunit|$func:f|]
      @=? [cunit|int add(int x) { return x + 10; }|]
  where
    f = add 10
    add n = [cfun|int add(int x) { return x + $int:n; } |]

exp_args :: Test
exp_args = testCase "exp args" $
    [cstm|f($exp:e1, $args:args, $exp:e2);|]
      @=? [cstm|f(1, 1, 2, 2);|]
  where
    e1 = [cexp|1|]
    e2 = [cexp|2|]
    args = [e1, e2]

exp_decl :: Test
exp_decl = testCase "exp decl" $
    [cfun|int inc(int n) {
             $decl:d1;
             $decls:decls

             return n + 1;
          }|]
       @=? [cfun|int inc(int n) {
                     int i;
                     int j;
                     char c = 'c';

                     return n + 1;
                  }|]
  where
    d1 = [cdecl|int i;|]
    d2 = [cdecl|int j;|]
    d3 = [cdecl|char c = 'c';|]
    decls = [d2, d3]

exp_sdecl :: Test
exp_sdecl = testCase "exp sdecl" $
    [cty|struct foo { $sdecl:d1 $sdecls:decls }|]
      @=? [cty|struct foo { int i; int j; char c; }|]
  where
    d1 = [csdecl|int i;|]
    d2 = [csdecl|int j;|]
    d3 = [csdecl|char c;|]
    decls = [d2, d3]

exp_enum :: Test
exp_enum = testCase "exp enum" $
    [cty|enum foo { $enum:enum1, $enums:enums }|]
      @=? [cty|enum foo { A = 0, B, C = 2 }|]
  where
    enum1 = [cenum|A = 0|]
    enum2 = [cenum|B|]
    enum3 = [cenum|C = 2|]
    enums = [enum2, enum3]

exp_edecl :: Test
exp_edecl = testCase "exp edecl" $
    [cunit|$edecl:d1 $edecls:decls|]
      @=? [cunit|int i; int j; char c = 'c';|]
  where
    d1 = [cedecl|int i;|]
    d2 = [cedecl|int j;|]
    d3 = [cedecl|char c = 'c';|]
    decls = [d2, d3]

exp_stm :: Test
exp_stm = testCase "exp stm" $
    [cfun|int add(int x) { $stms:stms return x + 1; }|]
      @=? [cfun|int add(int x) { a = 1; b = 2; return x + 1; }|]
  where
    one = 1
    stm1 = [cstm|a = $int:one;|]
    stm2 = [cstm|b = 2;|]
    stms = [stm1, stm2]

exp_param :: Test
exp_param = testCase "exp param" $
    [cdecl|int f($param:ty1, $params:tys);|]
      @=? [cdecl|int f(char, int, float);|]
  where
    ty1 = [cparam|char|]
    ty2 = [cparam|int|]
    ty3 = [cparam|float|]
    tys = [ty2, ty3]

exp_ty :: Test
exp_ty = testCase "exp ty" $
    [cdecl|$ty:ty1 f(const $ty:ty2);|]
      @=? [cdecl|int f(const float);|]
  where
    ty1 = [cty|int|]
    ty2 = [cty|float|]

pat_args :: Test
pat_args =
    testCase"pat args" $ stms @=?  [[cexp|2|], [cexp|3|]]
  where
    stms = case [cstm|f(1, 2, 3);|] of
             [cstm|f(1, $args:es);|] -> es
             _ -> []

exp_hexp :: Test
exp_hexp =
    testCase "exp hexp" $ [cexp|$ulint:(13 - 2*5)|] @=? [cexp|3UL|]

exp_init :: Test
exp_init = testCase "initializer" $
    [cinit|{$init:initializer, .a = 10}|] @=? [cinit|{{.d = 1}, .a = 10}|]
  where
    initializer = [cinit|{.d = 1}|]

exp_inits :: Test
exp_inits = testCase "initializers" $
    [cinit|{$inits:([initializer1, initializer2])}|] @=? [cinit|{{.d = 1},{.a = 10}}|]
  where
    initializer1 = [cinit|{.d = 1}|]
    initializer2 = [cinit|{.a = 10}|]

exp_item :: Test
exp_item = testCase "exp item" $
    [cfun|int add(int x) { int y = 2; return x + y; }|]
      @=? [cfun|int add(int x) { $items:([item1, item2]) }|]
  where
    item1 = [citem|int y = 2;|]
    item2 = [citem|return x + y;|]