{-# OPTIONS_GHC -Wno-orphans #-}
module FreeC.Util.Parsec where
import Data.Composition ( (.:) )
import Text.Parsec ( Parsec )
import qualified Text.Parsec as Parsec
import qualified Text.Parsec.Error as Parsec
import FreeC.IR.SrcSpan
import FreeC.Monad.Reporter
instance ConvertibleSrcSpan Parsec.SourcePos where
convertSrcSpan srcFileMap srcPos = SrcSpan
{ srcSpanFile = lookupSrcFile (Parsec.sourceName srcPos) srcFileMap
, srcSpanStartLine = Parsec.sourceLine srcPos
, srcSpanStartColumn = Parsec.sourceColumn srcPos
, srcSpanEndLine = Parsec.sourceLine srcPos
, srcSpanEndColumn = Parsec.sourceColumn srcPos
}
parsecErrorToMessage :: SrcFileMap -> Parsec.ParseError -> Message
parsecErrorToMessage srcFiles parseError = Message
(convertSrcSpan srcFiles (Parsec.errorPos parseError)) Error
(Parsec.showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected
msgEndOfInput (Parsec.errorMessages parseError))
where
msgOr, msgUnknown, msgExpecting, msgUnExpected, msgEndOfInput :: String
msgOr = "or"
msgUnknown = "unknown parse error"
msgExpecting = "expecting"
msgUnExpected = "unexpected"
msgEndOfInput = "end of input"
reportParsecError :: MonadReporter r => SrcFileMap -> Parsec.ParseError -> r a
reportParsecError = reportFatal .: parsecErrorToMessage
runParsecOrFail :: MonadReporter r
=> SrcFile
-> [t]
-> Parsec [t] () a
-> r a
runParsecOrFail srcFile stream parser = do
let srcFiles = mkSrcFileMap [srcFile]
result = Parsec.runParser parser () (srcFileName srcFile) stream
either (reportParsecError srcFiles) return result