url-bytes 0.1.0.0 → 0.1.1.0
raw patch · 5 files changed
+151/−112 lines, 5 filesdep +dormouse-uridep +tasty-benchdep −gaugedep ~bytesmithdep ~primitivedep ~template-haskell
Dependencies added: dormouse-uri, tasty-bench
Dependencies removed: gauge
Dependency ranges changed: bytesmith, primitive, template-haskell
Files
- bench/Main.hs +36/−12
- src/Url.hs +16/−16
- src/Url/Rebind.hs +69/−77
- test/Main.hs +23/−0
- url-bytes.cabal +7/−7
bench/Main.hs view
@@ -1,28 +1,30 @@ {-# LANGUAGE BangPatterns- , GADTs+ , DataKinds , DeriveGeneric- , StandaloneDeriving+ , GADTs , MagicHash+ , StandaloneDeriving+ , TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -import Gauge.Main (defaultMain, bench, nf)+import Test.Tasty.Bench (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 Data.Bytes.Text.Latin1 as BytesL import qualified Url import qualified Url.Unsafe import qualified Data.ByteString.Char8 as BS import qualified URI.ByteString as URI import qualified Weigh+import qualified Dormouse.Uri as Dormouse 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@@ -41,23 +43,45 @@ 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 +deriving instance Generic (Dormouse.Path a)+deriving instance Generic Dormouse.Authority+deriving instance Generic Dormouse.Fragment+deriving instance Generic Dormouse.Host+deriving instance Generic Dormouse.PathSegment+deriving instance Generic Dormouse.Query+deriving instance Generic Dormouse.Scheme+deriving instance Generic Dormouse.Uri+deriving instance Generic Dormouse.UserInfo+instance NFData (Dormouse.Path a)+instance NFData Dormouse.Authority+instance NFData Dormouse.Fragment+instance NFData Dormouse.Host+instance NFData Dormouse.PathSegment+instance NFData Dormouse.Query+instance NFData Dormouse.Scheme+instance NFData Dormouse.Uri+instance NFData Dormouse.UserInfo+ main :: IO () main = do+ putStr "\n"+ 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+ Weigh.func "dormouse-uri 1,000 [Maybe Uri]" (fmap (Dormouse.parseUri @Maybe)) bsUrls+ putStr "\n"+ 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+ , bench "dormouse-uri 1,000" $ nf (fmap (Dormouse.parseUri @Maybe)) 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)@@ -66,7 +90,7 @@ <*> ZipList (cycle paths) <*> ZipList (cycle queryParams) !bsUrls = BS.pack <$> permUrls- !bytesUrls = Bytes.fromAsciiString <$> permUrls+ !bytesUrls = BytesL.fromString <$> permUrls paths :: [String] paths =
src/Url.hs view
@@ -34,17 +34,17 @@ , literalUrl ) where -import Data.Word (Word16) import Data.Bytes.Types (Bytes(..))-import Url.Rebind (decodeUrl)-import Url.Unsafe (Url(..),ParseError(..))+import Data.List (intercalate)+import Data.Word (Word16) 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 Url.Rebind (decodeUrl)+import Url.Unsafe (Url(..),ParseError(..)) import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Text.Latin1 as BytesL -- | Slice into the 'Url' and retrieve the scheme, if it's present getScheme :: Url -> Maybe Bytes@@ -133,20 +133,20 @@ Bytes arr begin (end - begin) literalUrl :: String -> Q (TExp Url)-literalUrl ser = case decodeUrl $ Bytes.fromLatinString ser of+literalUrl ser = case decodeUrl $ BytesL.fromString 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)+ `AppE` (ParensE $ (VarE 'BytesL.fromString) `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))@@ -169,7 +169,7 @@ Nothing -> mempty Just x -> ':' : show x rqps :: String- rqps = "?" <> (intercalate "&" $ fmap (\(a,b) -> a <> "=" <> b) qps)+ rqps = "?" <> intercalate "&" (fmap (\(a,b) -> a <> "=" <> b) qps) frag = case mfrag of Nothing -> mempty Just x -> "#" <> x
src/Url/Rebind.hs view
@@ -1,15 +1,12 @@ {-# LANGUAGE- OverloadedStrings- , BangPatterns+ BangPatterns , UnboxedTuples , UnboxedSums , MagicHash , RebindableSyntax , ScopedTypeVariables- , LambdaCase , RecordWildCards , NamedFieldPuns- , ApplicativeDo #-} -- The parser lives in its own module because it uses RebindableSyntax,@@ -28,7 +25,7 @@ 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.Latin as P (skipUntil, char, char2, decWord16, skipDigits1) import qualified Data.Bytes.Parser.Unsafe as PU import qualified GHC.Exts as Exts @@ -38,46 +35,40 @@ 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+parserAuthority urlSchemeEnd = do+ userStart <- PU.cursor#+ i3 <- P.measure_# (P.skipUntil ':')+ PU.unconsume (I# i3)+ i4 <- P.measure_# (P.skipUntil '@')+ PU.unconsume (I# i4)+ i5 <- P.measure_# (P.skipUntil '/')+ PU.unconsume (I# i5)+ urlUsernameEnd <- ( 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+ urlHostStart <- PU.cursor#+ colonSlashNeither <- P.skipTrailedBy2# EndOfInput (c2w ':') (c2w '/') `orElse#` 2#+ (# !urlHostEnd, !urlPort #) <- case colonSlashNeither of+ 0# -> do+ urlHostEnd <- PU.cursor# -- ':' encountered first+ (W16# urlPort) <- P.decWord16 InvalidPort+ pure (# urlHostEnd -# 1#, Exts.word2Int# urlPort #)+ 1# -> do -- '/' encountered first+ urlHostEnd' <- PU.cursor#+ -- Backing up by one since we want to put the slash back+ -- to let it be part of the path.+ let urlHostEnd = urlHostEnd' -# 1#+ PU.jump (I# urlHostEnd)+ pure (# urlHostEnd, 0x10000# #)+ _ -> do -- neither encountered+ urlHostEnd <- PU.cursor#+ PU.jump (I# urlHostEnd)+ pure (# urlHostEnd, 0x10000# #)+ pure (# urlSchemeEnd , urlUsernameEnd , urlHostStart @@ -88,44 +79,42 @@ -- | 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+parserUrl = do+ urlSerialization@(Bytes _ _ (I# len)) <- P.peekRemaining + start <- PU.cursor#+ (I# i1, !slashFirst) <- P.measure $+ P.skipTrailedBy2 EndOfInput (c2w ':') (c2w '/')+ `P.orElse` pure True+ (# urlSchemeEnd, urlUsernameEnd, urlHostStart, urlHostEnd, urlPort #) <- case slashFirst of+ False ->+ -- If we see something like "abc://" with a colon followed by two+ -- slashes, we assume that the authority is present ("abc" in+ -- this case).+ succeeded (P.char2 InvalidAuthority '/' '/') >>= \hasAuthorityA -> do+ let urlSchemeEnd = (i1 -# 1# )+ case hasAuthorityA of+ 0# -> succeeded (P.skipDigits1 () >> P.char () '/') >>= \hasAuthorityB ->+ -- Here, we are looking for things like "example.com:8888/" that+ -- are missing the scheme but include a port.+ case hasAuthorityB 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 #) ->+ _ -> PU.jump (I# start) >> parserAuthority start+ _ -> parserAuthority urlSchemeEnd+ True ->+ PU.jump (I# start) >> parserAuthority start + urlPathStart <- PU.cursor#+ i8 <- P.measure_# (P.skipUntil '?')+ PU.unconsume (I# i8)+ i9 <- P.measure_# (P.skipUntil '#')+ PU.unconsume (I# i9)+ (# !urlQueryStart, !urlFragmentStart #) <- 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 #) pure (Url {..}) intCompare# :: Int# -> Int# -> Ordering@@ -150,7 +139,10 @@ (# | r #) -> (# s1, (# | r #) #) ) -succeeded :: PU.Parser e s a -> PU.Parser e s Int#+-- Runs the parser, returning 1 if it succeeds and 0 if it fails.+-- Rolls back on failure, but consumes on success.+succeeded :: PU.Parser x s a -> PU.Parser e s Int#+{-# inline succeeded #-} succeeded (PU.Parser f) = PU.Parser (\x@(# _, b, c #) s0 -> case f x s0 of (# s1, r0 #) -> case r0 of
test/Main.hs view
@@ -67,6 +67,21 @@ , testCase "constructUrl" $ do url1TH1 @?= url1 url1TH2 @?= url1+ , testCase "URL decoding 5, path" $ case decodeUrl urlBytes5 of+ Left{} -> assertFailure "could not decode url 5"+ Right u -> case getPath u of+ Nothing -> assertFailure "url 5 missing path"+ Just p -> fromAsciiString "/resource" @?= p+ , testCase "URL decoding 6, path" $ case decodeUrl urlBytes6 of+ Left{} -> assertFailure "could not decode url 6"+ Right u -> case getPath u of+ Nothing -> assertFailure "url 6 missing path"+ Just p -> fromAsciiString "/resource" @?= p+ , testCase "no-scheme-with-port" $ case decodeUrl urlBytes7 of+ Left{} -> assertFailure "could not decode url 7"+ Right u -> case getHost u of+ Nothing -> assertFailure "url 7 missing host"+ Just p -> fromAsciiString "example.com" @?= p ] unwrap :: Either a b -> b@@ -129,3 +144,11 @@ urlBytes4 :: Bytes urlBytes4 = fromAsciiString "file+udp:bar.txt" +urlBytes5 :: Bytes+urlBytes5 = fromAsciiString "http://example.com/resource?foo=bar"++urlBytes6 :: Bytes+urlBytes6 = fromAsciiString "example.com/resource?foo=bar"++urlBytes7 :: Bytes+urlBytes7 = fromAsciiString "example.com:8888/"
url-bytes.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: url-bytes-version: 0.1.0.0+version: 0.1.1.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@@ -25,8 +25,8 @@ 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+ , bytesmith >=0.3.7 && <0.4+ , template-haskell >=2.14.0.0 && <2.20.0.0 hs-source-dirs: src default-language: Haskell2010 @@ -56,13 +56,13 @@ build-depends: base , byteslice- , gauge- , primitive- , url-bytes- , uri-bytestring , bytestring , deepseq+ , dormouse-uri , primitive+ , tasty-bench+ , uri-bytestring+ , url-bytes , weigh ghc-options: -Wall -O2 default-language: Haskell2010