diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,6 @@ +2016-06-03 v0.5.1.1 + * Fixx haddocks for GHC 8.0 (@phadej) + * Add test files for ghc710-only to dist tarball (#41) 2016-06-02 v0.5.1.0 * Support for GHC 8.0.1 * Add graftT to the Transform module, courtesy of @xich diff --git a/ghc-exactprint.cabal b/ghc-exactprint.cabal --- a/ghc-exactprint.cabal +++ b/ghc-exactprint.cabal @@ -1,5 +1,5 @@ name: ghc-exactprint -version: 0.5.1.0 +version: 0.5.1.1 synopsis: ExactPrint for GHC description: Using the API Annotations available from GHC 7.10.2, this library provides a means to round trip any code that can @@ -30,6 +30,7 @@ extra-source-files: ChangeLog tests/examples/failing/*.hs tests/examples/ghc710/*.hs + tests/examples/ghc710-only/*.hs tests/examples/ghc8/*.hs tests/examples/transform/*.hs tests/examples/failing/*.hs.bad diff --git a/src/Language/Haskell/GHC/ExactPrint/Annotate.hs b/src/Language/Haskell/GHC/ExactPrint/Annotate.hs --- a/src/Language/Haskell/GHC/ExactPrint/Annotate.hs +++ b/src/Language/Haskell/GHC/ExactPrint/Annotate.hs @@ -1462,8 +1462,7 @@ markAST _ (GHC.HsOpTy t1 (_,lo) t2) = do #else markAST _ (GHC.HsOpTy t1 lo t2) = do - -- | HsOpTy (LHsType name) (Located name) (LHsType name) - + -- HsOpTy (LHsType name) (Located name) (LHsType name) #endif markLocated t1 mark GHC.AnnSimpleQuote diff --git a/tests/examples/ghc710-only/DataDecl.hs b/tests/examples/ghc710-only/DataDecl.hs new file mode 100644 --- /dev/null +++ b/tests/examples/ghc710-only/DataDecl.hs @@ -0,0 +1,34 @@ +{-# Language DatatypeContexts #-} +{-# Language ExistentialQuantification #-} +{-# LAnguage GADTs #-} +{-# LAnguage KindSignatures #-} + +data Foo = A + | B + | C + +-- | data_or_newtype capi_ctype tycl_hdr constrs deriving +data {-# Ctype "Foo" "bar" #-} F1 = F1 +data {-# Ctype "baz" #-} Eq a => F2 a = F2 a + +data (Eq a,Ord a) => F3 a = F3 Int a + +data F4 a = forall x y. (Eq x,Eq y) => F4 a x y + | forall x y. (Eq x,Eq y) => F4b a x y + + +data G1 a :: * where + G1A, G1B :: Int -> G1 a + G1C :: Double -> G1 a + +data G2 a :: * where + G2A { g2a :: a, g2b :: Int } :: G2 a + G2C :: Double -> G2 a + + + +data (Eq a,Ord a) => G3 a = G3 + { g3A :: Int + , g3B :: Bool + , g3a :: a + } deriving (Eq,Ord) diff --git a/tests/examples/ghc710-only/HashQQ.hs b/tests/examples/ghc710-only/HashQQ.hs new file mode 100644 --- /dev/null +++ b/tests/examples/ghc710-only/HashQQ.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} + +module Web.Maid.ApacheMimeTypes where + + +import qualified Data.Text as T +import Air.TH + + + +apache_mime_types :: T.Text +apache_mime_types = [here| + +# This file maps Internet media types to unique file extension(s). +# Although created for httpd, this file is used by many software systems +# and has been placed in the public domain for unlimited redisribution. +# +# The table below contains both registered and (common) unregistered types. +# A type that has no unique extension can be ignored -- they are listed +# here to guide configurations toward known types and to make it easier to +# identify "new" types. File extensions are also commonly used to indicate +# content languages and encodings, so choose them carefully. +# +# Internet media types should be registered as described in RFC 4288. +# The registry is at . +# +# MIME type (lowercased) Extensions +# ============================================ ========== +# application/1d-interleaved-parityfec +# application/3gpp-ims+xml +# application/activemessage +application/andrew-inset ez |] + + +testComplex = assertBool "" ([$istr| + ok +#{Foo 4 "Great!" : [Foo 3 "Scott!"]} + then +|] == ("\n" ++ + " ok\n" ++ + "[Foo 4 \"Great!\",Foo 3 \"Scott!\"]\n" ++ + " then\n")) + diff --git a/tests/examples/ghc710-only/QuasiQuote.hs b/tests/examples/ghc710-only/QuasiQuote.hs new file mode 100644 --- /dev/null +++ b/tests/examples/ghc710-only/QuasiQuote.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE QuasiQuotes #-} +module QuasiQuote where + +import T7918A + +ex1 = [qq|e1|] +ex2 = [qq|e2|] +ex3 = [qq|e3|] +ex4 = [qq|e4|] + +tx1 = undefined :: [qq|t1|] +tx2 = undefined :: [qq|t2|] +tx3 = undefined :: [qq|t3|] +tx4 = undefined :: [qq|t4|] + +px1 [qq|p1|] = undefined +px2 [qq|p2|] = undefined +px3 [qq|p3|] = undefined +px4 [qq|p4|] = undefined + +{-# LANGUAGE QuasiQuotes #-} + +testComplex = assertBool "" ([$istr| + ok +#{Foo 4 "Great!" : [Foo 3 "Scott!"]} + then +|] == ("\n" ++ + " ok\n" ++ + "[Foo 4 \"Great!\",Foo 3 \"Scott!\"]\n" ++ + " then\n")) + diff --git a/tests/examples/ghc710-only/TypeFamilies.hs b/tests/examples/ghc710-only/TypeFamilies.hs new file mode 100644 --- /dev/null +++ b/tests/examples/ghc710-only/TypeFamilies.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} + +-- From https://ocharles.org.uk/blog/posts/2014-12-12-type-families.html + +import Control.Concurrent.STM +import Control.Concurrent.MVar +import Data.Foldable (forM_) +import Data.IORef + +class IOStore store where + newIO :: a -> IO (store a) + getIO :: store a -> IO a + putIO :: store a -> a -> IO () + +instance IOStore MVar where + newIO = newMVar + getIO = readMVar + putIO mvar a = modifyMVar_ mvar (return . const a) + +instance IOStore IORef where + newIO = newIORef + getIO = readIORef + putIO ioref a = modifyIORef ioref (const a) + +type Present = String +storePresentsIO :: IOStore store => [Present] -> IO (store [Present]) +storePresentsIO xs = do + store <- newIO [] + forM_ xs $ \x -> do + old <- getIO store + putIO store (x : old) + return store + +-- Type family version + +class Store store where + type StoreMonad store :: * -> * + new :: a -> (StoreMonad store) (store a) + get :: store a -> (StoreMonad store) a + put :: store a -> a -> (StoreMonad store) () + +instance Store IORef where + type StoreMonad IORef = IO + new = newIORef + get = readIORef + put ioref a = modifyIORef ioref (const a) + +instance Store TVar where + type StoreMonad TVar = STM + new = newTVar + get = readTVar + put ioref a = modifyTVar ioref (const a) + +storePresents :: (Store store, Monad (StoreMonad store)) + => [Present] -> (StoreMonad store) (store [Present]) +storePresents xs = do + store <- new [] + forM_ xs $ \x -> do + old <- get store + put store (x : old) + return store + +type family (++) (a :: [k]) (b :: [k]) :: [k] where + '[] ++ b = b + (a ': as) ++ b = a ': (as ++ b) + +type family (f :: * -> *) |> (s :: * -> *) :: * -> * + +type instance f |> Union s = Union (f :> s) + +type family Compare (a :: k) (b :: k') :: Ordering where + Compare '() '() = EQ + +type family (r1 :++: r2); infixr 5 :++: +type instance r :++: Nil = r +type instance r1 :++: r2 :> a = (r1 :++: r2) :> a