-- | This library consists of a collection of parsing algorithms and a common interface for representing grammars as
-- records with rank-2 field types.
--
-- To implement a grammar, first determine if it is a context-free grammar or perhaps a parsing expression grammar. In
-- the latter case, you should import your parser type from either "Text.Grampa.PEG.Backtrack" or the
-- "Text.Grampa.PEG.Packrat" module. The former is faster on simple grammars but may require exponential time on more
-- complex cases. The Packrat parser on the other hand guarantees linear time complexity but has more overhead and
-- consumes more memory.
--
-- If your grammar is context-free, there are more possibilities to choose from:
--
-- * If the grammar is neither left-recursive nor ambiguous, you can import your parser type from
--   "Text.Grampa.ContextFree.Continued".
-- * If the grammar is ambiguous and you need to see all the results, there's "Text.Grampa.ContextFree.Parallel".
-- * For a complex but non-left-recursive grammar, you can use "Text.Grampa.ContextFree.SortedMemoizing".
-- * If you need to carry a monadic computation, there's "Text.Grampa.ContextFree.SortedMemoizing.Transformer".
-- * If the grammar is left-recursive, "Text.Grampa.ContextFree.SortedMemoizing.LeftRecursive" is the ticket.
-- * If the grammar is left-recursive /and/ you require monadic context, the final option is
--   "Text.Grampa.ContextFree.SortedMemoizing.Transformer.LeftRecursive".
--
-- Regardless of the chosen parer type, you'll construct your grammar the same way. A grammar is a set of productions
-- using the same parser type, collected and abstracted inside a rank-2 record type. Each production is built using
-- the standard parser combinators from the usual 'Applicative' and 'Alternative' classes, plus some additional
-- [classes](#g:classes) provided by this library. The 'Monad' operations are available as well, but should not be
-- used in left-recursive positions.
--
-- Once the grammar is complete, you can use 'parseComplete' or 'parsePrefix' to apply it to your input.

{-# LANGUAGE FlexibleContexts, KindSignatures, OverloadedStrings, RankNTypes, ScopedTypeVariables,
             TypeFamilies, TypeOperators #-}
module Text.Grampa (
   -- * Applying parsers
   failureDescription, simply,
   -- * Types
   Grammar, GrammarBuilder, GrammarOverlay, ParseResults, ParseFailure(..), FailureDescription(..), Ambiguous(..), Pos,
   -- * Classes #classes#
   -- ** Parsing
   DeterministicParsing(..), AmbiguousParsing(..), CommittedParsing(..), TraceableParsing(..),
   LexicalParsing(..),
   -- ** Grammars
   MultiParsing(..), GrammarParsing(..), overlay,
   -- ** From the [input-parsers](http://hackage.haskell.org/package/input-parsers) library
   InputParsing(..), InputCharParsing(..), ConsumedInputParsing(..), Position(..),
   -- ** From the [parsers](http://hackage.haskell.org/package/parsers) library
   module Text.Parser.Char,
   module Text.Parser.Combinators,
   module Text.Parser.LookAhead,
   TokenParsing(..),
   -- * Other combinators
   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)

-- | A grammar is a record type @g@ whose fields are parsers of type @p@ on input streams of type @s@. A value of a
-- @Grammar@ type is typically produced by applying 'fixGrammar' or 'overlay' to a 'GrammarBuilder'.
type Grammar (g  :: (Type -> Type) -> Type) p s = g (p g s)

-- | A @GrammarBuilder g g' p s@ is an endomorphic function on a grammar @g@, whose parsers of type @p@ build on
-- grammars of type @g'@ and parse an input stream of type @s@. Grammar parameters @g@ and @g'@ are typically
-- identical in simple monolithic grammars, but when composing complex grammars the first grammar parameter @g@ would
-- be just a building block for the final grammar @g'@.
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)

-- | A grammar overlay is a function that takes a final grammar @self@ and the parent grammar @super@ and builds a new
-- grammar from them. Use 'overlay' to apply a colection of overlays on top of a base grammar.
type GrammarOverlay (g  :: (Type -> Type) -> Type)
                    (m  :: Type -> Type)
   = g m -> g m -> g m

-- | Layers a sequence of 'GrammarOverlay' on top of a base 'GrammarBuilder' to produce a new grammar.
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 = Endo (g m) -> g m -> g m
forall a. Endo a -> a -> a
appEndo ((GrammarOverlay g m -> Endo (g m))
-> f (GrammarOverlay g m) -> Endo (g m)
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((g m -> g m) -> Endo (g m)
forall a. (a -> a) -> Endo a
Endo ((g m -> g m) -> Endo (g m))
-> (GrammarOverlay g m -> g m -> g m)
-> GrammarOverlay g m
-> Endo (g m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ParserGrammar m m -> g m -> g m)
-> ParserGrammar m m -> g m -> g m
forall a b. (a -> b) -> a -> b
$ ParserGrammar m m
self)) f (GrammarOverlay g m)
layers) (g m -> g m
base g m
ParserGrammar m m
self)
   where self :: ParserGrammar m m
self = ParserGrammar m m
forall (m :: * -> *) (g :: (* -> *) -> *).
(GrammarParsing m, g ~ ParserGrammar m, GrammarConstraint m g,
 Distributive g) =>
g m
forall (g :: (* -> *) -> *).
(g ~ ParserGrammar m, GrammarConstraint m g, Distributive g) =>
g m
selfReferring

-- | Apply the given parsing function (typically `parseComplete` or `parsePrefix`) to the given grammar-agnostic
-- parser and its input. A typical invocation might be
--
-- > getCompose $ simply parsePrefix myParser myInput
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 = 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)

-- | Given the textual parse input, the parse failure on the input, and the number of preceding lines of context you
-- want to show, produce a human-readable failure description.
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 =
   s -> pos -> Int -> s
forall s p.
(Eq s, TextualMonoid s, Position p) =>
s -> p -> Int -> s
Position.context s
input pos
pos Int
contextLineCount
   s -> s -> s
forall a. Semigroup a => a -> a -> a
<> [s] -> s
forall a. Monoid a => [a] -> a
mconcat
      (s -> [s] -> [s]
forall a. a -> [a] -> [a]
intersperse s
", but " ([s] -> [s]) -> [s] -> [s]
forall a b. (a -> b) -> a -> b
$ (s -> Bool) -> [s] -> [s]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (s -> Bool) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Bool
forall m. MonoidNull m => m -> Bool
null)
       [(s -> s) -> s -> s
forall {t}. MonoidNull t => (t -> t) -> t -> t
onNonEmpty (s
"expected " s -> s -> s
forall a. Semigroup a => a -> a -> a
<>) (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ s -> [s] -> s
oxfordComma s
" or " ((String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> [String] -> [s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
expected) [s] -> [s] -> [s]
forall a. Semigroup a => a -> a -> a
<> (s -> s
forall {a}. (Semigroup a, IsString a) => a -> a
fromLiteral (s -> s) -> [s] -> [s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [s]
inputs)),
        s -> [s] -> s
oxfordComma s
" and " (String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> [String] -> [s]
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 s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
conjunction s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
y
         oxfordComma s
conjunction (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 (Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
drop Int
1 s
conjunction s -> s -> s
forall a. Semigroup a => a -> a -> a
<>) [s]
rest))
         onNonEmpty :: (t -> t) -> t -> t
onNonEmpty t -> t
f t
x = if t -> Bool
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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
onLast a -> a
f [a]
xs
         fromLiteral :: a -> a
fromLiteral a
s = a
"string \"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""