{-# LANGUAGE OverloadedStrings #-}

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

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

import Data.Char (isSpace)
import Data.String (IsString(fromString))
import Data.Monoid (Dual(Dual))
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.
--
-- > move (distance pos1 pos2) pos1 == pos2
class 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 = (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)
   move :: Int -> Int -> Int
move = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
   offset :: s -> Int -> Int
offset = (Int -> Int) -> s -> Int -> Int
forall a b. a -> b -> a
const Int -> Int
forall a. a -> a
id

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

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

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

-- | 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 :: s -> p -> Int -> s
context s
input p
pos 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
<> s
"\n") [s]
prevLines s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
lastLinePadding
   s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
"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
<> s
", 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
+Int
1) s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
"\n"
   where ([s]
allPrevLines, Int
column) = s -> p -> ([s], Int)
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 <- Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.takeWhile_ Bool
False Char -> Bool
isSpace s
lastLine =
                 Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.take Int
column (s
paddingPrefix 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 Char
' ')) s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
"^\n"
            | Bool
otherwise = s
""
         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
lineAndColumn :: (Eq s, IsString s, FactorialMonoid s, Position p) => s -> p -> ([s], Int)
lineAndColumn :: s -> p -> ([s], Int)
lineAndColumn s
input p
pos = [s] -> Int -> [s] -> ([s], Int)
forall a.
(IsString a, Factorial a) =>
[a] -> Int -> [a] -> ([a], Int)
context [] (s -> p -> Int
forall p s. (Position p, FactorialMonoid s) => s -> p -> Int
offset s
input p
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
== s
"\n") s
input)
  where context :: [a] -> Int -> [a] -> ([a], Int)
context [a]
revLines Int
restCount []
          | Int
restCount Int -> Int -> Bool
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)
        context [a]
revLines Int
restCount (a
next:[a]
rest)
          | Int
restCount' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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
- Int
1