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
{ Span -> FilePath
file :: FilePath
, Span -> Position
start :: Position
, Span -> Position
end :: Position
}
| NoSpan
deriving (Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c== :: Span -> Span -> Bool
Eq, Eq Span
Eq Span =>
(Span -> Span -> Ordering)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Span)
-> (Span -> Span -> Span)
-> Ord Span
Span -> Span -> Bool
Span -> Span -> Ordering
Span -> Span -> Span
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Span -> Span -> Span
$cmin :: Span -> Span -> Span
max :: Span -> Span -> Span
$cmax :: Span -> Span -> Span
>= :: Span -> Span -> Bool
$c>= :: Span -> Span -> Bool
> :: Span -> Span -> Bool
$c> :: Span -> Span -> Bool
<= :: Span -> Span -> Bool
$c<= :: Span -> Span -> Bool
< :: Span -> Span -> Bool
$c< :: Span -> Span -> Bool
compare :: Span -> Span -> Ordering
$ccompare :: Span -> Span -> Ordering
$cp1Ord :: Eq Span
Ord, ReadPrec [Span]
ReadPrec Span
Int -> ReadS Span
ReadS [Span]
(Int -> ReadS Span)
-> ReadS [Span] -> ReadPrec Span -> ReadPrec [Span] -> Read Span
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Span]
$creadListPrec :: ReadPrec [Span]
readPrec :: ReadPrec Span
$creadPrec :: ReadPrec Span
readList :: ReadS [Span]
$creadList :: ReadS [Span]
readsPrec :: Int -> ReadS Span
$creadsPrec :: Int -> ReadS Span
Read, Int -> Span -> ShowS
[Span] -> ShowS
Span -> FilePath
(Int -> Span -> ShowS)
-> (Span -> FilePath) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> FilePath
$cshow :: Span -> FilePath
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
Show)
instance Pretty Span where
pPrint :: Span -> Doc
pPrint = Span -> Doc
ppSpan
instance HasPosition Span where
setPosition :: Position -> Span -> Span
setPosition p :: Position
p NoSpan = FilePath -> Position -> Position -> Span
Span "" Position
p Position
NoPos
setPosition p :: Position
p (Span f :: FilePath
f _ e :: Position
e) = FilePath -> Position -> Position -> Span
Span FilePath
f Position
p Position
e
getPosition :: Span -> Position
getPosition NoSpan = Position
NoPos
getPosition (Span _ p :: Position
p _) = Position
p
instance Binary Span where
put :: Span -> Put
put (Span _ s :: Position
s e :: Position
e) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Position -> Put
forall t. Binary t => t -> Put
put Position
s Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Position -> Put
forall t. Binary t => t -> Put
put Position
e
put NoSpan = Word8 -> Put
putWord8 1
get :: Get Span
get = do
Word8
x <- Get Word8
getWord8
case Word8
x of
0 -> (Position -> Position -> Span)
-> Get Position -> Get Position -> Get Span
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (FilePath -> Position -> Position -> Span
Span "") Get Position
forall t. Binary t => Get t
get Get Position
forall t. Binary t => Get t
get
1 -> Span -> Get Span
forall (m :: * -> *) a. Monad m => a -> m a
return Span
NoSpan
_ -> FilePath -> Get Span
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail "Not a valid encoding for a Span"
showSpan :: Span -> String
showSpan :: Span -> FilePath
showSpan = Doc -> FilePath
forall a. Show a => a -> FilePath
show (Doc -> FilePath) -> (Span -> Doc) -> Span -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Doc
ppSpan
ppSpan :: Span -> Doc
ppSpan :: Span -> Doc
ppSpan s :: Span
s@(Span f :: FilePath
f _ _)
| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
f = Doc
startEnd
| Bool
otherwise = FilePath -> Doc
text (ShowS
normalise FilePath
f) Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Doc
startEnd
where startEnd :: Doc
startEnd = Span -> Doc
ppPositions Span
s
ppSpan _ = Doc
empty
ppCompactSpan :: Span -> Doc
ppCompactSpan :: Span -> Doc
ppCompactSpan s :: Span
s@(Span f :: FilePath
f _ _)
| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
f = Span -> Doc
ppCompactPositions Span
s
| Bool
otherwise = FilePath -> Doc
text (ShowS
normalise FilePath
f) Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> Span -> Doc
ppCompactPositions Span
s
ppCompactSpan _ = Doc
empty
ppSpanPreview :: Span -> IO Doc
ppSpanPreview :: Span -> IO Doc
ppSpanPreview (Span f :: FilePath
f (Position _ sl :: Int
sl sc :: Int
sc) (Position _ el :: Int
el ec :: Int
ec))
| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
f = Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
empty
| Bool
otherwise = do
FilePath
fileContents <- FilePath -> IO FilePath
readFile FilePath
f
let lns :: [FilePath]
lns = FilePath -> [FilePath]
lines FilePath
fileContents
lnContent :: FilePath
lnContent | Int
sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
|| Int
sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
lns = ""
| Bool
otherwise = [FilePath]
lns [FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! (Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
lnNum :: [Doc]
lnNum = FilePath -> Doc
text (FilePath -> Doc) -> ShowS -> FilePath -> Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ShowS
lPadStr Int
lnNumWidth (FilePath -> Doc) -> [FilePath] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([FilePath]
vPad [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [Int -> FilePath
forall a. Show a => a -> FilePath
show Int
sl] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
vPad)
ec' :: Int
ec' = if Bool
isMultiline then FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
lnContent else Int
ec
gutter :: [Doc]
gutter = FilePath -> Doc
text (FilePath -> Doc) -> [FilePath] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> FilePath -> [FilePath]
forall a. Int -> a -> [a]
replicate (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
vPadCount) "|"
highlight :: FilePath
highlight = Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) ' ' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ec' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sc) '^' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool
isMultiline then "..." else ""
previews :: [Doc]
previews = FilePath -> Doc
text (FilePath -> Doc) -> [FilePath] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([FilePath]
vPad [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
lnContent, FilePath
highlight] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ Int -> FilePath -> [FilePath]
forall a. Int -> a -> [a]
replicate (Int
vPadCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) "")
Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> IO Doc) -> Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ([Doc] -> Doc) -> [[Doc]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Doc] -> Doc
hsep ([[Doc]] -> [Doc]) -> [[Doc]] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [[Doc]] -> [[Doc]]
forall a. [[a]] -> [[a]]
transpose [[Doc]
lnNum, [Doc]
gutter, [Doc]
previews]
where vPadCount :: Int
vPadCount = 1
isMultiline :: Bool
isMultiline = Int
el Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
numWidth :: Int -> Int
numWidth = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int) -> (Int -> FilePath) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show
lnNumWidth :: Int
lnNumWidth = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
numWidth Int
el
vPad :: [FilePath]
vPad = Int -> FilePath -> [FilePath]
forall a. Int -> a -> [a]
replicate Int
vPadCount ""
lPadStr :: Int -> ShowS
lPadStr n :: Int
n s :: FilePath
s = Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
s) ' ' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
s
ppSpanPreview _ = Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
empty
ppCompactPositions :: Span -> Doc
ppCompactPositions :: Span -> Doc
ppCompactPositions (Span _ s :: Position
s e :: Position
e) | Position
s Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
e = Position -> Doc
ppCompactLine Position
s
| Bool
otherwise = Position -> Doc
ppCompactLine Position
s Doc -> Doc -> Doc
<> FilePath -> Doc
text "-" Doc -> Doc -> Doc
<> Position -> Doc
ppCompactLine Position
e
ppCompactPositions _ = Doc
empty
ppPositions :: Span -> Doc
ppPositions :: Span -> Doc
ppPositions (Span _ s :: Position
s e :: Position
e) = FilePath -> Doc
text "startPos:" Doc -> Doc -> Doc
<+> Position -> Doc
ppLine Position
s Doc -> Doc -> Doc
<> Doc
comma
Doc -> Doc -> Doc
<+> FilePath -> Doc
text "endPos:" Doc -> Doc -> Doc
<+> Position -> Doc
ppLine Position
e
ppPositions _ = Doc
empty
fstSpan :: FilePath -> Span
fstSpan :: FilePath -> Span
fstSpan fn :: FilePath
fn = FilePath -> Position -> Position -> Span
Span FilePath
fn (FilePath -> Position
first FilePath
fn) (FilePath -> Position
first FilePath
fn)
startCol :: Span -> Int
startCol :: Span -> Int
startCol (Span _ p :: Position
p _) = Position -> Int
column Position
p
startCol _ = 0
nextSpan :: Span -> Span
nextSpan :: Span -> Span
nextSpan sp :: Span
sp = Span -> Int -> Span
incrSpan Span
sp 1
incrSpan :: Span -> Int -> Span
incrSpan :: Span -> Int -> Span
incrSpan (Span fn :: FilePath
fn s :: Position
s e :: Position
e) n :: Int
n = FilePath -> Position -> Position -> Span
Span FilePath
fn (Position -> Int -> Position
incr Position
s Int
n) (Position -> Int -> Position
incr Position
e Int
n)
incrSpan sp :: Span
sp _ = Span
sp
pos2Span :: Position -> Span
pos2Span :: Position -> Span
pos2Span p :: Position
p@(Position f :: FilePath
f _ _) = FilePath -> Position -> Position -> Span
Span FilePath
f Position
p Position
p
pos2Span _ = Span
NoSpan
span2Pos :: Span -> Position
span2Pos :: Span -> Position
span2Pos (Span _ p :: Position
p _) = Position
p
span2Pos NoSpan = Position
NoPos
combineSpans :: Span -> Span -> Span
combineSpans :: Span -> Span -> Span
combineSpans sp1 :: Span
sp1 sp2 :: Span
sp2 = FilePath -> Position -> Position -> Span
Span FilePath
f Position
s Position
e
where s :: Position
s = Span -> Position
start Span
sp1
e :: Position
e = Span -> Position
end Span
sp2
f :: FilePath
f = Span -> FilePath
file Span
sp1
tabSpan :: Span -> Span
tabSpan :: Span -> Span
tabSpan (Span fn :: FilePath
fn s :: Position
s e :: Position
e) = FilePath -> Position -> Position -> Span
Span FilePath
fn (Position -> Position
tab Position
s) (Position -> Position
tab Position
e)
tabSpan sp :: Span
sp = Span
sp
nlSpan :: Span -> Span
nlSpan :: Span -> Span
nlSpan (Span fn :: FilePath
fn s :: Position
s e :: Position
e) = FilePath -> Position -> Position -> Span
Span FilePath
fn (Position -> Position
nl Position
s) (Position -> Position
nl Position
e)
nlSpan sp :: Span
sp = Span
sp
addSpan :: Span -> (a, [Span]) -> (a, [Span])
addSpan :: Span -> (a, [Span]) -> (a, [Span])
addSpan sp :: Span
sp (a :: a
a, ss :: [Span]
ss) = (a
a, Span
spSpan -> [Span] -> [Span]
forall a. a -> [a] -> [a]
:[Span]
ss)
type Distance = (Int, Int)
setDistance :: Span -> Distance -> Span
setDistance :: Span -> Distance -> Span
setDistance (Span fn :: FilePath
fn p :: Position
p _) d :: Distance
d = FilePath -> Position -> Position -> Span
Span FilePath
fn Position
p (Position
p Position -> Distance -> Position
`moveBy` Distance
d)
setDistance s :: Span
s _ = Span
s
moveBy :: Position -> Distance -> Position
moveBy :: Position -> Distance -> Position
moveBy (Position fn :: FilePath
fn l :: Int
l c :: Int
c) (ld :: Int
ld, cd :: Int
cd) = FilePath -> Int -> Int -> Position
Position FilePath
fn (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ld) (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cd)
moveBy p :: Position
p _ = Position
p