module Cardano.Api.Parser.Text
  ( module Cardano.Api.Parser.Text
  , module Control.Applicative
  , module Data.Functor
  , module Text.Parsec
  , module Text.Parsec.Char
  , module Text.Parsec.Expr
  , module Text.Parsec.Text
  , module Text.ParserCombinators.Parsec.Combinator
  , module Data.Char
  )
where

import Cardano.Api.Monad.Error

import Control.Applicative
import Data.Bifunctor (first)
import Data.Char (digitToInt)
import Data.Foldable qualified as F
import Data.Functor
import Data.Text (Text)
import Data.Word (Word64)
import Text.Parsec hiding (many, optional, runParser, (<|>))
import Text.Parsec.Char
import Text.Parsec.Error (errorMessages, showErrorMessages)
import Text.Parsec.Expr (Assoc (..), Operator (..), buildExpressionParser)
import Text.Parsec.Text (Parser)
import Text.ParserCombinators.Parsec.Combinator (many1)

-- | Run parser
runParser
  :: Parser a
  -> Text
  -- ^ input text
  -> Either String a
runParser :: forall a. Parser a -> Text -> Either String a
runParser Parser a
parser Text
input =
  (ParseError -> String) -> Either ParseError a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseError -> String
formatParsecError (Either ParseError a -> Either String a)
-> Either ParseError a -> Either String a
forall a b. (a -> b) -> a -> b
$
    Parser a -> String -> Text -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parser a
parser Parser a -> ParsecT Text () Identity () -> Parser a
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
"" Text
input
 where
  formatParsecError :: ParseError -> String
  formatParsecError :: ParseError -> String
formatParsecError ParseError
err =
    String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages
      String
"or"
      String
"unknown parse error"
      String
"expecting"
      String
"unexpected"
      String
"end of input"
      ([Message] -> String) -> [Message] -> String
forall a b. (a -> b) -> a -> b
$ ParseError -> [Message]
errorMessages ParseError
err

-- | Run parser in 'MonadFail'
runParserFail :: MonadFail m => Parser a -> Text -> m a
runParserFail :: forall (m :: * -> *) a. MonadFail m => Parser a -> Text -> m a
runParserFail Parser a
p = Either String a -> m a
forall (m :: * -> *) a. MonadFail m => Either String a -> m a
failEither (Either String a -> m a)
-> (Text -> Either String a) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
runParser Parser a
p

-- | Word64 parser.
parseWord64 :: Parser Integer
parseWord64 :: Parser Integer
parseWord64 = do
  Integer
i <- Parser Integer
parseDecimal
  if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64)
    then
      String -> Parser Integer
forall a. String -> ParsecT Text () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Integer) -> String -> Parser Integer
forall a b. (a -> b) -> a -> b
$
        String
"expecting word64, but the number exceeds the max bound: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
i
    else Integer -> Parser Integer
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
i

-- | Non-negative decimal numbers parser
parseDecimal :: Parser Integer
parseDecimal :: Parser Integer
parseDecimal = do
  String
digits <- ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  Integer -> Parser Integer
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Parser Integer) -> Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$! (Integer -> Char -> Integer) -> Integer -> String -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\Integer
x Char
d -> Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
digitToInt Char
d)) Integer
0 String
digits