-- | A collection of general parsing definitions

module KMonad.Parsing
  ( Parser
  , ParserT
  , ParseError(..)

  , sc
  , hsc
  , lex
  , hlex

  , module Text.Megaparsec
  , module Text.Megaparsec.Char
  )

where

import KMonad.Prelude

import Text.Megaparsec hiding (ParseError)
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as X


--------------------------------------------------------------------------------

-- | Parsec type specified down to Void Text
type Parser a    = Parsec Void Text a
type ParserT m a = ParsecT Void Text m a

-- | Parsec parse errors under Void Text with an Exception instance
newtype ParseError = ParseError { ParseError -> ParseErrorBundle Text Void
_parseError :: ParseErrorBundle Text Void}
  deriving ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: ParseError -> ParseError -> Bool
Eq

instance Show ParseError where
  show :: ParseError -> String
show (ParseError ParseErrorBundle Text Void
e) = String
"Parse error at " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
e

instance Exception ParseError

--------------------------------------------------------------------------------

-- | Horizontal space consumption
hsc :: Parser ()
hsc :: Parser ()
hsc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
X.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 Parser ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty Parser ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Horizontal space lexeme
hlex :: Parser a -> Parser a
hlex :: forall a. Parser a -> Parser a
hlex = Parser ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
X.lexeme Parser ()
hsc

-- | Full space consumption
sc :: Parser ()
sc :: Parser ()
sc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
X.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 (Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
X.skipLineComment  Tokens Text
";;") (Tokens Text -> Tokens Text -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> Tokens s -> m ()
X.skipBlockComment Tokens Text
"#|" Tokens Text
"|#")

-- | Full space lexeme
lex :: Parser a -> Parser a
lex :: forall a. Parser a -> Parser a
lex = Parser ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
X.lexeme Parser ()
sc