Commit 82815489 authored by Ryan Scott's avatar Ryan Scott

Migrate haskell-src-meta/inspection-testing/shakespeare patches, drop old patches

The patches for `haskell-src-meta`, `inspection-testing`, and
`shakespeare` need to be migrated to the latest Hackage releases.

The patches for `happy`, `haskell-src-exts`, `kind-generics`,
`kind-generics-th`, and `xml-hamlet` all have newer versions on
Hackage that build with GHC 8.8 and HEAD, so drop them.
parent 8be3fb8a
Pipeline #9972 passed with stages
in 75 minutes and 33 seconds
diff -ru happy-1.19.11.orig/Setup.lhs happy-1.19.11/Setup.lhs
--- happy-1.19.11.orig/Setup.lhs 2019-06-06 03:20:45.000000000 -0400
+++ happy-1.19.11/Setup.lhs 2019-06-13 07:19:11.018577108 -0400
@@ -45,7 +45,7 @@
_ -> []
myPostBuild _ flags _ lbi = do
- let runProgram p = rawSystemProgramConf (fromFlagOrDefault normal (buildVerbosity flags))
+ let runProgram p = runDbProgram (fromFlagOrDefault normal (buildVerbosity flags))
p
(withPrograms lbi)
cpp_template src dst opts = do
commit 5479772132ee206696b8ae2fc67e5bd8587dd0ba
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri Mar 15 14:55:28 2019 -0400
Adapt to base-4.13.0.0
diff --git a/src/Language/Haskell/Exts/ExactPrint.hs b/src/Language/Haskell/Exts/ExactPrint.hs
index 394b858..0d1666a 100644
--- a/src/Language/Haskell/Exts/ExactPrint.hs
+++ b/src/Language/Haskell/Exts/ExactPrint.hs
@@ -129,7 +129,7 @@ printStringAt :: Pos -> String -> EP ()
printStringAt p str = printWhitespace p >> printString str
errorEP :: String -> EP a
-errorEP = fail
+errorEP = error
------------------------------------------------------------------------------
-- Printing of source elements
diff --git a/src/Language/Haskell/Exts/Fixity.hs b/src/Language/Haskell/Exts/Fixity.hs
index 56be8bf..332625d 100644
--- a/src/Language/Haskell/Exts/Fixity.hs
+++ b/src/Language/Haskell/Exts/Fixity.hs
@@ -39,6 +39,7 @@ import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts.SrcLoc
import Control.Monad (when, (<=<), liftM, liftM2, liftM3, liftM4)
+import qualified Control.Monad.Fail as Fail
import Data.Traversable (mapM)
import Data.Maybe (fromMaybe)
import Data.Typeable
@@ -59,7 +60,7 @@ class AppFixity ast where
-- | Tweak any expressions in the element to account for the
-- fixities given. Assumes that all operator expressions are
-- fully left associative chains to begin with.
- applyFixities :: Monad m => [Fixity] -- ^ The fixities to account for.
+ applyFixities :: Fail.MonadFail m => [Fixity] -- ^ The fixities to account for.
-> ast SrcSpanInfo -- ^ The element to tweak.
-> m (ast SrcSpanInfo) -- ^ The same element, but with operator expressions updated, or a failure.
@@ -241,7 +242,7 @@ instance AppFixity PatternSynDirection where
_ -> return dir
where fix x = applyFixities fixs x
-appFixDecls :: Monad m => Maybe (ModuleName SrcSpanInfo) -> [Fixity] -> [Decl SrcSpanInfo] -> m [Decl SrcSpanInfo]
+appFixDecls :: Fail.MonadFail m => Maybe (ModuleName SrcSpanInfo) -> [Fixity] -> [Decl SrcSpanInfo] -> m [Decl SrcSpanInfo]
appFixDecls mmdl fixs decls =
let extraFixs = getFixities mmdl decls
in mapM (applyFixities (fixs++extraFixs)) decls
@@ -379,7 +380,7 @@ instance AppFixity XAttr where
-- Recursively fixes the "leaves" of the infix chains,
-- without yet touching the chain itself. We assume all chains are
-- left-associate to begin with.
-leafFix :: Monad m => [Fixity] -> Exp SrcSpanInfo -> m (Exp SrcSpanInfo)
+leafFix :: Fail.MonadFail m => [Fixity] -> Exp SrcSpanInfo -> m (Exp SrcSpanInfo)
leafFix fixs e' = case e' of
InfixApp l e1 op e2 -> liftM2 (flip (InfixApp l) op) (leafFix fixs e1) (fix e2)
App l e1 e2 -> liftM2 (App l) (fix e1) (fix e2)
@@ -427,7 +428,7 @@ leafFix fixs e' = case e' of
where
fix x = applyFixities fixs x
-leafFixP :: Monad m => [Fixity] -> Pat SrcSpanInfo -> m (Pat SrcSpanInfo)
+leafFixP :: Fail.MonadFail m => [Fixity] -> Pat SrcSpanInfo -> m (Pat SrcSpanInfo)
leafFixP fixs p' = case p' of
PInfixApp l p1 op p2 -> liftM2 (flip (PInfixApp l) op) (leafFixP fixs p1) (fix p2)
PApp l n ps -> liftM (PApp l n) $ mapM fix ps
diff --git a/src/Language/Haskell/Exts/ParseMonad.hs b/src/Language/Haskell/Exts/ParseMonad.hs
index 09a55c0..da95ea6 100644
--- a/src/Language/Haskell/Exts/ParseMonad.hs
+++ b/src/Language/Haskell/Exts/ParseMonad.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
@@ -96,7 +97,9 @@ instance Applicative ParseResult where
instance Monad ParseResult where
return = ParseOk
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
+#endif
ParseOk x >>= f = f x
ParseFailed loc msg >>= _ = ParseFailed loc msg
instance Fail.MonadFail ParseResult where
@@ -246,7 +249,9 @@ instance Monad P where
case m i x y l ch s mode of
Failed loc msg -> Failed loc msg
Ok s' a -> runP (k a) i x y l ch s' mode
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
+#endif
instance Fail.MonadFail P where
fail s = P $ \_r _col _line loc _ _stk _m -> Failed loc s
@@ -354,7 +359,9 @@ instance Monad (Lex r) where
return a = Lex $ \k -> k a
Lex v >>= f = Lex $ \k -> v (\a -> runL (f a) k)
Lex v >> Lex w = Lex $ \k -> v (\_ -> w k)
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
+#endif
instance Fail.MonadFail (Lex r) where
fail s = Lex $ \_ -> fail s
diff -ru haskell-src-meta-0.8.2.orig/src/Language/Haskell/Meta/Syntax/Translate.hs haskell-src-meta-0.8.2/src/Language/Haskell/Meta/Syntax/Translate.hs
--- haskell-src-meta-0.8.2.orig/src/Language/Haskell/Meta/Syntax/Translate.hs 2019-02-26 21:44:20.000000000 -0500
+++ haskell-src-meta-0.8.2/src/Language/Haskell/Meta/Syntax/Translate.hs 2019-07-03 13:56:24.764549867 -0400
@@ -85,11 +85,23 @@
diff -ru haskell-src-meta-0.8.3.orig/src/Language/Haskell/Meta/Syntax/Translate.hs haskell-src-meta-0.8.3/src/Language/Haskell/Meta/Syntax/Translate.hs
--- haskell-src-meta-0.8.3.orig/src/Language/Haskell/Meta/Syntax/Translate.hs 2019-03-02 19:42:56.000000000 -0500
+++ haskell-src-meta-0.8.3/src/Language/Haskell/Meta/Syntax/Translate.hs 2019-09-07 16:14:45.414486693 -0400
@@ -83,11 +83,23 @@
instance (ToExp a) => ToExp [a] where
toExp = ListE . fmap toExp
toExp = TH.ListE . fmap toExp
instance (ToExp a, ToExp b) => ToExp (a,b) where
- toExp (a,b) = TupE [toExp a, toExp b]
+ toExp (a,b) = TupE $
- toExp (a,b) = TH.TupE [toExp a, toExp b]
+ toExp (a,b) = TH.TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+ map Just
+#endif
+ [toExp a, toExp b]
instance (ToExp a, ToExp b, ToExp c) => ToExp (a,b,c) where
- toExp (a,b,c) = TupE [toExp a, toExp b, toExp c]
+ toExp (a,b,c) = TupE $
- toExp (a,b,c) = TH.TupE [toExp a, toExp b, toExp c]
+ toExp (a,b,c) = TH.TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+ map Just
+#endif
+ [toExp a, toExp b, toExp c]
instance (ToExp a, ToExp b, ToExp c, ToExp d) => ToExp (a,b,c,d) where
- toExp (a,b,c,d) = TupE [toExp a, toExp b, toExp c, toExp d]
+ toExp (a,b,c,d) = TupE $
- toExp (a,b,c,d) = TH.TupE [toExp a, toExp b, toExp c, toExp d]
+ toExp (a,b,c,d) = TH.TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [toExp a, toExp b, toExp c, toExp d]
instance ToPat Lit where
@@ -250,8 +262,20 @@
toExp (Hs.Case _ e alts) = CaseE (toExp e) (map toMatch alts)
toExp (Hs.Do _ ss) = DoE (map toStmt ss)
toExp e@(Hs.MDo _ _) = noTH "toExp" e
- toExp (Hs.Tuple _ Hs.Boxed xs) = TupE (fmap toExp xs)
- toExp (Hs.Tuple _ Hs.Unboxed xs) = UnboxedTupE (fmap toExp xs)
+ toExp (Hs.Tuple _ Hs.Boxed xs) = TupE (fmap
instance ToPat TH.Lit where
@@ -273,8 +285,20 @@
toExp (Exts.Case _ e alts) = TH.CaseE (toExp e) (map toMatch alts)
toExp (Exts.Do _ ss) = TH.DoE (map toStmt ss)
toExp e@Exts.MDo{} = noTH "toExp" e
- toExp (Exts.Tuple _ Exts.Boxed xs) = TH.TupE (fmap toExp xs)
- toExp (Exts.Tuple _ Exts.Unboxed xs) = TH.UnboxedTupE (fmap toExp xs)
+ toExp (Exts.Tuple _ Exts.Boxed xs) = TH.TupE (fmap
+#if MIN_VERSION_template_haskell(2,16,0)
+ (Just . toExp)
+ (Just . toExp)
+#else
+ toExp
+ toExp
+#endif
+ xs)
+ toExp (Hs.Tuple _ Hs.Unboxed xs) = UnboxedTupE (fmap
+ xs)
+ toExp (Exts.Tuple _ Exts.Unboxed xs) = TH.UnboxedTupE (fmap
+#if MIN_VERSION_template_haskell(2,16,0)
+ (Just . toExp)
+ (Just . toExp)
+#else
+ toExp
+ toExp
+#endif
+ xs)
toExp e@Hs.TupleSection{} = noTH "toExp" e
toExp (Hs.List _ xs) = ListE (fmap toExp xs)
toExp (Hs.Paren _ e) = ParensE (toExp e)
diff -ru haskell-src-meta-0.8.2.orig/src/Language/Haskell/Meta/Utils.hs haskell-src-meta-0.8.2/src/Language/Haskell/Meta/Utils.hs
--- haskell-src-meta-0.8.2.orig/src/Language/Haskell/Meta/Utils.hs 2019-02-26 21:44:20.000000000 -0500
+++ haskell-src-meta-0.8.2/src/Language/Haskell/Meta/Utils.hs 2019-07-03 13:57:37.549286480 -0400
@@ -338,7 +338,13 @@
+ xs)
toExp e@Exts.TupleSection{} = noTH "toExp" e
toExp (Exts.List _ xs) = TH.ListE (fmap toExp xs)
toExp (Exts.Paren _ e) = TH.ParensE (toExp e)
diff -ru haskell-src-meta-0.8.3.orig/src/Language/Haskell/Meta/Utils.hs haskell-src-meta-0.8.3/src/Language/Haskell/Meta/Utils.hs
--- haskell-src-meta-0.8.3.orig/src/Language/Haskell/Meta/Utils.hs 2019-03-02 19:42:56.000000000 -0500
+++ haskell-src-meta-0.8.3/src/Language/Haskell/Meta/Utils.hs 2019-09-07 16:16:09.779248579 -0400
@@ -350,7 +350,13 @@
in replicateM n (newName "a")
>>= \ns -> return (Just (LamE
[ConP dConN (fmap VarP ns)]
- (TupE $ fmap VarE ns)))
+ (TupE $ fmap
+#if MIN_VERSION_template_haskell(2,16,0)
+# if MIN_VERSION_template_haskell(2,16,0)
+ (Just . VarE)
+#else
+# else
+ VarE
+#endif
+# endif
+ ns)))
fromDataConI _ = return Nothing
fromTyConI :: Info -> Maybe Dec
#else
fromDataConI (DataConI dConN ty _tyConN _fxty) =
let n = arityT ty
commit 241ff789d849a55cd23ea6825cf887aa8dbdbaac
commit 6d12b474822ed5968da05aaf29263c298620b184
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Wed Aug 28 06:50:40 2019 -0400
Date: Sat Sep 7 16:20:43 2019 -0400
Allow building with GHC 8.9
......
diff -ru kind-generics-0.3.0.0.orig/src/Generics/Kind.hs kind-generics-0.3.0.0/src/Generics/Kind.hs
--- kind-generics-0.3.0.0.orig/src/Generics/Kind.hs 2018-12-04 09:04:47.000000000 -0500
+++ kind-generics-0.3.0.0/src/Generics/Kind.hs 2019-07-03 13:39:40.002441920 -0400
@@ -75,7 +75,7 @@
-- > instance GenericK E LoT0 where
-- > type RepK E = Exists (*) (Field Var0)
data Exists k (f :: LoT (k -> d) -> *) (x :: LoT d) where
- Exists :: forall (t :: k) d (f :: LoT (k -> d) -> *) (x :: LoT d)
+ Exists :: forall k (t :: k) d (f :: LoT (k -> d) -> *) (x :: LoT d)
.{ unExists :: f (t ':&&: x) } -> Exists k f x
deriving instance (forall t. Show (f (t ':&&: x))) => Show (Exists k f x)
diff -ru kind-generics-th-0.1.1.0.orig/src/Generics/Kind/TH.hs kind-generics-th-0.1.1.0/src/Generics/Kind/TH.hs
--- kind-generics-th-0.1.1.0.orig/src/Generics/Kind/TH.hs 2019-04-30 04:39:19.000000000 -0400
+++ kind-generics-th-0.1.1.0/src/Generics/Kind/TH.hs 2019-05-11 08:47:16.451331266 -0400
@@ -1,3 +1,4 @@
+{-# language CPP #-}
{-# language ExplicitNamespaces #-}
{-# language MultiWayIf #-}
{-# language TemplateHaskellQuotes #-}
@@ -84,7 +85,12 @@
(conT ''GenericK `appT` dataApp `appT`
foldr (\x y -> infixT x '(:&&:) y)
(promotedT 'LoT0) (map varT argNamesToDrop))
- [ tySynInstD ''RepK $ tySynEqn [dataApp] $
+ [
+#if MIN_VERSION_template_haskell(2,15,0)
+ tySynInstD $ tySynEqn Nothing (conT ''RepK `appT` dataApp) $
+#else
+ tySynInstD ''RepK $ tySynEqn [dataApp] $
+#endif
deriveRepK dataName argNamesToDrop variant cons'
, deriveFromK cons'
, deriveToK cons'
Name: memory
version: 0.14.18
x-revision: 1
Synopsis: memory and related abstraction stuff
Description:
Chunk of memory, polymorphic byte array management and manipulation
.
* A polymorphic byte array abstraction and function similar to strict ByteString.
.
* Different type of byte array abstraction.
.
* Raw memory IO operations (memory set, memory copy, ..)
.
* Aliasing with endianness support.
.
* Encoding : Base16, Base32, Base64.
.
* Hashing : FNV, SipHash
License: BSD3
License-file: LICENSE
Copyright: Vincent Hanquez <vincent@snarc.org>
Author: Vincent Hanquez <vincent@snarc.org>
Maintainer: vincent@snarc.org, Nicolas Di Prima <nicolas@primetype.co.uk>
Category: memory
Stability: experimental
Build-Type: Simple
Homepage: https://github.com/vincenthz/hs-memory
Bug-Reports: https://github.com/vincenthz/hs-memory/issues
cabal-version: 1.18
extra-doc-files: README.md CHANGELOG.md
source-repository head
type: git
location: https://github.com/vincenthz/hs-memory
Flag support_bytestring
Description: add non-orphan bytearray support for bytestring
Default: True
Manual: True
Flag support_foundation
Description: add support for foundation strings and unboxed array (deprecated use support_basement)
Default: True
Manual: True
Flag support_basement
Description: add support for foundation strings and unboxed array
Default: True
Manual: True
Flag support_deepseq
Description: add deepseq instances for memory types
Default: True
Manual: True
Library
Exposed-modules: Data.ByteArray
Data.ByteArray.Encoding
Data.ByteArray.Mapping
Data.ByteArray.Pack
Data.ByteArray.Parse
Data.ByteArray.Hash
Data.Memory.Endian
Data.Memory.PtrMethods
Data.Memory.ExtendedWords
Data.Memory.Encoding.Base16
Data.Memory.Encoding.Base32
Data.Memory.Encoding.Base64
Other-modules: Data.Memory.Internal.Compat
Data.Memory.Internal.CompatPrim
Data.Memory.Internal.CompatPrim64
Data.Memory.Internal.DeepSeq
Data.Memory.Internal.Imports
Data.Memory.Internal.Scrubber
Data.Memory.Hash.SipHash
Data.Memory.Hash.FNV
Data.ByteArray.Pack.Internal
Data.ByteArray.Types
Data.ByteArray.Bytes
Data.ByteArray.ScrubbedBytes
Data.ByteArray.Methods
Data.ByteArray.MemView
Data.ByteArray.View
if impl(ghc < 8.0)
build-depends: base >= 4.9.0.0 && < 4.13
else
build-depends: base >= 4.9.0.0 && < 5
, ghc-prim
-- FIXME armel or mispel is also little endian.
-- might be a good idea to also add a runtime autodetect mode.
-- ARCH_ENDIAN_UNKNOWN
if (arch(i386) || arch(x86_64))
CPP-options: -DARCH_IS_LITTLE_ENDIAN
if os(windows)
Other-modules: Data.Memory.MemMap.Windows
else
Other-modules: Data.Memory.MemMap.Posix
-- optional support bytearray instance for bytestring
if flag(support_bytestring)
CPP-options: -DWITH_BYTESTRING_SUPPORT
Build-depends: bytestring
if flag(support_deepseq)
CPP-options: -DWITH_DEEPSEQ_SUPPORT
Build-depends: deepseq >= 1.1
if flag(support_foundation) || flag(support_basement)
CPP-options: -DWITH_BASEMENT_SUPPORT
Build-depends: basement
exposed-modules: Data.ByteArray.Sized
ghc-options: -Wall -fwarn-tabs
default-language: Haskell2010
Test-Suite test-memory
type: exitcode-stdio-1.0
hs-source-dirs: tests
Main-is: Tests.hs
Other-modules: Imports
SipHash
Utils
Build-Depends: base
, bytestring
, memory
, basement >= 0.0.7
, foundation
ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -threaded
default-language: Haskell2010
if flag(support_foundation)
CPP-options: -DWITH_BASEMENT_SUPPORT
-- Test-Suite test-examples
-- default-language: Haskell2010
-- type: exitcode-stdio-1.0
-- hs-source-dirs: tests
-- ghc-options: -threaded
-- Main-is: DocTests.hs
-- Build-Depends: base >= 3 && < 5
-- , memory
-- , bytestring
-- , doctest
commit d4241481d32fec2466a1a15572c1a65ea6ff1aca
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Sat Mar 16 09:04:38 2019 -0400
Adapt to base-4.13.0.0
diff --git a/Data/ByteArray/Parse.hs b/Data/ByteArray/Parse.hs
index 10b7c06..b0235a8 100644
--- a/Data/ByteArray/Parse.hs
+++ b/Data/ByteArray/Parse.hs
@@ -12,6 +12,7 @@
-- > > parse ((,,) <$> take 2 <*> byte 0x20 <*> (bytes "abc" *> anyByte)) "xx abctest"
-- > ParseOK "est" ("xx", 116)
--
+{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -36,6 +37,7 @@ module Data.ByteArray.Parse
) where
import Control.Monad
+import qualified Control.Monad.Fail as Fail
import Foreign.Storable (Storable, peek, sizeOf)
import Data.Word
@@ -84,10 +86,14 @@ instance Applicative (Parser byteArray) where
pure = return
(<*>) d e = d >>= \b -> e >>= \a -> return (b a)
instance Monad (Parser byteArray) where
- fail errorMsg = Parser $ \buf err _ -> err buf ("Parser failed: " ++ errorMsg)
+#if !(MIN_VERSION_base(4,13,0))
+ fail = Fail.fail
+#endif
return v = Parser $ \buf _ ok -> ok buf v
m >>= k = Parser $ \buf err ok ->
runParser m buf err (\buf' a -> runParser (k a) buf' err ok)
+instance Fail.MonadFail (Parser byteArray) where
+ fail errorMsg = Parser $ \buf err _ -> err buf ("Parser failed: " ++ errorMsg)
instance MonadPlus (Parser byteArray) where
mzero = fail "MonadPlus.mzero"
mplus f g = Parser $ \buf err ok ->
commit 75a8f2dc33924128ec68674a80be679c705c052e
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Wed Aug 28 07:00:25 2019 -0400
Adapt to base-4.13.* / template-haskell-2.16.*
diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
index c8e4e78..8d56a3f 100644
--- a/Text/Hamlet.hs
+++ b/Text/Hamlet.hs
diff -ru shakespeare-2.0.21.orig/Text/Hamlet.hs shakespeare-2.0.21/Text/Hamlet.hs
--- shakespeare-2.0.21.orig/Text/Hamlet.hs 2018-10-16 09:06:57.000000000 -0400
+++ shakespeare-2.0.21/Text/Hamlet.hs 2019-09-07 17:17:55.441074391 -0400
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -231,7 +232,11 @@ docToExp env hr scope (DocCond conds final) = do
@@ -231,7 +232,11 @@
go (d, docs) = do
let d' = derefToExp ((specialOrIdent, VarE 'or):scope) d
docs' <- docsToExp env hr scope docs
......@@ -26,7 +19,7 @@ index c8e4e78..8d56a3f 100644
docToExp env hr scope (DocCase deref cases) = do
let exp_ = derefToExp scope deref
matches <- mapM toMatch cases
@@ -538,7 +543,11 @@ hamletFileReloadWithSettings hrr settings fp = do
@@ -538,7 +543,11 @@
vtToExp (d, vt) = do
d' <- lift d
c' <- toExp vt
......@@ -39,38 +32,9 @@ index c8e4e78..8d56a3f 100644
where
toExp = c
where
diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs
index 2f0642b..6eb8e49 100644
--- a/Text/Hamlet/Parse.hs
+++ b/Text/Hamlet/Parse.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -22,6 +23,7 @@ module Text.Hamlet.Parse
import Text.Shakespeare.Base
import Control.Applicative ((<$>), Applicative (..))
import Control.Monad
+import qualified Control.Monad.Fail as Fail
import Control.Arrow
import Data.Char (GeneralCategory(..), generalCategory, isUpper)
import Data.Data
@@ -37,6 +39,10 @@ instance Monad Result where
return = Ok
Error s >>= _ = Error s
Ok v >>= f = f v
+#if !(MIN_VERSION_base(4,13,0))
+ fail = Fail.fail
+#endif
+instance Fail.MonadFail Result where
fail = Error
instance Functor Result where
fmap = liftM
diff --git a/Text/Internal/Css.hs b/Text/Internal/Css.hs
index 05e915c..96a6113 100644
--- a/Text/Internal/Css.hs
+++ b/Text/Internal/Css.hs
diff -ru shakespeare-2.0.21.orig/Text/Internal/Css.hs shakespeare-2.0.21/Text/Internal/Css.hs
--- shakespeare-2.0.21.orig/Text/Internal/Css.hs 2019-09-02 03:49:06.000000000 -0400
+++ shakespeare-2.0.21/Text/Internal/Css.hs 2019-09-07 17:16:52.168488272 -0400
@@ -1,6 +1,7 @@
{-# OPTIONS_HADDOCK hide #-}
-- | This module is only being exposed to work around a GHC bug, its API is not stable
......@@ -79,7 +43,7 @@ index 05e915c..96a6113 100644
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -281,7 +282,11 @@ vtToExp :: (Deref, VarType) -> Q Exp
@@ -281,7 +282,11 @@
vtToExp (d, vt) = do
d' <- lift d
c' <- c vt
......@@ -92,30 +56,26 @@ index 05e915c..96a6113 100644
where
c :: VarType -> Q Exp
c VTPlain = [|CDPlain . toCss|]
@@ -298,15 +303,15 @@ getVars scope (ContentVar d) =
getVars scope (ContentUrl d) =
case lookupD d scope of
Nothing -> return [(d, VTUrl)]
- Just s -> fail $ "Expected URL for " ++ s
+ Just s -> error $ "Expected URL for " ++ s
getVars scope (ContentUrlParam d) =
case lookupD d scope of
Nothing -> return [(d, VTUrlParam)]
- Just s -> fail $ "Expected URLParam for " ++ s
+ Just s -> error $ "Expected URLParam for " ++ s
getVars scope (ContentMixin d) =
case lookupD d scope of
Nothing -> return [(d, VTMixin)]
- Just s -> fail $ "Expected Mixin for " ++ s
+ Just s -> error $ "Expected Mixin for " ++ s
diff -ru shakespeare-2.0.21.orig/Text/Shakespeare/Base.hs shakespeare-2.0.21/Text/Shakespeare/Base.hs
--- shakespeare-2.0.21.orig/Text/Shakespeare/Base.hs 2018-10-16 09:06:57.000000000 -0400
+++ shakespeare-2.0.21/Text/Shakespeare/Base.hs 2019-09-07 17:14:39.463256263 -0400
@@ -198,7 +198,11 @@
derefToExp _ (DerefRational r) = LitE $ RationalL r
derefToExp _ (DerefString s) = LitE $ StringL s
derefToExp s (DerefList ds) = ListE $ map (derefToExp s) ds
-derefToExp s (DerefTuple ds) = TupE $ map (derefToExp s) ds
+derefToExp s (DerefTuple ds) = TupE
+#if MIN_VERSION_template_haskell(2,16,0)
+ $ map Just
+#endif
+ $ map (derefToExp s) ds
lookupD :: Deref -> [(String, b)] -> Maybe String
lookupD (DerefIdent (Ident s)) scope =
diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
index 68baf51..55f19ab 100644
--- a/Text/Shakespeare.hs
+++ b/Text/Shakespeare.hs
@@ -426,7 +426,11 @@ shakespeareFileReload settings fp = do
-- FIXME shouldn't we use something besides a list here?
flattenDeref :: Deref -> Maybe [String]
diff -ru shakespeare-2.0.21.orig/Text/Shakespeare.hs shakespeare-2.0.21/Text/Shakespeare.hs
--- shakespeare-2.0.21.orig/Text/Shakespeare.hs 2018-10-16 09:06:57.000000000 -0400
+++ shakespeare-2.0.21/Text/Shakespeare.hs 2019-09-07 17:15:59.051995627 -0400
@@ -426,7 +426,11 @@
vtToExp (d, vt) = do
d' <- lift d
c' <- c vt
......@@ -128,20 +88,3 @@ index 68baf51..55f19ab 100644
where
c :: VarType -> Q Exp
c VTPlain = [|EPlain . $(return $
diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
index 3379ed3..b106632 100644
--- a/Text/Shakespeare/Base.hs
+++ b/Text/Shakespeare/Base.hs
@@ -198,7 +198,11 @@ derefToExp _ (DerefIntegral i) = LitE $ IntegerL i
derefToExp _ (DerefRational r) = LitE $ RationalL r
derefToExp _ (DerefString s) = LitE $ StringL s
derefToExp s (DerefList ds) = ListE $ map (derefToExp s) ds
-derefToExp s (DerefTuple ds) = TupE $ map (derefToExp s) ds
+derefToExp s (DerefTuple ds) = TupE
+#if MIN_VERSION_template_haskell(2,16,0)
+ $ map Just
+#endif
+ $ map (derefToExp s) ds
-- FIXME shouldn't we use something besides a list here?
flattenDeref :: Deref -> Maybe [String]
diff -ru xml-hamlet-0.5.0.orig/Text/Hamlet/XMLParse.hs xml-hamlet-0.5.0/Text/Hamlet/XMLParse.hs
--- xml-hamlet-0.5.0.orig/Text/Hamlet/XMLParse.hs 2017-01-16 07:55:00.000000000 -0500
+++ xml-hamlet-0.5.0/Text/Hamlet/XMLParse.hs 2019-05-17 14:34:44.015911657 -0400
@@ -15,6 +15,7 @@
import Text.Shakespeare.Base
import Control.Applicative ((<$>), Applicative (..))
import Control.Monad
+import qualified Control.Monad.Fail as Fail
import Data.Char (isUpper)
import Data.Data
import Text.ParserCombinators.Parsec hiding (Line)
@@ -25,6 +26,10 @@
return = Ok
Error s >>= _ = Error s
Ok v >>= f = f v
+#if !(MIN_VERSION_base(4,13,0))
+ fail = Fail.fail
+#endif
+instance Fail.MonadFail Result where
fail = Error
instance Functor Result where
fmap = liftM
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment