{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module URI.ByteString.Extension where

import Data.ByteString (ByteString)
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Lens.Micro

import qualified Data.ByteString.Char8 as C8

import URI.ByteString

instance IsString Scheme where
  fromString :: String -> Scheme
fromString = ByteString -> Scheme
Scheme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance IsString Host where
  fromString :: String -> Host
fromString = ByteString -> Host
Host forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance IsString (URIRef Absolute) where
  fromString :: String -> URIRef Absolute
fromString =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
strictURIParserOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack

instance IsString (URIRef Relative) where
  fromString :: String -> URIRef Relative
fromString =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions
-> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef URIParserOptions
strictURIParserOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack

fromText :: Text -> Maybe URI
fromText :: Text -> Maybe (URIRef Absolute)
fromText =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
strictURIParserOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

unsafeFromText :: Text -> URI
unsafeFromText :: Text -> URIRef Absolute
unsafeFromText =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
strictURIParserOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

toText :: URI -> Text
toText :: URIRef Absolute -> Text
toText = ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. URIRef a -> ByteString
serializeURIRef'

fromRelative :: Scheme -> Host -> RelativeRef -> URI
fromRelative :: Scheme -> Host -> URIRef Relative -> URIRef Absolute
fromRelative Scheme
s Host
h = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. URIRef a -> Host -> URIRef a
withHost Host
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Scheme -> URIRef a -> URIRef Absolute
toAbsolute Scheme
s

withHost :: URIRef a -> Host -> URIRef a
withHost :: forall a. URIRef a -> Host -> URIRef a
withHost URIRef a
u Host
h = URIRef a
u forall a b. a -> (a -> b) -> b
& forall a. Lens' (URIRef a) (Maybe Authority)
authorityL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall b a. b -> (a -> b) -> Maybe a -> b
maybe
  (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe UserInfo -> Host -> Maybe Port -> Authority
Authority forall a. Maybe a
Nothing Host
h forall a. Maybe a
Nothing)
  (\Authority
a -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Authority
a forall a b. a -> (a -> b) -> b
& Lens' Authority Host
authorityHostL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Host
h)

withPath :: URIRef a -> ByteString -> URIRef a
withPath :: forall a. URIRef a -> ByteString -> URIRef a
withPath URIRef a
u ByteString
p = URIRef a
u forall a b. a -> (a -> b) -> b
& forall a. Lens' (URIRef a) ByteString
pathL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
p

withQuery :: URIRef a -> [(ByteString, ByteString)] -> URIRef a
withQuery :: forall a. URIRef a -> [(ByteString, ByteString)] -> URIRef a
withQuery URIRef a
u [(ByteString, ByteString)]
q = URIRef a
u forall a b. a -> (a -> b) -> b
& (forall a. Lens' (URIRef a) Query
queryL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Query [(ByteString, ByteString)]
queryPairsL) forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. [a] -> [a] -> [a]
++ [(ByteString, ByteString)]
q)