module Internal.Quasi.Parser (module Parsec, module Char, Parser, parse, var, expr, satisfyOneOf, char') where

import Control.Monad
import Data.Char as Char
import Language.Haskell.Exts.Parser (ParseResult (..), parseExp)
import Language.Haskell.Meta.Syntax.Translate (toExp)
import Language.Haskell.TH.Syntax
import Text.Parsec as Parsec hiding (parse)
import qualified Text.Parsec as P
import Text.Parsec.Char as Parsec
import Text.Parsec.Combinator as Parsec
import Text.Parsec.Error as Parsec

type Parser a = Parsec String () a

parse :: Parser a -> SourceName -> String -> Either [String] a
parse :: Parser a -> SourceName -> SourceName -> Either [SourceName] a
parse parser :: Parser a
parser name :: SourceName
name source :: SourceName
source = case Parser a -> SourceName -> SourceName -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
P.parse Parser a
parser SourceName
name SourceName
source of
  Right a :: a
a -> a -> Either [SourceName] a
forall a b. b -> Either a b
Right a
a
  Left err :: ParseError
err -> [SourceName] -> Either [SourceName] a
forall a b. a -> Either a b
Left ([SourceName] -> Either [SourceName] a)
-> [SourceName] -> Either [SourceName] a
forall a b. (a -> b) -> a -> b
$ (Message -> SourceName) -> [Message] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map Message -> SourceName
messageString ([Message] -> [SourceName]) -> [Message] -> [SourceName]
forall a b. (a -> b) -> a -> b
$ ParseError -> [Message]
errorMessages (ParseError -> [Message]) -> ParseError -> [Message]
forall a b. (a -> b) -> a -> b
$ ParseError
err

satisfyOneOf :: [Char -> Bool] -> Parser Char
satisfyOneOf :: [Char -> Bool] -> Parser Char
satisfyOneOf ps :: [Char -> Bool]
ps = (Char -> Bool) -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> (Char -> [Bool]) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char -> Bool] -> SourceName -> [Bool]
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap [Char -> Bool]
ps (SourceName -> [Bool]) -> (Char -> SourceName) -> Char -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> SourceName
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

expr :: String -> Parser Exp
expr :: SourceName -> Parser Exp
expr source :: SourceName
source =
  case SourceName -> ParseResult (Exp SrcSpanInfo)
parseExp SourceName
source of
    ParseOk exp :: Exp SrcSpanInfo
exp -> Exp -> Parser Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Parser Exp) -> Exp -> Parser Exp
forall a b. (a -> b) -> a -> b
$ Exp SrcSpanInfo -> Exp
forall a. ToExp a => a -> Exp
toExp Exp SrcSpanInfo
exp
    ParseFailed _ e :: SourceName
e -> SourceName -> Parser Exp
forall s u (m :: * -> *) a. SourceName -> ParsecT s u m a
parserFail SourceName
e

char' :: Char -> Parser String
char' :: Char -> Parser SourceName
char' = (Char -> SourceName) -> Parser Char -> Parser SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> SourceName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser Char -> Parser SourceName)
-> (Char -> Parser Char) -> Char -> Parser SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char

anyChar' :: Parser String
anyChar' :: Parser SourceName
anyChar' = (Char -> SourceName) -> Parser Char -> Parser SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> SourceName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser Char -> Parser SourceName)
-> Parser Char -> Parser SourceName
forall a b. (a -> b) -> a -> b
$ Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar

var :: Parser String
var :: Parser SourceName
var = ((Parser Char -> Parser SourceName
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Parser Char -> Parser SourceName)
-> Parser Char -> Parser SourceName
forall a b. (a -> b) -> a -> b
$ [Char -> Bool] -> Parser Char
satisfyOneOf [Char -> Bool]
outer) Parser SourceName -> Parser SourceName -> Parser SourceName
forall a. Semigroup a => a -> a -> a
<> (Parser Char -> Parser SourceName
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parser Char -> Parser SourceName)
-> Parser Char -> Parser SourceName
forall a b. (a -> b) -> a -> b
$ [Char -> Bool] -> Parser Char
satisfyOneOf [Char -> Bool]
inner))
  where
    outer :: [Char -> Bool]
outer = [Char -> Bool
isAlpha, (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_')]
    inner :: [Char -> Bool]
inner = Char -> Bool
isDigit (Char -> Bool) -> [Char -> Bool] -> [Char -> Bool]
forall a. a -> [a] -> [a]
: (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'') (Char -> Bool) -> [Char -> Bool] -> [Char -> Bool]
forall a. a -> [a] -> [a]
: [Char -> Bool]
outer