{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Parsec.Pos
-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License     :  BSD-style (see the LICENSE file)
--
-- Maintainer  :  derek.a.elkins@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Textual source positions.
--
-----------------------------------------------------------------------------

module Text.Parsec.Pos
    ( SourceName, Line, Column
    , SourcePos
    , sourceLine, sourceColumn, sourceName
    , incSourceLine, incSourceColumn
    , setSourceLine, setSourceColumn, setSourceName
    , newPos, initialPos
    , updatePosChar, updatePosString
    ) where

import Data.Data (Data)
import Data.Typeable (Typeable)

-- < Source positions: a file name, a line and a column
-- upper left is (1,1)

type SourceName = String
type Line       = Int
type Column     = Int

-- | 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 SourceName !Line !Column
    deriving ( SourcePos -> SourcePos -> Bool
(SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool) -> Eq SourcePos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourcePos -> SourcePos -> Bool
$c/= :: SourcePos -> SourcePos -> Bool
== :: SourcePos -> SourcePos -> Bool
$c== :: SourcePos -> SourcePos -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Eq Line
External instance of the constraint type Eq Line
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
Eq, Eq SourcePos
Eq SourcePos
-> (SourcePos -> SourcePos -> Ordering)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> Bool)
-> (SourcePos -> SourcePos -> SourcePos)
-> (SourcePos -> SourcePos -> SourcePos)
-> Ord SourcePos
SourcePos -> SourcePos -> Bool
SourcePos -> SourcePos -> Ordering
SourcePos -> SourcePos -> SourcePos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourcePos -> SourcePos -> SourcePos
$cmin :: SourcePos -> SourcePos -> SourcePos
max :: SourcePos -> SourcePos -> SourcePos
$cmax :: SourcePos -> SourcePos -> SourcePos
>= :: SourcePos -> SourcePos -> Bool
$c>= :: SourcePos -> SourcePos -> Bool
> :: SourcePos -> SourcePos -> Bool
$c> :: SourcePos -> SourcePos -> Bool
<= :: SourcePos -> SourcePos -> Bool
$c<= :: SourcePos -> SourcePos -> Bool
< :: SourcePos -> SourcePos -> Bool
$c< :: SourcePos -> SourcePos -> Bool
compare :: SourcePos -> SourcePos -> Ordering
$ccompare :: SourcePos -> SourcePos -> Ordering
External instance of the constraint type Ord Char
External instance of the constraint type Ord Line
External instance of the constraint type Ord Char
External instance of the constraint type Ord Line
External instance of the constraint type Ord Line
External instance of the constraint type Ord Char
External instance of the constraint type forall a. Ord a => Ord [a]
Instance of class: Eq of the constraint type Eq SourcePos
Instance of class: Ord of the constraint type Ord SourcePos
Instance of class: Eq of the constraint type Eq SourcePos
Ord, Typeable SourcePos
DataType
Constr
Typeable SourcePos
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SourcePos -> c SourcePos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourcePos)
-> (SourcePos -> Constr)
-> (SourcePos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourcePos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos))
-> ((forall b. Data b => b -> b) -> SourcePos -> SourcePos)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourcePos -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourcePos -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourcePos -> [u])
-> (forall u.
    Line -> (forall d. Data d => d -> u) -> SourcePos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos)
-> Data SourcePos
SourcePos -> DataType
SourcePos -> Constr
(forall b. Data b => b -> b) -> SourcePos -> SourcePos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Line -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Line -> (forall d. Data d => d -> u) -> SourcePos -> u
forall u. (forall d. Data d => d -> u) -> SourcePos -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourcePos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos)
$cSourcePos :: Constr
$tSourcePos :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
gmapMp :: (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
gmapM :: (forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourcePos -> m SourcePos
gmapQi :: Line -> (forall d. Data d => d -> u) -> SourcePos -> u
$cgmapQi :: forall u. Line -> (forall d. Data d => d -> u) -> SourcePos -> u
gmapQ :: (forall d. Data d => d -> u) -> SourcePos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourcePos -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourcePos -> r
gmapT :: (forall b. Data b => b -> b) -> SourcePos -> SourcePos
$cgmapT :: (forall b. Data b => b -> b) -> SourcePos -> SourcePos
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourcePos)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SourcePos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourcePos)
dataTypeOf :: SourcePos -> DataType
$cdataTypeOf :: SourcePos -> DataType
toConstr :: SourcePos -> Constr
$ctoConstr :: SourcePos -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourcePos
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourcePos -> c SourcePos
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type Data Line
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data Line
External instance of the constraint type Data Line
Data, Typeable)

-- | Create a new 'SourcePos' with the given source name,
-- line number and column number.

newPos :: SourceName -> Line -> Column -> SourcePos
newPos :: SourceName -> Line -> Line -> SourcePos
newPos SourceName
name Line
line Line
column
    = SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
name Line
line Line
column

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

initialPos :: SourceName -> SourcePos
initialPos :: SourceName -> SourcePos
initialPos SourceName
name
    = SourceName -> Line -> Line -> SourcePos
newPos SourceName
name Line
1 Line
1

-- | Extracts the name of the source from a source position.

sourceName :: SourcePos -> SourceName
sourceName :: SourcePos -> SourceName
sourceName (SourcePos SourceName
name Line
_line Line
_column) = SourceName
name

-- | Extracts the line number from a source position.

sourceLine :: SourcePos -> Line
sourceLine :: SourcePos -> Line
sourceLine (SourcePos SourceName
_name Line
line Line
_column) = Line
line

-- | Extracts the column number from a source position.

sourceColumn :: SourcePos -> Column
sourceColumn :: SourcePos -> Line
sourceColumn (SourcePos SourceName
_name Line
_line Line
column) = Line
column

-- | Increments the line number of a source position.

incSourceLine :: SourcePos -> Line -> SourcePos
incSourceLine :: SourcePos -> Line -> SourcePos
incSourceLine (SourcePos SourceName
name Line
line Line
column) Line
n = SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
name (Line
lineLine -> Line -> Line
forall a. Num a => a -> a -> a
External instance of the constraint type Num Line
+Line
n) Line
column

-- | Increments the column number of a source position.

incSourceColumn :: SourcePos -> Column -> SourcePos
incSourceColumn :: SourcePos -> Line -> SourcePos
incSourceColumn (SourcePos SourceName
name Line
line Line
column) Line
n = SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
name Line
line (Line
columnLine -> Line -> Line
forall a. Num a => a -> a -> a
External instance of the constraint type Num Line
+Line
n)

-- | Set the name of the source.

setSourceName :: SourcePos -> SourceName -> SourcePos
setSourceName :: SourcePos -> SourceName -> SourcePos
setSourceName (SourcePos SourceName
_name Line
line Line
column) SourceName
n = SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
n Line
line Line
column

-- | Set the line number of a source position.

setSourceLine :: SourcePos -> Line -> SourcePos
setSourceLine :: SourcePos -> Line -> SourcePos
setSourceLine (SourcePos SourceName
name Line
_line Line
column) Line
n = SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
name Line
n Line
column

-- | Set the column number of a source position.

setSourceColumn :: SourcePos -> Column -> SourcePos
setSourceColumn :: SourcePos -> Line -> SourcePos
setSourceColumn (SourcePos SourceName
name Line
line Line
_column) Line
n = SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
name Line
line Line
n

-- | The expression @updatePosString pos s@ updates the source position
-- @pos@ by calling 'updatePosChar' on every character in @s@, ie.
-- @foldl updatePosChar pos string@.

updatePosString :: SourcePos -> String -> SourcePos
updatePosString :: SourcePos -> SourceName -> SourcePos
updatePosString SourcePos
pos SourceName
string
    = (SourcePos -> Char -> SourcePos)
-> SourcePos -> SourceName -> SourcePos
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl SourcePos -> Char -> SourcePos
updatePosChar SourcePos
pos SourceName
string

-- | Update a source position given a character. If the character is a
-- newline (\'\\n\') or carriage return (\'\\r\') the line number is
-- incremented by 1. If the character is a tab (\'\t\') the column
-- number is incremented to the nearest 8'th column, ie. @column + 8 -
-- ((column-1) \`mod\` 8)@. In all other cases, the column is
-- incremented by 1.

updatePosChar   :: SourcePos -> Char -> SourcePos
updatePosChar :: SourcePos -> Char -> SourcePos
updatePosChar (SourcePos SourceName
name Line
line Line
column) Char
c
    = case Char
c of
        Char
'\n' -> SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
name (Line
lineLine -> Line -> Line
forall a. Num a => a -> a -> a
External instance of the constraint type Num Line
+Line
1) Line
1
        Char
'\t' -> SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
name Line
line (Line
column Line -> Line -> Line
forall a. Num a => a -> a -> a
External instance of the constraint type Num Line
+ Line
8 Line -> Line -> Line
forall a. Num a => a -> a -> a
External instance of the constraint type Num Line
- ((Line
columnLine -> Line -> Line
forall a. Num a => a -> a -> a
External instance of the constraint type Num Line
-Line
1) Line -> Line -> Line
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Line
`mod` Line
8))
        Char
_    -> SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
name Line
line (Line
column Line -> Line -> Line
forall a. Num a => a -> a -> a
External instance of the constraint type Num Line
+ Line
1)

instance Show SourcePos where
  show :: SourcePos -> SourceName
show (SourcePos SourceName
name Line
line Line
column)
    | SourceName -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null SourceName
name = SourceName
showLineColumn
    | Bool
otherwise = SourceName
"\"" SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
name SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
"\" " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
showLineColumn
    where
      showLineColumn :: SourceName
showLineColumn    = SourceName
"(line " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> SourceName
forall a. Show a => a -> SourceName
External instance of the constraint type Show Line
show Line
line SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++
                          SourceName
", column " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> SourceName
forall a. Show a => a -> SourceName
External instance of the constraint type Show Line
show Line
column SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++
                          SourceName
")"