diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,7 @@ +Version 1.3.1 +------------- +* Update cabal file to include testing files in sdist. + Version 1.3.0 ------------- * Update to work with `type Pred = Type` in GHC 7.9. This changed the diff --git a/Test/Splices.hs b/Test/Splices.hs new file mode 100644 --- /dev/null +++ b/Test/Splices.hs @@ -0,0 +1,136 @@ +{- Tests for the th-desugar package + +(c) Richard Eisenberg 2013 +eir@cis.upenn.edu +-} + +{-# LANGUAGE TemplateHaskell, LambdaCase, MagicHash, UnboxedTuples, + MultiWayIf, ParallelListComp, CPP, BangPatterns, + ScopedTypeVariables, RankNTypes, TypeFamilies, ImpredicativeTypes, + DataKinds, PolyKinds #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults + -fno-warn-name-shadowing #-} + +module Test.Splices where + +import Data.List +import GHC.Exts +import GHC.TypeLits + +import Language.Haskell.TH +import Language.Haskell.TH.Desugar +import Language.Haskell.TH.Desugar.Sweeten + +dsSplice :: Q Exp -> Q Exp +dsSplice expq = expq >>= dsExp >>= (return . expToTH) + +test1_sections = [| map ((* 3) . (4 +) . (\x -> x * x)) [10, 11, 12] |] +test2_lampats = [| (\(Just x) (Left z) -> x + z) (Just 5) (Left 10) |] +test3_lamcase = [| foldr (-) 0 (map (\case { Just x -> x ; Nothing -> (-3) }) [Just 1, Nothing, Just 19, Nothing]) |] +test4_tuples = [| (\(a, _) (# b, _ #) -> a + b) (1,2) (# 3, 4 #) |] +test5_ifs = [| if (5 > 7) then "foo" else if | Nothing <- Just "bar", True -> "blargh" | otherwise -> "bum" |] +test6_ifs2 = [| if | Nothing <- Nothing, False -> 3 | Just _ <- Just "foo" -> 5 |] +test7_let = [| let { x :: Double; x = 5; f :: Double -> Double; f x = x + 1 } in f (x * 2) + x |] +test8_case = [| case Just False of { Just True -> 1 ; Just _ -> 2 ; Nothing -> 3 } |] +test9_do = [| show $ do { foo <- Just "foo" + ; let fool = foo ++ "l" + ; elemIndex 'o' fool + ; x <- elemIndex 'l' fool + ; return (x + 10) } |] +test10_comp = [| [ (x, x+1) | x <- [1..10], x `mod` 2 == 0 ] |] +#if __GLASGOW_HASKELL__ >= 707 +test11_parcomp = [| [ (x,y) | x <- [1..10], x `mod` 2 == 0 | y <- [2,5..20] ] |] +test12_parcomp2 = [| [ (x,y,z) | x <- [1..10], z <- [3..100], x + z `mod` 2 == 0 | y <- [2,5..20] ] |] +#endif +test13_sig = [| show (read "[10, 11, 12]" :: [Int]) |] + +data Record = MkRecord1 { field1 :: Bool, field2 :: Int } + | MkRecord2 { field2 :: Int, field3 :: Char } + +test14_record = [| let r1 = [MkRecord1 { field2 = 5, field1 = False }, MkRecord2 { field2 = 6, field3 = 'q' }] + r2 = map (\r -> r { field2 = 18 }) r1 + r3 = (head r2) { field1 = True } in + map (\case MkRecord1 { field2 = some_int, field1 = some_bool } -> show some_int ++ show some_bool + MkRecord2 { field2 = some_int, field3 = some_char } -> show some_int ++ show some_char) (r3 : r2) |] + +test15_litp = [| map (\case { 5 -> True ; _ -> False }) [5,6] |] +test16_tupp = [| map (\(x,y,z) -> x + y + z) [(1,2,3),(4,5,6)] |] + +data InfixType = Int :+: Bool + deriving (Show, Eq) + +test17_infixp = [| map (\(x :+: y) -> if y then x + 1 else x - 1) [5 :+: True, 10 :+: False] |] +test18_tildep = [| map (\ ~() -> Nothing :: Maybe Int) [undefined, ()] |] +test19_bangp = [| map (\ !() -> 5) [()] |] +test20_asp = [| map (\ a@(b :+: c) -> (if c then b + 1 else b - 1, a)) [5 :+: True, 10 :+: False] |] +test21_wildp = [| zipWith (\_ _ -> 10) [1,2,3] ['a','b','c'] |] +test22_listp = [| map (\ [a,b,c] -> a + b + c) [[1,2,3],[4,5,6]] |] +-- type signatures in patterns not yet handled by Template Haskell +-- test23_sigp = [| map (\ (a :: Int) -> a + a) [5, 10] |] + +test24_fun = [| let f (Just x) = x + f Nothing = Nothing in + f (Just (Just 10)) |] + +test25_fun2 = [| let f (Just x) + | x > 0 = x + | x < 0 = x + 10 + f Nothing = 0 + f _ = 18 in + map f [Just (-5), Just 5, Just 10, Nothing, Just 0] |] + +test26_forall = [| let f :: Num a => a -> a + f x = x + 10 in + (f 5, f 3.0) |] + +data Proxy a = Proxy + deriving Show + +test27_kisig = [| let f :: Proxy (a :: Bool) -> () + f _ = () in + (f (Proxy :: Proxy False), f (Proxy :: Proxy True)) |] +test28_tupt = [| let f :: (a,b) -> a + f (a,_) = a in + map f [(1,'a'),(2,'b')] |] +test29_listt = [| let f :: [[a]] -> a + f = head . head in + map f [ [[1]], [[2]] ] |] +test30_promoted = [| let f :: Proxy '() -> Proxy '[Int, Bool] -> () + f _ _ = () in + f Proxy Proxy |] +test31_constraint = [| let f :: Proxy (c :: * -> Constraint) -> () + f _ = () in + [f (Proxy :: Proxy Eq), f (Proxy :: Proxy Show)] |] +test32_tylit = [| let f :: Proxy (a :: Symbol) -> Proxy (b :: Nat) -> () + f _ _ = () in + f (Proxy :: Proxy "Hi there!") (Proxy :: Proxy 10) |] +test33_tvbs = [| let f :: forall a (b :: * -> *). Monad b => a -> b a + f = return in + [f 1, f 2] :: [Maybe Int] |] + +test34_let_as = [| let a@(Just x) = Just 5 in + show x ++ show a |] + +type Pair a = (a, a) +test35_expand = [| let f :: Pair a -> a + f = fst in + f |] + +type Const a b = b +test36_expand = [| let f :: Const Int (,) Bool Char -> Char + f = snd in + f |] + +#if __GLASGOW_HASKELL__ >= 709 +test37_pred = [| let f :: (Read a, (Show a, Num a)) => a -> a + f x = read (show x) + x in + (f 3, f 4.5) |] + +test38_pred2 = [| let f :: a b => Proxy a -> b -> b + f _ x = x in + (f (Proxy :: Proxy Show) False, f (Proxy :: Proxy Num) (3 :: Int)) |] + +test39_eq = [| let f :: (a ~ b) => a -> b + f x = x in + (f ()) |] +#endif diff --git a/th-desugar.cabal b/th-desugar.cabal --- a/th-desugar.cabal +++ b/th-desugar.cabal @@ -1,5 +1,5 @@ name: th-desugar -version: 1.3.0 +version: 1.3.1 cabal-version: >= 1.10 synopsis: Functions to desugar Template Haskell homepage: http://www.cis.upenn.edu/~eir/packages/th-desugar @@ -26,7 +26,7 @@ source-repository this type: git location: https://github.com/goldfirere/th-desugar.git - tag: v1.3.0 + tag: v1.3.1 library build-depends: @@ -47,6 +47,7 @@ ghc-options: -Wall -Werror -main-is Test.Run default-language: Haskell2010 main-is: Test/Run.hs + other-modules: Test.Splices build-depends: base >= 4 && < 5,