-- | Define a position datatype for giving locations in error messages.
module Text.XML.HaXml.Posn
  (
  -- * Position type
    Posn()
  -- ** Constructors of a new position
  , posInNewCxt    -- :: String -> Maybe Posn -> Posn
  , noPos          -- :: Posn
  -- ** Strictifier
  , forcep
  -- ** Modifiers
  , addcol, newline, tab, white
  -- ** Accessors
  , posnFilename, posnLine, posnColumn
  ) where

import Data.Char

-- | Source positions contain a filename, line, column, and an
--   inclusion point, which is itself another source position,
--   recursively.
data Posn = Pn String !Int !Int (Maybe Posn)
        deriving (Posn -> Posn -> Bool
(Posn -> Posn -> Bool) -> (Posn -> Posn -> Bool) -> Eq Posn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Posn -> Posn -> Bool
$c/= :: Posn -> Posn -> Bool
== :: Posn -> Posn -> Bool
$c== :: Posn -> Posn -> Bool
Eq)

posnFilename :: Posn -> FilePath
posnFilename :: Posn -> FilePath
posnFilename (Pn FilePath
f Int
_ Int
_ Maybe Posn
_) = FilePath
f

posnLine, posnColumn :: Posn -> Int
posnLine :: Posn -> Int
posnLine   (Pn FilePath
_ Int
x Int
_ Maybe Posn
_) = Int
x
posnColumn :: Posn -> Int
posnColumn (Pn FilePath
_ Int
_ Int
x Maybe Posn
_) = Int
x

-- | Dummy value for generated data, where a true source position does
--   not exist.
noPos :: Posn
noPos :: Posn
noPos = FilePath -> Int -> Int -> Maybe Posn -> Posn
Pn FilePath
"no recorded position" Int
0 Int
0 Maybe Posn
forall a. Maybe a
Nothing

-- | @posInNewCxt name pos@ creates a new source position from an old one.
--   It is used when opening a new file (e.g. a DTD inclusion), to denote
--   the start of the file @name@, but retain the stacked information that
--   it was included from the old @pos@.
posInNewCxt :: String -> Maybe Posn -> Posn
posInNewCxt :: FilePath -> Maybe Posn -> Posn
posInNewCxt FilePath
name Maybe Posn
pos = FilePath -> Int -> Int -> Maybe Posn -> Posn
Pn FilePath
name Int
1 Int
1 Maybe Posn
pos

instance Show Posn where
      showsPrec :: Int -> Posn -> ShowS
showsPrec Int
_ (Pn FilePath
f Int
l Int
c Maybe Posn
i) = FilePath -> ShowS
showString FilePath
"file " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 FilePath -> ShowS
showString FilePath
f ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 FilePath -> ShowS
showString FilePath
"  at line " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 FilePath -> ShowS
showString FilePath
" col " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
c ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 ( case Maybe Posn
i of
                                    Maybe Posn
Nothing -> ShowS
forall a. a -> a
id
                                    Just Posn
p  -> FilePath -> ShowS
showString FilePath
"\n    used by  " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                               Posn -> ShowS
forall a. Show a => a -> ShowS
shows Posn
p )

-- | Just used to strictify the internal values of a position, to avoid
--   space leaks.
forcep :: Posn -> Int
forcep :: Posn -> Int
forcep (Pn FilePath
_ Int
n Int
m Maybe Posn
_) = Int
m Int -> Int -> Int
`seq` Int
n

-- | Add n character positions to the given position.
addcol :: Int -> Posn -> Posn
addcol :: Int -> Posn -> Posn
addcol Int
n (Pn FilePath
f Int
r Int
c Maybe Posn
i) = FilePath -> Int -> Int -> Maybe Posn -> Posn
Pn FilePath
f Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Maybe Posn
i

-- | Add a newline or tab to the given position.
newline, tab :: Posn -> Posn
newline :: Posn -> Posn
newline (Pn FilePath
f Int
r Int
_ Maybe Posn
i) = FilePath -> Int -> Int -> Maybe Posn -> Posn
Pn FilePath
f (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
1 Maybe Posn
i
tab :: Posn -> Posn
tab     (Pn FilePath
f Int
r Int
c Maybe Posn
i) = FilePath -> Int -> Int -> Maybe Posn -> Posn
Pn FilePath
f Int
r (((Int
cInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
8)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) Maybe Posn
i

-- | Add the given whitespace char to the given position.
--   Precondition: @white c | isSpace c = True@
white :: Char -> Posn -> Posn
white :: Char -> Posn -> Posn
white Char
' '    = Int -> Posn -> Posn
addcol Int
1
white Char
'\n'   = Posn -> Posn
newline
white Char
'\r'   = Posn -> Posn
forall a. a -> a
id
white Char
'\t'   = Posn -> Posn
tab
white Char
'\xa0' = Int -> Posn -> Posn
addcol Int
1
white Char
x | Char -> Bool
isSpace Char
x = Int -> Posn -> Posn
addcol Int
1 -- other Unicode whitespace
white Char
_      = FilePath -> Posn -> Posn
forall a. HasCallStack => FilePath -> a
error FilePath
"precondition not satisfied: Posn.white c | isSpace c"