1-----------------------------------------------------------------------------
2-- |
3-- Module      :  Position
4-- Copyright   :  2000-2004 Malcolm Wallace
5-- Licence     :  LGPL
6--
7-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
8-- Stability   :  experimental
9-- Portability :  All
10--
11-- Simple file position information, with recursive inclusion points.
12-----------------------------------------------------------------------------
13
14module Language.Preprocessor.Cpphs.Position
15  ( Posn(..)
16  , newfile
17  , addcol, newline, tab, newlines, newpos
18  , cppline, haskline, cpp2hask
19  , filename, lineno, directory
20  , cleanPath
21  ) where
22
23import Data.List (isPrefixOf)
24
25-- | Source positions contain a filename, line, column, and an
26--   inclusion point, which is itself another source position,
27--   recursively.
28data Posn = Pn String !Int !Int (Maybe Posn)
29        deriving (Eq)
30
31instance Show Posn where
32      showsPrec _ (Pn f l c i) = showString f .
33                                 showString "  at line " . shows l .
34                                 showString " col " . shows c .
35                                 ( case i of
36                                    Nothing -> id
37                                    Just p  -> showString "\n    used by  " .
38                                               shows p )
39
40-- | Constructor.  Argument is filename.
41newfile :: String -> Posn
42newfile name = Pn (cleanPath name) 1 1 Nothing
43
44-- | Increment column number by given quantity.
45addcol :: Int -> Posn -> Posn
46addcol n (Pn f r c i) = Pn f r (c+n) i
47
48-- | Increment row number, reset column to 1.
49newline :: Posn -> Posn
50--newline (Pn f r _ i) = Pn f (r+1) 1 i
51newline (Pn f r _ i) = let r' = r+1 in r' `seq` Pn f r' 1 i
52
53-- | Increment column number, tab stops are every 8 chars.
54tab     :: Posn -> Posn
55tab     (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i
56
57-- | Increment row number by given quantity.
58newlines :: Int -> Posn -> Posn
59newlines n (Pn f r _ i) = Pn f (r+n) 1 i
60
61-- | Update position with a new row, and possible filename.
62newpos :: Int -> Maybe String -> Posn -> Posn
63newpos r Nothing  (Pn f _ c i) = Pn f r c i
64newpos r (Just ('"':f)) (Pn _ _ c i) = Pn (init f) r c i
65newpos r (Just f)       (Pn _ _ c i) = Pn f r c i
66
67-- | Project the line number.
68lineno    :: Posn -> Int
69-- | Project the filename.
70filename  :: Posn -> String
71-- | Project the directory of the filename.
72directory :: Posn -> FilePath
73
74lineno    (Pn _ r _ _) = r
75filename  (Pn f _ _ _) = f
76directory (Pn f _ _ _) = dirname f
77
78
79-- | cpp-style printing of file position
80cppline :: Posn -> String
81cppline (Pn f r _ _) = "#line "++show r++" "++show f
82
83-- | haskell-style printing of file position
84haskline :: Posn -> String
85haskline (Pn f r _ _) = "{-# LINE "++show r++" "++show f++" #-}"
86
87-- | Conversion from a cpp-style "#line" to haskell-style pragma.
88cpp2hask :: String -> String
89cpp2hask line | "#line" `isPrefixOf` line = "{-# LINE "
90                                            ++unwords (tail (words line))
91                                            ++" #-}"
92              | otherwise = line
93
94-- | Strip non-directory suffix from file name (analogous to the shell
95--   command of the same name).
96dirname :: String -> String
97dirname  = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse
98  where safetail [] = []
99        safetail (_:x) = x
100
101-- | Sigh.  Mixing Windows filepaths with unix is bad.  Make sure there is a
102--   canonical path separator.
103cleanPath :: FilePath -> FilePath
104cleanPath [] = []
105cleanPath ('\\':cs) = '/': cleanPath cs
106cleanPath (c:cs)    = c:   cleanPath cs
107