-----------------------------------------------------------------------------
-- |
-- Module      :  Position
-- Copyright   :  2000-2004 Malcolm Wallace
-- Licence     :  LGPL
--
-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
-- Stability   :  experimental
-- Portability :  All
--
-- Simple file position information, with recursive inclusion points.
-----------------------------------------------------------------------------

module Language.Preprocessor.Cpphs.Position
  ( Posn(..)
  , newfile
  , addcol, newline, tab, newlines, newpos
  , cppline, haskline, cpp2hask
  , filename, lineno, directory
  , cleanPath
  ) where

import Data.List (isPrefixOf)

-- | 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
$c== :: Posn -> Posn -> Bool
== :: Posn -> Posn -> Bool
$c/= :: Posn -> Posn -> Bool
/= :: Posn -> Posn -> Bool
Eq)

instance Show Posn where
      showsPrec :: Int -> Posn -> ShowS
showsPrec Int
_ (Pn [Char]
f Int
l Int
c Maybe Posn
i) = [Char] -> ShowS
showString [Char]
f ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 [Char] -> ShowS
showString [Char]
"  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
.
                                 [Char] -> ShowS
showString [Char]
" 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  -> [Char] -> ShowS
showString [Char]
"\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 )

-- | Constructor.  Argument is filename.
newfile :: String -> Posn
newfile :: [Char] -> Posn
newfile [Char]
name = [Char] -> Int -> Int -> Maybe Posn -> Posn
Pn (ShowS
cleanPath [Char]
name) Int
1 Int
1 Maybe Posn
forall a. Maybe a
Nothing

-- | Increment column number by given quantity.
addcol :: Int -> Posn -> Posn
addcol :: Int -> Posn -> Posn
addcol Int
n (Pn [Char]
f Int
r Int
c Maybe Posn
i) = [Char] -> Int -> Int -> Maybe Posn -> Posn
Pn [Char]
f Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Maybe Posn
i

-- | Increment row number, reset column to 1.
newline :: Posn -> Posn
--newline (Pn f r _ i) = Pn f (r+1) 1 i
newline :: Posn -> Posn
newline (Pn [Char]
f Int
r Int
_ Maybe Posn
i) = let r' :: Int
r' = Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in Int
r' Int -> Posn -> Posn
forall a b. a -> b -> b
`seq` [Char] -> Int -> Int -> Maybe Posn -> Posn
Pn [Char]
f Int
r' Int
1 Maybe Posn
i

-- | Increment column number, tab stops are every 8 chars.
tab     :: Posn -> Posn
tab :: Posn -> Posn
tab     (Pn [Char]
f Int
r Int
c Maybe Posn
i) = [Char] -> Int -> Int -> Maybe Posn -> Posn
Pn [Char]
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

-- | Increment row number by given quantity.
newlines :: Int -> Posn -> Posn
newlines :: Int -> Posn -> Posn
newlines Int
n (Pn [Char]
f Int
r Int
_ Maybe Posn
i) = [Char] -> Int -> Int -> Maybe Posn -> Posn
Pn [Char]
f (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Int
1 Maybe Posn
i

-- | Update position with a new row, and possible filename.
newpos :: Int -> Maybe String -> Posn -> Posn
newpos :: Int -> Maybe [Char] -> Posn -> Posn
newpos Int
r Maybe [Char]
Nothing  (Pn [Char]
f Int
_ Int
c Maybe Posn
i) = [Char] -> Int -> Int -> Maybe Posn -> Posn
Pn [Char]
f Int
r Int
c Maybe Posn
i
newpos Int
r (Just (Char
'"':[Char]
f)) (Pn [Char]
_ Int
_ Int
c Maybe Posn
i) = [Char] -> Int -> Int -> Maybe Posn -> Posn
Pn (ShowS
forall a. HasCallStack => [a] -> [a]
init [Char]
f) Int
r Int
c Maybe Posn
i
newpos Int
r (Just [Char]
f)       (Pn [Char]
_ Int
_ Int
c Maybe Posn
i) = [Char] -> Int -> Int -> Maybe Posn -> Posn
Pn [Char]
f Int
r Int
c Maybe Posn
i

-- | Project the line number.
lineno    :: Posn -> Int
-- | Project the filename.
filename  :: Posn -> String
-- | Project the directory of the filename.
directory :: Posn -> FilePath

lineno :: Posn -> Int
lineno    (Pn [Char]
_ Int
r Int
_ Maybe Posn
_) = Int
r
filename :: Posn -> [Char]
filename  (Pn [Char]
f Int
_ Int
_ Maybe Posn
_) = [Char]
f
directory :: Posn -> [Char]
directory (Pn [Char]
f Int
_ Int
_ Maybe Posn
_) = ShowS
dirname [Char]
f


-- | cpp-style printing of file position
cppline :: Posn -> String
cppline :: Posn -> [Char]
cppline (Pn [Char]
f Int
r Int
_ Maybe Posn
_) = [Char]
"#line "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show Int
r[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
forall a. Show a => a -> [Char]
show [Char]
f

-- | haskell-style printing of file position
haskline :: Posn -> String
haskline :: Posn -> [Char]
haskline (Pn [Char]
f Int
r Int
_ Maybe Posn
_) = [Char]
"{-# LINE "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show Int
r[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
forall a. Show a => a -> [Char]
show [Char]
f[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" #-}"

-- | Conversion from a cpp-style "#line" to haskell-style pragma.
cpp2hask :: String -> String
cpp2hask :: ShowS
cpp2hask [Char]
line | [Char]
"#line" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
line = [Char]
"{-# LINE "
                                            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[[Char]] -> [Char]
unwords ([[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
tail ([Char] -> [[Char]]
words [Char]
line))
                                            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" #-}"
              | Bool
otherwise = [Char]
line

-- | Strip non-directory suffix from file name (analogous to the shell
--   command of the same name).
dirname :: String -> String
dirname :: ShowS
dirname  = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
safetail ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`[Char]
"\\/")) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse
  where safetail :: [a] -> [a]
safetail [] = []
        safetail (a
_:[a]
x) = [a]
x

-- | Sigh.  Mixing Windows filepaths with unix is bad.  Make sure there is a
--   canonical path separator.
cleanPath :: FilePath -> FilePath
cleanPath :: ShowS
cleanPath [] = []
cleanPath (Char
'\\':[Char]
cs) = Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
cleanPath [Char]
cs
cleanPath (Char
c:[Char]
cs)    = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:   ShowS
cleanPath [Char]
cs