    {-# 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 = (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 :: forall s. FactorialMonoid s => 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 (Down a) where
       distance :: Down a -> Down a -> Int
    distance (Down a
    p1) (Down a
    p2) = a -> a -> Int
    forall p. Position p => p -> p -> Int
    distance a
    p2 a
    p1
       move :: Int -> Down a -> Down a
    move Int
    dist (Down a
    p) = a -> Down a
    forall a. a -> Down a
    Down (Int -> a -> a
    forall p. Position p => Int -> p -> p
    move (Int -> Int
    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) = 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 s. FactorialMonoid s => s -> a -> Int
    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 = 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 -> Down Int
    fromEnd :: Int -> Down Int
    fromEnd = Int -> Down Int
    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 =
       (s -> s) -> [s] -> s
    forall m a. Monoid m => (a -> m) -> [a] -> m
    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 a. [a] -> 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 :: forall s p.
    (Eq s, IsString s, FactorialMonoid s, Position p) =>
    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)
    go [] (s -> p -> Int
    forall s. FactorialMonoid s => 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 go :: [a] -> Int -> [a] -> ([a], Int)
    go [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)
            go [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)
    go (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