{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Safe #-}
module Text.Megaparsec.Pos
(
Pos,
mkPos,
unPos,
pos1,
defaultTabWidth,
InvalidPosException (..),
SourcePos (..),
initialPos,
sourcePosPretty,
)
where
import Control.DeepSeq
import Control.Exception
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics
newtype Pos = Pos Int
deriving (Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> FilePath
$cshow :: Pos -> FilePath
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, Pos -> Pos -> Bool
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
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
Ord, Typeable Pos
Pos -> DataType
Pos -> Constr
(forall b. Data b => b -> b) -> Pos -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Pos -> ()
$crnf :: Pos -> ()
NFData)
mkPos :: Int -> Pos
mkPos :: Int -> Pos
mkPos Int
a =
if Int
a forall a. Ord a => a -> a -> Bool
<= Int
0
then forall a e. Exception e => e -> a
throw (Int -> InvalidPosException
InvalidPosException Int
a)
else Int -> Pos
Pos Int
a
{-# INLINE mkPos #-}
unPos :: Pos -> Int
unPos :: Pos -> Int
unPos (Pos Int
w) = Int
w
{-# INLINE unPos #-}
pos1 :: Pos
pos1 :: Pos
pos1 = Int -> Pos
mkPos Int
1
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 forall a. Num a => a -> a -> a
+ Int
y)
{-# INLINE (<>) #-}
instance Read Pos where
readsPrec :: Int -> ReadS Pos
readsPrec Int
d =
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ \FilePath
r1 -> do
(FilePath
"Pos", FilePath
r2) <- ReadS FilePath
lex FilePath
r1
(Int
x, FilePath
r3) <- forall a. Read a => Int -> ReadS a
readsPrec Int
11 FilePath
r2
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Pos
mkPos Int
x, FilePath
r3)
newtype InvalidPosException
=
InvalidPosException Int
deriving (InvalidPosException -> InvalidPosException -> Bool
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 -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InvalidPosException] -> ShowS
$cshowList :: [InvalidPosException] -> ShowS
show :: InvalidPosException -> FilePath
$cshow :: InvalidPosException -> FilePath
showsPrec :: Int -> InvalidPosException -> ShowS
$cshowsPrec :: Int -> InvalidPosException -> ShowS
Show, Typeable InvalidPosException
InvalidPosException -> DataType
InvalidPosException -> Constr
(forall b. Data b => b -> b)
-> InvalidPosException -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> InvalidPosException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InvalidPosException -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> InvalidPosException -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> InvalidPosException -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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
data SourcePos = SourcePos
{
SourcePos -> FilePath
sourceName :: FilePath,
SourcePos -> Pos
sourceLine :: !Pos,
SourcePos -> Pos
sourceColumn :: !Pos
}
deriving (Int -> SourcePos -> ShowS
[SourcePos] -> ShowS
SourcePos -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SourcePos] -> ShowS
$cshowList :: [SourcePos] -> ShowS
show :: SourcePos -> FilePath
$cshow :: SourcePos -> FilePath
showsPrec :: Int -> SourcePos -> ShowS
$cshowsPrec :: Int -> SourcePos -> ShowS
Show, ReadPrec [SourcePos]
ReadPrec SourcePos
Int -> ReadS SourcePos
ReadS [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
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
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
Ord, Typeable SourcePos
SourcePos -> DataType
SourcePos -> Constr
(forall b. Data b => b -> b) -> SourcePos -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> SourcePos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourcePos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SourcePos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourcePos -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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
initialPos :: FilePath -> SourcePos
initialPos :: FilePath -> SourcePos
initialPos FilePath
n = FilePath -> Pos -> Pos -> SourcePos
SourcePos FilePath
n Pos
pos1 Pos
pos1
sourcePosPretty :: SourcePos -> String
sourcePosPretty :: SourcePos -> FilePath
sourcePosPretty (SourcePos FilePath
n Pos
l Pos
c)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
n = FilePath
showLC
| Bool
otherwise = FilePath
n forall a. Semigroup a => a -> a -> a
<> FilePath
":" forall a. Semigroup a => a -> a -> a
<> FilePath
showLC
where
showLC :: FilePath
showLC = forall a. Show a => a -> FilePath
show (Pos -> Int
unPos Pos
l) forall a. Semigroup a => a -> a -> a
<> FilePath
":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show (Pos -> Int
unPos Pos
c)