{-# LANGUAGE OverloadedStrings #-}

-- | A parser's position in the input.

module Text.Parser.Input.Position (Position(..), fromStart, fromEnd, context, lineAndColumn) where

import Data.Char (isSpace)
import Data.String (IsString(fromString))
import Data.Ord (Down(Down))
import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Textual as Textual
import Data.Monoid.Factorial (FactorialMonoid)
import Data.Monoid.Textual (TextualMonoid)

-- | A class for representing position values. The methods satisfy these laws:
--
-- > move (distance pos1 pos2) pos1 == pos2
-- > (pos1 < pos2) == (distance pos1 pos2 > 0)
class Ord p => Position p where
   -- | Distance from the first position to the second
   distance :: p -> p -> Int
   -- | Move the position by the given distance.
   move :: Int -> p -> p
   -- | Map the position into its offset from the beginning of the full input.
   offset :: FactorialMonoid s => s -> p -> Int

instance Position Int where
   distance :: Int -> Int -> Int
distance = forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
   move :: Int -> Int -> Int
move = forall a. Num a => a -> a -> a
(+)
   offset :: forall s. FactorialMonoid s => s -> Int -> Int
offset = forall a b. a -> b -> a
const forall a. a -> a
id

instance Position a => Position (Down a) where
   distance :: Down a -> Down a -> Int
distance (Down a
p1) (Down a
p2) = forall p. Position p => p -> p -> Int
distance a
p2 a
p1
   move :: Int -> Down a -> Down a
move Int
dist (Down a
p) = forall a. a -> Down a
Down (forall p. Position p => Int -> p -> p
move (forall a. Num a => a -> a
negate Int
dist) a
p)
   offset :: forall s. FactorialMonoid s => s -> Down a -> Int
offset s
wholeInput (Down a
p) = forall m. Factorial m => m -> Int
Factorial.length s
wholeInput forall a. Num a => a -> a -> a
- forall p s. (Position p, FactorialMonoid s) => s -> p -> Int
offset s
wholeInput a
p
   {-# INLINE distance #-}
   {-# INLINE move #-}
   {-# INLINE offset #-}

-- | Construct a 'Position' given the offset from the beginning of the full input.
fromStart :: Int -> Int
fromStart :: Int -> Int
fromStart = forall a. a -> a
id

-- | Construct a 'Position' given the length remaining from the position to the end of the input.
fromEnd :: Int -> Down Int
fromEnd :: Int -> Down Int
fromEnd = forall a. a -> Down a
Down

-- | Given the parser input, a 'Position' within it, and desired number of context lines, returns a description of
-- the offset position in English.
context :: (Eq s, TextualMonoid s, Position p) => s -> p -> Int -> s
context :: forall s p.
(Eq s, TextualMonoid s, Position p) =>
s -> p -> Int -> s
context s
input p
pos Int
contextLineCount = 
   forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Semigroup a => a -> a -> a
<> s
"\n") [s]
prevLines forall a. Semigroup a => a -> a -> a
<> s
lastLinePadding
   forall a. Semigroup a => a -> a -> a
<> s
"at line " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [s]
allPrevLines) forall a. Semigroup a => a -> a -> a
<> s
", column " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
columnforall a. Num a => a -> a -> a
+Int
1) forall a. Semigroup a => a -> a -> a
<> s
"\n"
   where ([s]
allPrevLines, Int
column) = forall s p.
(Eq s, IsString s, FactorialMonoid s, Position p) =>
s -> p -> ([s], Int)
lineAndColumn s
input p
pos
         lastLinePadding :: s
lastLinePadding
            | (s
lastLine:[s]
_) <- [s]
allPrevLines, s
paddingPrefix <- forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
isSpace s
lastLine =
                 forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
column (s
paddingPrefix forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Int -> a -> [a]
replicate Int
column Char
' ')) forall a. Semigroup a => a -> a -> a
<> s
"^\n"
            | Bool
otherwise = s
""
         prevLines :: [s]
prevLines = forall a. [a] -> [a]
reverse (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
lineAndColumn :: (Eq s, IsString s, FactorialMonoid s, Position p) => s -> p -> ([s], Int)
lineAndColumn :: forall s p.
(Eq s, IsString s, FactorialMonoid s, Position p) =>
s -> p -> ([s], Int)
lineAndColumn s
input p
pos = forall {a}.
(IsString a, Factorial a) =>
[a] -> Int -> [a] -> ([a], Int)
go [] (forall p s. (Position p, FactorialMonoid s) => s -> p -> Int
offset s
input p
pos) (forall m. FactorialMonoid m => (m -> Bool) -> m -> [m]
Factorial.split (forall a. Eq a => a -> a -> Bool
== s
"\n") s
input)
  where go :: [a] -> Int -> [a] -> ([a], Int)
go [a]
revLines Int
restCount []
          | Int
restCount forall a. Ord a => a -> a -> Bool
> Int
0 = ([a
"Error: the offset is beyond the input length"], -Int
1)
          | Bool
otherwise = ([a]
revLines, Int
restCount)
        go [a]
revLines Int
restCount (a
next:[a]
rest)
          | Int
restCount' forall a. Ord a => a -> a -> Bool
< Int
0 = (a
nextforall a. a -> [a] -> [a]
:[a]
revLines, Int
restCount)
          | Bool
otherwise = [a] -> Int -> [a] -> ([a], Int)
go (a
nextforall a. a -> [a] -> [a]
:[a]
revLines) Int
restCount' [a]
rest
          where nextLength :: Int
nextLength = forall m. Factorial m => m -> Int
Factorial.length a
next
                restCount' :: Int
restCount' = Int
restCount forall a. Num a => a -> a -> a
- Int
nextLength forall a. Num a => a -> a -> a
- Int
1