-- | 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 #-}
module Text.Grampa (
   -- * Parsing methods
   failureDescription, simply,
   -- * Types
   Grammar, GrammarBuilder, ParseResults, ParseFailure(..), Expected(..), Ambiguous(..), Position,
   -- * Parser combinators and primitives
   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(..))

-- | A type synonym for a fixed grammar record type @g@ with a given parser type @p@ on input streams of type @s@
type Grammar (g  :: (* -> *) -> *) p s = g (p g s)

-- | A type synonym for an endomorphic function on a grammar record type @g@, whose parsers of type @p@ build grammars
-- of type @g'@, parsing input streams of type @s@
type GrammarBuilder (g  :: (* -> *) -> *)
                    (g' :: (* -> *) -> *)
                    (p  :: ((* -> *) -> *) -> * -> * -> *)
                    (s  :: *)
   = g (p g' s) -> g (p g' s)

-- | Apply the given 'parse' function to the given grammar-free parser and its input.
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 parseGrammar :: Only r (p (Only r) s) -> s -> Only r f
parseGrammar p :: p (Only r) s r
p input :: 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 lines preceding the failure to
-- show, produce a human-readable failure description.
failureDescription :: forall s. (Ord s, TextualMonoid s) => s -> ParseFailure s -> Int -> s
failureDescription :: s -> ParseFailure s -> Int -> s
failureDescription input :: s
input (ParseFailure pos :: Int
pos expected :: [Expected s]
expected) contextLineCount :: Int
contextLineCount =
   s -> Position -> Int -> s
forall s. (Eq s, TextualMonoid s) => s -> Position -> Int -> s
Position.context s
input (Int -> Position
Position.fromStart Int
pos) Int
contextLineCount
   s -> s -> s
forall a. Semigroup a => a -> a -> a
<> "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 [] = ""
         oxfordComma [x :: s
x] = s
x
         oxfordComma [x :: s
x, y :: s
y] = s
x s -> s -> s
forall a. Semigroup a => a -> a -> a
<> " or " s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
y
         oxfordComma (x :: s
x:y :: s
y:rest :: [s]
rest) = [s] -> s
forall a. Monoid a => [a] -> a
mconcat (s -> [s] -> [s]
forall a. a -> [a] -> [a]
intersperse ", " (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 ("or " s -> s -> s
forall a. Semigroup a => a -> a -> a
<>) [s]
rest))
         onLast :: (a -> a) -> [a] -> [a]
onLast _ [] = []
         onLast f :: a -> a
f [x :: a
x] = [a -> a
f a
x]
         onLast f :: a -> a
f (x :: a
x:xs :: [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 s :: String
s) = String -> p
forall a. IsString a => String -> a
fromString String
s
         fromExpected (ExpectedInput s :: p
s) = "string \"" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
s p -> p -> p
forall a. Semigroup a => a -> a -> a
<> "\""