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

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

import           Control.DeepSeq
import qualified Data.Aeson              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 qualified Data.Text               as T
import           GHC.Generics
import           Network.URI             hiding (authority)
import           Safe                    (tailMay)
import qualified System.FilePath         as FP
import qualified System.FilePath.Posix   as FPP
import qualified System.FilePath.Windows as FPW
import qualified System.Info

newtype Uri = Uri { Uri -> Text
getUri :: Text }
  deriving (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,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)

instance NFData Uri

-- If you care about performance then you should use a hash map. The keys
-- are cached in order to make hashing very fast.
data NormalizedUri = NormalizedUri !Int !Text
  deriving (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 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
'/'

-- | When URIs are supposed to be used as keys, 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.
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
                          -> Maybe String -- ^ authority
                          -> String -- ^ path
                          -> 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

{-| 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.

== Adoption Plan of OsPath

Currently we store 'Text'. 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.
-}
data NormalizedFilePath = NormalizedFilePath !NormalizedUri {-# UNPACK #-} !Text
    deriving (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
""