Skip to content
Snippets Groups Projects
Commit 0de3a3fa authored by Teo Camarasu's avatar Teo Camarasu
Browse files

Fix build of doctest

The build was broken by the introduction of the ModuleModInfo type in:
ghc!14187
parent 480d7ba8
No related branches found
No related tags found
1 merge request!411Fix build of doctest
......@@ -152,7 +152,7 @@ extra_package servant 0.20.1
extra_package hgmp 0.1.2.1
extra_package Agda 2.7.0.1
extra_package mmark 0.0.7.6
extra_package doctest 0.22.2
extra_package doctest 0.24.0
extra_package tasty 1.5
extra_package pandoc 3.1.11.1
extra_package servant-conduit 0.16
......
diff --git a/src/Extract.hs b/src/Extract.hs
index f8237de..4ca77cc 100644
--- a/src/Extract.hs
+++ b/src/Extract.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
module Extract (Module(..), extract) where
import Imports hiding (mod, concat)
@@ -115,7 +116,11 @@ parse args = withGhc args $ \modules_ -> withTempOutputDir $ do
$ filterToposortToModules
#endif
$ topSortModuleGraph False mods Nothing
+#if __GLASGOW_HASKELL__ >= 913
+ reverse <$> (mapM (loadModPlugins >=> parseModule) $ mapMaybe (\case ModuleNodeCompile mod -> Just mod; _ -> Nothing) sortedMods)
+#else
reverse <$> mapM (loadModPlugins >=> parseModule) sortedMods
+#endif
where
-- copied from Haddock/GhcUtils.hs
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