Pos.hs

-- |
-- Module      :  Text.Megaparsec.Pos
-- Copyright   :  © 2015–2016 Megaparsec contributors
--                © 2007 Paolo Martini
--                © 1999–2001 Daan Leijen
-- License     :  FreeBSD
--
-- Maintainer  :  Mark Karpov <markkarpov@opmbx.org>
-- Stability   :  experimental
-- Portability :  portable
--
-- Textual source position.

module Text.Megaparsec.Pos
  ( SourcePos
  , sourceName
  , sourceLine
  , sourceColumn
  , InvalidTextualPosition (..)
  , newPos
  , initialPos
  , incSourceLine
  , incSourceColumn
  , setSourceName
  , setSourceLine
  , setSourceColumn
  , updatePosChar
  , updatePosString
  , defaultTabWidth )
where

import Control.Exception (Exception, throw)
import Data.List (foldl')
import Data.Typeable (Typeable)

-- | The abstract data type @SourcePos@ represents source positions. It
-- contains the name of the source (i.e. file name), a line number and a
-- column number. @SourcePos@ is an instance of the 'Show', 'Eq' and 'Ord'
-- class.

data SourcePos = SourcePos
  { -- | Extract the name of the source from a source position.
    sourceName   :: !String
    -- | Extract the line number from a source position.
  , sourceLine   :: !Int
    -- | Extract the column number from a source position.
  , sourceColumn :: !Int }
  deriving (Eq, Ord)

instance Show SourcePos where
  show (SourcePos n l c)
    | null n    = showLC
    | otherwise = n ++ ":" ++ showLC
      where showLC = show l ++ ":" ++ show c

-- | This exception is thrown when some action on 'SourcePos' is performed
-- that would make column number or line number inside this data structure
-- non-positive.
--
-- The 'InvalidTextualPosition' structure includes in order:
--
--     * name of file
--     * line number (possibly non-positive value)
--     * column number (possibly non-positive value)

data InvalidTextualPosition =
  InvalidTextualPosition String Int Int
  deriving (Eq, Show, Typeable)

instance Exception InvalidTextualPosition

-- | Create a new 'SourcePos' with the given source name, line number and
-- column number.
--
-- If line number of column number is not positive, 'InvalidTextualPosition'
-- will be thrown.

newPos :: String -- ^ File name
       -> Int    -- ^ Line number, minimum is 1
       -> Int    -- ^ Column number, minimum is 1
       -> SourcePos
newPos n l c =
  if l < 1 || c < 1
  then throw $ InvalidTextualPosition n l c
  else SourcePos n l c

-- | Create a new 'SourcePos' with the given source name, and line number
-- and column number set to 1, the upper left.

initialPos :: String -> SourcePos
initialPos name = newPos name 1 1

-- | Increment the line number of a source position. If resulting line
-- number is not positive, 'InvalidTextualPosition' will be thrown.

incSourceLine :: SourcePos -> Int -> SourcePos
incSourceLine (SourcePos n l c) d = newPos n (l + d) c

-- | Increment the column number of a source position. If resulting column
-- number is not positive, 'InvalidTextualPosition' will be thrown.

incSourceColumn :: SourcePos -> Int -> SourcePos
incSourceColumn (SourcePos n l c) d = newPos n l (c + d)

-- | Set the name of the source.

setSourceName :: SourcePos -> String -> SourcePos
setSourceName (SourcePos _ l c) n = newPos n l c

-- | Set the line number of a source position. If the line number is not
-- positive, 'InvalidTextualPosition' will be thrown.

setSourceLine :: SourcePos -> Int -> SourcePos
setSourceLine (SourcePos n _ c) l = newPos n l c

-- | Set the column number of a source position. If the line number is not
-- positive, 'InvalidTextualPosition' will be thrown.

setSourceColumn :: SourcePos -> Int -> SourcePos
setSourceColumn (SourcePos n l _) = newPos n l

-- | Update a source position given a character. The first argument
-- specifies tab width. If the character is a newline (\'\\n\') the line
-- number is incremented by 1. If the character is a tab (\'\\t\') the
-- column number is incremented to the nearest tab position, i.e. @column +
-- width - ((column - 1) \`rem\` width)@. In all other cases, the column is
-- incremented by 1.
--
-- If given tab width is not positive, 'defaultTabWidth' will be used.

updatePosChar :: Int       -- ^ Tab width
              -> SourcePos -- ^ Initial position
              -> Char      -- ^ Character at the position
              -> SourcePos
updatePosChar width (SourcePos n l c) ch =
  case ch of
    '\n' -> SourcePos n (l + 1) 1
    '\t' -> let w = if width < 1 then defaultTabWidth else width
            in SourcePos n l (c + w - ((c - 1) `rem` w))
    _    -> SourcePos n l (c + 1)

-- | The expression @updatePosString pos s@ updates the source position
-- @pos@ by calling 'updatePosChar' on every character in @s@, i.e.
--
-- > updatePosString width = foldl (updatePosChar width)

updatePosString :: Int       -- ^ Tab width
                -> SourcePos -- ^ Initial position
                -> String    -- ^ String to process
                -> SourcePos
updatePosString w = foldl' (updatePosChar w)

-- | Value of tab width used by default. This is used as fall-back by
-- 'updatePosChar' and possibly in other cases. Always prefer this constant
-- when you want to refer to default tab width because actual value /may/
-- change in future. Current value is @8@.

defaultTabWidth :: Int
defaultTabWidth = 8