-- 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
import           Language.LSP.Protocol.Types  (Location (..), Position (..),
                                               Range (..))
import qualified Language.LSP.Protocol.Types  as LSP
import           Text.ParserCombinators.ReadP as ReadP

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

#if !MIN_VERSION_ghc(9,0,0)
import           FastString
import           SrcLoc                       as GHC
#endif

#if MIN_VERSION_ghc(9,0,0)
import           GHC.Data.FastString
import           GHC.Types.SrcLoc             as GHC
#endif

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
$sel:_line:Position :: Position -> UInt
$sel:_character:Position :: 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