-- | A collection of parsing algorithms with a common interface, operating on grammars represented as records with
-- rank-2 field types.
{-# 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
   -- ** 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)

-- | Fixed grammar record type @g@ with a given parser type @p@ on input streams of type @s@
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 grammars
-- of type @g'@, parsing input streams of type @s@. The first grammar @g@ may be 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 = 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

-- | 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 = 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)

-- | Given the textual parse input, the parse failure on the input, and the number of lines preceding the failure 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 =
   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
"\""