{- |
    Module      :  $Header$
    Description :  Spans in a source file
    Copyright   :  (c) 2016 Jan Tikovsky
                       2016 Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  jrt@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module implements a data type for span information in a source file and
    respective functions to operate on them. A source file span consists
    of a filename, a start position and an end position.

    In addition, the type 'SrcRef' identifies the path to an expression in
    the abstract syntax tree by argument positions, which is used for
    debugging purposes.
-}
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
  -- |Normal source code span
  = Span
    { Span -> FilePath
file     :: FilePath -- ^ 'FilePath' of the source file
    , Span -> Position
start    :: Position -- ^ start position
    , Span -> Position
end      :: Position -- ^ end position
    }
  -- |no span
  | 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"

-- |Show a 'Span' as a 'String'
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

-- |Pretty print a 'Span'
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

-- |Pretty print a span with it's file path and position compactly.
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

-- |Pretty print a source preview of a span
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 -- Number of padding lines at the top and bottom
        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

-- |Pretty print the positions compactly.
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

-- |Pretty print the start and end position of a 'Span'
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)

-- |Compute the column of the start position of a 'Span'
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

-- TODO: Rename to tab and nl as soon as positions are completely replaced by spans

-- |Convert a position to a single character span.
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

-- |Convert a span to a (start) position
-- TODO: This function should be removed as soon as positions are completely replaced by spans
-- in the frontend
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

-- |First position after the next tabulator
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

-- |First position of the next line
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)

-- |Distance of a span, i.e. the line and column distance between start
-- and end position
type Distance = (Int, Int)

-- |Set the distance of a span, i.e. update its end position
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

-- |Move position by given distance
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