forward port to megaparsec-7

2 files changed, 21 insertions, 0 deletions

diff --git a/lambdacube-compiler.cabal b/lambdacube-compiler.cabal
index 6d47d950..693ed41b 100644
--- a/lambdacube-compiler.cabal
+++ b/lambdacube-compiler.cabal
@@ -119,6 +119,7 @@ library
 
 executable lc
   hs-source-dirs:   tool
+  other-modules: Paths_lambdacube_compiler
   main-is:          Compiler.hs
   default-language: Haskell2010
 
diff --git a/src/LambdaCube/Compiler/Lexer.hs b/src/LambdaCube/Compiler/Lexer.hs
index 29b88930..3281fdb0 100644
--- a/src/LambdaCube/Compiler/Lexer.hs
+++ b/src/LambdaCube/Compiler/Lexer.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP #-}
 module LambdaCube.Compiler.Lexer
     ( module LambdaCube.Compiler.Lexer
     , module ParseUtils
@@ -43,7 +44,11 @@ toSPos :: SourcePos -> SPos
 toSPos p = SPos (fromIntegral $ unPos $ sourceLine p) (fromIntegral $ unPos $ sourceColumn p)
 
 getSPos :: Parse r w SPos
+#if MIN_VERSION_megaparsec(7,0,0)
+getSPos = toSPos <$> getSourcePos
+#else
 getSPos = toSPos <$> getPosition
+#endif
 
 -------------------------------------------------------------------------------- literals
 
@@ -121,10 +126,25 @@ parseState fi di = (ParseEnv fi di ExpNS (SPos 0 0), either (error "impossible")
 --type Parse r w = ReaderT (ParseEnv r) (WriterT [w] (StateT SPos (Parsec String)))
 type Parse r w = RWST (ParseEnv r) [w] SPos (Parsec (ErrorFancy Void) String)
 
+#if MIN_VERSION_megaparsec(7,0,0)
+newtype ParseError = ParseErr (P.ParseErrorBundle (String) (ErrorFancy Void))
+instance ShowErrorComponent (ErrorFancy Void) where
+    showErrorComponent (ErrorFail s) = s
+        -- fail has been used in parser monad
+    showErrorComponent (ErrorIndentation ordering row col) = "Indentation error " ++ show (ordering,row,col)
+        -- Incorrect indentation error: desired ordering between reference level and actual level, reference indentation level, actual indentation level
+    showErrorComponent _ = "CustomError"
+        -- ErrorCustom e   -- Custom error data, can be conveniently disabled by indexing ErrorFancy by Void
+#else
 newtype ParseError = ParseErr (P.ParseError (Token String) (ErrorFancy Void))
+#endif
 
 instance Show ParseError where
+#if MIN_VERSION_megaparsec(7,0,0)
+    show (ParseErr e) = errorBundlePretty e
+#else
     show (ParseErr e) = parseErrorPretty e
+#endif
 
 runParse :: Parse r w a -> ParseState r -> Either ParseError (a, [w])
 runParse p (env, st) = left ParseErr . snd . flip runParser' st $ evalRWST p env (error "spos")