-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}


-- | Types and functions for working with source code locations.
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

#if MIN_VERSION_ghc(9,0,0)
import           GHC.Data.FastString
import           GHC.Types.SrcLoc             as GHC
#else
import           FastString
import           SrcLoc                       as GHC
#endif
import           Language.LSP.Types           (Location (..), Position (..),
                                               Range (..))
import qualified Language.LSP.Types           as LSP
import           Text.ParserCombinators.ReadP as ReadP

toNormalizedFilePath' :: FilePath -> LSP.NormalizedFilePath
-- We want to keep empty paths instead of normalising them to "."
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

-- | We use an empty string as a filepath when we don’t have a file.
-- However, haskell-lsp doesn’t support that in uriToFilePath and given
-- that it is not a valid filepath it does not make sense to upstream a fix.
-- So we have our own wrapper here that supports empty filepaths.
uriToFilePath' :: LSP.Uri -> Maybe FilePath
uriToFilePath' :: Uri -> Maybe [Char]
uriToFilePath' Uri
uri
    | Uri
uri forall a. Eq a => a -> a -> Bool
== NormalizedUri -> Uri
LSP.fromNormalizedUri NormalizedUri
emptyPathUri = 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 (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 = forall a. a -> Maybe a -> a
fromMaybe ([Char] -> NormalizedFilePath
toNormalizedFilePath' [Char]
noFilePath) forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedUri -> Maybe NormalizedFilePath
LSP.uriToNormalizedFilePath

noFilePath :: FilePath
noFilePath :: [Char]
noFilePath = [Char]
"<unknown>"

-- A dummy range to use when range is 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 :: Position -> UInt
_character :: Position -> UInt
_character :: UInt
_line :: UInt
..} = forall a. Show a => a -> [Char]
show (UInt
_line forall a. Num a => a -> a -> a
+ UInt
1) forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (UInt
_character forall a. Num a => a -> a -> a
+ UInt
1)

-- | Parser for the GHC output format
readSrcSpan :: ReadS RealSrcSpan
readSrcSpan :: ReadS RealSrcSpan
readSrcSpan = forall a. ReadP a -> ReadS a
readP_to_S (ReadP RealSrcSpan
singleLineSrcSpanP 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  <- forall a. ReadS a -> ReadP a
readS_to_P forall a. Read a => ReadS a
reads forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadP Char
char Char
':'
      Int
c0 <- forall a. ReadS a -> ReadP a
readS_to_P forall a. Read a => ReadS a
reads
      Int
c1 <- (Char -> ReadP Char
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. ReadS a -> ReadP a
readS_to_P forall a. Read a => ReadS a
reads) forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall a. ReadP a -> ReadP a
parensP (FastString -> ReadP RealSrcLoc
srcLocP FastString
fp)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
'-'
      RealSrcLoc
e <- forall a. ReadP a -> ReadP a
parensP (FastString -> ReadP RealSrcLoc
srcLocP FastString
fp)
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 = 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 = forall a. IsString a => [Char] -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReadP [Char]
readFilePath forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadP Char
char Char
':') forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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 <- forall a. ReadS a -> ReadP a
readS_to_P forall a. Read a => ReadS a
reads
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
','
      Int
c <- forall a. ReadS a -> ReadP a
readS_to_P forall a. Read a => ReadS a
reads
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ReadP Char
ReadP.get