{-# LANGUAGE CPP #-}
module Development.IDE.Types.Location
( Location(..)
, noFilePath
, noRange
, Position(..)
, showPosition
, Range(..)
, LSP.Uri(..)
, LSP.NormalizedUri
, LSP.toNormalizedUri
, LSP.fromNormalizedUri
, LSP.NormalizedFilePath
, fromUri
, emptyFilePath
, emptyPathUri
, toNormalizedFilePath'
, LSP.fromNormalizedFilePath
, filePathToUri'
, uriToFilePath'
, readSrcSpan
) where
import Control.Applicative
import Control.Monad
import Data.Hashable (Hashable (hash))
import Data.Maybe (fromMaybe)
import Data.String
import Language.LSP.Protocol.Types (Location (..), Position (..),
Range (..))
import qualified Language.LSP.Protocol.Types as LSP
import Text.ParserCombinators.ReadP as ReadP
import GHC.Data.FastString
import GHC.Types.SrcLoc as GHC
toNormalizedFilePath' :: FilePath -> LSP.NormalizedFilePath
toNormalizedFilePath' :: [Char] -> NormalizedFilePath
toNormalizedFilePath' [Char]
"" = NormalizedFilePath
emptyFilePath
toNormalizedFilePath' [Char]
fp = [Char] -> NormalizedFilePath
LSP.toNormalizedFilePath [Char]
fp
emptyFilePath :: LSP.NormalizedFilePath
emptyFilePath :: NormalizedFilePath
emptyFilePath = NormalizedFilePath
LSP.emptyNormalizedFilePath
uriToFilePath' :: LSP.Uri -> Maybe FilePath
uriToFilePath' :: Uri -> Maybe [Char]
uriToFilePath' Uri
uri
| Uri
uri Uri -> Uri -> Bool
forall a. Eq a => a -> a -> Bool
== NormalizedUri -> Uri
LSP.fromNormalizedUri NormalizedUri
emptyPathUri = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
""
| Bool
otherwise = Uri -> Maybe [Char]
LSP.uriToFilePath Uri
uri
emptyPathUri :: LSP.NormalizedUri
emptyPathUri :: NormalizedUri
emptyPathUri =
let s :: Text
s = Text
"file://"
in Int -> Text -> NormalizedUri
LSP.NormalizedUri (Text -> Int
forall a. Hashable a => a -> Int
hash Text
s) Text
s
filePathToUri' :: LSP.NormalizedFilePath -> LSP.NormalizedUri
filePathToUri' :: NormalizedFilePath -> NormalizedUri
filePathToUri' = NormalizedFilePath -> NormalizedUri
LSP.normalizedFilePathToUri
fromUri :: LSP.NormalizedUri -> LSP.NormalizedFilePath
fromUri :: NormalizedUri -> NormalizedFilePath
fromUri = NormalizedFilePath
-> Maybe NormalizedFilePath -> NormalizedFilePath
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> NormalizedFilePath
toNormalizedFilePath' [Char]
noFilePath) (Maybe NormalizedFilePath -> NormalizedFilePath)
-> (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri
-> NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedUri -> Maybe NormalizedFilePath
LSP.uriToNormalizedFilePath
noFilePath :: FilePath
noFilePath :: [Char]
noFilePath = [Char]
"<unknown>"
noRange :: Range
noRange :: Range
noRange = Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
0 UInt
0) (UInt -> UInt -> Position
Position UInt
1 UInt
0)
showPosition :: Position -> String
showPosition :: Position -> [Char]
showPosition Position{UInt
_line :: UInt
_character :: UInt
$sel:_character:Position :: Position -> UInt
$sel:_line:Position :: Position -> UInt
..} = UInt -> [Char]
forall a. Show a => a -> [Char]
show (UInt
_line UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UInt -> [Char]
forall a. Show a => a -> [Char]
show (UInt
_character UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1)
readSrcSpan :: ReadS RealSrcSpan
readSrcSpan :: ReadS RealSrcSpan
readSrcSpan = ReadP RealSrcSpan -> ReadS RealSrcSpan
forall a. ReadP a -> ReadS a
readP_to_S (ReadP RealSrcSpan
singleLineSrcSpanP ReadP RealSrcSpan -> ReadP RealSrcSpan -> ReadP RealSrcSpan
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadP RealSrcSpan
multiLineSrcSpanP)
where
singleLineSrcSpanP, multiLineSrcSpanP :: ReadP RealSrcSpan
singleLineSrcSpanP :: ReadP RealSrcSpan
singleLineSrcSpanP = do
FastString
fp <- ReadP FastString
filePathP
Int
l <- ReadS Int -> ReadP Int
forall a. ReadS a -> ReadP a
readS_to_P ReadS Int
forall a. Read a => ReadS a
reads ReadP Int -> ReadP Char -> ReadP Int
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadP Char
char Char
':'
Int
c0 <- ReadS Int -> ReadP Int
forall a. ReadS a -> ReadP a
readS_to_P ReadS Int
forall a. Read a => ReadS a
reads
Int
c1 <- (Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP Int -> ReadP Int
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadS Int -> ReadP Int
forall a. ReadS a -> ReadP a
readS_to_P ReadS Int
forall a. Read a => ReadS a
reads) ReadP Int -> ReadP Int -> ReadP Int
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> ReadP Int
forall a. a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
c0
let from :: RealSrcLoc
from = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
fp Int
l Int
c0
to :: RealSrcLoc
to = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
fp Int
l Int
c1
RealSrcSpan -> ReadP RealSrcSpan
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (RealSrcSpan -> ReadP RealSrcSpan)
-> RealSrcSpan -> ReadP RealSrcSpan
forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
from RealSrcLoc
to
multiLineSrcSpanP :: ReadP RealSrcSpan
multiLineSrcSpanP = do
FastString
fp <- ReadP FastString
filePathP
RealSrcLoc
s <- ReadP RealSrcLoc -> ReadP RealSrcLoc
forall a. ReadP a -> ReadP a
parensP (FastString -> ReadP RealSrcLoc
srcLocP FastString
fp)
ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
'-'
RealSrcLoc
e <- ReadP RealSrcLoc -> ReadP RealSrcLoc
forall a. ReadP a -> ReadP a
parensP (FastString -> ReadP RealSrcLoc
srcLocP FastString
fp)
RealSrcSpan -> ReadP RealSrcSpan
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (RealSrcSpan -> ReadP RealSrcSpan)
-> RealSrcSpan -> ReadP RealSrcSpan
forall a b. (a -> b) -> a -> b
$ RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
s RealSrcLoc
e
parensP :: ReadP a -> ReadP a
parensP :: forall a. ReadP a -> ReadP a
parensP = ReadP Char -> ReadP Char -> ReadP a -> ReadP a
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (Char -> ReadP Char
char Char
'(') (Char -> ReadP Char
char Char
')')
filePathP :: ReadP FastString
filePathP :: ReadP FastString
filePathP = [Char] -> FastString
forall a. IsString a => [Char] -> a
fromString ([Char] -> FastString) -> ReadP [Char] -> ReadP FastString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReadP [Char]
readFilePath ReadP [Char] -> ReadP Char -> ReadP [Char]
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadP Char
char Char
':') ReadP FastString -> ReadP FastString -> ReadP FastString
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FastString -> ReadP FastString
forall a. a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FastString
""
srcLocP :: FastString -> ReadP RealSrcLoc
srcLocP :: FastString -> ReadP RealSrcLoc
srcLocP FastString
fp = do
Int
l <- ReadS Int -> ReadP Int
forall a. ReadS a -> ReadP a
readS_to_P ReadS Int
forall a. Read a => ReadS a
reads
ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
','
Int
c <- ReadS Int -> ReadP Int
forall a. ReadS a -> ReadP a
readS_to_P ReadS Int
forall a. Read a => ReadS a
reads
RealSrcLoc -> ReadP RealSrcLoc
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (RealSrcLoc -> ReadP RealSrcLoc) -> RealSrcLoc -> ReadP RealSrcLoc
forall a b. (a -> b) -> a -> b
$ FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
fp Int
l Int
c
readFilePath :: ReadP FilePath
readFilePath :: ReadP [Char]
readFilePath = ReadP Char -> ReadP [Char]
forall a. ReadP a -> ReadP [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ReadP Char
ReadP.get