Fix compilation and CI on GHC 8.6 & 8.8

  * Backwards compatible handling of:

     - `MonadFail` changes (`fail` moved out of `Monad`)
     - `Semigroup` changes (re-exported from `Prelude`)

  * `happy` recently broke partial type signatures for parametrized
     productions (they were unsound). Thankfully, it turns out there
     was all along a better way to write type signatures for these
     productions.

  * Update CI scripts, testing new configurations...

Author: harpocrates

.travis.yml

@@ -3,16 +3,17 @@ sudo: true
 
 # Add new environments to the build here:
 env:
-  - GHCVER=7.10.3 CABALVER=1.22 
-  - GHCVER=8.0.2  CABALVER=1.24
-  - GHCVER=8.2.2  CABALVER=2.0
-  - GHCVER=8.4.1  CABALVER=head
+  - GHCVER=8.0.2  CABALVER=3.0
+  - GHCVER=8.2.2  CABALVER=3.0
+  - GHCVER=8.4.4  CABALVER=3.0
+  - GHCVER=8.6.5  CABALVER=3.0
+  - GHCVER=8.8.1  CABALVER=3.0
   - GHCVER=head   CABALVER=head
 
 # Allow for develop branch to break
 matrix:
   allow_failures:
-    - env: GHCVER=8.4.1  CABALVER=head
+    - env: GHCVER=8.8.1  CABALVER=3.0
     - env: GHCVER=head   CABALVER=head
 
 # Manually install ghc and cabal
@@ -29,10 +30,7 @@ install:
   - echo $PATH
   - cabal --version
   - ghc --version
-  - cabal install happy --constraint 'happy >= 1.19.8'
-  - cabal install alex
-  - cabal install --verbose --enable-tests
-  - cabal configure
+  - cabal configure --verbose --enable-tests
 
 script:
   - cabal test

appveyor.yml

@@ -7,7 +7,9 @@ environment:
     # - resolver: lts-6.35 # ghc-7.10.3
     # - resolver: lts-7.24 # ghc-8.0.1
     # - resolver: lts-9.21 # ghc-8.0.2
-    - resolver: lts-10.7 # ghc-2.2.2
+    - resolver: lts-11.22 # ghc-8.2.2
+    - resolver: lts-12.14 # ghc-8.4.4
+    - resolver: lts-14.4  # ghc-8.6.5
     - resolver: nightly
 
 # Manually fetch stack
@@ -21,7 +23,7 @@ install:
 
 # Install Happy and Alex first, before installing
 build_script:
-  - stack --no-terminal install --resolver %resolver% happy-1.19.8
+  - stack --no-terminal install --resolver %resolver% happy-1.19.12
   - stack --no-terminal install --resolver %resolver% alex
 
 test_script:

language-rust.cabal

@@ -56,7 +56,7 @@ library
                        Language.Rust.Data.InputStream
   if flag(enableQuasiquotes)
     exposed-modules:   Language.Rust.Quote
- 
+
   other-modules:       Language.Rust.Parser.Literals
                        Language.Rust.Parser.Reversed
                        Language.Rust.Pretty.Resolve
@@ -65,6 +65,11 @@ library
                        Language.Rust.Syntax.AST
                        Language.Rust.Syntax.Token
 
+  -- Starting in 8.8, `MonadFailDesugaring` is default
+  if impl(ghc < 8.8)
+    default-extensions:
+                       MonadFailDesugaring
+
   other-extensions:    FlexibleContexts
                      , FlexibleInstances
                      , OverloadedStrings
@@ -79,13 +84,11 @@ library
                      , BangPatterns
                      , CPP
 
-  build-depends:       base                 >=4.8  && <5.0
+  build-depends:       base                 >=4.9  && <5.0
                      , prettyprinter        >=1.0  && <2.0
                      , transformers         >=0.4  && <0.6
                      , array                >=0.5  && <0.6
                      , deepseq              >=1.1  && <1.5
-  if impl(ghc < 8)
-    build-depends:     semigroups           >=0.18
 
   if flag(useByteStrings)
     cpp-options:       -DUSE_BYTESTRING
@@ -128,15 +131,15 @@ test-suite rustc-tests
   other-modules:       Diff
                        DiffUtils
 
-  other-extensions:    InstanceSigs 
+  other-extensions:    InstanceSigs
                      , OverloadedStrings
                      , OverloadedLists
                      , MultiParamTypeClasses
                      , UnicodeSyntax
 
   type:                exitcode-stdio-1.0
   default-language:    Haskell2010
-  
+
   build-depends:       process              >=1.3
                      , bytestring           >=0.10
                      , aeson                >=0.11.0.0
@@ -151,8 +154,6 @@ test-suite rustc-tests
                      , language-rust
                      , base
                      , prettyprinter        >=1.1
-  if impl(ghc < 8)
-    build-depends:     semigroups           >=0.18
 
 benchmark timing-benchmarks
   hs-source-dirs:      bench/timing-benchmarks

src/Language/Rust/Data/Ident.hs

@@ -24,7 +24,7 @@ import Data.Typeable      ( Typeable )
 import Data.List          ( foldl' )
 import Data.Char          ( ord )
 import Data.String        ( IsString(..) )
-import Data.Semigroup     ( Semigroup(..) )
+import Data.Semigroup as Sem
 
 -- | An identifier
 data Ident
@@ -57,7 +57,7 @@ instance Monoid Ident where
   mempty = mkIdent ""
 
 -- | "Forgets" about whether either argument was raw
-instance Semigroup Ident where
+instance Sem.Semigroup Ident where
   Ident n1 _ _ <> Ident n2 _  _ = mkIdent (n1 <> n2)
 
 

src/Language/Rust/Data/Position.hs

@@ -42,8 +42,8 @@ import Data.Data          ( Data )
 import Data.Typeable      ( Typeable )
 
 import Data.List.NonEmpty ( NonEmpty(..) )
-import Data.Monoid        ( Monoid(..) )
-import Data.Semigroup     ( Semigroup(..) )
+import Data.Monoid as Mon
+import Data.Semigroup as Sem
 
 
 -- | A position in a source file. The row and column information is kept only for its convenience
@@ -139,22 +139,22 @@ instance Show Span where
 subsetOf :: Span -> Span -> Bool
 Span l1 h1 `subsetOf` Span l2 h2 = minPos l1 l2 == l1 && maxPos h1 h2 == h2
 
--- | Convenience function lifting '<>' to work on all 'Located' things
+-- | Convenience function lifting 'Mon.<>' to work on all 'Located' things
 {-# INLINE (#) #-}
 (#) :: (Located a, Located b) => a -> b -> Span
-left # right = spanOf left <> spanOf right
+left # right = spanOf left Mon.<> spanOf right
 
 -- | smallest covering 'Span'
-instance Semigroup Span where
+instance Sem.Semigroup Span where
   {-# INLINE (<>) #-}
   Span l1 h1 <> Span l2 h2 = Span (l1 `minPos` l2) (h1 `maxPos` h2)
 
-instance Monoid Span where
+instance Mon.Monoid Span where
   {-# INLINE mempty #-}
   mempty = Span NoPosition NoPosition
 
   {-# INLINE mappend #-}
-  mappend = (<>) 
+  mappend = (Sem.<>)
 
 -- | Pretty print a 'Span'
 prettySpan :: Span -> String
@@ -178,11 +178,11 @@ instance Applicative Spanned where
   pure x = Spanned x mempty
 
   {-# INLINE (<*>) #-}
-  Spanned f s1 <*> Spanned x s2 = Spanned (f x) (s1 <> s2)
+  Spanned f s1 <*> Spanned x s2 = Spanned (f x) (s1 Sem.<> s2)
 
 instance Monad Spanned where
   return = pure
-  Spanned x s1 >>= f = let Spanned y s2 = f x in Spanned y (s1 <> s2) 
+  Spanned x s1 >>= f = let Spanned y s2 = f x in Spanned y (s1 Sem.<> s2)
 
 instance Show a => Show (Spanned a) where
   show = show . unspan

src/Language/Rust/Parser/Internal.y

@@ -26,7 +26,6 @@ To get information about transition states and such, run
 {-# OPTIONS_HADDOCK hide, not-home #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE PartialTypeSignatures #-}
 
 module Language.Rust.Parser.Internal (
   -- * Parsers
@@ -368,33 +367,33 @@ pipe :: { () }
 -------------
 
 -- | One or more occurences of 'p'
-some(p) :: { Reversed NonEmpty _ }
+some(p) :: { Reversed NonEmpty p }
   : some(p) p             { let Reversed xs = $1 in Reversed ($2 <| xs) }
   | p                     { [$1] }
 
 -- | Zero or more occurences of 'p'
-many(p) :: { [ _ ] }
+many(p) :: { [ p ] }
   : some(p)               { toList $1 }
   | {- empty -}           { [] }
 
 -- | One or more occurences of 'p', seperated by 'sep'
-sep_by1(p,sep) :: { Reversed NonEmpty _ }
+sep_by1(p,sep) :: { Reversed NonEmpty p }
   : sep_by1(p,sep) sep p  { let Reversed xs = $1 in Reversed ($3 <| xs) }
   | p                     { [$1] }
 
 -- | Zero or more occurrences of 'p', separated by 'sep'
-sep_by(p,sep) :: { [ _ ] }
+sep_by(p,sep) :: { [ p ] }
   : sep_by1(p,sep)        { toList $1 }
   | {- empty -}           { [] }
 
 -- | One or more occurrences of 'p', seperated by 'sep', optionally ending in 'sep'
-sep_by1T(p,sep) :: { Reversed NonEmpty _ }
+sep_by1T(p,sep) :: { Reversed NonEmpty p }
   : sep_by1(p,sep) sep    { $1 }
   | sep_by1(p,sep)        { $1 }
 
 -- | Zero or more occurences of 'p', seperated by 'sep', optionally ending in 'sep' (only if there
 -- is at least one 'p')
-sep_byT(p,sep) :: { [ _ ] }
+sep_byT(p,sep) :: { [ p ] }
   : sep_by1T(p,sep)       { toList $1 }
   | {- empty -}           { [] }
 

src/Language/Rust/Parser/ParseMonad.hs

@@ -49,6 +49,7 @@ import Language.Rust.Data.InputStream  ( InputStream )
 import Language.Rust.Data.Position     ( Spanned, Position, initPos, prettyPosition )
 import Language.Rust.Syntax.Token      ( Token )
 
+import Control.Monad.Fail as Fail
 import Control.Exception               ( Exception )
 import Data.Maybe                      ( listToMaybe )
 import Data.Typeable                   ( Typeable )
@@ -87,9 +88,9 @@ instance Monad P where
     let pOk' x s' = unParser (k x) s' pOk pFailed
     in unParser m s pOk' pFailed
 
+instance Fail.MonadFail P where
   fail msg = P $ \ !s _ pFailed -> pFailed msg (curPos s)
 
-
 -- | Exceptions that occur during parsing
 data ParseFail = ParseFail Position String deriving (Eq, Typeable)
 
@@ -165,5 +166,5 @@ popToken = P $ \ !s@PState{ pushedTokens = toks } pOk _ -> pOk (listToMaybe toks
 
 -- | Signal a syntax error.
 parseError :: Show b => b -> P a
-parseError b = fail ("Syntax error: the symbol `" ++ show b ++ "' does not fit here")
+parseError b = Fail.fail ("Syntax error: the symbol `" ++ show b ++ "' does not fit here")
 

src/Language/Rust/Parser/Reversed.hs

@@ -27,7 +27,7 @@ module Language.Rust.Parser.Reversed (
 import Language.Rust.Data.Position
 
 import Data.Foldable          ( Foldable(toList) )
-import Data.Semigroup         ( Semigroup(..) )
+import Data.Semigroup as Sem  ( Semigroup(..) )
 
 import qualified Data.List.NonEmpty as N
 import qualified GHC.Exts as G
@@ -46,8 +46,8 @@ instance Foldable (Reversed N.NonEmpty) where
   foldMap f (Reversed xs) = foldMap f (N.reverse xs)
   toList (Reversed xs) = reverse (toList xs)
 
-instance Semigroup (f a) => Semigroup (Reversed f a) where
-  Reversed xs <> Reversed ys = Reversed (ys <> xs)
+instance Sem.Semigroup (f a) => Sem.Semigroup (Reversed f a) where
+  Reversed xs <> Reversed ys = Reversed (ys Sem.<> xs)
 
 instance Monoid (f a) => Monoid (Reversed f a) where
   mempty = Reversed mempty

src/Language/Rust/Pretty/Util.hs

@@ -23,7 +23,7 @@ neutral element for @<+>@, @hsep@, @<#>@, @vsep@, and @</>@.
 
 module Language.Rust.Pretty.Util where
 
-import Data.Monoid ( (<>) )
+import Data.Monoid as M
 
 import qualified Data.Text.Prettyprint.Doc as PP
 import Data.Text.Prettyprint.Doc.Internal.Type ( Doc(..) )
@@ -44,11 +44,11 @@ emptyElim _ f doc   = f doc
 
 -- | Vertically concatenate two 'Doc's with a collapsible line between them
 (<##>) :: Doc a -> Doc a -> Doc a
-d1 <##> d2 = d1 <> PP.line' <> d2
+d1 <##> d2 = d1 M.<> PP.line' M.<> d2
 
 -- | Flatten a 'Doc'
 flatten :: Doc a -> Doc a
-flatten d@Fail{}          = d 
+flatten d@Fail{}          = d
 flatten d@Empty{}         = d 
 flatten d@Char{}          = d 
 flatten d@Text{}          = d