1module Language.Haskell.Lexer.Position where
2
3-- | The posisiotn within a file.
4data Pos = Pos { char, line, column :: !Int } deriving (Show)
5
6-- | The line and column numbers of a position.
7simpPos :: Pos -> (Int,Int)
8simpPos (Pos _ l c) = (l,c)
9
10-- Some functions still put fake char positions in Pos values, so...
11instance Eq Pos where p1 == p2 = simpPos p1 == simpPos p2
12instance Ord Pos where compare p1 p2 = compare (simpPos p1) (simpPos p2)
13
14-- | The first column is designated column 1, not 0.
15startPos :: Pos
16startPos = Pos { char = 0, line = 1, column = 1 }
17
18-- | Advance position by a string.
19nextPos :: Pos -> String -> Pos
20nextPos = foldl nextPos1
21
22-- | Advance position by a single character.
23nextPos1 :: Pos -> Char -> Pos
24nextPos1 (Pos n y x) c =
25    case c of
26      -- The characters newline, return, linefeed, and formfeed, all start
27      -- a new line.
28      '\CR' -> Pos (n+1) (y+1) 1
29      '\LF' -> Pos (n+1) (y+1) 1
30      '\FF' -> Pos (n+1) (y+1) 1
31      -- Tab stops are 8 characters apart.
32      -- A tab character causes the insertion of enough spaces to align the
33      -- current position with the next tab stop.
34      -- + (not in the report) the first tab stop is column 1.
35      '\t'  -> Pos (n+1) y (x+8-(x-1) `mod` 8)
36      _ -> Pos (n+1) y (x+1)
37