Extension.hs

{-# 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 = Scheme . fromString

instance IsString Host where
  fromString = Host . fromString

instance IsString (URIRef Absolute) where
  fromString =
    either (error . show) id . parseURI strictURIParserOptions . C8.pack

instance IsString (URIRef Relative) where
  fromString =
    either (error . show) id . parseRelativeRef strictURIParserOptions . C8.pack

fromText :: Text -> Maybe URI
fromText =
  either (const Nothing) Just . parseURI strictURIParserOptions . encodeUtf8

unsafeFromText :: Text -> URI
unsafeFromText =
  either (error . show) id . parseURI strictURIParserOptions . encodeUtf8

toText :: URI -> Text
toText = decodeUtf8 . serializeURIRef'

fromRelative :: Scheme -> Host -> RelativeRef -> URI
fromRelative s h = flip withHost h . toAbsolute s

withHost :: URIRef a -> Host -> URIRef a
withHost u h = u & authorityL %~ maybe
  (Just $ Authority Nothing h Nothing)
  (\a -> Just $ a & authorityHostL .~ h)

withPath :: URIRef a -> ByteString -> URIRef a
withPath u p = u & pathL .~ p

withQuery :: URIRef a -> [(ByteString, ByteString)] -> URIRef a
withQuery u q = u & (queryL . queryPairsL) %~ (++ q)