{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Dhall.Parser (
exprFromText
, exprAndHeaderFromText
, censor
, createHeader
, expr, exprA
, Header(..)
, Src(..)
, SourcedException(..)
, ParseError(..)
, Parser(..)
) where
import Control.Exception (Exception)
import Data.Text (Text)
import Data.Void (Void)
import Dhall.Src (Src (..))
import Dhall.Syntax
import Text.Megaparsec (ParseErrorBundle (..), PosState (..))
import qualified Data.Text as Text
import qualified Dhall.Core as Core
import qualified Text.Megaparsec
import Dhall.Parser.Combinators
import Dhall.Parser.Expression
import Dhall.Parser.Token hiding (text)
expr :: Parser (Expr Src Import)
expr = exprA (Text.Megaparsec.try import_)
exprA :: Parser a -> Parser (Expr Src a)
exprA = completeExpression
{-# DEPRECATED exprA "Support for parsing custom imports will be dropped in a future release" #-}
data ParseError = ParseError {
unwrap :: Text.Megaparsec.ParseErrorBundle Text Void
, input :: Text
}
censor :: ParseError -> ParseError
censor parseError =
parseError
{ unwrap =
(unwrap parseError)
{ bundlePosState =
(bundlePosState (unwrap parseError))
{ pstateInput =
Core.censorText
(pstateInput (bundlePosState (unwrap parseError)))
}
}
}
instance Show ParseError where
show (ParseError {..}) =
"\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" <> Text.Megaparsec.errorBundlePretty unwrap
instance Exception ParseError
exprFromText
:: String
-> Text
-> Either ParseError (Expr Src Import)
exprFromText delta text = fmap snd (exprAndHeaderFromText delta text)
newtype Header = Header Text deriving Show
createHeader :: Text -> Header
createHeader text = Header (prefix <> newSuffix)
where
isWhitespace c = c == ' ' || c == '\n' || c == '\r' || c == '\t'
prefix = Text.dropAround isWhitespace text
newSuffix
| Text.null prefix = ""
| otherwise = "\n"
exprAndHeaderFromText
:: String
-> Text
-> Either ParseError (Header, Expr Src Import)
exprAndHeaderFromText delta text = case result of
Left errInfo -> Left (ParseError { unwrap = errInfo, input = text })
Right (txt, r) -> Right (createHeader 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