-- | 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
   MultiParsing(..),
   offsetContext, offsetLineAndColumn, positionOffset, failureDescription, simply,
   -- * Types
   Grammar, GrammarBuilder, ParseResults, ParseFailure(..), Ambiguous(..), Position,
   -- * Parser combinators and primitives
   GrammarParsing(..), MonoidParsing(..), AmbiguousParsing(..), Lexical(..),
   module Text.Parser.Char,
   module Text.Parser.Combinators,
   module Text.Parser.LookAhead)
where

import Data.List (intersperse)
import Data.Monoid ((<>))
import qualified Data.Monoid.Factorial as Factorial
import Data.Monoid.Factorial (FactorialMonoid)
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 qualified Rank2
import Text.Grampa.Class (Lexical(..), MultiParsing(..), GrammarParsing(..), MonoidParsing(..), AmbiguousParsing(..),
                          Ambiguous(..), ParseResults, ParseFailure(..), Position, positionOffset)

-- | 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. (Eq s, IsString s, FactorialMonoid s) => s -> ParseFailure -> Int -> s
failureDescription :: s -> ParseFailure -> Int -> s
failureDescription input :: s
input (ParseFailure pos :: Int
pos expected :: [String]
expected) contextLineCount :: Int
contextLineCount =
   s -> Int -> Int -> s
forall s.
(Eq s, IsString s, FactorialMonoid s) =>
s -> Int -> Int -> s
offsetContext s
input 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 (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)
   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

-- | Given the parser input, an offset within it, and desired number of context lines, returns a description of
-- the offset position in English.
offsetContext :: (Eq s, IsString s, FactorialMonoid s) => s -> Int -> Int -> s
offsetContext :: s -> Int -> Int -> s
offsetContext input :: s
input offset :: Int
offset contextLineCount :: Int
contextLineCount = 
   (s -> s) -> [s] -> s
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (s -> s -> s
forall a. Semigroup a => a -> a -> a
<> "\n") [s]
prevLines s -> s -> s
forall a. Semigroup a => a -> a -> a
<> String -> s
forall a. IsString a => String -> a
fromString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
column ' ') s -> s -> s
forall a. Semigroup a => a -> a -> a
<> "^\n"
   s -> s -> s
forall a. Semigroup a => a -> a -> a
<> "at line " s -> s -> s
forall a. Semigroup a => a -> a -> a
<> String -> s
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [s] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [s]
allPrevLines) s -> s -> s
forall a. Semigroup a => a -> a -> a
<> ", column " s -> s -> s
forall a. Semigroup a => a -> a -> a
<> String -> s
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) s -> s -> s
forall a. Semigroup a => a -> a -> a
<> "\n"
   where (allPrevLines :: [s]
allPrevLines, column :: Int
column) = s -> Int -> ([s], Int)
forall s.
(Eq s, IsString s, FactorialMonoid s) =>
s -> Int -> ([s], Int)
offsetLineAndColumn s
input Int
offset
         prevLines :: [s]
prevLines = [s] -> [s]
forall a. [a] -> [a]
reverse (Int -> [s] -> [s]
forall a. Int -> [a] -> [a]
take Int
contextLineCount [s]
allPrevLines)

-- | Given the full input and an offset within it, returns all the input lines up to and including the offset
-- in reverse order, as well as the zero-based column number of the offset
offsetLineAndColumn :: (Eq s, IsString s, FactorialMonoid s) => s -> Int -> ([s], Int)
offsetLineAndColumn :: s -> Int -> ([s], Int)
offsetLineAndColumn input :: s
input pos :: Int
pos = [s] -> Int -> [s] -> ([s], Int)
forall a.
(IsString a, Factorial a) =>
[a] -> Int -> [a] -> ([a], Int)
context [] Int
pos ((s -> Bool) -> s -> [s]
forall m. FactorialMonoid m => (m -> Bool) -> m -> [m]
Factorial.split (s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== "\n") s
input)
  where context :: [a] -> Int -> [a] -> ([a], Int)
context revLines :: [a]
revLines restCount :: Int
restCount []
          | Int
restCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = (["Error: the offset is beyond the input length"], -1)
          | Bool
otherwise = ([a]
revLines, Int
restCount)
        context revLines :: [a]
revLines restCount :: Int
restCount (next :: a
next:rest :: [a]
rest)
          | Int
restCount' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (a
nexta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
revLines, Int
restCount)
          | Bool
otherwise = [a] -> Int -> [a] -> ([a], Int)
context (a
nexta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
revLines) Int
restCount' [a]
rest
          where nextLength :: Int
nextLength = a -> Int
forall m. Factorial m => m -> Int
Factorial.length a
next
                restCount' :: Int
restCount' = Int
restCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nextLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1