module Curry.Base.Span where
import Prelude hiding ((<>))
import Data.Binary
import Data.List (transpose)
import Control.Monad
import System.FilePath
import Curry.Base.Position hiding (file)
import Curry.Base.Pretty
data Span
= Span
{ file :: FilePath
, start :: Position
, end :: Position
}
| NoSpan
deriving (Eq, Ord, Read, Show)
instance Pretty Span where
pPrint = ppSpan
instance HasPosition Span where
setPosition p NoSpan = Span "" p NoPos
setPosition p (Span f _ e) = Span f p e
getPosition NoSpan = NoPos
getPosition (Span _ p _) = p
instance Binary Span where
put (Span _ s e) = putWord8 0 >> put s >> put e
put NoSpan = putWord8 1
get = do
x <- getWord8
case x of
0 -> liftM2 (Span "") get get
1 -> return NoSpan
_ -> fail "Not a valid encoding for a Span"
showSpan :: Span -> String
showSpan = show . ppSpan
ppSpan :: Span -> Doc
ppSpan s@(Span f _ _)
| null f = startEnd
| otherwise = text (normalise f) <> comma <+> startEnd
where startEnd = ppPositions s
ppSpan _ = empty
ppCompactSpan :: Span -> Doc
ppCompactSpan s@(Span f _ _)
| null f = ppCompactPositions s
| otherwise = text (normalise f) <> colon <> ppCompactPositions s
ppCompactSpan _ = empty
ppSpanPreview :: Span -> IO Doc
ppSpanPreview (Span f (Position _ sl sc) (Position _ el ec))
| null f = return empty
| otherwise = do
fileContents <- readFile f
let lnContents = take lnCount $ drop (sl - 1) $ lines fileContents
lnNumsRaw = (\i -> if (i - sl) `mod` lnInterval == 0 then show i else "") <$> [sl..el]
lnNums = text <$> lPadStr lnNumWidth <$> (vPad ++ lnNumsRaw ++ vPad)
gutter = text <$> replicate (lnCount + 2 * vPadCount) "|"
highlight = replicate (minC - 1) ' ' ++ replicate (1 + maxC - minC) '^'
previews = text <$> (vPad ++ lnContents ++ [highlight] ++ replicate (vPadCount - 1) "")
return $ vcat $ map hsep $ transpose [lnNums, gutter, previews]
where vPadCount = 1
lnInterval = 1
lnCount = 1 + el - sl
minC = min sc ec
maxC = max sc ec
numWidth n = 1 + floor (logBase 10 $ (fromIntegral n) :: Double)
lnNumWidth = 1 + numWidth el
vPad = replicate vPadCount ""
lPadStr n s = replicate (n - length s) ' ' ++ s
ppSpanPreview _ = return empty
ppCompactPositions :: Span -> Doc
ppCompactPositions (Span _ s e) | s == e = ppCompactLine s
| otherwise = ppCompactLine s <> text "-" <> ppCompactLine e
ppCompactPositions _ = empty
ppPositions :: Span -> Doc
ppPositions (Span _ s e) = text "startPos:" <+> ppLine s <> comma
<+> text "endPos:" <+> ppLine e
ppPositions _ = empty
fstSpan :: FilePath -> Span
fstSpan fn = Span fn (first fn) (first fn)
startCol :: Span -> Int
startCol (Span _ p _) = column p
startCol _ = 0
nextSpan :: Span -> Span
nextSpan sp = incrSpan sp 1
incrSpan :: Span -> Int -> Span
incrSpan (Span fn s e) n = Span fn (incr s n) (incr e n)
incrSpan sp _ = sp
pos2Span :: Position -> Span
pos2Span p@(Position f _ _) = Span f p p
pos2Span _ = NoSpan
span2Pos :: Span -> Position
span2Pos (Span _ p _) = p
span2Pos NoSpan = NoPos
combineSpans :: Span -> Span -> Span
combineSpans sp1 sp2 = Span f s e
where s = start sp1
e = end sp2
f = file sp1
tabSpan :: Span -> Span
tabSpan (Span fn s e) = Span fn (tab s) (tab e)
tabSpan sp = sp
nlSpan :: Span -> Span
nlSpan (Span fn s e) = Span fn (nl s) (nl e)
nlSpan sp = sp
addSpan :: Span -> (a, [Span]) -> (a, [Span])
addSpan sp (a, ss) = (a, sp:ss)
type Distance = (Int, Int)
setDistance :: Span -> Distance -> Span
setDistance (Span fn p _) d = Span fn p (p `moveBy` d)
setDistance s _ = s
moveBy :: Position -> Distance -> Position
moveBy (Position fn l c) (ld, cd) = Position fn (l + ld) (c + cd)
moveBy p _ = p