{-# LANGUAGE RecordWildCards #-}
module Dhall.Parser (
exprFromText
, exprAndHeaderFromText
, censor
, createHeader
, expr, exprA
, Header(..)
, Src(..)
, SourcedException(..)
, ParseError(..)
, Parser(..)
) where
import Control.Exception (Exception)
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Void (Void)
import Dhall.Syntax
import Dhall.Src (Src(..))
import Prelude hiding (const, pi)
import Text.Megaparsec (ParseErrorBundle(..), PosState(..))
import qualified Data.Char
import qualified Data.Text
import qualified Dhall.Core as Core
import qualified Text.Megaparsec
import Dhall.Parser.Combinators
import Dhall.Parser.Token hiding (text)
import Dhall.Parser.Expression
expr :: Parser (Expr Src Import)
expr :: Parser (Expr Src Import)
expr = Parser Import -> Parser (Expr Src Import)
forall a. Parser a -> Parser (Expr Src a)
exprA (Parser Import -> Parser Import
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Text.Megaparsec.try Parser Import
import_)
exprA :: Parser a -> Parser (Expr Src a)
exprA :: Parser a -> Parser (Expr Src a)
exprA = Parser a -> Parser (Expr Src a)
forall a. Parser a -> Parser (Expr Src a)
completeExpression
{-# DEPRECATED exprA "Support for parsing custom imports will be dropped in a future release" #-}
data ParseError = ParseError {
ParseError -> ParseErrorBundle Text Void
unwrap :: Text.Megaparsec.ParseErrorBundle Text Void
, ParseError -> Text
input :: Text
}
censor :: ParseError -> ParseError
censor :: ParseError -> ParseError
censor ParseError
parseError =
ParseError
parseError
{ unwrap :: ParseErrorBundle Text Void
unwrap =
(ParseError -> ParseErrorBundle Text Void
unwrap ParseError
parseError)
{ bundlePosState :: PosState Text
bundlePosState =
(ParseErrorBundle Text Void -> PosState Text
forall s e. ParseErrorBundle s e -> PosState s
bundlePosState (ParseError -> ParseErrorBundle Text Void
unwrap ParseError
parseError))
{ pstateInput :: Text
pstateInput =
Text -> Text
Core.censorText
(PosState Text -> Text
forall s. PosState s -> s
pstateInput (ParseErrorBundle Text Void -> PosState Text
forall s e. ParseErrorBundle s e -> PosState s
bundlePosState (ParseError -> ParseErrorBundle Text Void
unwrap ParseError
parseError)))
}
}
}
instance Show ParseError where
show :: ParseError -> String
show (ParseError {Text
ParseErrorBundle Text Void
input :: Text
unwrap :: ParseErrorBundle Text Void
input :: ParseError -> Text
unwrap :: ParseError -> ParseErrorBundle Text Void
..}) =
String
"\n\ESC[1;31mError\ESC[0m: Invalid input\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParseErrorBundle Text Void -> String
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Text.Megaparsec.errorBundlePretty ParseErrorBundle Text Void
unwrap
instance Exception ParseError
exprFromText
:: String
-> Text
-> Either ParseError (Expr Src Import)
exprFromText :: String -> Text -> Either ParseError (Expr Src Import)
exprFromText String
delta Text
text = ((Header, Expr Src Import) -> Expr Src Import)
-> Either ParseError (Header, Expr Src Import)
-> Either ParseError (Expr Src Import)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Header, Expr Src Import) -> Expr Src Import
forall a b. (a, b) -> b
snd (String -> Text -> Either ParseError (Header, Expr Src Import)
exprAndHeaderFromText String
delta Text
text)
newtype = Text deriving Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show
createHeader :: Text -> Header
=
Text -> Header
Header (Text -> Header) -> (Text -> Text) -> Text -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Data.Text.dropWhile Char -> Bool
Data.Char.isSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Data.Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
exprAndHeaderFromText
:: String
-> Text
-> Either ParseError (Header, Expr Src Import)
exprAndHeaderFromText :: String -> Text -> Either ParseError (Header, Expr Src Import)
exprAndHeaderFromText String
delta Text
text = case Either (ParseErrorBundle Text Void) (Text, Expr Src Import)
result of
Left ParseErrorBundle Text Void
errInfo -> ParseError -> Either ParseError (Header, Expr Src Import)
forall a b. a -> Either a b
Left (ParseError :: ParseErrorBundle Text Void -> Text -> ParseError
ParseError { unwrap :: ParseErrorBundle Text Void
unwrap = ParseErrorBundle Text Void
errInfo, input :: Text
input = Text
text })
Right (Text
txt, Expr Src Import
r) -> (Header, Expr Src Import)
-> Either ParseError (Header, Expr Src Import)
forall a b. b -> Either a b
Right (Text -> Header
createHeader Text
txt, Expr Src Import
r)
where
parser :: Parser (Text, Expr Src Import)
parser = do
(Text
bytes, ()
_) <- Parser () -> Parser (Tokens Text, ())
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser ()
whitespace
Expr Src Import
r <- Parser (Expr Src Import)
expr
Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Text.Megaparsec.eof
(Text, Expr Src Import) -> Parser (Text, Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
bytes, Expr Src Import
r)
result :: Either (ParseErrorBundle Text Void) (Text, Expr Src Import)
result = Parsec Void Text (Text, Expr Src Import)
-> String
-> Text
-> Either (ParseErrorBundle Text Void) (Text, Expr Src Import)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Text.Megaparsec.parse (Parser (Text, Expr Src Import)
-> Parsec Void Text (Text, Expr Src Import)
forall a. Parser a -> Parsec Void Text a
unParser Parser (Text, Expr Src Import)
parser) String
delta Text
text