module Language.Haskell.HBB.Internal.SrcSpan where
import System.FilePath (normalise,makeRelative)
import Data.Generics
import FastString (unpackFS,fsLit)
import Data.Char (isSpace)
import SrcLoc
data BufLoc = BufLoc Int Int
deriving (Eq,Data,Typeable)
instance Show BufLoc where
show (BufLoc l1 c1) = (show l1) ++ ':':(show c1)
instance Ord BufLoc where
compare (BufLoc l1 _ ) (BufLoc l2 _ ) | l1 /= l2 = l1 `compare` l2
compare (BufLoc _ c1) (BufLoc _ c2) = c1 `compare` c2
data BufSpan = BufSpan BufLoc BufLoc
deriving (Eq,Typeable,Data)
instance Show BufSpan where
show (BufSpan l1 l2) = (show l1) ++ " - " ++ (show l2)
type LineBuf = [String]
spanStart :: BufSpan -> BufLoc
spanStart (BufSpan s _) = s
spanEnd :: BufSpan -> BufLoc
spanEnd (BufSpan _ e) = e
unpackRealSrcSpan :: RealSrcSpan -> (FilePath,BufSpan)
unpackRealSrcSpan r = (unpackFS $ srcSpanFile r,toBufSpan r)
packRealSrcSpan :: (FilePath,BufSpan) -> RealSrcSpan
packRealSrcSpan (f,(BufSpan (BufLoc l1s l1e) (BufLoc l2s l2e))) =
let newFilename = fsLit f
in mkRealSrcSpan
(mkRealSrcLoc newFilename l1s l1e)
(mkRealSrcLoc newFilename l2s l2e)
normalisePath
:: FilePath
-> FilePath
-> FilePath
normalisePath c p = makeRelative c $ normalise p
showSpan
:: Maybe FilePath
-> (FilePath,BufSpan)
-> String
showSpan cwd (f,(BufSpan (BufLoc sli sco) (BufLoc eli eco))) =
let filePart = case cwd of Nothing -> f
Just c -> normalisePath c f
in ('"':filePart ++ "\"") ++ (' ':(show sli)) ++ (' ':(show sco)) ++
(' ':(show eli)) ++ (' ':(show eco))
str2LineBuf :: String -> LineBuf
str2LineBuf x = str2LineBufAcc x []
where
str2LineBufAcc :: String -> LineBuf -> LineBuf
str2LineBufAcc [] acc = reverse $ map reverse acc
str2LineBufAcc ('\n':s) [] = str2LineBufAcc s ["",""]
str2LineBufAcc ('\n':s) acc = str2LineBufAcc s ("":acc)
str2LineBufAcc (c :s) [] = str2LineBufAcc s [(c:"")]
str2LineBufAcc (c :s) (a:acc) = str2LineBufAcc s ((c:a):acc)
lineBuf2Str :: LineBuf -> String
lineBuf2Str [] = ""
lineBuf2Str xs = (unlines (init xs)) ++ (last xs)
type Indentation = Int
getIndentation :: LineBuf -> Indentation
getIndentation buf = minimum $ map (countInd 0) buf
where
countInd :: Indentation -> String -> Indentation
countInd _ [] = 0
countInd acc (c:s) | isSpace c = countInd (acc+1) s
countInd acc _ = acc
compareByStartLoc :: RealSrcSpan -> RealSrcSpan -> Ordering
compareByStartLoc r1 r2 = compare s1 s2
where s1 = realSrcSpanStart r1
s2 = realSrcSpanStart r2
toBufLoc :: RealSrcLoc -> BufLoc
toBufLoc x =
let line = srcLocLine x
col = srcLocCol x
in BufLoc line col
toBufSpan :: RealSrcSpan -> BufSpan
toBufSpan x = BufSpan startLoc endLoc
where startLoc = toBufLoc $ realSrcSpanStart x
endLoc = toBufLoc $ realSrcSpanEnd x
pointBufSpan :: Int -> Int -> BufSpan
pointBufSpan line column = BufSpan loc loc
where loc = BufLoc line column
splitAtBufLoc :: LineBuf -> BufLoc -> (LineBuf,LineBuf)
splitAtBufLoc [] _ = ([],[])
splitAtBufLoc lns (BufLoc ln co) =
let leftPart =
let firstPart = (take (max ln 0) lns)
in (init firstPart) ++ [take (max (co1) 0) (last firstPart)]
in case (drop (max (ln1) 0) lns) of
(r:rs) -> let rightPart = (drop (max (co1) 0) r):rs in (leftPart,rightPart)
_ -> (leftPart,[])
splitBufferedLinesAtBufSpan :: LineBuf -> BufSpan -> (LineBuf,LineBuf,LineBuf)
splitBufferedLinesAtBufSpan lns (BufSpan l1 l2) =
let (rest,traiLines) = splitAtBufLoc lns l2
(initLines,subjLines) = splitAtBufLoc rest l1
in (initLines,subjLines,traiLines)
leq :: RealSrcSpan -> RealSrcSpan -> Bool
s1 `leq` s2 =
let endS1 = realSrcSpanEnd s1
startS2 = realSrcSpanStart s2
in endS1 <= startS2
disjoint :: RealSrcSpan -> RealSrcSpan -> Bool
disjoint s1 s2 =
let startS1 = realSrcSpanStart s1
endS1 = realSrcSpanEnd s1
startS2 = realSrcSpanStart s2
endS2 = realSrcSpanEnd s2
in endS1 <= startS2 || endS2 <= startS1
joinSplit :: ([String],[String]) -> [String]
joinSplit (lines1,[]) = lines1
joinSplit ([],lines2) = lines2
joinSplit t = joinSplitAcc [] t
where
joinSplitAcc :: [String] -> ([String],[String]) -> [String]
joinSplitAcc acc ([],[]) = reverse acc
joinSplitAcc acc ([],(l:lines2)) = joinSplitAcc (l:acc) ([],lines2)
joinSplitAcc acc ((x:y@(_:_)),lines2) = joinSplitAcc (x:acc) (y ,lines2)
joinSplitAcc acc ([x],(l:lines2)) = joinSplitAcc ((x ++ l):acc) ([],lines2)
joinSplitAcc acc ([x],[]) = joinSplitAcc ( x :acc) ([],[])
reassembleSplit :: ([String],[String],[String]) -> [String]
reassembleSplit (initLines,subjLines,traiLines) =
joinSplit (initLines,(joinSplit (subjLines,traiLines)))