{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Safe #-}

-- |
-- Module      :  Text.Megaparsec.Pos
-- Copyright   :  © 2015–present Megaparsec contributors
-- License     :  FreeBSD
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Textual source position. The position includes name of file, line number,
-- and column number.
--
-- You probably do not want to import this module directly because
-- "Text.Megaparsec" re-exports it anyway.
module Text.Megaparsec.Pos
  ( -- * Abstract position
    Pos,
    mkPos,
    unPos,
    pos1,
    defaultTabWidth,
    InvalidPosException (..),

    -- * Source position
    SourcePos (..),
    initialPos,
    sourcePosPretty,
  )
where

import Control.DeepSeq
import Control.Exception
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics

----------------------------------------------------------------------------
-- Abstract position

-- | 'Pos' is the type for positive integers. This is used to represent line
-- number, column number, and similar things like indentation level.
-- 'Semigroup' instance can be used to safely and efficiently add 'Pos'es
-- together.
--
-- @since 5.0.0
newtype Pos = Pos Int
  deriving (Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
(Int -> Pos -> ShowS)
-> (Pos -> String) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Eq Pos
Eq Pos
-> (Pos -> Pos -> Ordering)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Pos)
-> (Pos -> Pos -> Pos)
-> Ord Pos
Pos -> Pos -> Bool
Pos -> Pos -> Ordering
Pos -> Pos -> Pos
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 :: Pos -> Pos -> Pos
$cmin :: Pos -> Pos -> Pos
max :: Pos -> Pos -> Pos
$cmax :: Pos -> Pos -> Pos
>= :: Pos -> Pos -> Bool
$c>= :: Pos -> Pos -> Bool
> :: Pos -> Pos -> Bool
$c> :: Pos -> Pos -> Bool
<= :: Pos -> Pos -> Bool
$c<= :: Pos -> Pos -> Bool
< :: Pos -> Pos -> Bool
$c< :: Pos -> Pos -> Bool
compare :: Pos -> Pos -> Ordering
$ccompare :: Pos -> Pos -> Ordering
$cp1Ord :: Eq Pos
Ord, Typeable Pos
DataType
Constr
Typeable Pos
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pos -> c Pos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pos)
-> (Pos -> Constr)
-> (Pos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos))
-> ((forall b. Data b => b -> b) -> Pos -> Pos)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pos -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> Data Pos
Pos -> DataType
Pos -> Constr
(forall b. Data b => b -> b) -> Pos -> Pos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
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. Int -> (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. Int -> (forall d. Data d => d -> u) -> Pos -> u
forall u. (forall d. Data d => d -> u) -> Pos -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cPos :: Constr
$tPos :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapMp :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapM :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
gmapQ :: (forall d. Data d => d -> u) -> Pos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
$cgmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Pos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
dataTypeOf :: Pos -> DataType
$cdataTypeOf :: Pos -> DataType
toConstr :: Pos -> Constr
$ctoConstr :: Pos -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cp1Data :: Typeable Pos
Data, (forall x. Pos -> Rep Pos x)
-> (forall x. Rep Pos x -> Pos) -> Generic Pos
forall x. Rep Pos x -> Pos
forall x. Pos -> Rep Pos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pos x -> Pos
$cfrom :: forall x. Pos -> Rep Pos x
Generic, Typeable, Pos -> ()
(Pos -> ()) -> NFData Pos
forall a. (a -> ()) -> NFData a
rnf :: Pos -> ()
$crnf :: Pos -> ()
NFData)

-- | Construction of 'Pos' from 'Int'. The function throws
-- 'InvalidPosException' when given a non-positive argument.
--
-- @since 6.0.0
mkPos :: Int -> Pos
mkPos :: Int -> Pos
mkPos Int
a =
  if Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
    then InvalidPosException -> Pos
forall a e. Exception e => e -> a
throw (Int -> InvalidPosException
InvalidPosException Int
a)
    else Int -> Pos
Pos Int
a
{-# INLINE mkPos #-}

-- | Extract 'Int' from 'Pos'.
--
-- @since 6.0.0
unPos :: Pos -> Int
unPos :: Pos -> Int
unPos (Pos Int
w) = Int
w
{-# INLINE unPos #-}

-- | Position with value 1.
--
-- @since 6.0.0
pos1 :: Pos
pos1 :: Pos
pos1 = Int -> Pos
mkPos Int
1

-- | Value of tab width used by default. Always prefer this constant when
-- you want to refer to the default tab width because actual value /may/
-- change in future.
--
-- Currently:
--
-- > defaultTabWidth = mkPos 8
--
-- @since 5.0.0
defaultTabWidth :: Pos
defaultTabWidth :: Pos
defaultTabWidth = Int -> Pos
mkPos Int
8

instance Semigroup Pos where
  (Pos Int
x) <> :: Pos -> Pos -> Pos
<> (Pos Int
y) = Int -> Pos
Pos (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
  {-# INLINE (<>) #-}

instance Read Pos where
  readsPrec :: Int -> ReadS Pos
readsPrec Int
d =
    Bool -> ReadS Pos -> ReadS Pos
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS Pos -> ReadS Pos) -> ReadS Pos -> ReadS Pos
forall a b. (a -> b) -> a -> b
$ \String
r1 -> do
      (String
"Pos", String
r2) <- ReadS String
lex String
r1
      (Int
x, String
r3) <- Int -> ReadS Int
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
r2
      (Pos, String) -> [(Pos, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Pos
mkPos Int
x, String
r3)

-- | The exception is thrown by 'mkPos' when its argument is not a positive
-- number.
--
-- @since 5.0.0
newtype InvalidPosException
  = -- | Contains the actual value that was passed to 'mkPos'
    InvalidPosException Int
  deriving (InvalidPosException -> InvalidPosException -> Bool
(InvalidPosException -> InvalidPosException -> Bool)
-> (InvalidPosException -> InvalidPosException -> Bool)
-> Eq InvalidPosException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidPosException -> InvalidPosException -> Bool
$c/= :: InvalidPosException -> InvalidPosException -> Bool
== :: InvalidPosException -> InvalidPosException -> Bool
$c== :: InvalidPosException -> InvalidPosException -> Bool
Eq, Int -> InvalidPosException -> ShowS
[InvalidPosException] -> ShowS
InvalidPosException -> String
(Int -> InvalidPosException -> ShowS)
-> (InvalidPosException -> String)
-> ([InvalidPosException] -> ShowS)
-> Show InvalidPosException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidPosException] -> ShowS
$cshowList :: [InvalidPosException] -> ShowS
show :: InvalidPosException -> String
$cshow :: InvalidPosException -> String
showsPrec :: Int -> InvalidPosException -> ShowS
$cshowsPrec :: Int -> InvalidPosException -> ShowS
Show, Typeable InvalidPosException
DataType
Constr
Typeable InvalidPosException
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> InvalidPosException
    -> c InvalidPosException)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InvalidPosException)
-> (InvalidPosException -> Constr)
-> (InvalidPosException -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InvalidPosException))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InvalidPosException))
-> ((forall b. Data b => b -> b)
    -> InvalidPosException -> InvalidPosException)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InvalidPosException -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InvalidPosException -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InvalidPosException -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InvalidPosException -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InvalidPosException -> m InvalidPosException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InvalidPosException -> m InvalidPosException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InvalidPosException -> m InvalidPosException)
-> Data InvalidPosException
InvalidPosException -> DataType
InvalidPosException -> Constr
(forall b. Data b => b -> b)
-> InvalidPosException -> InvalidPosException
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InvalidPosException
-> c InvalidPosException
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvalidPosException
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. Int -> (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.
Int -> (forall d. Data d => d -> u) -> InvalidPosException -> u
forall u.
(forall d. Data d => d -> u) -> InvalidPosException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvalidPosException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvalidPosException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InvalidPosException -> m InvalidPosException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvalidPosException -> m InvalidPosException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvalidPosException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InvalidPosException
-> c InvalidPosException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InvalidPosException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InvalidPosException)
$cInvalidPosException :: Constr
$tInvalidPosException :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> InvalidPosException -> m InvalidPosException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvalidPosException -> m InvalidPosException
gmapMp :: (forall d. Data d => d -> m d)
-> InvalidPosException -> m InvalidPosException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvalidPosException -> m InvalidPosException
gmapM :: (forall d. Data d => d -> m d)
-> InvalidPosException -> m InvalidPosException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InvalidPosException -> m InvalidPosException
gmapQi :: Int -> (forall d. Data d => d -> u) -> InvalidPosException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InvalidPosException -> u
gmapQ :: (forall d. Data d => d -> u) -> InvalidPosException -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> InvalidPosException -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvalidPosException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvalidPosException -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvalidPosException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvalidPosException -> r
gmapT :: (forall b. Data b => b -> b)
-> InvalidPosException -> InvalidPosException
$cgmapT :: (forall b. Data b => b -> b)
-> InvalidPosException -> InvalidPosException
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InvalidPosException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InvalidPosException)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InvalidPosException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InvalidPosException)
dataTypeOf :: InvalidPosException -> DataType
$cdataTypeOf :: InvalidPosException -> DataType
toConstr :: InvalidPosException -> Constr
$ctoConstr :: InvalidPosException -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvalidPosException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvalidPosException
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InvalidPosException
-> c InvalidPosException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InvalidPosException
-> c InvalidPosException
$cp1Data :: Typeable InvalidPosException
Data, Typeable, (forall x. InvalidPosException -> Rep InvalidPosException x)
-> (forall x. Rep InvalidPosException x -> InvalidPosException)
-> Generic InvalidPosException
forall x. Rep InvalidPosException x -> InvalidPosException
forall x. InvalidPosException -> Rep InvalidPosException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InvalidPosException x -> InvalidPosException
$cfrom :: forall x. InvalidPosException -> Rep InvalidPosException x
Generic)

instance Exception InvalidPosException

instance NFData InvalidPosException

----------------------------------------------------------------------------
-- Source position

-- | The data type 'SourcePos' represents source positions. It contains the
-- name of the source file, a line number, and a column number. Source line
-- and column positions change intensively during parsing, so we need to
-- make them strict to avoid memory leaks.
data SourcePos = SourcePos
  { -- | Name of source file
    SourcePos -> String
sourceName :: FilePath,
    -- | Line number
    SourcePos -> Pos
sourceLine :: !Pos,
    -- | Column number
    SourcePos -> Pos
sourceColumn :: !Pos
  }
  deriving (Int -> SourcePos -> ShowS
[SourcePos] -> ShowS
SourcePos -> String
(Int -> SourcePos -> ShowS)
-> (SourcePos -> String)
-> ([SourcePos] -> ShowS)
-> Show SourcePos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourcePos] -> ShowS
$cshowList :: [SourcePos] -> ShowS
show :: SourcePos -> String
$cshow :: SourcePos -> String
showsPrec :: Int -> SourcePos -> ShowS
$cshowsPrec :: Int -> SourcePos -> ShowS
Show, ReadPrec [SourcePos]
ReadPrec SourcePos
Int -> ReadS SourcePos
ReadS [SourcePos]
(Int -> ReadS SourcePos)
-> ReadS [SourcePos]
-> ReadPrec SourcePos
-> ReadPrec [SourcePos]
-> Read SourcePos
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourcePos]
$creadListPrec :: ReadPrec [SourcePos]
readPrec :: ReadPrec SourcePos
$creadPrec :: ReadPrec SourcePos
readList :: ReadS [SourcePos]
$creadList :: ReadS [SourcePos]
readsPrec :: Int -> ReadS SourcePos
$creadsPrec :: Int -> ReadS SourcePos
Read, 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
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
$cp1Ord :: 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.
    Int -> (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. Int -> (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. Int -> (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 :: Int -> (forall d. Data d => d -> u) -> SourcePos -> u
$cgmapQi :: forall u. Int -> (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
$cp1Data :: Typeable SourcePos
Data, Typeable, (forall x. SourcePos -> Rep SourcePos x)
-> (forall x. Rep SourcePos x -> SourcePos) -> Generic SourcePos
forall x. Rep SourcePos x -> SourcePos
forall x. SourcePos -> Rep SourcePos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourcePos x -> SourcePos
$cfrom :: forall x. SourcePos -> Rep SourcePos x
Generic)

instance NFData SourcePos

-- | Construct initial position (line 1, column 1) given name of source
-- file.
initialPos :: FilePath -> SourcePos
initialPos :: String -> SourcePos
initialPos String
n = String -> Pos -> Pos -> SourcePos
SourcePos String
n Pos
pos1 Pos
pos1

-- | Pretty-print a 'SourcePos'.
--
-- @since 5.0.0
sourcePosPretty :: SourcePos -> String
sourcePosPretty :: SourcePos -> String
sourcePosPretty (SourcePos String
n Pos
l Pos
c)
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n = String
showLC
  | Bool
otherwise = String
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
showLC
  where
    showLC :: String
showLC = Int -> String
forall a. Show a => a -> String
show (Pos -> Int
unPos Pos
l) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Pos -> Int
unPos Pos
c)