packages feed

url-bytes (empty) → 0.1.0.0

raw patch · 9 files changed

+823/−0 lines, 9 filesdep +HUnitdep +basedep +byteslicesetup-changed

Dependencies added: HUnit, base, byteslice, bytesmith, bytestring, deepseq, gauge, primitive, tasty, tasty-hunit, template-haskell, uri-bytestring, url-bytes, weigh

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for url-bytes++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020 Zachary Churchill++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,199 @@+{-# LANGUAGE+    BangPatterns+  , GADTs+  , DeriveGeneric+  , StandaloneDeriving+  , MagicHash+#-}++{-# OPTIONS_GHC+    -fno-warn-orphans+#-}++import Gauge.Main (defaultMain, bench, nf)++import Data.Bytes.Types+import Control.DeepSeq+import GHC.Generics+import Data.Primitive.ByteArray+import Control.Applicative (ZipList(..))+import qualified Data.Bytes as Bytes+import qualified Url+import qualified Url.Unsafe+import qualified Data.ByteString.Char8 as BS+import qualified URI.ByteString as URI+import qualified Weigh++instance NFData (URI.URIRef a) where+  rnf (URI.URI a b c d e) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e+  rnf (URI.RelativeRef b c d e) = rnf b `seq` rnf c `seq` rnf d `seq` rnf e++instance NFData URI.Authority+instance NFData URI.Host+instance NFData URI.UserInfo+instance NFData URI.SchemaError+instance NFData URI.URIParseError+instance NFData URI.Scheme+instance NFData URI.Port+instance NFData URI.Query++deriving instance Generic Url.ParseError+deriving instance Generic Url.Url+deriving instance Generic Bytes+instance NFData Url.ParseError+instance NFData ByteArray where+  rnf !b = b `seq` ()+instance NFData Bytes+instance NFData Url.Unsafe.Url where+  rnf (Url.Unsafe.Url a _ _ _ _ _ _ _ _) = rnf a++main :: IO ()+main = do+  defaultMain+    [ bench "url-bytes 1,000" $ nf (fmap Url.decodeUrl) bytesUrls+    , bench "uri-bytestring strict 1,000" $ nf (fmap $ URI.parseURI URI.strictURIParserOptions) bsUrls+    , bench "uri-bytestring lax 1,000" $ nf (fmap $ URI.parseURI URI.laxURIParserOptions) bsUrls+    ]+  putStr "Memory usage:"+  Weigh.mainWith $ do+    Weigh.func "url-bytes 1,000 [Maybe Url]" (fmap Url.decodeUrl) bytesUrls+    Weigh.func "uri-bytestring 1,000 [Maybe URI]" (fmap $ URI.parseURI URI.strictURIParserOptions) bsUrls+  where+  !permUrls = take 1000 $ getZipList $ +    (\a b c d -> a <> b <> c <> d)+    <$> ZipList (cycle schemes) +    <*> ZipList (cycle urls)+    <*> ZipList (cycle paths)+    <*> ZipList (cycle queryParams)+  !bsUrls = BS.pack <$> permUrls+  !bytesUrls = Bytes.fromAsciiString <$> permUrls++paths :: [String]+paths =+  [ "/example"+  , "//foo/bar@:"+  , ""+  , "/"+  , "/en/wikipedia/Foo.txt"+  ]++queryParams :: [String]+queryParams =+  [ "?foo=bar&qux=quine"+  , ""+  , "?"+  ]++schemes :: [String]+schemes =+  [ "http://"+  , "https://"+  ]++urls :: [String]+urls =+  [ "ggoogle.com"+  , "guser:password@facebook.org:322"+  , "en.wikipedia.org"+  , "github.com"+  , "www.youtube.com"+  , "www.facebook.com"+  , "www.baidu.com"+  , "www.yahoo.com"+  , "www.amazon.com"+  , "www.wikipedia.org"+  , "www.qq.com"+  , "www.google.co.in"+  , "www.twitter.com"+  , "www.live.com"+  , "www.taobao.com"+  , "www.bing.com#foo"+  , "www.instagram.com"+  , "www.weibo.com"+  , "www.sina.com.cn"+  , "www.linkedin.com"+  , "www.yahoo.co.jp"+  , "www.msn.com"+  , "www.vk.com"+  , "www.google.de"+  , "www.yandex.ru"+  , "www.hao123.com"+  , "www.google.co.uk"+  , "www.reddit.com"+  , "www.ebay.com"+  , "www.google.fr"+  , "www.t.co"+  , "www.tmall.com"+  , "www.google.com.br"+  , "www.360.cn"+  , "www.sohu.com"+  , "www.amazon.co.jp"+  , "www.pinterest.com"+  , "www.netflix.com"+  , "www.google.it"+  , "www.google.ru"+  , "www.microsoft.com"+  , "www.google.es"+  , "www.wordpress.com"+  , "www.gmw.cn"+  , "www.tumblr.com"+  , "www.paypal.com"+  , "www.blogspot.com"+  , "www.imgur.com"+  , "www.stackoverflow.com"+  , "www.aliexpress.com"+  , "www.naver.com"+  , "www.ok.ru"+  , "www.apple.com"+  , "www.github.com"+  , "www.chinadaily.com.cn"+  , "www.imdb.com"+  , "www.google.co.kr"+  , "www.fc2.com"+  , "www.jd.com"+  , "www.blogger.com"+  , "www.163.com"+  , "www.google.ca"+  , "www.whatsapp.com"+  , "www.amazon.in"+  , "www.office.com"+  , "www.tianya.cn"+  , "www.google.co.id"+  , "www.youku.com"+  , "www.rakuten.co.jp"+  , "www.craigslist.org"+  , "www.amazon.de"+  , "www.nicovideo.jp"+  , "www.google.pl"+  , "www.soso.com"+  , "www.bilibili.com"+  , "www.dropbox.com"+  , "www.xinhuanet.com"+  , "www.outbrain.com"+  , "www.pixnet.net"+  , "www.alibaba.com"+  , "www.alipay.com"+  , "www.microsoftonline.com"+  , "www.booking.com"+  , "www.googleusercontent.com"+  , "www.google.com.au"+  , "www.popads.net"+  , "www.cntv.cn"+  , "www.zhihu.com"+  , "www.amazon.co.uk"+  , "www.diply.com"+  , "www.coccoc.com"+  , "www.cnn.com"+  , "www.bbc.co.uk"+  , "www.twitch.tv"+  , "www.wikia.com"+  , "www.google.co.th"+  , "www.go.com"+  , "www.google.com.ph"+  , "www.doubleclick.net"+  , "www.onet.pl"+  , "www.googleadservices.com"+  , "www.accuweather.com"+  , "www.googleweblight.com"+  , "www.answers.yahoo.com"+  ]
+ src/Url.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE+    OverloadedStrings+  , BangPatterns+  , UnboxedTuples+  , UnboxedSums+  , MagicHash+  , ScopedTypeVariables+  , LambdaCase+  , RecordWildCards+  , NamedFieldPuns+  , ApplicativeDo+  , TemplateHaskell+#-}++-- | Note: this library parses, but does not validate urls+module Url +  ( -- * Types+    Url(urlSerialization)+  , ParseError(..)+    -- * Parsing+  , decodeUrl+    -- * Slicing+  , getScheme+  , getUsername+  , getAuthority+  , getPassword+  , getHost+  , getPath+  , getQuery+  , getFragment+  , getExtension+  , getPort+  , constructUrl+  , literalUrl+  ) where++import Data.Word (Word16)+import Data.Bytes.Types (Bytes(..))+import Url.Rebind (decodeUrl)+import Url.Unsafe (Url(..),ParseError(..))+import GHC.Exts (Int(I#),(==#),Int#,int2Word#)+import GHC.Word (Word16(..))+import Language.Haskell.TH+import Language.Haskell.TH.Syntax (TExp(TExp))+import Data.List (intercalate)+-- import GHC.Integer.GMP.Internals (Integer(..))+import qualified Data.Bytes as Bytes++-- | Slice into the 'Url' and retrieve the scheme, if it's present+getScheme :: Url -> Maybe Bytes+getScheme Url{urlSerialization,urlSchemeEnd} = +  if I# urlSchemeEnd == 0+    then Nothing+    else Just $ Bytes.unsafeTake (I# urlSchemeEnd) urlSerialization++-- | Slice into the 'Url' and retrieve the username, if it's present+getUsername :: Url -> Maybe Bytes+getUsername Url{urlSerialization,urlSchemeEnd,urlUsernameEnd,urlHostStart} =+  case urlUsernameEnd ==# urlHostStart of+    0# -> Just $ unsafeSlice (I# urlSchemeEnd + 3) (I# urlUsernameEnd) urlSerialization+    _ -> Nothing++getAuthority :: Url -> Maybe Bytes+getAuthority Url{urlSerialization,urlSchemeEnd,urlUsernameEnd,urlHostStart} =+  case urlUsernameEnd ==# urlHostStart of+    0# -> Just $ unsafeSlice (I# urlSchemeEnd + 3) (I# urlHostStart - 1) urlSerialization+    _ -> Nothing++getPassword :: Url -> Maybe Bytes+getPassword Url{urlSerialization,urlUsernameEnd,urlHostStart} =+  case urlUsernameEnd ==# urlHostStart of+    0# -> +      let mpass = unsafeSlice (I# urlUsernameEnd) (I# urlHostStart - 1) urlSerialization+      in case Bytes.uncons mpass of+        Just (58,password) -> Just password+        _ -> Nothing+    _ -> Nothing++-- | Slice into the 'Url' and retrieve the host, if it's present+getHost :: Url -> Maybe Bytes+getHost Url{urlSerialization,urlHostStart,urlHostEnd} =+  case urlHostStart ==# urlHostEnd of+    0# -> Just $ unsafeSlice (I# urlHostStart) (I# urlHostEnd) urlSerialization+    _ -> Nothing++-- | Slice into the 'Url' and retrieve the path starting with @\'/'@, if it's present+getPath :: Url -> Maybe Bytes+getPath Url{urlSerialization,urlPathStart,urlQueryStart} = +  case urlPathStart ==# len of+    0# -> Just $ unsafeSlice (I# urlPathStart) (I# urlQueryStart) urlSerialization+    _ -> Nothing+  where+  !(I# len) = Bytes.length urlSerialization++-- | Slice into the 'Url' and retrieve the query string starting with @\'?'@, if it's present+getQuery :: Url -> Maybe Bytes+getQuery Url{urlSerialization,urlQueryStart,urlFragmentStart} =+  case len ==# urlQueryStart of+    0# -> Just $ unsafeSlice (I# urlQueryStart) (I# urlFragmentStart) urlSerialization+    _ -> Nothing+  where+  !(I# len) = Bytes.length urlSerialization++-- | Slice into the 'Url' and retrieve the fragment starting with @\'#'@, if it's present+getFragment :: Url -> Maybe Bytes+getFragment Url{urlSerialization,urlFragmentStart} =+  case len ==# urlFragmentStart of+    0# -> Just $ unsafeSlice (I# urlFragmentStart) (I# len) urlSerialization+    _ -> Nothing+  where+  !(I# len) = Bytes.length urlSerialization++getPort :: Url -> Maybe Word16+getPort Url{urlPort} =+  case urlPort of+    0x10000# -> Nothing+    x -> Just $ W16# (int2Word# x)++-- | This function is intentionally imprecise. +-- E.g. @getExtension "google.com/facebook.com" == Just ".com"@+getExtension :: Url -> Maybe Bytes+getExtension url = do+  path <- getPath url+  if not (Bytes.elem 0x2e path)+  then Nothing+  else case Bytes.split 0x2e path of+    [] -> Nothing+    xs -> Just $ last xs++{-# INLINE unsafeSlice #-}+unsafeSlice :: Int -> Int -> Bytes -> Bytes+unsafeSlice begin end (Bytes arr _ _) = +  Bytes arr begin (end - begin)++literalUrl :: String -> Q (TExp Url)+literalUrl ser = case decodeUrl $ Bytes.fromLatinString ser of+  Left e -> fail $ "Invalid url. Parse error: " <> show e+  Right Url{..} -> do+    pure $ TExp $+      ConE 'Url+        `AppE` (ParensE $ (VarE 'Bytes.fromLatinString) `AppE` (LitE $ StringL ser))+        `AppE` (liftInt# urlSchemeEnd)+        `AppE` (liftInt# urlUsernameEnd)+        `AppE` (liftInt# urlHostStart)+        `AppE` (liftInt# urlHostEnd)+        `AppE` (liftInt# urlPort)+        `AppE` (liftInt# urlPathStart)+        `AppE` (liftInt# urlQueryStart)+        `AppE` (liftInt# urlFragmentStart)+  where+  liftInt# :: Int# -> Exp+  liftInt# x = LitE (IntPrimL (fromIntegral $ I# x))++constructUrl ::+     Maybe String -- ^ scheme+  -> String -- ^ host+  -> Maybe Word16 -- ^ port+  -> String -- ^ path+  -> [(String,String)] -- query string params+  -> Maybe String -- ^ framgent+  -> Q (TExp Url)+constructUrl mscheme host mport path qps mfrag = literalUrl ser+  where+  ser = scheme <> host <> port <> path <> rqps <> frag+  scheme = case mscheme of+    Nothing -> mempty+    Just x -> x <> "://"+  port = case mport of+    Nothing -> mempty+    Just x -> ':' : show x+  rqps :: String+  rqps = "?" <> (intercalate "&" $ fmap (\(a,b) -> a <> "=" <> b) qps)+  frag = case mfrag of+    Nothing -> mempty+    Just x -> "#" <> x
+ src/Url/Rebind.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE+    OverloadedStrings+  , BangPatterns+  , UnboxedTuples+  , UnboxedSums+  , MagicHash+  , RebindableSyntax+  , ScopedTypeVariables+  , LambdaCase+  , RecordWildCards+  , NamedFieldPuns+  , ApplicativeDo+#-}++-- The parser lives in its own module because it uses RebindableSyntax,+-- which adversely affects inference and error messages.+module Url.Rebind+  ( decodeUrl+  ) where++import Prelude hiding ((>>=),(>>),pure)+import Data.Bytes.Parser.Rebindable ((>>),(>>=),pure)++import Data.Bytes.Types (Bytes(..))+import Data.Char (ord)+import Data.Word (Word8)+import GHC.Exts (Int(I#),Int#,(+#),(<#),(-#),orI#,(>=#),(==#),(>#))+import GHC.Word (Word16(W16#))+import Url.Unsafe (Url(..),ParseError(..))+import qualified Data.Bytes.Parser as P+import qualified Data.Bytes.Parser.Latin as P (skipUntil, char2, decWord16)+import qualified Data.Bytes.Parser.Unsafe as PU+import qualified GHC.Exts as Exts++-- | Decode a hierarchical URL+decodeUrl :: Bytes -> Either ParseError Url+decodeUrl urlSerialization = P.parseBytesEither parserUrl urlSerialization++parserAuthority :: Int# -> P.Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)+{-# inline parserAuthority #-}+parserAuthority urlSchemeEnd = PU.cursor#+  >>= \userStart -> P.measure_# (P.skipUntil ':')+  >>= \i3 -> PU.unconsume (I# i3)+  >>  P.measure_# (P.skipUntil '@')+  >>= \i4 -> PU.unconsume (I# i4)+  >>  P.measure_# (P.skipUntil '/')+  >>= \i5 -> PU.unconsume (I# i5)+  >>  ( case (i4 >=# i5) `orI#` (i3 ==# i4) of+          1# -> PU.jump (I# userStart) >> pure userStart+          _ -> let jumpi = i4 in+            case i3 <# i4 of+              1# -> PU.jump (I# (userStart +# jumpi +# 1# )) >> pure (userStart +# i3)+              _ -> PU.jump (I# (userStart +# jumpi +# 1# )) >> pure (userStart +# i4)+      )+  >>= \urlUsernameEnd -> PU.cursor#+  >>= \urlHostStart ->+    ( P.skipTrailedBy2# EndOfInput (c2w ':') (c2w '/')+      `orElse#` 2#+    )+  >>= \colonSlashNeither ->+    ( case colonSlashNeither of+        0# -> PU.cursor# -- ':' encountered first+          >>= \urlHostEnd -> P.decWord16 InvalidPort+          >>= \(W16# urlPort) ->+          pure (# urlHostEnd -# 1#, Exts.word2Int# urlPort #)+        1# -> -- '/' encountered first+              PU.cursor#+          >>= \urlHostEnd' ->+              -- Backing up by one since we want to put the slash back+              -- to let it be part of the path.+              let urlHostEnd = urlHostEnd' -# 1# in+              PU.jump (I# urlHostEnd)+          >>  pure (# urlHostEnd, 0x10000# #)+        _ -> -- neither encountered+              PU.cursor#+          >>= \urlHostEnd ->+              PU.jump (I# urlHostEnd)+          >>  pure (# urlHostEnd, 0x10000# #)+    )+  >>= \(# !urlHostEnd, !urlPort #) -> pure+    (# urlSchemeEnd +    , urlUsernameEnd +    , urlHostStart  +    , urlHostEnd    +    , urlPort       +    #)++-- | Parser type from @bytesmith@+-- Note: non-hierarchical Urls (such as relative paths) will not currently parse.+parserUrl :: P.Parser ParseError s Url+parserUrl = +  P.peekRemaining +  >>= \urlSerialization@(Bytes _ _ (I# len)) ->+  PU.cursor#+  >>= \start ->+  P.measure+    ( P.skipTrailedBy2 EndOfInput (c2w ':') (c2w '/')+      `P.orElse`+      pure True+    )+  >>= \(I# i1, !slashFirst) ->+    ( case slashFirst of+        False ->+          succeeded (P.char2 InvalidAuthority '/' '/') >>= \hasAuthority -> do+            let urlSchemeEnd = (i1 -# 1# )+            case hasAuthority of+              0# -> pure (# urlSchemeEnd, urlSchemeEnd, urlSchemeEnd, urlSchemeEnd, 0x10000# #)+              _ -> parserAuthority urlSchemeEnd+        True ->+          PU.jump (I# start) >> +            let urlSchemeEnd = start+             in parserAuthority urlSchemeEnd +    )+  >>= \(# urlSchemeEnd, urlUsernameEnd, urlHostStart, urlHostEnd, urlPort #) -> PU.cursor#+  >>= \urlPathStart -> P.measure_# (P.skipUntil '?')+  >>= \i8 -> PU.unconsume (I# i8)+  >>  P.measure_# (P.skipUntil '#')+  >>= \i9 -> PU.unconsume (I# i9)+  >>  ( case intCompare# i8 i9 of+          EQ -> pure (# len, len #)+          LT -> P.skipUntil '#' >> +            let !urlFragmentStart = i9 +# urlPathStart+             in pure (# (i8 +# urlPathStart), urlFragmentStart #)+          GT -> P.skipUntil '#' >> +            let !urlFragmentStart = i9 +# urlPathStart+             in pure (# urlFragmentStart, urlFragmentStart #)+      )+  >>= \(# !urlQueryStart, !urlFragmentStart #) ->+  pure (Url {..})++intCompare# :: Int# -> Int# -> Ordering+intCompare# a b = case a ==# b of+  0# -> case a ># b of+    0# -> LT+    _ -> GT+  _ -> EQ++-- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and+-- silently truncates to 8 bits Chars > '\255'.+c2w :: Char -> Word8+c2w = fromIntegral . ord+{-# INLINE c2w #-}++orElse# :: forall e x s. PU.Parser x s Int# -> Int# -> PU.Parser e s Int#+{-# inline orElse# #-}+orElse# (PU.Parser f) i = PU.Parser+  (\x@(# _, b, c #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# _ | #) -> (# s1, (# | (# i, b, c #) #) #)+      (# | r #) -> (# s1, (# | r #) #)+  )++succeeded :: PU.Parser e s a -> PU.Parser e s Int#+succeeded (PU.Parser f) = PU.Parser+  (\x@(# _, b, c #) s0 -> case f x s0 of+    (# s1, r0 #) -> case r0 of+      (# _ | #) -> (# s1, (# | (# 0#, b, c #) #) #)+      (# | (# _, b1, c1 #) #) -> (# s1, (# | (# 1#, b1, c1 #) #) #)+  )+
+ src/Url/Unsafe.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE+    OverloadedStrings+  , BangPatterns+  , UnboxedTuples+  , UnboxedSums+  , MagicHash+  , ScopedTypeVariables+  , LambdaCase+  , RecordWildCards+  , NamedFieldPuns+  , ApplicativeDo+#-}++{-# OPTIONS_HADDOCK not-home #-}++module Url.Unsafe+  ( -- * Types+    Url(..)+  , ParseError(..)+  ) where++import Data.Bytes.Types (Bytes(..))+import GHC.Exts (Int#)++-- | Url type represented by its serialization,+-- and slices of that serialization.+{- | Syntax in pseudo-BNF:++@+url = scheme ":" [ hierarchical | non-hierarchical ] [ "?" query ]? [ "#" fragment ]?+non-hierarchical = non-hierarchical-path+non-hierarchical-path = /* Does not start with "/" */+hierarchical = authority? hierarchical-path+authority = "//" userinfo? host [ ":" port ]?+userinfo = username [ ":" password ]? "@"+hierarchical-path = [ "/" path-segment ]++@+-}+data Url = Url+  { urlSerialization :: {-# UNPACK #-} !Bytes+  -- Components+  , urlSchemeEnd     :: !Int# -- ^ Before @\':'@+  , urlUsernameEnd   :: !Int# -- ^ Before @\':'@ (if a password is given) or @\'\@'@ (if not)+  , urlHostStart     :: !Int#+  , urlHostEnd       :: !Int#+  , urlPort          :: !Int#+  , urlPathStart     :: !Int# -- ^ Before initial @\'/'@, if any+  , urlQueryStart    :: !Int# -- ^ Before @\'?'@+  , urlFragmentStart :: !Int# -- ^ Before @\'#'@+  } deriving (Eq, Ord, Show)++-- | Possible parse errors+data ParseError+  = EndOfInput+  | InvalidAuthority+  | InvalidPort+  deriving (Eq, Ord, Show)
+ test/Main.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE +    MagicHash +  , TemplateHaskell+#-}++module Main where++import Control.Monad+import Data.Bytes+import Data.Either+import Test.Tasty+import Test.Tasty.HUnit+import Url+import Url.Unsafe++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests]++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [ testCase "URL decoding test 1" $+      decodeUrl urlBytes1 @?= Right url1+  , testCase "URL decoding test 2" $+      decodeUrl urlBytes2 @?= Right url2+  , testCase "URL decoding test 3" $+      decodeUrl urlBytes3 @?= Right url3+  , testCase "URL decoding test 4" $+      when (isLeft (decodeUrl urlBytes4)) (assertFailure "")+  , testCase "getScheme" $+      getScheme url2 @?= Just (fromAsciiString "http")+  , testCase "getUsername" $+      getUsername url2 @?= Just (fromAsciiString "user")+  , testCase "getPassword" $+      getPassword url2 @?= Just (fromAsciiString "password")+  , testCase "getAuthority" $+      getAuthority url2 @?= Just (fromAsciiString "user:password")+  , testCase "getHost" $+      getHost url2 @?= Just (fromAsciiString "facebook.org")+  , testCase "getPath" $+      getPath url1 @?= Just (fromAsciiString "/foo")+  , testCase "getQuery" $+      getQuery url1 @?= Just (fromAsciiString "?bar=qux")+  , testCase "getQuery 2" $+      getQuery url3 @?= Just (fromAsciiString "?")+  , testCase "getQuery 3" $+      getQuery url2 @?= Nothing+  , testCase "getFragment" $+      getFragment url1 @?= Just (fromAsciiString "#quine")+  , testCase "getFragment 2" $+      getFragment url3 @?= Just (fromAsciiString "#")+  , testCase "getFragment 3" $+      getFragment url2 @?= Nothing+  , testCase "getExtension" $ do+      let eurl1 = getExtension $ unwrap $ decodeUrl $ fromAsciiString "https://imgur.com/./f.o.o.png?bar=bar#q"+          eurl2 = getExtension $ unwrap $ decodeUrl $ fromAsciiString "foo.com/sustainability/bikeuab/commutesmart/itemlist/user/79-2020-05-20-18-13-31&format=feed&Itemid=597&format=feed&Itemid=597&type=rss&format=feed&Itemid=597&type=rss&format=feed&Itemid=597&type=rss&format=feed&Itemid=597"+          eurl3 = getExtension $ unwrap $ decodeUrl $ fromAsciiString "foo.com/news/health/item/11418-o-neal-cancer-center-at-uab-urges-continued-cancer-screenings-during-pandemic"+      eurl1 @?= Just (fromAsciiString "png")+      eurl2 @?= Nothing+      eurl3 @?= Nothing+  , testCase "offsetUrl" $ do+      let urlBytes1Offset = unsafeDrop 2 $ fromAsciiString "  " <> urlBytes1+          Right url1Offset = decodeUrl urlBytes1Offset+      getPath url1 @?= getPath url1Offset+  , testCase "constructUrl" $ do+      url1TH1 @?= url1+      url1TH2 @?= url1+  ]++unwrap :: Either a b -> b+unwrap = either (error "unwrap") id++urlBytes1 :: Bytes+urlBytes1 = fromAsciiString "https://google.com/foo?bar=qux#quine"++url1TH1 :: Url+url1TH1 = $$(constructUrl (Just "https") "google.com" Nothing "/foo" [("bar", "qux")] (Just "quine"))++url1TH2 :: Url+url1TH2 = $$(literalUrl "https://google.com/foo?bar=qux#quine")++url1 :: Url+url1 = Url+  { urlSerialization = urlBytes1+  , urlSchemeEnd     = 5#+  , urlUsernameEnd   = 8#+  , urlHostStart     = 8#+  , urlHostEnd       = 18#+  , urlPort          = 0x10000#+  , urlPathStart     = 18#+  , urlQueryStart    = 22#+  , urlFragmentStart = 30#+  }++urlBytes2 :: Bytes+urlBytes2 = fromAsciiString "http://user:password@facebook.org:322/"++url2 :: Url+url2 = Url+  { urlSerialization = urlBytes2+  , urlSchemeEnd     = 4#+  , urlUsernameEnd   = 11#+  , urlHostStart     = 21#+  , urlHostEnd       = 33#+  , urlPort          = 322#+  , urlPathStart     = 37#+  , urlQueryStart    = 38#+  , urlFragmentStart = 38#+  }++urlBytes3 :: Bytes+urlBytes3 = fromAsciiString "x@g/f/:/@?#"++url3 :: Url+url3 = Url+  { urlSerialization = urlBytes3+  , urlSchemeEnd     = 0#+  , urlUsernameEnd   = 1#+  , urlHostStart     = 2#+  , urlHostEnd       = 3#+  , urlPort          = 0x10000#+  , urlPathStart     = 3#+  , urlQueryStart    = 9#+  , urlFragmentStart = 10#+  }++urlBytes4 :: Bytes+urlBytes4 = fromAsciiString "file+udp:bar.txt"+
+ url-bytes.cabal view
@@ -0,0 +1,74 @@+cabal-version: 2.0+name: url-bytes+version: 0.1.0.0+synopsis: Memory efficient url type and parser.+description: Memory efficient url type and parser library using the Bytes type from byteverse.+bug-reports: github.com/goolord/url-bytes/issues+license: MIT+license-file: LICENSE+author: Zachary Churchill+maintainer: zacharyachurchill@gmail.com+copyright: 2020 Zachary Churchill+category: Data+build-type: Simple+extra-source-files: CHANGELOG.md++library+  ghc-options: -Wall -O2+  exposed-modules: +      Url+      Url.Unsafe+  other-modules:+      Url.Rebind+  -- other-extensions:+  build-depends: +      base >=4.12.0.0 && <5+    , byteslice >=0.2.1 && <0.3+    , primitive >= 0.7.1 && < 0.8+    , bytesmith >=0.3.6 && <0.4+    , template-haskell >=2.14.0.0 && <2.17.0.0+  hs-source-dirs: src+  default-language: Haskell2010++test-suite test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    Main.hs+  build-depends:+      HUnit+    , tasty+    , base+    , tasty-hunit+    , url-bytes+    , byteslice+    , primitive+  ghc-options:+    -Wall+    -O2+  default-language:+    Haskell2010++benchmark bench+  type: exitcode-stdio-1.0+  build-depends:+      base+    , byteslice+    , gauge+    , primitive+    , url-bytes+    , uri-bytestring+    , bytestring+    , deepseq+    , primitive+    , weigh+  ghc-options: -Wall -O2+  default-language: Haskell2010+  hs-source-dirs: bench+  main-is: Main.hs++source-repository head+  type:     git+  location: https://github.com/goolord/url-bytes