Skip to content
Snippets Groups Projects
Commit 8981eb8b authored by Ryan Scott's avatar Ryan Scott
Browse files

Drop old snap-core patch; migrate pandoc, shakespeare patches

`snap-core` has a more recent Hackage version that builds without
issue on GHC HEAD.

`pandoc` and `shakespeare` have more recent Hackage versions that
require patching.
parent c1999211
No related branches found
No related tags found
1 merge request!60Drop old snap-core patch; migrate pandoc, shakespeare patches
Pipeline #13161 passed
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 8d9caa6..c87ff64 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -981,7 +981,7 @@ instance PandocMonad PandocPure where
u : us -> do
modifyPureState $ \st -> st { stUniqStore = us }
return u
- _ -> M.fail "uniq store ran out of elements"
+ _ -> error "uniq store ran out of elements"
openURL u = throwError $ PandocResourceNotFound u
readFileLazy fp = do
fps <- getsPureState stFiles
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
index 45650e3..926b6d3 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
@@ -230,12 +230,12 @@ isEnabled :: HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled ext opts = ext `extensionEnabled` getExtensions opts
#ifdef DERIVE_JSON_VIA_TH
+$(deriveJSON defaultOptions ''TrackChanges)
$(deriveJSON defaultOptions ''ReaderOptions)
$(deriveJSON defaultOptions ''HTMLMathMethod)
$(deriveJSON defaultOptions ''CiteMethod)
$(deriveJSON defaultOptions ''ObfuscationMethod)
$(deriveJSON defaultOptions ''HTMLSlideVariant)
-$(deriveJSON defaultOptions ''TrackChanges)
$(deriveJSON defaultOptions ''WrapOption)
$(deriveJSON defaultOptions ''TopLevelDivision)
$(deriveJSON defaultOptions ''ReferenceLocation)
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index ab5aa6b..e245aee 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -260,7 +260,7 @@ yamlBsToMeta bstr = do
nodeToKey :: Monad m => YAML.Node -> m Text
nodeToKey (YAML.Scalar (YAML.SStr t)) = return t
nodeToKey (YAML.Scalar (YAML.SUnknown _ t)) = return t
-nodeToKey _ = fail "Non-string key in YAML mapping"
+nodeToKey _ = error "Non-string key in YAML mapping"
toMetaValue :: PandocMonad m
=> Text -> MarkdownParser m (F MetaValue)
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index a7b9ee6..c38ffc3 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -560,7 +560,7 @@ writeDocx opts doc@(Pandoc meta _) = do
settingsEntry <- copyChildren refArchive distArchive settingsPath epochtime settingsList
let entryFromArchive arch path =
- maybe (fail $ path ++ " missing in reference docx")
+ maybe (error $ path ++ " missing in reference docx")
return
(findEntryByPath path arch `mplus` findEntryByPath path distArchive)
docPropsAppEntry <- entryFromArchive refArchive "docProps/app.xml"
diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index c03fd0c..f297f08 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -605,7 +605,7 @@ inlineToMuse (Subscript lst) = do
modify $ \st -> st { stUseTags = False }
return $ "<sub>" <> contents <> "</sub>"
inlineToMuse SmallCaps {} =
- fail "SmallCaps should be expanded before normalization"
+ error "SmallCaps should be expanded before normalization"
inlineToMuse (Quoted SingleQuote lst) = do
contents <- inlineListToMuse lst
modify $ \st -> st { stUseTags = False }
@@ -615,7 +615,7 @@ inlineToMuse (Quoted DoubleQuote lst) = do
modify $ \st -> st { stUseTags = False }
return $ "“" <> contents <> "”"
inlineToMuse Cite {} =
- fail "Citations should be expanded before normalization"
+ error "Citations should be expanded before normalization"
inlineToMuse (Code _ str) = do
useTags <- gets stUseTags
modify $ \st -> st { stUseTags = False }
@@ -623,7 +623,7 @@ inlineToMuse (Code _ str) = do
then "<code>" <> text (substitute "</code>" "<</code><code>/code>" str) <> "</code>"
else "=" <> text str <> "="
inlineToMuse Math{} =
- fail "Math should be expanded before normalization"
+ error "Math should be expanded before normalization"
inlineToMuse (RawInline (Format f) str) = do
modify $ \st -> st { stUseTags = False }
return $ "<literal style=\"" <> text f <> "\">" <> text str <> "</literal>"
diff --git a/src/Text/Pandoc/Writers/OOXML.hs b/src/Text/Pandoc/Writers/OOXML.hs
index 3c62a4f..469fe31 100644
--- a/src/Text/Pandoc/Writers/OOXML.hs
+++ b/src/Text/Pandoc/Writers/OOXML.hs
@@ -54,9 +54,9 @@ parseXml :: (PandocMonad m) => Archive -> Archive -> String -> m Element
parseXml refArchive distArchive relpath =
case findEntryByPath relpath refArchive `mplus`
findEntryByPath relpath distArchive of
- Nothing -> fail $ relpath ++ " missing in reference file"
+ Nothing -> error $ relpath ++ " missing in reference file"
Just e -> case parseXMLDoc . UTF8.toStringLazy . fromEntry $ e of
- Nothing -> fail $ relpath ++ " corrupt in reference file"
+ Nothing -> error $ relpath ++ " corrupt in reference file"
Just d -> return d
-- Copied from Util
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index a45c09b..6a0d4a0 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -153,7 +153,7 @@ copyFileToArchive arch fp = do
refArchive <- asks envRefArchive
distArchive <- asks envDistArchive
case findEntryByPath fp refArchive `mplus` findEntryByPath fp distArchive of
- Nothing -> fail $ fp ++ " missing in reference file"
+ Nothing -> error $ fp ++ " missing in reference file"
Just e -> return $ addEntryToArchive e arch
alwaysInheritedPatterns :: [Pattern]
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
index 0fe80be..2f320fb 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
@@ -316,6 +316,10 @@ defaultMathJaxURL = "https://cdn.jsdelivr.net/npm/mathjax@3/es5/"
defaultKaTeXURL :: Text
defaultKaTeXURL = "https://cdnjs.cloudflare.com/ajax/libs/KaTeX/0.11.1/"
+$(deriveJSON defaultOptions{ constructorTagModifier =
+ camelCaseStrToHyphenated
+ } ''TrackChanges)
+
$(deriveJSON defaultOptions ''ReaderOptions)
$(deriveJSON defaultOptions{
@@ -339,10 +343,6 @@ $(deriveJSON defaultOptions{ constructorTagModifier =
$(deriveJSON defaultOptions ''HTMLSlideVariant)
-$(deriveJSON defaultOptions{ constructorTagModifier =
- camelCaseStrToHyphenated
- } ''TrackChanges)
-
$(deriveJSON defaultOptions{ constructorTagModifier =
camelCaseStrToHyphenated
} ''WrapOption)
...@@ -59,10 +59,10 @@ index a76e4a5..31b8608 100644 ...@@ -59,10 +59,10 @@ index a76e4a5..31b8608 100644
c :: VarType -> Q Exp c :: VarType -> Q Exp
c VTPlain = [|CDPlain . toCss|] c VTPlain = [|CDPlain . toCss|]
diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
index 68baf51..55f19ab 100644 index 56ff289..460c1e2 100644
--- a/Text/Shakespeare.hs --- a/Text/Shakespeare.hs
+++ b/Text/Shakespeare.hs +++ b/Text/Shakespeare.hs
@@ -426,7 +426,11 @@ shakespeareFileReload settings fp = do @@ -429,7 +429,11 @@ shakespeareFileReload settings fp = do
vtToExp (d, vt) = do vtToExp (d, vt) = do
d' <- lift d d' <- lift d
c' <- c vt c' <- c vt
......
diff --git a/src/Snap/Internal/Core.hs b/src/Snap/Internal/Core.hs
index ceb81dd..738d762 100644
--- a/src/Snap/Internal/Core.hs
+++ b/src/Snap/Internal/Core.hs
@@ -311,7 +311,9 @@ instance Monad Snap where
return = pure
{-# INLINE return #-}
#endif
+#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
+#endif
instance Fail.MonadFail Snap where
fail = snapFail
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment