{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.Parser (
exprFromText
, exprAndHeaderFromText
, expr, exprA
, Src(..)
, SourcedException(..)
, ParseError(..)
, Parser(..)
) where
import Control.Exception (Exception)
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Void (Void)
import Dhall.Core
import Dhall.Src (Src(..))
import Prelude hiding (const, pi)
import qualified Data.Char
import qualified Data.Text
import qualified Text.Megaparsec
import Dhall.Parser.Combinators
import Dhall.Parser.Token
import Dhall.Parser.Expression
expr :: Parser (Expr Src Import)
expr = exprA (Text.Megaparsec.try import_)
exprA :: Parser a -> Parser (Expr Src a)
exprA = completeExpression
data ParseError = ParseError {
#if MIN_VERSION_megaparsec(7, 0, 0)
unwrap :: Text.Megaparsec.ParseErrorBundle Text Void
#else
unwrap :: Text.Megaparsec.ParseError Char Void
#endif
, input :: Text
}
instance Show ParseError where
show (ParseError {..}) =
#if MIN_VERSION_megaparsec(7, 0, 0)
"\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> Text.Megaparsec.errorBundlePretty unwrap
#else
"\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> Text.Megaparsec.parseErrorPretty unwrap
#endif
instance Exception ParseError
exprFromText
:: String
-> Text
-> Either ParseError (Expr Src Import)
exprFromText delta text = fmap snd (exprAndHeaderFromText delta text)
exprAndHeaderFromText
:: String
-> Text
-> Either ParseError (Text, Expr Src Import)
exprAndHeaderFromText delta text = case result of
Left errInfo -> Left (ParseError { unwrap = errInfo, input = text })
Right (txt, r) -> Right (stripHeader txt, r)
where
parser = do
(bytes, _) <- Text.Megaparsec.match whitespace
r <- expr
Text.Megaparsec.eof
return (bytes, r)
result = Text.Megaparsec.parse (unParser parser) delta text
stripHeader = Data.Text.dropWhile Data.Char.isSpace . Data.Text.dropWhileEnd (/= '\n')