-- | This module provides some higher-level types and infrastructure to  make it easier to use.

{-# LANGUAGE PatternGuards, ScopedTypeVariables, NoMonomorphismRestriction,FlexibleInstances,  FlexibleContexts, RankNTypes, ScopedTypeVariables #-}
-- {-# LANGUAGE  MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}

module Text.ParserCombinators.UU.Utils (
   -- * Single-char parsers
  pCR,
  pLF,
  pLower,
  pUpper,
  pLetter,
  pAscii,
  pDigit,
  pDigitAsNum,
  pAnySym,

  -- * Whitespace and comments (comments - not yet supported)
  pSpaces, -- This should not be used very often. In general
           -- you may want to use it to skip initial whitespace
           -- at the start of all input, but after that you
           -- should rely on Lexeme parsers to skip whitespace
           -- as needed. (This is the same as the strategy used
           -- by Parsec).

  -- * Lexeme parsers (as opposed to 'Raw' parsers)
  lexeme,
  pDot,
  pComma,
  pDQuote,
  pLParen,
  pRParen,
  pLBracket,
  pRBracket,
  pLBrace,
  pRBrace,
  pSymbol,

  -- * Raw parsers for numbers
  pNaturalRaw,
  pIntegerRaw,
  pDoubleRaw,
  pDoubleStr,

  -- * Lexeme parsers for numbers
  pNatural,
  pInteger,
  pDouble,
  pPercent,

  -- * Parsers for Enums
  pEnumRaw,
  pEnum,
  pEnumStrs,

  -- * Parenthesized parsers
  pParens,
  pBraces,
  pBrackets,
  listParser,
  tupleParser,
  pTuple,

  -- * Lexeme parsers for `Date`-s
  pDay,
  pDayMonthYear,

  -- * Lexeme parser for quoted `String`-s
  pParentheticalString,
  pQuotedString,

  -- * Read-compatability
  parserReadsPrec,
  
  -- * Basic facility for runninga parser, getting at most a single error message
  execParser,
  runParser
)
where

import Data.Char
import Data.List
import Data.Time
import Text.ParserCombinators.UU.Core
import Text.ParserCombinators.UU.BasicInstances
import Text.ParserCombinators.UU.Derived 
import Text.Printf
import qualified Data.ListLike  as LL

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

--  Single Char parsers

pCR :: Parser Char
pCR :: P (Str Char state loc) Char
pCR       = Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'\r'

pLF :: Parser Char
pLF :: P (Str Char state loc) Char
pLF       = Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'\n'

pLower :: Parser Char
pLower :: P (Str Char state loc) Char
pLower  = (Char, Char) -> P (Str Char state loc) Char
forall a loc state.
(Ord a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a, a) -> P (Str a state loc) a
pRange (Char
'a',Char
'z')

pUpper :: Parser Char
pUpper :: P (Str Char state loc) Char
pUpper  = (Char, Char) -> P (Str Char state loc) Char
forall a loc state.
(Ord a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a, a) -> P (Str a state loc) a
pRange (Char
'A',Char
'Z')

pLetter:: Parser Char
pLetter :: P (Str Char state loc) Char
pLetter = P (Str Char state loc) Char
Parser Char
pUpper P (Str Char state loc) Char
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P (Str Char state loc) Char
Parser Char
pLower

pAscii :: Parser Char
pAscii :: P (Str Char state loc) Char
pAscii = (Char, Char) -> P (Str Char state loc) Char
forall a loc state.
(Ord a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a, a) -> P (Str a state loc) a
pRange (Char
'\000', Char
'\254')

pDigit :: Parser Char
pDigit :: P (Str Char state loc) Char
pDigit  = (Char, Char) -> P (Str Char state loc) Char
forall a loc state.
(Ord a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a, a) -> P (Str a state loc) a
pRange (Char
'0',Char
'9')


pDigitAsNum ::  Num a => Parser a
pDigitAsNum :: Parser a
pDigitAsNum =
  Char -> a
forall a. Num a => Char -> a
digit2Int (Char -> a)
-> P (Str Char state loc) Char -> P (Str Char state loc) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) Char
Parser Char
pDigit
  where
  digit2Int :: Char -> a
digit2Int Char
a = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'

pAnySym ::  (IsLocationUpdatedBy loc Char, LL.ListLike state Char) => String -> P (Str Char state loc) Char
pAnySym :: String -> P (Str Char state loc) Char
pAnySym = (Char -> P (Str Char state loc) Char)
-> String -> P (Str Char state loc) Char
forall (p :: * -> *) a a1. IsParser p => (a -> p a1) -> [a] -> p a1
pAny Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym

-- * Dealing with Whitespace
pSpaces :: Parser String
pSpaces :: P (Str Char state loc) String
pSpaces = (Char -> Bool) -> P (Str Char state loc) String
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> P (Str a state loc) [a]
pMunch (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" \r\n\t") P (Str Char state loc) String
-> String -> P (Str Char state loc) String
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> String
"Whitespace"

-- | Lexeme Parsers skip trailing whitespace (this terminology comes from Parsec)
lexeme :: ParserTrafo a a
lexeme :: P (Str Char state loc) a -> P (Str Char state loc) a
lexeme P (Str Char state loc) a
p = P (Str Char state loc) a
p P (Str Char state loc) a
-> P (Str Char state loc) String -> P (Str Char state loc) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char state loc) String
Parser String
pSpaces

pDot, pComma, pDQuote, pLParen, pRParen, pLBracket, pRBracket, pLBrace, pRBrace :: Parser Char
pDot :: P (Str Char state loc) Char
pDot      = P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) Char -> P (Str Char state loc) Char)
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'.'
pComma :: P (Str Char state loc) Char
pComma    = P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) Char -> P (Str Char state loc) Char)
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
','
pDQuote :: P (Str Char state loc) Char
pDQuote   = P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) Char -> P (Str Char state loc) Char)
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'"'
pLParen :: P (Str Char state loc) Char
pLParen   = P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) Char -> P (Str Char state loc) Char)
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'('
pRParen :: P (Str Char state loc) Char
pRParen   = P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) Char -> P (Str Char state loc) Char)
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
')'
pLBracket :: P (Str Char state loc) Char
pLBracket = P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) Char -> P (Str Char state loc) Char)
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'['
pRBracket :: P (Str Char state loc) Char
pRBracket = P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) Char -> P (Str Char state loc) Char)
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
']'
pLBrace :: P (Str Char state loc) Char
pLBrace   = P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) Char -> P (Str Char state loc) Char)
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'{'
pRBrace :: P (Str Char state loc) Char
pRBrace   = P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) Char -> P (Str Char state loc) Char)
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'}'

pSymbol :: (IsLocationUpdatedBy loc Char, LL.ListLike state Char) => String -> P (Str Char state loc)  String
pSymbol :: String -> P (Str Char state loc) String
pSymbol   = P (Str Char state loc) String -> P (Str Char state loc) String
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) String -> P (Str Char state loc) String)
-> (String -> P (Str Char state loc) String)
-> String
-> P (Str Char state loc) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> P (Str Char state loc) String
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> P (Str a state loc) [a]
pToken

-- * Parsers for Numbers
-- ** Raw (non lexeme) parsers
pNaturalRaw :: (Num a) => Parser a
pNaturalRaw :: Parser a
pNaturalRaw = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
a a
b -> a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) a
0 ([a] -> a)
-> P (Str Char state loc) [a] -> P (Str Char state loc) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) a -> P (Str Char state loc) [a]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList1 P (Str Char state loc) a
forall a. Num a => Parser a
pDigitAsNum P (Str Char state loc) a -> String -> P (Str Char state loc) a
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> String
"Natural"

pIntegerRaw :: (Num a) => Parser a
pIntegerRaw :: Parser a
pIntegerRaw = P (Str Char state loc) (a -> a)
forall a. Num a => Parser (a -> a)
pSign P (Str Char state loc) (a -> a)
-> P (Str Char state loc) a -> P (Str Char state loc) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char state loc) a
forall a. Num a => Parser a
pNaturalRaw P (Str Char state loc) a -> String -> P (Str Char state loc) a
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> String
"Integer"

pDoubleRaw :: (Read a) => Parser a
pDoubleRaw :: Parser a
pDoubleRaw = String -> a
forall a. Read a => String -> a
read (String -> a)
-> P (Str Char state loc) String -> P (Str Char state loc) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) String
Parser String
pDoubleStr

pDoubleStr :: Parser  [Char]
pDoubleStr :: P (Str Char state loc) String
pDoubleStr = P (Str Char state loc) (String -> String)
forall loc state.
(IsLocationUpdatedBy loc Char, ListLike state Char) =>
P (Str Char state loc) (String -> String)
pOptSign P (Str Char state loc) (String -> String)
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> P (Str Char state loc) String
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> P (Str a state loc) [a]
pToken String
"Infinity" P (Str Char state loc) String
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P (Str Char state loc) String
Parser String
pPlainDouble)
             P (Str Char state loc) String
-> String -> P (Str Char state loc) String
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> String
"Double (eg -3.4e-5)"
  where
    pPlainDouble :: P (Str Char state loc) String
pPlainDouble = String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> P (Str Char state loc) String
-> P (Str Char state loc) (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> P (Str Char state loc) String
-> P (Str Char state loc) (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) Char -> P (Str Char state loc) String
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList1 P (Str Char state loc) Char
Parser Char
pDigit P (Str Char state loc) (String -> String)
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P (Str Char state loc) String
Parser String
pFraction P (Str Char state loc) String
-> String -> P (Str Char state loc) String
forall (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
`opt` [])) P (Str Char state loc) (String -> String)
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char state loc) String
Parser String
pExponent
    pFraction :: P (Str Char state loc) String
pFraction = (:) (Char -> String -> String)
-> P (Str Char state loc) Char
-> P (Str Char state loc) (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'.' P (Str Char state loc) (String -> String)
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char state loc) Char -> P (Str Char state loc) String
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList1 P (Str Char state loc) Char
Parser Char
pDigit
    pExponent :: P (Str Char state loc) String
pExponent = ((:) (Char -> String -> String)
-> P (Str Char state loc) Char
-> P (Str Char state loc) (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> P (Str Char state loc) Char
forall loc state.
(IsLocationUpdatedBy loc Char, ListLike state Char) =>
String -> P (Str Char state loc) Char
pAnySym String
"eE" P (Str Char state loc) (String -> String)
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P (Str Char state loc) (String -> String)
forall loc state.
(IsLocationUpdatedBy loc Char, ListLike state Char) =>
P (Str Char state loc) (String -> String)
pOptSign P (Str Char state loc) (String -> String)
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char state loc) Char -> P (Str Char state loc) String
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList1 P (Str Char state loc) Char
Parser Char
pDigit)) P (Str Char state loc) String
-> String -> P (Str Char state loc) String
forall (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
`opt` []
    pOptSign :: P (Str Char state loc) (String -> String)
pOptSign = (((Char
'+'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String)
-> P (Str Char state loc) Char
-> P (Str Char state loc) (String -> String)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'+')) P (Str Char state loc) (String -> String)
-> P (Str Char state loc) (String -> String)
-> P (Str Char state loc) (String -> String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String)
-> P (Str Char state loc) Char
-> P (Str Char state loc) (String -> String)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'-'))) P (Str Char state loc) (String -> String)
-> (String -> String) -> P (Str Char state loc) (String -> String)
forall (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
`opt` String -> String
forall a. a -> a
id

-- | NB - At present this is /not/ a lexeme parser, hence we don't
--   support @- 7.0@, @- 7@, @+ 7.0@ etc.
--   It's also currently private - ie local to this module.
pSign :: (Num a) => Parser (a -> a)
pSign :: Parser (a -> a)
pSign = (a -> a
forall a. a -> a
id (a -> a)
-> P (Str Char state loc) Char -> P (Str Char state loc) (a -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'+')) P (Str Char state loc) (a -> a)
-> P (Str Char state loc) (a -> a)
-> P (Str Char state loc) (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a
forall a. Num a => a -> a
negate (a -> a)
-> P (Str Char state loc) Char -> P (Str Char state loc) (a -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'-')) P (Str Char state loc) (a -> a)
-> (a -> a) -> P (Str Char state loc) (a -> a)
forall (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
`opt` a -> a
forall a. a -> a
id

pPercentRaw ::Parser Double
pPercentRaw :: P (Str Char state loc) Double
pPercentRaw = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0) (Double -> Double) -> (String -> Double) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double
forall a. Read a => String -> a
read (String -> Double)
-> P (Str Char state loc) String -> P (Str Char state loc) Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) String
Parser String
pDoubleStr P (Str Char state loc) Double
-> P (Str Char state loc) Char -> P (Str Char state loc) Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'%' P (Str Char state loc) Double
-> String -> P (Str Char state loc) Double
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> String
"Double%"

pPctOrDbl :: P (Str Char state loc) Double
pPctOrDbl = P (Str Char state loc) Double
Parser Double
pPercentRaw P (Str Char state loc) Double
-> P (Str Char state loc) Double -> P (Str Char state loc) Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P (Str Char state loc) Double
forall a. Read a => Parser a
pDoubleRaw

-- ** Lexeme Parsers for Numbers

pNatural :: Num a => Parser a
pNatural :: Parser a
pNatural = P (Str Char state loc) a -> P (Str Char state loc) a
forall a. ParserTrafo a a
lexeme P (Str Char state loc) a
forall a. Num a => Parser a
pNaturalRaw

pInteger :: Num a => Parser a
pInteger :: Parser a
pInteger = P (Str Char state loc) a -> P (Str Char state loc) a
forall a. ParserTrafo a a
lexeme P (Str Char state loc) a
forall a. Num a => Parser a
pIntegerRaw

pDouble :: Parser Double
pDouble :: P (Str Char state loc) Double
pDouble = P (Str Char state loc) Double -> P (Str Char state loc) Double
forall a. ParserTrafo a a
lexeme P (Str Char state loc) Double
forall a. Read a => Parser a
pDoubleRaw

pPercent :: Parser Double
pPercent :: P (Str Char state loc) Double
pPercent = P (Str Char state loc) Double -> P (Str Char state loc) Double
forall a. ParserTrafo a a
lexeme P (Str Char state loc) Double
Parser Double
pPctOrDbl

-- * Parsers for Enums

pEnumRaw :: forall a . ((Enum a, Show a)=> Parser  a)
pEnumRaw :: Parser a
pEnumRaw = (a -> P (Str Char state loc) a -> P (Str Char state loc) a)
-> P (Str Char state loc) a -> [a] -> P (Str Char state loc) a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
c P (Str Char state loc) a
r -> a
c a -> P (Str Char state loc) String -> P (Str Char state loc) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> P (Str Char state loc) String
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> P (Str a state loc) [a]
pToken (a -> String
forall a. Show a => a -> String
show a
c) P (Str Char state loc) a
-> P (Str Char state loc) a -> P (Str Char state loc) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P (Str Char state loc) a
r) P (Str Char state loc) a
forall (p :: * -> *) a. Alternative p => p a
pFail [a]
enumerated
           P (Str Char state loc) a -> String -> P (Str Char state loc) a
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Enum (eg %s or ... %s)" (a -> String
forall a. Show a => a -> String
show ([a] -> a
forall a. [a] -> a
head [a]
enumerated)) (a -> String
forall a. Show a => a -> String
show ([a] -> a
forall a. [a] -> a
last [a]
enumerated)))
            -- unless it is an empty data decl we will always have a head/last (even if the same)
            -- if it is empty, you cannot use it anyhow...
  where
    enumerated :: [a]
    enumerated :: [a]
enumerated = [Int -> a
forall a. Enum a => Int -> a
toEnum Int
0..] 
--    pToken :: Provides st s s => [s] -> P st [s]
--    pToken []     = pure []
--    pToken (a:as) = (:) <$> pSym a <*> pToken as

pEnum ::  (Enum a, Show a) => Parser a
pEnum :: Parser a
pEnum = P (Str Char state loc) a -> P (Str Char state loc) a
forall a. ParserTrafo a a
lexeme P (Str Char state loc) a
forall a. (Enum a, Show a) => Parser a
pEnumRaw

pEnumStrs :: [String]-> Parser String
pEnumStrs :: [String] -> Parser String
pEnumStrs [String]
xs = (String -> P (Str Char state loc) String)
-> [String] -> P (Str Char state loc) String
forall (p :: * -> *) a a1. IsParser p => (a -> p a1) -> [a] -> p a1
pAny (\String
t -> P (Str Char state loc) String
Parser String
pSpaces P (Str Char state loc) String
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> P (Str Char state loc) String
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> P (Str a state loc) [a]
pToken String
t P (Str Char state loc) String
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char state loc) String
Parser String
pSpaces) [String]
xs P (Str Char state loc) String
-> String -> P (Str Char state loc) String
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> String
"enumerated value in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
xs


-- * Parenthesized structures
pParens :: ParserTrafo a a
pParens :: P (Str Char state loc) a -> P (Str Char state loc) a
pParens P (Str Char state loc) a
p = P (Str Char state loc) Char
Parser Char
pLParen P (Str Char state loc) Char
-> P (Str Char state loc) a -> P (Str Char state loc) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P (Str Char state loc) a
p P (Str Char state loc) a
-> P (Str Char state loc) Char -> P (Str Char state loc) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char state loc) Char
Parser Char
pRParen

pBraces ::  ParserTrafo a a
pBraces :: P (Str Char state loc) a -> P (Str Char state loc) a
pBraces P (Str Char state loc) a
p = P (Str Char state loc) Char
Parser Char
pLBrace P (Str Char state loc) Char
-> P (Str Char state loc) a -> P (Str Char state loc) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P (Str Char state loc) a
p P (Str Char state loc) a
-> P (Str Char state loc) Char -> P (Str Char state loc) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char state loc) Char
Parser Char
pRBrace

pBrackets ::  ParserTrafo a a
pBrackets :: P (Str Char state loc) a -> P (Str Char state loc) a
pBrackets P (Str Char state loc) a
p = P (Str Char state loc) Char
Parser Char
pLBracket P (Str Char state loc) Char
-> P (Str Char state loc) a -> P (Str Char state loc) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P (Str Char state loc) a
p P (Str Char state loc) a
-> P (Str Char state loc) Char -> P (Str Char state loc) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char state loc) Char
Parser Char
pRBracket

-- * Lists and tuples
-- | eg [1,2,3]
listParser :: ParserTrafo a [a]
listParser :: P (Str Char state loc) a -> P (Str Char state loc) [a]
listParser = P (Str Char state loc) [a] -> P (Str Char state loc) [a]
forall a. ParserTrafo a a
pBrackets (P (Str Char state loc) [a] -> P (Str Char state loc) [a])
-> (P (Str Char state loc) a -> P (Str Char state loc) [a])
-> P (Str Char state loc) a
-> P (Str Char state loc) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P (Str Char state loc) Char
-> P (Str Char state loc) a -> P (Str Char state loc) [a]
forall (p :: * -> *) a1 a. IsParser p => p a1 -> p a -> p [a]
pListSep P (Str Char state loc) Char
Parser Char
pComma

-- | eg (1,2,3)
tupleParser :: ParserTrafo a [a]
tupleParser :: P (Str Char state loc) a -> P (Str Char state loc) [a]
tupleParser = P (Str Char state loc) [a] -> P (Str Char state loc) [a]
forall a. ParserTrafo a a
pParens (P (Str Char state loc) [a] -> P (Str Char state loc) [a])
-> (P (Str Char state loc) a -> P (Str Char state loc) [a])
-> P (Str Char state loc) a
-> P (Str Char state loc) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P (Str Char state loc) Char
-> P (Str Char state loc) a -> P (Str Char state loc) [a]
forall (p :: * -> *) a1 a. IsParser p => p a1 -> p a -> p [a]
pListSep P (Str Char state loc) Char
Parser Char
pComma

pTuple :: (IsLocationUpdatedBy loc Char, LL.ListLike state Char) => [P (Str Char state loc) a] -> P (Str Char state loc) [a]
pTuple :: [P (Str Char state loc) a] -> P (Str Char state loc) [a]
pTuple []     = [] [a] -> P (Str Char state loc) String -> P (Str Char state loc) [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P (Str Char state loc) String -> P (Str Char state loc) String
forall a. ParserTrafo a a
pParens P (Str Char state loc) String
Parser String
pSpaces
pTuple (P (Str Char state loc) a
p:[P (Str Char state loc) a]
ps) = P (Str Char state loc) [a] -> P (Str Char state loc) [a]
forall a. ParserTrafo a a
pParens (P (Str Char state loc) [a] -> P (Str Char state loc) [a])
-> P (Str Char state loc) [a] -> P (Str Char state loc) [a]
forall a b. (a -> b) -> a -> b
$ (:) (a -> [a] -> [a])
-> P (Str Char state loc) a -> P (Str Char state loc) ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) a -> P (Str Char state loc) a
forall a. ParserTrafo a a
lexeme P (Str Char state loc) a
p P (Str Char state loc) ([a] -> [a])
-> P (Str Char state loc) [a] -> P (Str Char state loc) [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P (Str Char state loc) a -> P (Str Char state loc) a)
-> [P (Str Char state loc) a] -> P (Str Char state loc) [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((P (Str Char state loc) Char
Parser Char
pComma P (Str Char state loc) Char
-> P (Str Char state loc) a -> P (Str Char state loc) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (P (Str Char state loc) a -> P (Str Char state loc) a)
-> (P (Str Char state loc) a -> P (Str Char state loc) a)
-> P (Str Char state loc) a
-> P (Str Char state loc) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P (Str Char state loc) a -> P (Str Char state loc) a
forall a. ParserTrafo a a
lexeme) [P (Str Char state loc) a]
ps

-- * Lexeme parsers for Dates

data Month = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
           deriving (Int -> Month
Month -> Int
Month -> [Month]
Month -> Month
Month -> Month -> [Month]
Month -> Month -> Month -> [Month]
(Month -> Month)
-> (Month -> Month)
-> (Int -> Month)
-> (Month -> Int)
-> (Month -> [Month])
-> (Month -> Month -> [Month])
-> (Month -> Month -> [Month])
-> (Month -> Month -> Month -> [Month])
-> Enum Month
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Month -> Month -> Month -> [Month]
$cenumFromThenTo :: Month -> Month -> Month -> [Month]
enumFromTo :: Month -> Month -> [Month]
$cenumFromTo :: Month -> Month -> [Month]
enumFromThen :: Month -> Month -> [Month]
$cenumFromThen :: Month -> Month -> [Month]
enumFrom :: Month -> [Month]
$cenumFrom :: Month -> [Month]
fromEnum :: Month -> Int
$cfromEnum :: Month -> Int
toEnum :: Int -> Month
$ctoEnum :: Int -> Month
pred :: Month -> Month
$cpred :: Month -> Month
succ :: Month -> Month
$csucc :: Month -> Month
Enum, Month
Month -> Month -> Bounded Month
forall a. a -> a -> Bounded a
maxBound :: Month
$cmaxBound :: Month
minBound :: Month
$cminBound :: Month
Bounded, Month -> Month -> Bool
(Month -> Month -> Bool) -> (Month -> Month -> Bool) -> Eq Month
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Month -> Month -> Bool
$c/= :: Month -> Month -> Bool
== :: Month -> Month -> Bool
$c== :: Month -> Month -> Bool
Eq, Int -> Month -> String -> String
[Month] -> String -> String
Month -> String
(Int -> Month -> String -> String)
-> (Month -> String) -> ([Month] -> String -> String) -> Show Month
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Month] -> String -> String
$cshowList :: [Month] -> String -> String
show :: Month -> String
$cshow :: Month -> String
showsPrec :: Int -> Month -> String -> String
$cshowsPrec :: Int -> Month -> String -> String
Show, Eq Month
Eq Month
-> (Month -> Month -> Ordering)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Bool)
-> (Month -> Month -> Month)
-> (Month -> Month -> Month)
-> Ord Month
Month -> Month -> Bool
Month -> Month -> Ordering
Month -> Month -> Month
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Month -> Month -> Month
$cmin :: Month -> Month -> Month
max :: Month -> Month -> Month
$cmax :: Month -> Month -> Month
>= :: Month -> Month -> Bool
$c>= :: Month -> Month -> Bool
> :: Month -> Month -> Bool
$c> :: Month -> Month -> Bool
<= :: Month -> Month -> Bool
$c<= :: Month -> Month -> Bool
< :: Month -> Month -> Bool
$c< :: Month -> Month -> Bool
compare :: Month -> Month -> Ordering
$ccompare :: Month -> Month -> Ordering
$cp1Ord :: Eq Month
Ord)

pDayMonthYear :: (Num d, Num y) => Parser (d, Int, y)
pDayMonthYear :: Parser (d, Int, y)
pDayMonthYear = P (Str Char state loc) (d, Int, y)
-> P (Str Char state loc) (d, Int, y)
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) (d, Int, y)
 -> P (Str Char state loc) (d, Int, y))
-> P (Str Char state loc) (d, Int, y)
-> P (Str Char state loc) (d, Int, y)
forall a b. (a -> b) -> a -> b
$ (,,) (d -> Int -> y -> (d, Int, y))
-> P (Str Char state loc) d
-> P (Str Char state loc) (Int -> y -> (d, Int, y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) d
forall a loc state.
(Num a, IsLocationUpdatedBy loc Char, ListLike state Char) =>
P (Str Char state loc) a
pDayNum P (Str Char state loc) (Int -> y -> (d, Int, y))
-> P (Str Char state loc) Int
-> P (Str Char state loc) (y -> (d, Int, y))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'-' P (Str Char state loc) Char
-> P (Str Char state loc) Int -> P (Str Char state loc) Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P (Str Char state loc) Int
forall loc state.
(IsLocationUpdatedBy loc Char, ListLike state Char) =>
P (Str Char state loc) Int
pMonthNum) P (Str Char state loc) (y -> (d, Int, y))
-> P (Str Char state loc) y -> P (Str Char state loc) (d, Int, y)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'-' P (Str Char state loc) Char
-> P (Str Char state loc) y -> P (Str Char state loc) y
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P (Str Char state loc) y
forall a loc state.
(Num a, IsLocationUpdatedBy loc Char, ListLike state Char) =>
P (Str Char state loc) a
pYearNum)
  where
    pMonthNum :: P (Str Char state loc) Int
pMonthNum = ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> (Month -> Int) -> Month -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Month -> Int
forall a. Enum a => a -> Int
fromEnum :: Month -> Int)) (Month -> Int)
-> P (Str Char state loc) Month -> P (Str Char state loc) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) Month
forall a. (Enum a, Show a) => Parser a
pEnumRaw P (Str Char state loc) Int -> String -> P (Str Char state loc) Int
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> String
"Month (eg Jan)"
    pDayNum :: P (Str Char state loc) a
pDayNum   = P (Str Char state loc) a
forall a. Num a => Parser a
pNaturalRaw P (Str Char state loc) a -> String -> P (Str Char state loc) a
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> String
"Day (1-31)"
    pYearNum :: P (Str Char state loc) a
pYearNum  = P (Str Char state loc) a
forall a. Num a => Parser a
pNaturalRaw P (Str Char state loc) a -> String -> P (Str Char state loc) a
forall (p :: * -> *) a. ExtAlternative p => p a -> String -> p a
<?> String
"Year (eg 2019)"

pDay :: Parser Day
pDay :: P (Str Char state loc) Day
pDay = (\(Int
d,Int
m,Integer
y) -> Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
d) ((Int, Int, Integer) -> Day)
-> P (Str Char state loc) (Int, Int, Integer)
-> P (Str Char state loc) Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) (Int, Int, Integer)
forall d y. (Num d, Num y) => Parser (d, Int, y)
pDayMonthYear

-- * Quoted Strings

pParentheticalString :: Char -> Parser String

pParentheticalString :: Char -> Parser String
pParentheticalString Char
d = P (Str Char state loc) String -> P (Str Char state loc) String
forall a. ParserTrafo a a
lexeme (P (Str Char state loc) String -> P (Str Char state loc) String)
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall a b. (a -> b) -> a -> b
$ Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
d P (Str Char state loc) Char
-> P (Str Char state loc) String -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P (Str Char state loc) Char -> P (Str Char state loc) String
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList P (Str Char state loc) Char
Parser Char
pNonQuoteVChar P (Str Char state loc) String
-> P (Str Char state loc) Char -> P (Str Char state loc) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> P (Str Char state loc) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
d
  where
    pNonQuoteVChar :: P (Str Char state loc) Char
pNonQuoteVChar = (Char -> Bool) -> Insertion Char -> P (Str Char state loc) Char
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> Insertion a -> P (Str a state loc) a
pSatisfy (\Char
c -> Char -> Bool
visibleChar Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
d) 
                              (String -> Char -> Int -> Insertion Char
forall a. String -> a -> Int -> Insertion a
Insertion  String
"Character in a string set off from main text by delimiter, e.g. double-quotes or comment token" Char
'y' Int
5)
    -- visibleChar :: Char -> Bool
    visibleChar :: Char -> Bool
visibleChar Char
c = Char
'\032' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\126'

pQuotedString :: Parser String
pQuotedString :: P (Str Char state loc) String
pQuotedString = Char -> Parser String
pParentheticalString Char
'"'


-- * Read-compatability

-- | Converts a UU Parser into a read-style one.
--
-- This is intended to facilitate migration from read-style
-- parsers to UU-based ones.
parserReadsPrec :: Parser a -> Int -> ReadS a
parserReadsPrec :: Parser a -> Int -> ReadS a
parserReadsPrec Parser a
p Int
_ String
s = [P (Str Char String Int) (a, String)
-> Str Char String Int -> (a, String)
forall t a. Eof t => P t a -> t -> a
parse ((,) (a -> String -> (a, String))
-> P (Str Char String Int) a
-> P (Str Char String Int) (String -> (a, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char String Int) a
Parser a
p P (Str Char String Int) (String -> (a, String))
-> P (Str Char String Int) String
-> P (Str Char String Int) (a, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> P (Str Char String Int) String
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> P (Str a state loc) [a]
pMunch (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)) (Str Char String Int -> (a, String))
-> (String -> Str Char String Int) -> String -> (a, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> Str Char String Int
forall s a loc. ListLike s a => loc -> s -> Str a s loc
createStr (Int
0::Int) (String -> (a, String)) -> String -> (a, String)
forall a b. (a -> b) -> a -> b
$ String
s]



-- * Running parsers straightforwardly

-- | The lower-level interface. Returns all errors. 
execParser :: Parser a -> String -> (a, [Error LineColPos])
execParser :: Parser a -> String -> (a, [Error LineColPos])
execParser Parser a
p = P (Str Char String LineColPos) (a, [Error LineColPos])
-> Str Char String LineColPos -> (a, [Error LineColPos])
forall t a. Eof t => P t a -> t -> a
parse_h ((,) (a -> [Error LineColPos] -> (a, [Error LineColPos]))
-> P (Str Char String LineColPos) a
-> P (Str Char String LineColPos)
     ([Error LineColPos] -> (a, [Error LineColPos]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char String LineColPos) a
Parser a
p P (Str Char String LineColPos)
  ([Error LineColPos] -> (a, [Error LineColPos]))
-> P (Str Char String LineColPos) [Error LineColPos]
-> P (Str Char String LineColPos) (a, [Error LineColPos])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char String LineColPos) [Error LineColPos]
forall st error. (StoresErrors st error, Eof st) => P st [error]
pEnd) (Str Char String LineColPos -> (a, [Error LineColPos]))
-> (String -> Str Char String LineColPos)
-> String
-> (a, [Error LineColPos])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineColPos -> String -> Str Char String LineColPos
forall s a loc. ListLike s a => loc -> s -> Str a s loc
createStr (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0)

-- | The higher-level interface. (Calls 'error' with a simplified error).  
--   Runs the parser; if the complete input is accepted without problems  return the
--   result else fail with reporting unconsumed tokens
runParser :: String -> Parser a -> String -> a
runParser :: String -> Parser a -> String -> a
runParser String
inputName Parser a
p String
s | (a
a,[Error LineColPos]
b) <- Parser a -> String -> (a, [Error LineColPos])
forall a. Parser a -> String -> (a, [Error LineColPos])
execParser Parser a
p String
s =
    if [Error LineColPos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Error LineColPos]
b
    then a
a
    else String -> a
forall a. HasCallStack => String -> a
error (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Failed parsing '%s' :\n%s\n" String
inputName (String -> [Error LineColPos] -> String
pruneError String
s [Error LineColPos]
b))
         -- We do 'pruneError' above because otherwise you can end
         -- up reporting huge correction streams, and that's
         -- generally not helpful... but the pruning does discard info...
    where -- | Produce a single simple, user-friendly error message
          pruneError :: String -> [Error LineColPos] -> String
          pruneError :: String -> [Error LineColPos] -> String
pruneError String
_ [] = String
""
          pruneError String
_ (DeletedAtEnd String
x     : [Error LineColPos]
_) = String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Unexpected '%s' at end." String
x
          pruneError String
s (Inserted String
_ LineColPos
pos [String]
exp : [Error LineColPos]
_) = String -> [String] -> LineColPos -> String
prettyError String
s [String]
exp LineColPos
pos
          pruneError String
s (Deleted  String
_ LineColPos
pos [String]
exp : [Error LineColPos]
_) = String -> [String] -> LineColPos -> String
prettyError String
s [String]
exp LineColPos
pos
          prettyError :: String -> [String] -> LineColPos -> String
          prettyError :: String -> [String] -> LineColPos -> String
prettyError String
s [String]
exp p :: LineColPos
p@(LineColPos Int
line Int
c Int
abs) = String -> String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Expected %s at %s :\n%s\n%s\n%s\n"
                                                           (LineColPos -> [String] -> String
forall pos. Show pos => pos -> [String] -> String
show_expecting LineColPos
p [String]
exp)
                                                           (LineColPos -> String
forall a. Show a => a -> String
show LineColPos
p)
                                                           String
aboveString
                                                           String
inputFrag
                                                           String
belowString
                             where
                                s' :: String
s' = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n' Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\r' Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\t' then Char
' ' else Char
c) String
s
                                aboveString :: String
aboveString = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
30 Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"v"
                                belowString :: String
belowString = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
30 Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^"
                                inputFrag :: String
inputFrag   = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
abs) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
71 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
abs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
30) String
s')