module Language.Preprocessor.Cpphs.Position
( Posn(..)
, newfile
, addcol, newline, tab, newlines, newpos
, cppline, haskline, cpp2hask
, filename, lineno, directory
, cleanPath
) where
import Data.List (isPrefixOf)
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)
instance Show Posn where
showsPrec :: Int -> Posn -> ShowS
showsPrec _ (Pn f :: String
f l :: Int
l c :: Int
c i :: Maybe Posn
i) = String -> ShowS
showString String
f ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString " 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
.
String -> ShowS
showString " 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
Nothing -> ShowS
forall a. a -> a
id
Just p :: Posn
p -> String -> ShowS
showString "\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 )
newfile :: String -> Posn
newfile :: String -> Posn
newfile name :: String
name = String -> Int -> Int -> Maybe Posn -> Posn
Pn (ShowS
cleanPath String
name) 1 1 Maybe Posn
forall a. Maybe a
Nothing
addcol :: Int -> Posn -> Posn
addcol :: Int -> Posn -> Posn
addcol n :: Int
n (Pn f :: String
f r :: Int
r c :: Int
c i :: Maybe Posn
i) = String -> Int -> Int -> Maybe Posn -> Posn
Pn String
f Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Maybe Posn
i
newline :: Posn -> Posn
newline :: Posn -> Posn
newline (Pn f :: String
f r :: Int
r _ i :: Maybe Posn
i) = let r' :: Int
r' = Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+1 in Int
r' Int -> Posn -> Posn
forall a b. a -> b -> b
`seq` String -> Int -> Int -> Maybe Posn -> Posn
Pn String
f Int
r' 1 Maybe Posn
i
tab :: Posn -> Posn
tab :: Posn -> Posn
tab (Pn f :: String
f r :: Int
r c :: Int
c i :: Maybe Posn
i) = String -> Int -> Int -> Maybe Posn -> Posn
Pn String
f Int
r (((Int
cInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`8)Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*8) Maybe Posn
i
newlines :: Int -> Posn -> Posn
newlines :: Int -> Posn -> Posn
newlines n :: Int
n (Pn f :: String
f r :: Int
r _ i :: Maybe Posn
i) = String -> Int -> Int -> Maybe Posn -> Posn
Pn String
f (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) 1 Maybe Posn
i
newpos :: Int -> Maybe String -> Posn -> Posn
newpos :: Int -> Maybe String -> Posn -> Posn
newpos r :: Int
r Nothing (Pn f :: String
f _ c :: Int
c i :: Maybe Posn
i) = String -> Int -> Int -> Maybe Posn -> Posn
Pn String
f Int
r Int
c Maybe Posn
i
newpos r :: Int
r (Just ('"':f :: String
f)) (Pn _ _ c :: Int
c i :: Maybe Posn
i) = String -> Int -> Int -> Maybe Posn -> Posn
Pn (ShowS
forall a. [a] -> [a]
init String
f) Int
r Int
c Maybe Posn
i
newpos r :: Int
r (Just f :: String
f) (Pn _ _ c :: Int
c i :: Maybe Posn
i) = String -> Int -> Int -> Maybe Posn -> Posn
Pn String
f Int
r Int
c Maybe Posn
i
lineno :: Posn -> Int
filename :: Posn -> String
directory :: Posn -> FilePath
lineno :: Posn -> Int
lineno (Pn _ r :: Int
r _ _) = Int
r
filename :: Posn -> String
filename (Pn f :: String
f _ _ _) = String
f
directory :: Posn -> String
directory (Pn f :: String
f _ _ _) = ShowS
dirname String
f
cppline :: Posn -> String
cppline :: Posn -> String
cppline (Pn f :: String
f r :: Int
r _ _) = "#line "String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
rString -> ShowS
forall a. [a] -> [a] -> [a]
++" "String -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
forall a. Show a => a -> String
show String
f
haskline :: Posn -> String
haskline :: Posn -> String
haskline (Pn f :: String
f r :: Int
r _ _) = "{-# LINE "String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
rString -> ShowS
forall a. [a] -> [a] -> [a]
++" "String -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
forall a. Show a => a -> String
show String
fString -> ShowS
forall a. [a] -> [a] -> [a]
++" #-}"
cpp2hask :: String -> String
cpp2hask :: ShowS
cpp2hask line :: String
line | "#line" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
line = "{-# LINE "
String -> ShowS
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords ([String] -> [String]
forall a. [a] -> [a]
tail (String -> [String]
words String
line))
String -> ShowS
forall a. [a] -> [a] -> [a]
++" #-}"
| Bool
otherwise = String
line
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 -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`"\\/")) 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 (_:x :: [a]
x) = [a]
x
cleanPath :: FilePath -> FilePath
cleanPath :: ShowS
cleanPath [] = []
cleanPath ('\\':cs :: String
cs) = '/'Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
cleanPath String
cs
cleanPath (c :: Char
c:cs :: String
cs) = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
: ShowS
cleanPath String
cs