{-# 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           GHCup.Prelude.Internal

import           Data.Bifunctor (first)
import           Data.Text                      ( Text )
import           Control.Applicative
import           Data.Attoparsec.ByteString
import           Data.ByteString
import           URI.ByteString hiding (parseURI)
import           System.URI.File
import qualified Data.Text.Encoding            as E



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


parseURI :: ByteString -> Either URIParseError (URIRef Absolute)
parseURI :: ByteString -> Either URIParseError (URIRef Absolute)
parseURI = (String -> URIParseError)
-> Either String (URIRef Absolute)
-> Either URIParseError (URIRef Absolute)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> URIParseError
OtherError (Either String (URIRef Absolute)
 -> Either URIParseError (URIRef Absolute))
-> (ByteString -> Either String (URIRef Absolute))
-> ByteString
-> Either URIParseError (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (URIRef Absolute)
-> ByteString -> Either String (URIRef Absolute)
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser (URIRef Absolute)
parseURIP

parseURI' :: Text -> Either URIParseError (URIRef Absolute)
parseURI' :: Text -> Either URIParseError (URIRef Absolute)
parseURI' = (String -> URIParseError)
-> Either String (URIRef Absolute)
-> Either URIParseError (URIRef Absolute)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> URIParseError
OtherError (Either String (URIRef Absolute)
 -> Either URIParseError (URIRef Absolute))
-> (Text -> Either String (URIRef Absolute))
-> Text
-> Either URIParseError (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (URIRef Absolute)
-> ByteString -> Either String (URIRef Absolute)
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser (URIRef Absolute)
parseURIP (ByteString -> Either String (URIRef Absolute))
-> (Text -> ByteString) -> Text -> Either String (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
E.encodeUtf8

parseURIP :: Parser (URIRef Absolute)
parseURIP :: Parser (URIRef Absolute)
parseURIP = do
  Either (URIRef Absolute) FileURI
ref <- (FileURI -> Either (URIRef Absolute) FileURI
forall a b. b -> Either a b
Right (FileURI -> Either (URIRef Absolute) FileURI)
-> Parser ByteString FileURI
-> Parser ByteString (Either (URIRef Absolute) FileURI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString FileURI
parseFile) Parser ByteString (Either (URIRef Absolute) FileURI)
-> Parser ByteString (Either (URIRef Absolute) FileURI)
-> Parser ByteString (Either (URIRef Absolute) FileURI)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (URIRef Absolute -> Either (URIRef Absolute) FileURI
forall a b. a -> Either a b
Left (URIRef Absolute -> Either (URIRef Absolute) FileURI)
-> Parser (URIRef Absolute)
-> Parser ByteString (Either (URIRef Absolute) FileURI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URIParserOptions -> Parser (URIRef Absolute)
uriParser URIParserOptions
laxURIParserOptions)
  case Either (URIRef Absolute) FileURI
ref of
    Left (URI { uriScheme :: URIRef Absolute -> Scheme
uriScheme = (Scheme ByteString
"file") }) ->
#if defined(IS_WINDOWS)
      fail "Invalid file URI. File URIs must be absolute (start with a drive letter or UNC path) and not contain backslashes."
#else
      String -> Parser (URIRef Absolute)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid file URI. File URIs must be absolute."
#endif
    Left URIRef Absolute
o -> URIRef Absolute -> Parser (URIRef Absolute)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URIRef Absolute
o
    Right (FileURI (Just ByteString
_) ByteString
_) -> String -> Parser (URIRef Absolute)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"File URIs with auth part are not supported!"
    Right (FileURI Maybe ByteString
_ ByteString
fp) -> URIRef Absolute -> Parser (URIRef Absolute)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URIRef Absolute -> Parser (URIRef Absolute))
-> URIRef Absolute -> Parser (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 :: Parser ByteString FileURI
parseFile
#if defined(IS_WINDOWS)
    = fileURIExtendedWindowsP
#else
    = Parser ByteString FileURI
fileURIExtendedPosixP
#endif