{-# LANGUAGE FlexibleContexts, KindSignatures, OverloadedStrings, RankNTypes, ScopedTypeVariables #-}
module Text.Grampa (
failureDescription, simply,
Grammar, GrammarBuilder, ParseResults, ParseFailure(..), Expected(..), Ambiguous(..), Position,
DeterministicParsing(..), AmbiguousParsing(..),
InputParsing(..), InputCharParsing(..), ConsumedInputParsing(..),
MultiParsing(..), GrammarParsing(..),
TokenParsing(..), LexicalParsing(..),
module Text.Parser.Char,
module Text.Parser.Combinators,
module Text.Parser.LookAhead,
module Text.Grampa.Combinators)
where
import Data.List (intersperse, nub, sort)
import Data.Monoid ((<>))
import Data.Monoid.Textual (TextualMonoid)
import Data.String (IsString(fromString))
import Text.Parser.Char (CharParsing(char, notChar, anyChar))
import Text.Parser.Combinators (Parsing((<?>), notFollowedBy, skipMany, skipSome, unexpected))
import Text.Parser.LookAhead (LookAheadParsing(lookAhead))
import Text.Parser.Token (TokenParsing(..))
import Text.Parser.Input.Position (Position)
import qualified Text.Parser.Input.Position as Position
import Text.Grampa.Combinators (concatMany, concatSome)
import qualified Rank2
import Text.Grampa.Class (MultiParsing(..), GrammarParsing(..),
InputParsing(..), InputCharParsing(..),
ConsumedInputParsing(..), DeterministicParsing(..), LexicalParsing(..),
AmbiguousParsing(..), Ambiguous(..), ParseResults, ParseFailure(..), Expected(..))
type Grammar (g :: (* -> *) -> *) p s = g (p g s)
type GrammarBuilder (g :: (* -> *) -> *)
(g' :: (* -> *) -> *)
(p :: ((* -> *) -> *) -> * -> * -> *)
(s :: *)
= g (p g' s) -> g (p g' s)
simply :: (Rank2.Only r (p (Rank2.Only r) s) -> s -> Rank2.Only r f) -> p (Rank2.Only r) s r -> s -> f r
simply :: (Only r (p (Only r) s) -> s -> Only r f)
-> p (Only r) s r -> s -> f r
simply Only r (p (Only r) s) -> s -> Only r f
parseGrammar p (Only r) s r
p s
input = Only r f -> f r
forall k (a :: k) (f :: k -> *). Only a f -> f a
Rank2.fromOnly (Only r (p (Only r) s) -> s -> Only r f
parseGrammar (p (Only r) s r -> Only r (p (Only r) s)
forall k (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only p (Only r) s r
p) s
input)
failureDescription :: forall s. (Ord s, TextualMonoid s) => s -> ParseFailure s -> Int -> s
failureDescription :: s -> ParseFailure s -> Int -> s
failureDescription s
input (ParseFailure Int
pos [Expected s]
expected) Int
contextLineCount =
s -> Int -> Int -> s
forall s p.
(Eq s, TextualMonoid s, Position p) =>
s -> p -> Int -> s
Position.context s
input (Int -> Int
Position.fromStart Int
pos) Int
contextLineCount
s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
"expected " s -> s -> s
forall a. Semigroup a => a -> a -> a
<> [s] -> s
oxfordComma (Expected s -> s
forall p. (IsString p, Semigroup p) => Expected p -> p
fromExpected (Expected s -> s) -> [Expected s] -> [s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expected s] -> [Expected s]
forall a. Eq a => [a] -> [a]
nub ([Expected s] -> [Expected s]
forall a. Ord a => [a] -> [a]
sort [Expected s]
expected))
where oxfordComma :: [s] -> s
oxfordComma :: [s] -> s
oxfordComma [] = s
""
oxfordComma [s
x] = s
x
oxfordComma [s
x, s
y] = s
x s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
" or " s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
y
oxfordComma (s
x:s
y:[s]
rest) = [s] -> s
forall a. Monoid a => [a] -> a
mconcat (s -> [s] -> [s]
forall a. a -> [a] -> [a]
intersperse s
", " (s
x s -> [s] -> [s]
forall a. a -> [a] -> [a]
: s
y s -> [s] -> [s]
forall a. a -> [a] -> [a]
: (s -> s) -> [s] -> [s]
forall a. (a -> a) -> [a] -> [a]
onLast (s
"or " s -> s -> s
forall a. Semigroup a => a -> a -> a
<>) [s]
rest))
onLast :: (a -> a) -> [a] -> [a]
onLast a -> a
_ [] = []
onLast a -> a
f [a
x] = [a -> a
f a
x]
onLast a -> a
f (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
onLast a -> a
f [a]
xs
fromExpected :: Expected p -> p
fromExpected (Expected String
s) = String -> p
forall a. IsString a => String -> a
fromString String
s
fromExpected (ExpectedInput p
s) = p
"string \"" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
s p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"\""