Add HsSyn prettyprinter tests

Summary:
Add prettyprinter tests, which take a file, parse it, pretty print it,
re-parse the pretty printed version and then compare the original and
new ASTs (ignoring locations)

Updates haddock submodule to match the AST changes.

There are three issues outstanding

1. Extra parens around a context are not reproduced. This will require an
   AST change and will be done in a separate patch.

2. Currently if an `HsTickPragma` is found, this is not pretty-printed,
   to prevent noise in the output.

   I am not sure what the desired behaviour in this case is, so have left
   it as before. Test Ppr047 is marked as expected fail for this.

3. Apart from in a context, the ParsedSource AST keeps all the parens from
   the original source.  Something is happening in the renamer to remove the
   parens around visible type application, causing T12530 to fail, as the
   dumped splice decl is after the renamer.

   This needs to be fixed by keeping the parens, but I do not know where they
   are being removed.  I have amended the test to pass, by removing the parens
   in the expected output.

Test Plan: ./validate

Reviewers: goldfire, mpickering, simonpj, bgamari, austin

Reviewed By: simonpj, bgamari

Subscribers: simonpj, goldfire, thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D2752

GHC Trac Issues: #3384

1 files changed, 427 insertions, 0 deletions

diff --git a/testsuite/tests/printer/Ppr019.hs b/testsuite/tests/printer/Ppr019.hs
new file mode 100644
index 0000000000..c934cc5ccc
--- /dev/null
+++ b/testsuite/tests/printer/Ppr019.hs
@@ -0,0 +1,427 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses,
+             CPP #-}
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE RoleAnnotations #-}
+#endif
+
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Array.IO.Internal
+-- Copyright   :  (c) The University of Glasgow 2001-2012
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (uses Data.Array.Base)
+--
+-- Mutable boxed and unboxed arrays in the IO monad.
+--
+-----------------------------------------------------------------------------
+
+module Data.Array.IO.Internals (
+    IOArray(..),         -- instance of: Eq, Typeable
+    IOUArray(..),        -- instance of: Eq, Typeable
+    castIOUArray,        -- :: IOUArray ix a -> IO (IOUArray ix b)
+    unsafeThawIOUArray,
+  ) where
+
+import Data.Int
+import Data.Word
+import Data.Typeable
+
+import Control.Monad.ST         ( RealWorld, stToIO )
+import Foreign.Ptr              ( Ptr, FunPtr )
+import Foreign.StablePtr        ( StablePtr )
+
+#if __GLASGOW_HASKELL__ < 711
+import Data.Ix
+#endif
+import Data.Array.Base
+
+import GHC.IOArray (IOArray(..))
+
+-----------------------------------------------------------------------------
+-- Flat unboxed mutable arrays (IO monad)
+
+-- | Mutable, unboxed, strict arrays in the 'IO' monad.  The type
+-- arguments are as follows:
+--
+--  * @i@: the index type of the array (should be an instance of 'Ix')
+--
+--  * @e@: the element type of the array.  Only certain element types
+--    are supported: see "Data.Array.MArray" for a list of instances.
+--
+newtype IOUArray i e = IOUArray (STUArray RealWorld i e)
+                       deriving Typeable
+#if __GLASGOW_HASKELL__ >= 708
+-- Both parameters have class-based invariants. See also #9220.
+type role IOUArray nominal nominal
+#endif
+
+instance Eq (IOUArray i e) where
+    IOUArray s1 == IOUArray s2  =  s1 == s2
+
+instance MArray IOUArray Bool IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Char IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray (Ptr a) IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray (FunPtr a) IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Float IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Double IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray (StablePtr a) IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int8 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int16 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int32 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int64 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word8 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word16 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word32 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word64 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
+    {-# INLINE getNumElements #-}
+    getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+    {-# INLINE newArray #-}
+    newArray lu initialValue = stToIO $ do
+        marr <- newArray lu initialValue; return (IOUArray marr)
+    {-# INLINE unsafeNewArray_ #-}
+    unsafeNewArray_ lu = stToIO $ do
+        marr <- unsafeNewArray_ lu; return (IOUArray marr)
+    {-# INLINE newArray_ #-}
+    newArray_ = unsafeNewArray_
+    {-# INLINE unsafeRead #-}
+    unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+-- | Casts an 'IOUArray' with one element type into one with a
+-- different element type.  All the elements of the resulting array
+-- are undefined (unless you know what you\'re doing...).
+castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
+castIOUArray (IOUArray marr) = stToIO $ do
+    marr' <- castSTUArray marr
+    return (IOUArray marr')
+
+{-# INLINE unsafeThawIOUArray #-}
+#if __GLASGOW_HASKELL__ >= 711
+unsafeThawIOUArray :: UArray ix e -> IO (IOUArray ix e)
+#else
+unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
+#endif
+unsafeThawIOUArray arr = stToIO $ do
+    marr <- unsafeThawSTUArray arr
+    return (IOUArray marr)
+
+{-# RULES
+"unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
+    #-}
+
+#if __GLASGOW_HASKELL__ >= 711
+thawIOUArray :: UArray ix e -> IO (IOUArray ix e)
+#else
+thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
+#endif
+thawIOUArray arr = stToIO $ do
+    marr <- thawSTUArray arr
+    return (IOUArray marr)
+
+{-# RULES
+"thaw/IOUArray" thaw = thawIOUArray
+    #-}
+
+{-# INLINE unsafeFreezeIOUArray #-}
+#if __GLASGOW_HASKELL__ >= 711
+unsafeFreezeIOUArray :: IOUArray ix e -> IO (UArray ix e)
+#else
+unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
+#endif
+unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
+
+{-# RULES
+"unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
+    #-}
+
+#if __GLASGOW_HASKELL__ >= 711
+freezeIOUArray :: IOUArray ix e -> IO (UArray ix e)
+#else
+freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
+#endif
+freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
+
+{-# RULES
+"freeze/IOUArray" freeze = freezeIOUArray
+    #-}