{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Language.LSP.Protocol.Types.Uri (
  Uri (..),
  uriToFilePath,
  filePathToUri,
  NormalizedUri (..),
  toNormalizedUri,
  fromNormalizedUri,
  NormalizedFilePath,
  toNormalizedFilePath,
  fromNormalizedFilePath,
  normalizedFilePathToUri,
  uriToNormalizedFilePath,
  emptyNormalizedFilePath,
  -- Private functions
  platformAwareUriToFilePath,
  platformAwareFilePathToUri,
)
where

import Control.DeepSeq
import Data.Aeson qualified as A
import Data.Binary (Binary, Get, get, put)
import Data.Hashable
import Data.List (stripPrefix)
import Data.String (IsString (fromString))
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics
import Network.URI hiding (authority)
import Prettyprinter
import Safe (tailMay)
import System.FilePath qualified as FP
import System.FilePath.Posix qualified as FPP
import System.FilePath.Windows qualified as FPW
import System.Info qualified

-- | The @Uri@ type in the LSP specification.
newtype Uri = Uri {Uri -> Text
getUri :: Text}
  deriving stock (Uri -> Uri -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Uri -> Uri -> Bool
$c/= :: Uri -> Uri -> Bool
== :: Uri -> Uri -> Bool
$c== :: Uri -> Uri -> Bool
Eq, Eq Uri
Uri -> Uri -> Bool
Uri -> Uri -> Ordering
Uri -> Uri -> Uri
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 :: Uri -> Uri -> Uri
$cmin :: Uri -> Uri -> Uri
max :: Uri -> Uri -> Uri
$cmax :: Uri -> Uri -> Uri
>= :: Uri -> Uri -> Bool
$c>= :: Uri -> Uri -> Bool
> :: Uri -> Uri -> Bool
$c> :: Uri -> Uri -> Bool
<= :: Uri -> Uri -> Bool
$c<= :: Uri -> Uri -> Bool
< :: Uri -> Uri -> Bool
$c< :: Uri -> Uri -> Bool
compare :: Uri -> Uri -> Ordering
$ccompare :: Uri -> Uri -> Ordering
Ord, ReadPrec [Uri]
ReadPrec Uri
Int -> ReadS Uri
ReadS [Uri]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Uri]
$creadListPrec :: ReadPrec [Uri]
readPrec :: ReadPrec Uri
$creadPrec :: ReadPrec Uri
readList :: ReadS [Uri]
$creadList :: ReadS [Uri]
readsPrec :: Int -> ReadS Uri
$creadsPrec :: Int -> ReadS Uri
Read, Int -> Uri -> ShowS
[Uri] -> ShowS
Uri -> SystemOS
forall a.
(Int -> a -> ShowS) -> (a -> SystemOS) -> ([a] -> ShowS) -> Show a
showList :: [Uri] -> ShowS
$cshowList :: [Uri] -> ShowS
show :: Uri -> SystemOS
$cshow :: Uri -> SystemOS
showsPrec :: Int -> Uri -> ShowS
$cshowsPrec :: Int -> Uri -> ShowS
Show, forall x. Rep Uri x -> Uri
forall x. Uri -> Rep Uri x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Uri x -> Uri
$cfrom :: forall x. Uri -> Rep Uri x
Generic)
  deriving newtype (Value -> Parser [Uri]
Value -> Parser Uri
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Uri]
$cparseJSONList :: Value -> Parser [Uri]
parseJSON :: Value -> Parser Uri
$cparseJSON :: Value -> Parser Uri
A.FromJSON, [Uri] -> Encoding
[Uri] -> Value
Uri -> Encoding
Uri -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Uri] -> Encoding
$ctoEncodingList :: [Uri] -> Encoding
toJSONList :: [Uri] -> Value
$ctoJSONList :: [Uri] -> Value
toEncoding :: Uri -> Encoding
$ctoEncoding :: Uri -> Encoding
toJSON :: Uri -> Value
$ctoJSON :: Uri -> Value
A.ToJSON, Eq Uri
Int -> Uri -> Int
Uri -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Uri -> Int
$chash :: Uri -> Int
hashWithSalt :: Int -> Uri -> Int
$chashWithSalt :: Int -> Uri -> Int
Hashable, ToJSONKeyFunction [Uri]
ToJSONKeyFunction Uri
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Uri]
$ctoJSONKeyList :: ToJSONKeyFunction [Uri]
toJSONKey :: ToJSONKeyFunction Uri
$ctoJSONKey :: ToJSONKeyFunction Uri
A.ToJSONKey, FromJSONKeyFunction [Uri]
FromJSONKeyFunction Uri
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [Uri]
$cfromJSONKeyList :: FromJSONKeyFunction [Uri]
fromJSONKey :: FromJSONKeyFunction Uri
$cfromJSONKey :: FromJSONKeyFunction Uri
A.FromJSONKey, forall ann. [Uri] -> Doc ann
forall ann. Uri -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [Uri] -> Doc ann
$cprettyList :: forall ann. [Uri] -> Doc ann
pretty :: forall ann. Uri -> Doc ann
$cpretty :: forall ann. Uri -> Doc ann
Pretty)

instance NFData Uri

{- | A normalized 'Uri'.

If you want to use a URI as a map key, use this type. It is important to normalize
the percent encoding in the URI since URIs that only differ
when it comes to the percent-encoding should be treated as equivalent.

'NormalizedUri' has a cached hash in order to make it especially fast in a hash map.
-}
data NormalizedUri = NormalizedUri !Int !Text
  deriving stock (ReadPrec [NormalizedUri]
ReadPrec NormalizedUri
Int -> ReadS NormalizedUri
ReadS [NormalizedUri]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NormalizedUri]
$creadListPrec :: ReadPrec [NormalizedUri]
readPrec :: ReadPrec NormalizedUri
$creadPrec :: ReadPrec NormalizedUri
readList :: ReadS [NormalizedUri]
$creadList :: ReadS [NormalizedUri]
readsPrec :: Int -> ReadS NormalizedUri
$creadsPrec :: Int -> ReadS NormalizedUri
Read, Int -> NormalizedUri -> ShowS
[NormalizedUri] -> ShowS
NormalizedUri -> SystemOS
forall a.
(Int -> a -> ShowS) -> (a -> SystemOS) -> ([a] -> ShowS) -> Show a
showList :: [NormalizedUri] -> ShowS
$cshowList :: [NormalizedUri] -> ShowS
show :: NormalizedUri -> SystemOS
$cshow :: NormalizedUri -> SystemOS
showsPrec :: Int -> NormalizedUri -> ShowS
$cshowsPrec :: Int -> NormalizedUri -> ShowS
Show, forall x. Rep NormalizedUri x -> NormalizedUri
forall x. NormalizedUri -> Rep NormalizedUri x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NormalizedUri x -> NormalizedUri
$cfrom :: forall x. NormalizedUri -> Rep NormalizedUri x
Generic, NormalizedUri -> NormalizedUri -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormalizedUri -> NormalizedUri -> Bool
$c/= :: NormalizedUri -> NormalizedUri -> Bool
== :: NormalizedUri -> NormalizedUri -> Bool
$c== :: NormalizedUri -> NormalizedUri -> Bool
Eq)

-- Slow but compares paths alphabetically as you would expect.
instance Ord NormalizedUri where
  compare :: NormalizedUri -> NormalizedUri -> Ordering
compare (NormalizedUri Int
_ Text
u1) (NormalizedUri Int
_ Text
u2) = forall a. Ord a => a -> a -> Ordering
compare Text
u1 Text
u2

instance Hashable NormalizedUri where
  hash :: NormalizedUri -> Int
hash (NormalizedUri Int
h Text
_) = Int
h
  hashWithSalt :: Int -> NormalizedUri -> Int
hashWithSalt Int
salt (NormalizedUri Int
h Text
_) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Int
h

instance Pretty NormalizedUri where
  pretty :: forall ann. NormalizedUri -> Doc ann
pretty (NormalizedUri Int
_ Text
t) = forall a ann. Pretty a => a -> Doc ann
pretty Text
t

instance NFData NormalizedUri

isUnescapedInUriPath :: SystemOS -> Char -> Bool
isUnescapedInUriPath :: SystemOS -> Char -> Bool
isUnescapedInUriPath SystemOS
systemOS Char
c
  | SystemOS
systemOS forall a. Eq a => a -> a -> Bool
== SystemOS
windowsOS = Char -> Bool
isUnreserved Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
':', Char
'\\', Char
'/']
  | Bool
otherwise = Char -> Bool
isUnreserved Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'/'

normalizeUriEscaping :: String -> String
normalizeUriEscaping :: ShowS
normalizeUriEscaping SystemOS
uri =
  case forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (SystemOS
fileScheme forall a. [a] -> [a] -> [a]
++ SystemOS
"//") SystemOS
uri of
    Just SystemOS
p -> SystemOS
fileScheme forall a. [a] -> [a] -> [a]
++ SystemOS
"//" forall a. [a] -> [a] -> [a]
++ ShowS
escapeURIPath (ShowS
unEscapeString SystemOS
p)
    Maybe SystemOS
Nothing -> (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isUnescapedInURI forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString SystemOS
uri
 where
  escapeURIPath :: ShowS
escapeURIPath = (Char -> Bool) -> ShowS
escapeURIString (SystemOS -> Char -> Bool
isUnescapedInUriPath SystemOS
System.Info.os)

toNormalizedUri :: Uri -> NormalizedUri
toNormalizedUri :: Uri -> NormalizedUri
toNormalizedUri Uri
uri = Int -> Text -> NormalizedUri
NormalizedUri (forall a. Hashable a => a -> Int
hash Text
norm) Text
norm
 where
  (Uri Text
t) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Uri
uri SystemOS -> Uri
filePathToUri (Uri -> Maybe SystemOS
uriToFilePath Uri
uri)
  -- To ensure all `Uri`s have the file path normalized
  norm :: Text
norm = SystemOS -> Text
T.pack (ShowS
normalizeUriEscaping (Text -> SystemOS
T.unpack Text
t))

fromNormalizedUri :: NormalizedUri -> Uri
fromNormalizedUri :: NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri Int
_ Text
t) = Text -> Uri
Uri Text
t

fileScheme :: String
fileScheme :: SystemOS
fileScheme = SystemOS
"file:"

windowsOS :: String
windowsOS :: SystemOS
windowsOS = SystemOS
"mingw32"

type SystemOS = String

uriToFilePath :: Uri -> Maybe FilePath
uriToFilePath :: Uri -> Maybe SystemOS
uriToFilePath = SystemOS -> Uri -> Maybe SystemOS
platformAwareUriToFilePath SystemOS
System.Info.os

{-# WARNING platformAwareUriToFilePath "This function is considered private. Use normalizedFilePathToUri instead." #-}
platformAwareUriToFilePath :: String -> Uri -> Maybe FilePath
platformAwareUriToFilePath :: SystemOS -> Uri -> Maybe SystemOS
platformAwareUriToFilePath SystemOS
systemOS (Uri Text
uri) = do
  URI{SystemOS
Maybe URIAuth
uriScheme :: URI -> SystemOS
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> SystemOS
uriQuery :: URI -> SystemOS
uriFragment :: URI -> SystemOS
uriFragment :: SystemOS
uriQuery :: SystemOS
uriPath :: SystemOS
uriAuthority :: Maybe URIAuth
uriScheme :: SystemOS
..} <- SystemOS -> Maybe URI
parseURI forall a b. (a -> b) -> a -> b
$ Text -> SystemOS
T.unpack Text
uri
  if SystemOS
uriScheme forall a. Eq a => a -> a -> Bool
== SystemOS
fileScheme
    then
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        SystemOS -> Maybe SystemOS -> ShowS
platformAdjustFromUriPath SystemOS
systemOS (URIAuth -> SystemOS
uriRegName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URIAuth
uriAuthority) forall a b. (a -> b) -> a -> b
$
          ShowS
unEscapeString SystemOS
uriPath
    else forall a. Maybe a
Nothing

{- | We pull in the authority because in relative file paths the Uri likes to put everything before the slash
   into the authority field
-}
platformAdjustFromUriPath ::
  SystemOS ->
  -- | authority
  Maybe String ->
  -- | path
  String ->
  FilePath
platformAdjustFromUriPath :: SystemOS -> Maybe SystemOS -> ShowS
platformAdjustFromUriPath SystemOS
systemOS Maybe SystemOS
authority SystemOS
srcPath =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. [a] -> [a] -> [a]
(++) Maybe SystemOS
authority forall a b. (a -> b) -> a -> b
$
    if SystemOS
systemOS forall a. Eq a => a -> a -> Bool
/= SystemOS
windowsOS
      then SystemOS
srcPath
      else case SystemOS -> [SystemOS]
FPP.splitDirectories forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe [a]
tailMay SystemOS
srcPath of
        Just (SystemOS
firstSegment : [SystemOS]
rest) ->
          -- Drop leading '/' for absolute Windows paths
          let drive :: SystemOS
drive =
                if SystemOS -> Bool
FPW.isDrive SystemOS
firstSegment
                  then ShowS
FPW.addTrailingPathSeparator SystemOS
firstSegment
                  else SystemOS
firstSegment
           in SystemOS -> ShowS
FPW.joinDrive SystemOS
drive forall a b. (a -> b) -> a -> b
$ [SystemOS] -> SystemOS
FPW.joinPath [SystemOS]
rest
        Maybe [SystemOS]
_ -> SystemOS
srcPath

filePathToUri :: FilePath -> Uri
filePathToUri :: SystemOS -> Uri
filePathToUri = SystemOS -> SystemOS -> Uri
platformAwareFilePathToUri SystemOS
System.Info.os forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
FP.normalise

{-# WARNING platformAwareFilePathToUri "This function is considered private. Use normalizedUriToFilePath instead." #-}
platformAwareFilePathToUri :: SystemOS -> FilePath -> Uri
platformAwareFilePathToUri :: SystemOS -> SystemOS -> Uri
platformAwareFilePathToUri SystemOS
systemOS SystemOS
fp =
  Text -> Uri
Uri forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemOS -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> SystemOS
show forall a b. (a -> b) -> a -> b
$
    URI
      { uriScheme :: SystemOS
uriScheme = SystemOS
fileScheme
      , uriAuthority :: Maybe URIAuth
uriAuthority = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SystemOS -> SystemOS -> SystemOS -> URIAuth
URIAuth SystemOS
"" SystemOS
"" SystemOS
""
      , uriPath :: SystemOS
uriPath = SystemOS -> ShowS
platformAdjustToUriPath SystemOS
systemOS SystemOS
fp
      , uriQuery :: SystemOS
uriQuery = SystemOS
""
      , uriFragment :: SystemOS
uriFragment = SystemOS
""
      }

platformAdjustToUriPath :: SystemOS -> FilePath -> String
platformAdjustToUriPath :: SystemOS -> ShowS
platformAdjustToUriPath SystemOS
systemOS SystemOS
srcPath
  | SystemOS
systemOS forall a. Eq a => a -> a -> Bool
== SystemOS
windowsOS = Char
'/' forall a. a -> [a] -> [a]
: SystemOS
escapedPath
  | Bool
otherwise = SystemOS
escapedPath
 where
  (SystemOS -> [SystemOS]
splitDirectories, SystemOS -> (SystemOS, SystemOS)
splitDrive)
    | SystemOS
systemOS forall a. Eq a => a -> a -> Bool
== SystemOS
windowsOS =
        (SystemOS -> [SystemOS]
FPW.splitDirectories, SystemOS -> (SystemOS, SystemOS)
FPW.splitDrive)
    | Bool
otherwise =
        (SystemOS -> [SystemOS]
FPP.splitDirectories, SystemOS -> (SystemOS, SystemOS)
FPP.splitDrive)
  escapedPath :: SystemOS
escapedPath =
    case SystemOS -> (SystemOS, SystemOS)
splitDrive SystemOS
srcPath of
      (SystemOS
drv, SystemOS
rest) ->
        ShowS
convertDrive SystemOS
drv
          SystemOS -> ShowS
`FPP.joinDrive` [SystemOS] -> SystemOS
FPP.joinPath (forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> ShowS
escapeURIString (SystemOS -> Char -> Bool
isUnescapedInUriPath SystemOS
systemOS)) forall a b. (a -> b) -> a -> b
$ SystemOS -> [SystemOS]
splitDirectories SystemOS
rest)
  -- splitDirectories does not remove the path separator after the drive so
  -- we do a final replacement of \ to /
  convertDrive :: ShowS
convertDrive SystemOS
drv
    | SystemOS
systemOS forall a. Eq a => a -> a -> Bool
== SystemOS
windowsOS Bool -> Bool -> Bool
&& SystemOS -> Bool
FPW.hasTrailingPathSeparator SystemOS
drv =
        ShowS
FPP.addTrailingPathSeparator (forall a. [a] -> [a]
init SystemOS
drv)
    | Bool
otherwise = SystemOS
drv

{- Note [Adoption Plan of OsPath]
Currently we store 'Text' in 'NormalizedFilePath'. We may change it to OsPath in the future if
the following steps are executed.

1. In the client codebase, use 'osPathToNormalizedFilePath' and 'normalizedFilePathToOsPath' instead of 'fromNormalizedFilePath'
  and 'toNormalizedFilePath'. For HLS, we could wait until GHC 9.6 becomes the oldest
  GHC we support, then change 'FilePath' to OsPath everywhere in the codebase.
2. Deprecate and remove 'fromNormalizedFilePath' and 'toNormalizedFilePath'.
3. Change 'Text' to OsPath and benchmark it to make sure performance doesn't go down. Don't forget to check Windows,
  as OsPath on Windows uses UTF-16, which may consume more memory.

See [#453](https://github.com/haskell/lsp/pull/453) and [#446](https://github.com/haskell/lsp/pull/446)
for more discussions on this topic.
-}

{- | A file path that is already normalized.

The 'NormalizedUri' is cached to avoided
repeated normalisation when we need to compute them (which is a lot).

This is one of the most performance critical parts of HLS, do not
modify it without profiling.
-}
data NormalizedFilePath = NormalizedFilePath !NormalizedUri {-# UNPACK #-} !Text
  deriving stock (forall x. Rep NormalizedFilePath x -> NormalizedFilePath
forall x. NormalizedFilePath -> Rep NormalizedFilePath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NormalizedFilePath x -> NormalizedFilePath
$cfrom :: forall x. NormalizedFilePath -> Rep NormalizedFilePath x
Generic, NormalizedFilePath -> NormalizedFilePath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormalizedFilePath -> NormalizedFilePath -> Bool
$c/= :: NormalizedFilePath -> NormalizedFilePath -> Bool
== :: NormalizedFilePath -> NormalizedFilePath -> Bool
$c== :: NormalizedFilePath -> NormalizedFilePath -> Bool
Eq, Eq NormalizedFilePath
NormalizedFilePath -> NormalizedFilePath -> Bool
NormalizedFilePath -> NormalizedFilePath -> Ordering
NormalizedFilePath -> NormalizedFilePath -> NormalizedFilePath
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 :: NormalizedFilePath -> NormalizedFilePath -> NormalizedFilePath
$cmin :: NormalizedFilePath -> NormalizedFilePath -> NormalizedFilePath
max :: NormalizedFilePath -> NormalizedFilePath -> NormalizedFilePath
$cmax :: NormalizedFilePath -> NormalizedFilePath -> NormalizedFilePath
>= :: NormalizedFilePath -> NormalizedFilePath -> Bool
$c>= :: NormalizedFilePath -> NormalizedFilePath -> Bool
> :: NormalizedFilePath -> NormalizedFilePath -> Bool
$c> :: NormalizedFilePath -> NormalizedFilePath -> Bool
<= :: NormalizedFilePath -> NormalizedFilePath -> Bool
$c<= :: NormalizedFilePath -> NormalizedFilePath -> Bool
< :: NormalizedFilePath -> NormalizedFilePath -> Bool
$c< :: NormalizedFilePath -> NormalizedFilePath -> Bool
compare :: NormalizedFilePath -> NormalizedFilePath -> Ordering
$ccompare :: NormalizedFilePath -> NormalizedFilePath -> Ordering
Ord)

instance NFData NormalizedFilePath

instance Binary NormalizedFilePath where
  put :: NormalizedFilePath -> Put
put (NormalizedFilePath NormalizedUri
_ Text
fp) = forall t. Binary t => t -> Put
put Text
fp
  get :: Get NormalizedFilePath
get = do
    Text
v <- forall t. Binary t => Get t
Data.Binary.get :: Get Text
    forall (m :: * -> *) a. Monad m => a -> m a
return (NormalizedUri -> Text -> NormalizedFilePath
NormalizedFilePath (SystemOS -> NormalizedUri
internalNormalizedFilePathToUri (Text -> SystemOS
T.unpack Text
v)) Text
v)

{- | Internal helper that takes a file path that is assumed to
 already be normalized to a URI. It is up to the caller
 to ensure normalization.
-}
internalNormalizedFilePathToUri :: FilePath -> NormalizedUri
internalNormalizedFilePathToUri :: SystemOS -> NormalizedUri
internalNormalizedFilePathToUri SystemOS
fp = NormalizedUri
nuri
 where
  uriPath :: SystemOS
uriPath = SystemOS -> ShowS
platformAdjustToUriPath SystemOS
System.Info.os SystemOS
fp
  nuriStr :: Text
nuriStr = SystemOS -> Text
T.pack forall a b. (a -> b) -> a -> b
$ SystemOS
fileScheme forall a. Semigroup a => a -> a -> a
<> SystemOS
"//" forall a. Semigroup a => a -> a -> a
<> SystemOS
uriPath
  nuri :: NormalizedUri
nuri = Int -> Text -> NormalizedUri
NormalizedUri (forall a. Hashable a => a -> Int
hash Text
nuriStr) Text
nuriStr

instance Show NormalizedFilePath where
  show :: NormalizedFilePath -> SystemOS
show (NormalizedFilePath NormalizedUri
_ Text
fp) = SystemOS
"NormalizedFilePath " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> SystemOS
show Text
fp

instance Hashable NormalizedFilePath where
  hash :: NormalizedFilePath -> Int
hash (NormalizedFilePath NormalizedUri
uri Text
_) = forall a. Hashable a => a -> Int
hash NormalizedUri
uri
  hashWithSalt :: Int -> NormalizedFilePath -> Int
hashWithSalt Int
salt (NormalizedFilePath NormalizedUri
uri Text
_) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt NormalizedUri
uri

instance IsString NormalizedFilePath where
  fromString :: String -> NormalizedFilePath
  fromString :: SystemOS -> NormalizedFilePath
fromString = SystemOS -> NormalizedFilePath
toNormalizedFilePath

toNormalizedFilePath :: FilePath -> NormalizedFilePath
toNormalizedFilePath :: SystemOS -> NormalizedFilePath
toNormalizedFilePath SystemOS
fp = NormalizedUri -> Text -> NormalizedFilePath
NormalizedFilePath NormalizedUri
nuri forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemOS -> Text
T.pack forall a b. (a -> b) -> a -> b
$ SystemOS
nfp
 where
  nfp :: SystemOS
nfp = ShowS
FP.normalise SystemOS
fp
  nuri :: NormalizedUri
nuri = SystemOS -> NormalizedUri
internalNormalizedFilePathToUri SystemOS
nfp

-- | Extracts 'FilePath' from 'NormalizedFilePath'.
fromNormalizedFilePath :: NormalizedFilePath -> FilePath
fromNormalizedFilePath :: NormalizedFilePath -> SystemOS
fromNormalizedFilePath (NormalizedFilePath NormalizedUri
_ Text
fp) = Text -> SystemOS
T.unpack Text
fp

normalizedFilePathToUri :: NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri :: NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri (NormalizedFilePath NormalizedUri
uri Text
_) = NormalizedUri
uri

uriToNormalizedFilePath :: NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath :: NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath NormalizedUri
nuri = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NormalizedUri -> Text -> NormalizedFilePath
NormalizedFilePath NormalizedUri
nuri forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemOS -> Text
T.pack) Maybe SystemOS
mbFilePath
 where
  mbFilePath :: Maybe SystemOS
mbFilePath = SystemOS -> Uri -> Maybe SystemOS
platformAwareUriToFilePath SystemOS
System.Info.os (NormalizedUri -> Uri
fromNormalizedUri NormalizedUri
nuri)

emptyNormalizedUri :: NormalizedUri
emptyNormalizedUri :: NormalizedUri
emptyNormalizedUri =
  let s :: Text
s = Text
"file://"
   in Int -> Text -> NormalizedUri
NormalizedUri (forall a. Hashable a => a -> Int
hash Text
s) Text
s

-- | 'NormalizedFilePath' that contains an empty file path
emptyNormalizedFilePath :: NormalizedFilePath
emptyNormalizedFilePath :: NormalizedFilePath
emptyNormalizedFilePath = NormalizedUri -> Text -> NormalizedFilePath
NormalizedFilePath NormalizedUri
emptyNormalizedUri Text
""