{-# LANGUAGE FlexibleContexts, KindSignatures, OverloadedStrings, RankNTypes, ScopedTypeVariables,
TypeFamilies, TypeOperators #-}
module Text.Grampa (
failureDescription, simply,
Grammar, GrammarBuilder, GrammarOverlay, ParseResults, ParseFailure(..), FailureDescription(..), Ambiguous(..), Pos,
DeterministicParsing(..), AmbiguousParsing(..), CommittedParsing(..), TraceableParsing(..),
LexicalParsing(..),
MultiParsing(..), GrammarParsing(..), overlay,
InputParsing(..), InputCharParsing(..), ConsumedInputParsing(..), Position(..),
module Text.Parser.Char,
module Text.Parser.Combinators,
module Text.Parser.LookAhead,
TokenParsing(..),
module Text.Grampa.Combinators)
where
import Data.List (intersperse)
import Data.Kind (Type)
import Data.Monoid ((<>), Endo (Endo, appEndo))
import Data.Monoid.Factorial (drop)
import Data.Monoid.Null (null)
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(..), LexicalParsing(..),
CommittedParsing(..), DeterministicParsing(..),
AmbiguousParsing(..), Ambiguous(..),
ParseResults, ParseFailure(..), FailureDescription(..), Pos)
import Text.Grampa.Internal (TraceableParsing(..))
import Prelude hiding (drop, null)
type Grammar (g :: (Type -> Type) -> Type) p s = g (p g s)
type GrammarBuilder (g :: (Type -> Type) -> Type)
(g' :: (Type -> Type) -> Type)
(p :: ((Type -> Type) -> Type) -> Type -> Type -> Type)
(s :: Type)
= g (p g' s) -> g (p g' s)
type GrammarOverlay (g :: (Type -> Type) -> Type)
(m :: Type -> Type)
= g m -> g m -> g m
overlay :: (GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g, Rank2.Distributive g, Foldable f)
=> (g m -> g m) -> f (GrammarOverlay g m) -> g m
overlay :: forall (m :: * -> *) (g :: (* -> *) -> *) (f :: * -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
Distributive g, Foldable f) =>
(g m -> g m) -> f (GrammarOverlay g m) -> g m
overlay g m -> g m
base f (GrammarOverlay g m)
layers = forall a. Endo a -> a -> a
appEndo (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ParserGrammar m m
self)) f (GrammarOverlay g m)
layers) (g m -> g m
base ParserGrammar m m
self)
where self :: ParserGrammar m m
self = forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
Distributive g) =>
g m
selfReferring
simply :: (Rank2.Only r (p (Rank2.Only r) s) -> s -> Rank2.Only r f) -> p (Rank2.Only r) s r -> s -> f r
simply :: forall r (p :: ((* -> *) -> *) -> * -> * -> *) s (f :: * -> *).
(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 = forall {k} (a :: k) (f :: k -> *). Only a f -> f a
Rank2.fromOnly (Only r (p (Only r) s) -> s -> Only r f
parseGrammar (forall {k} (a :: k) (f :: k -> *). f a -> Only a f
Rank2.Only p (Only r) s r
p) s
input)
failureDescription :: forall s pos. (Ord s, TextualMonoid s, Position pos) => s -> ParseFailure pos s -> Int -> s
failureDescription :: forall s pos.
(Ord s, TextualMonoid s, Position pos) =>
s -> ParseFailure pos s -> Int -> s
failureDescription s
input (ParseFailure pos
pos (FailureDescription [String]
expected [s]
inputs) [String]
erroneous) Int
contextLineCount =
forall s p.
(Eq s, TextualMonoid s, Position p) =>
s -> p -> Int -> s
Position.context s
input pos
pos Int
contextLineCount
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat
(forall a. a -> [a] -> [a]
intersperse s
", but " forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. MonoidNull m => m -> Bool
null)
[forall {t}. MonoidNull t => (t -> t) -> t -> t
onNonEmpty (s
"expected " forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ s -> [s] -> s
oxfordComma s
" or " ((forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
expected) forall a. Semigroup a => a -> a -> a
<> (forall {a}. (Semigroup a, IsString a) => a -> a
fromLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [s]
inputs)),
s -> [s] -> s
oxfordComma s
" and " (forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
erroneous)])
where oxfordComma :: s -> [s] -> s
oxfordComma :: s -> [s] -> s
oxfordComma s
_ [] = s
""
oxfordComma s
_ [s
x] = s
x
oxfordComma s
conjunction [s
x, s
y] = s
x forall a. Semigroup a => a -> a -> a
<> s
conjunction forall a. Semigroup a => a -> a -> a
<> s
y
oxfordComma s
conjunction (s
x:s
y:[s]
rest) = forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse s
", " (s
x forall a. a -> [a] -> [a]
: s
y forall a. a -> [a] -> [a]
: forall {a}. (a -> a) -> [a] -> [a]
onLast (forall m. FactorialMonoid m => Int -> m -> m
drop Int
1 s
conjunction forall a. Semigroup a => a -> a -> a
<>) [s]
rest))
onNonEmpty :: (t -> t) -> t -> t
onNonEmpty t -> t
f t
x = if forall m. MonoidNull m => m -> Bool
null t
x then t
x else t -> t
f t
x
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 forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
onLast a -> a
f [a]
xs
fromLiteral :: a -> a
fromLiteral a
s = a
"string \"" forall a. Semigroup a => a -> a -> a
<> a
s forall a. Semigroup a => a -> a -> a
<> a
"\""