{-# 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 (ByteString -> Scheme)
-> (String -> ByteString) -> String -> Scheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString

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

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

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

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

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

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

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

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

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

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