{-# LANGUAGE CPP                   #-}
{-# LANGUAGE OverloadedStrings     #-}

{-|
Module      : GHCup.Utils.URI
Description : GHCup domain specific URI utilities
Copyright   : (c) Julian Ospald, 2024
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : portable

This module contains GHCup helpers specific to
URI handling.
-}
module GHCup.Utils.URI where

import           Data.ByteString
import           URI.ByteString hiding (parseURI)
import           System.URI.File

import qualified URI.ByteString                as URI


    -----------
    --[ URI ]--
    -----------


parseURI :: ByteString -> Either URIParseError (URIRef Absolute)
parseURI :: ByteString -> Either URIParseError (URIRef Absolute)
parseURI ByteString
bs = case ByteString -> Either String FileURI
parseFile ByteString
bs of
                Left String
_ -> case URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
URI.parseURI URIParserOptions
strictURIParserOptions ByteString
bs of
                            Right (URI { uriScheme :: URIRef Absolute -> Scheme
uriScheme = (Scheme ByteString
"file") }) ->
#if defined(IS_WINDOWS)
                              Left (OtherError "Invalid file URI. File URIs must be absolute (start with a drive letter or UNC path) and not contain backslashes.")
#else
                              URIParseError -> Either URIParseError (URIRef Absolute)
forall a b. a -> Either a b
Left (String -> URIParseError
OtherError String
"Invalid file URI. File URIs must be absolute.")
#endif
                            Either URIParseError (URIRef Absolute)
o -> Either URIParseError (URIRef Absolute)
o
                Right (FileURI (Just ByteString
_) ByteString
_) -> URIParseError -> Either URIParseError (URIRef Absolute)
forall a b. a -> Either a b
Left (URIParseError -> Either URIParseError (URIRef Absolute))
-> URIParseError -> Either URIParseError (URIRef Absolute)
forall a b. (a -> b) -> a -> b
$ String -> URIParseError
OtherError String
"File URIs with auth part are not supported!"
                Right (FileURI Maybe ByteString
_ ByteString
fp) -> URIRef Absolute -> Either URIParseError (URIRef Absolute)
forall a b. b -> Either a b
Right (URIRef Absolute -> Either URIParseError (URIRef Absolute))
-> URIRef Absolute -> Either URIParseError (URIRef Absolute)
forall a b. (a -> b) -> a -> b
$ Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URIRef Absolute
URI (ByteString -> Scheme
Scheme ByteString
"file") Maybe Authority
forall a. Maybe a
Nothing ByteString
fp ([(ByteString, ByteString)] -> Query
Query []) Maybe ByteString
forall a. Maybe a
Nothing
 where
  parseFile :: ByteString -> Either String FileURI
parseFile
#if defined(IS_WINDOWS)
    = parseFileURI ExtendedWindows
#else
    = ParseSyntax -> ByteString -> Either String FileURI
parseFileURI ParseSyntax
ExtendedPosix
#endif