{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
module Language.LSP.Types.Uri
  ( Uri(..)
  , uriToFilePath
  , filePathToUri
  , NormalizedUri(..)
  , toNormalizedUri
  , fromNormalizedUri
  , NormalizedFilePath
  , normalizedFilePath
  , toNormalizedFilePath
  , fromNormalizedFilePath
  , normalizedFilePathToUri
  , uriToNormalizedFilePath
  -- Private functions
  , platformAwareUriToFilePath
  , platformAwareFilePathToUri
  )
  where

import           Control.DeepSeq
import qualified Data.Aeson                                 as A
import           Data.Binary                                (Binary, Get, put, get)
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 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
(Uri -> Uri -> Bool) -> (Uri -> Uri -> Bool) -> Eq Uri
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
Eq Uri
-> (Uri -> Uri -> Ordering)
-> (Uri -> Uri -> Bool)
-> (Uri -> Uri -> Bool)
-> (Uri -> Uri -> Bool)
-> (Uri -> Uri -> Bool)
-> (Uri -> Uri -> Uri)
-> (Uri -> Uri -> Uri)
-> Ord 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
$cp1Ord :: Eq Uri
Ord,ReadPrec [Uri]
ReadPrec Uri
Int -> ReadS Uri
ReadS [Uri]
(Int -> ReadS Uri)
-> ReadS [Uri] -> ReadPrec Uri -> ReadPrec [Uri] -> Read 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 -> String
(Int -> Uri -> ShowS)
-> (Uri -> String) -> ([Uri] -> ShowS) -> Show Uri
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Uri] -> ShowS
$cshowList :: [Uri] -> ShowS
show :: Uri -> String
$cshow :: Uri -> String
showsPrec :: Int -> Uri -> ShowS
$cshowsPrec :: Int -> Uri -> ShowS
Show,(forall x. Uri -> Rep Uri x)
-> (forall x. Rep Uri x -> Uri) -> Generic Uri
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
(Value -> Parser Uri) -> (Value -> Parser [Uri]) -> FromJSON 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
(Uri -> Value)
-> (Uri -> Encoding)
-> ([Uri] -> Value)
-> ([Uri] -> Encoding)
-> ToJSON Uri
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
Eq Uri -> (Int -> Uri -> Int) -> (Uri -> Int) -> Hashable 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
$cp1Hashable :: Eq Uri
Hashable,ToJSONKeyFunction [Uri]
ToJSONKeyFunction Uri
ToJSONKeyFunction Uri -> ToJSONKeyFunction [Uri] -> ToJSONKey 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
FromJSONKeyFunction Uri
-> FromJSONKeyFunction [Uri] -> FromJSONKey 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]
(Int -> ReadS NormalizedUri)
-> ReadS [NormalizedUri]
-> ReadPrec NormalizedUri
-> ReadPrec [NormalizedUri]
-> Read 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 -> String
(Int -> NormalizedUri -> ShowS)
-> (NormalizedUri -> String)
-> ([NormalizedUri] -> ShowS)
-> Show NormalizedUri
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NormalizedUri] -> ShowS
$cshowList :: [NormalizedUri] -> ShowS
show :: NormalizedUri -> String
$cshow :: NormalizedUri -> String
showsPrec :: Int -> NormalizedUri -> ShowS
$cshowsPrec :: Int -> NormalizedUri -> ShowS
Show,(forall x. NormalizedUri -> Rep NormalizedUri x)
-> (forall x. Rep NormalizedUri x -> NormalizedUri)
-> Generic NormalizedUri
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
(NormalizedUri -> NormalizedUri -> Bool)
-> (NormalizedUri -> NormalizedUri -> Bool) -> Eq NormalizedUri
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) = Text -> Text -> Ordering
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
_) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Int
h

instance NFData NormalizedUri

isUnescapedInUriPath :: SystemOS -> Char -> Bool
isUnescapedInUriPath :: String -> Char -> Bool
isUnescapedInUriPath String
systemOS Char
c
   | String
systemOS String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
windowsOS = Char -> Bool
isUnreserved Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
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 Char -> Char -> Bool
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 String
uri =
  case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (String
fileScheme String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"//") String
uri of
    Just String
p -> String
fileScheme String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"//" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
escapeURIPath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString String
p)
    Maybe String
Nothing -> (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isUnescapedInURI ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString String
uri
  where escapeURIPath :: ShowS
escapeURIPath = (Char -> Bool) -> ShowS
escapeURIString (String -> Char -> Bool
isUnescapedInUriPath String
System.Info.os)

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

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

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

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

type SystemOS = String

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

{-# WARNING platformAwareUriToFilePath "This function is considered private. Use normalizedFilePathToUri instead." #-}
platformAwareUriToFilePath :: String -> Uri -> Maybe FilePath
platformAwareUriToFilePath :: String -> Uri -> Maybe String
platformAwareUriToFilePath String
systemOS (Uri Text
uri) = do
  URI{String
Maybe URIAuth
uriScheme :: URI -> String
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> String
uriQuery :: URI -> String
uriFragment :: URI -> String
uriFragment :: String
uriQuery :: String
uriPath :: String
uriAuthority :: Maybe URIAuth
uriScheme :: String
..} <- String -> Maybe URI
parseURI (String -> Maybe URI) -> String -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
uri
  if String
uriScheme String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
fileScheme
    then String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
      String -> Maybe String -> ShowS
platformAdjustFromUriPath String
systemOS (URIAuth -> String
uriRegName (URIAuth -> String) -> Maybe URIAuth -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URIAuth
uriAuthority) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString String
uriPath
    else Maybe String
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 :: String -> Maybe String -> ShowS
platformAdjustFromUriPath String
systemOS Maybe String
authority String
srcPath =
  (ShowS -> (String -> ShowS) -> Maybe String -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id String -> ShowS
forall a. [a] -> [a] -> [a]
(++) Maybe String
authority) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
  if String
systemOS String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
windowsOS Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
srcPath then String
srcPath
    else let
      String
firstSegment:[String]
rest = (String -> [String]
FPP.splitDirectories (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
tail) String
srcPath  -- Drop leading '/' for absolute Windows paths
      drive :: String
drive = if String -> Bool
FPW.isDrive String
firstSegment
              then ShowS
FPW.addTrailingPathSeparator String
firstSegment
              else String
firstSegment
      in String -> ShowS
FPW.joinDrive String
drive ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
FPW.joinPath [String]
rest

filePathToUri :: FilePath -> Uri
filePathToUri :: String -> Uri
filePathToUri = (String -> String -> Uri
platformAwareFilePathToUri String
System.Info.os) (String -> Uri) -> ShowS -> String -> Uri
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 :: String -> String -> Uri
platformAwareFilePathToUri String
systemOS String
fp = Text -> Uri
Uri (Text -> Uri) -> (URI -> Text) -> URI -> Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (URI -> String) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show (URI -> Uri) -> URI -> Uri
forall a b. (a -> b) -> a -> b
$ URI :: String -> Maybe URIAuth -> String -> String -> String -> URI
URI
  { uriScheme :: String
uriScheme = String
fileScheme
  , uriAuthority :: Maybe URIAuth
uriAuthority = URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just (URIAuth -> Maybe URIAuth) -> URIAuth -> Maybe URIAuth
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> URIAuth
URIAuth String
"" String
"" String
""
  , uriPath :: String
uriPath = String -> ShowS
platformAdjustToUriPath String
systemOS String
fp
  , uriQuery :: String
uriQuery = String
""
  , uriFragment :: String
uriFragment = String
""
  }

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

-- | Newtype wrapper around FilePath that always has normalized slashes.
-- The NormalizedUri and hash of the FilePath are 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 ghcide, do not
-- modify it without profiling.
data NormalizedFilePath = NormalizedFilePath NormalizedUri !FilePath
    deriving ((forall x. NormalizedFilePath -> Rep NormalizedFilePath x)
-> (forall x. Rep NormalizedFilePath x -> NormalizedFilePath)
-> Generic NormalizedFilePath
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
(NormalizedFilePath -> NormalizedFilePath -> Bool)
-> (NormalizedFilePath -> NormalizedFilePath -> Bool)
-> Eq NormalizedFilePath
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
Eq NormalizedFilePath
-> (NormalizedFilePath -> NormalizedFilePath -> Ordering)
-> (NormalizedFilePath -> NormalizedFilePath -> Bool)
-> (NormalizedFilePath -> NormalizedFilePath -> Bool)
-> (NormalizedFilePath -> NormalizedFilePath -> Bool)
-> (NormalizedFilePath -> NormalizedFilePath -> Bool)
-> (NormalizedFilePath -> NormalizedFilePath -> NormalizedFilePath)
-> (NormalizedFilePath -> NormalizedFilePath -> NormalizedFilePath)
-> Ord 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
$cp1Ord :: Eq NormalizedFilePath
Ord)

instance NFData NormalizedFilePath

instance Binary NormalizedFilePath where
  put :: NormalizedFilePath -> Put
put (NormalizedFilePath NormalizedUri
_ String
fp) = String -> Put
forall t. Binary t => t -> Put
put String
fp
  get :: Get NormalizedFilePath
get = do
    String
v <- Get String
forall t. Binary t => Get t
Data.Binary.get :: Get FilePath
    let nuri :: NormalizedUri
nuri = String -> NormalizedUri
internalNormalizedFilePathToUri String
v
    NormalizedFilePath -> Get NormalizedFilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (NormalizedUri -> String -> NormalizedFilePath
normalizedFilePath NormalizedUri
nuri String
v)

-- | A smart constructor that performs UTF-8 encoding and hash consing
normalizedFilePath :: NormalizedUri -> FilePath -> NormalizedFilePath
normalizedFilePath :: NormalizedUri -> String -> NormalizedFilePath
normalizedFilePath NormalizedUri
nuri String
nfp = NormalizedUri -> String -> NormalizedFilePath
NormalizedFilePath NormalizedUri
nuri String
nfp

-- | 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 :: String -> NormalizedUri
internalNormalizedFilePathToUri String
fp = NormalizedUri
nuri
  where
    uriPath :: String
uriPath = String -> ShowS
platformAdjustToUriPath String
System.Info.os String
fp
    nuriStr :: Text
nuriStr = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
fileScheme String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"//" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
uriPath
    nuri :: NormalizedUri
nuri = Int -> Text -> NormalizedUri
NormalizedUri (Text -> Int
forall a. Hashable a => a -> Int
hash Text
nuriStr) Text
nuriStr

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

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

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

toNormalizedFilePath :: FilePath -> NormalizedFilePath
toNormalizedFilePath :: String -> NormalizedFilePath
toNormalizedFilePath String
fp = NormalizedUri -> String -> NormalizedFilePath
normalizedFilePath NormalizedUri
nuri String
nfp
  where
      nfp :: String
nfp = ShowS
FP.normalise String
fp
      nuri :: NormalizedUri
nuri = String -> NormalizedUri
internalNormalizedFilePathToUri String
nfp

fromNormalizedFilePath :: NormalizedFilePath -> FilePath
fromNormalizedFilePath :: NormalizedFilePath -> String
fromNormalizedFilePath (NormalizedFilePath NormalizedUri
_ String
fp) = String
fp

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

uriToNormalizedFilePath :: NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath :: NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath NormalizedUri
nuri = (String -> NormalizedFilePath)
-> Maybe String -> Maybe NormalizedFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NormalizedUri -> String -> NormalizedFilePath
normalizedFilePath NormalizedUri
nuri) Maybe String
mbFilePath
  where mbFilePath :: Maybe String
mbFilePath = String -> Uri -> Maybe String
platformAwareUriToFilePath String
System.Info.os (NormalizedUri -> Uri
fromNormalizedUri NormalizedUri
nuri)