Location.hs

module Language.Fluent.Parser.Location where

import Data.Attoparsec.Internal.Types (Pos (Pos))
import Data.List qualified as List
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Unsafe (dropWord8, lengthWord8, takeWord8)
import Language.Fluent.AST
import Prelude

-- | Replaces the byte offsets of the errors of junk with character offsets, lines and columns.
locate :: Pos -> Text -> [Entry] -> [Entry]
locate (Pos start) whole = snd . List.mapAccumL step (Cursor 0 0 1 1 whole)
  where
    step :: Cursor -> Entry -> (Cursor, Entry)
    step cursor (JunkEntry text ParseError{offset, reason}) =
        let moved@Cursor{characters, lineNumber, columnNumber} = advanceTo (offset - start) cursor
         in ( moved
            , JunkEntry
                text
                ParseError
                    { offset = characters
                    , line = lineNumber
                    , column = columnNumber
                    , reason
                    }
            )
    step cursor other = (cursor, other)

-- | A position in the text in bytes, characters, lines and columns, and the text after it.
data Cursor = Cursor
    { bytes :: !Int
    , characters :: !Int
    , lineNumber :: !Int
    , columnNumber :: !Int
    , remaining :: Text
    }

-- | Moves the cursor forward to the given byte offset.
advanceTo :: Int -> Cursor -> Cursor
advanceTo target Cursor{..} =
    Cursor
        { bytes = target
        , characters = characters + Text.length passed
        , lineNumber = lineNumber + breaks
        , columnNumber = newColumn
        , remaining = dropWord8 skipped remaining
        }
  where
    skipped = target - bytes
    passed = takeWord8 skipped remaining
    breaks = Text.count "\n" passed
    newColumn
        | breaks == 0 = columnNumber + Text.length passed
        | otherwise = 1 + Text.length (Text.takeWhileEnd (/= '\n') passed)

-- | Moves a failure that follows a line break back to the end of the last non-blank character,
-- where what is missing belongs. Both offsets are in bytes of the text.
settle :: Text -> Int -> Int
settle text failure
    | Text.any (== '\n') $ Text.takeWhileEnd isBlank before = lengthWord8 content
    | otherwise = failure
  where
    before = takeWord8 failure text
    content = Text.dropWhileEnd isBlank before
    isBlank = (`elem` (" \r\n" :: String))