packages feed

http-link-header 1.1.1 → 1.2.0

raw patch · 10 files changed

+75/−86 lines, 10 files

Files

benchmark/ParserBench.hs view
@@ -4,9 +4,14 @@  import           Criterion import           Network.HTTP.Link.Parser+import           Network.HTTP.Link.Types (Link)+import           Network.URI (URI)  benchmarks :: [Benchmark] benchmarks = [-    bench "minimal" $ whnf parseLinkHeader "<http://example.com>; rel=\"next\""-  , bench "large" $ whnf parseLinkHeader "\n\t <  http://example.com>; rel=next; title=\"Hello world\",  <ftp://hello.world>; rev=license; someWeirdParam=\"YOLO LOL\", <https://long.ass.domain.name.just.because/lol>; rel=\"something something something http://some.thing/lol/rel\" "+    bench "minimal" $ whnf parseLinkHeaderURI "<http://example.com>; rel=\"next\""+  , bench "large" $ whnf parseLinkHeaderURI "\n\t <  http://example.com>; rel=next; title=\"Hello world\",  <ftp://hello.world>; rev=license; someWeirdParam=\"YOLO LOL\", <https://long.ass.domain.name.just.because/lol>; rel=\"something something something http://some.thing/lol/rel\" "   ]++  where+    parseLinkHeaderURI t = parseLinkHeader t :: Maybe [Link URI]
benchmark/WriterBench.hs view
@@ -4,6 +4,7 @@  import           Criterion import           Data.String              (IsString (..))+import           Data.Text                (Text) import           Network.HTTP.Link.Types import           Network.HTTP.Link.Writer import           Network.URI@@ -15,9 +16,9 @@  benchmarks :: [Benchmark] benchmarks = [-    bench "minimal" $ whnf writeLinkHeader+    bench "minimal" $ whnf writeLinkHeaderURI         [ Link "http://example.com/thing" [ (Rel, "next") ] ]-  , bench "large" $ whnf writeLinkHeader+  , bench "large" $ whnf writeLinkHeaderURI         [ Link "http://example.com/something_long"                [ (Rel, "next prev http://hello.world/undefined")                , (Title, "this is a test benchmark thingy")@@ -26,3 +27,6 @@                [ (Rel, "license")                , (Rev, "author") ]]   ]++  where+    writeLinkHeaderURI = writeLinkHeader :: [Link URI] -> Text
@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               http-link-header-version:            1.1.1+version:            1.2.0 license:            PublicDomain license-file:       UNLICENSE copyright:          2014-2020 Greg V <greg@unrelenting.technology>
library/Network/HTTP/Link.hs view
@@ -1,23 +1,31 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE Trustworthy, FlexibleInstances #-}+{-# LANGUAGE Trustworthy, FlexibleInstances, UnicodeSyntax #-} --- | This module exports all the things at the same time.+-- | This module exports all the things at the same time, plus a utility+-- function. module Network.HTTP.Link (   module Network.HTTP.Link.Types , module Network.HTTP.Link.Writer , module Network.HTTP.Link.Parser+, lnk ) where -import           Web.HttpApiData+import           Control.Error.Util (hush)+import           Data.Text (Text, pack) import           Data.Text.Encoding import safe      Network.HTTP.Link.Parser import safe      Network.HTTP.Link.Types import safe      Network.HTTP.Link.Writer+import           Web.HttpApiData -instance ToHttpApiData [Link] where+instance (IsURI uri) ⇒ ToHttpApiData [Link uri] where   toUrlPiece = toUrlPiece . writeLinkHeader   toHeader = encodeUtf8 . writeLinkHeader -instance ToHttpApiData Link where+instance (IsURI uri) ⇒ ToHttpApiData (Link uri) where   toUrlPiece = toUrlPiece . writeLink   toHeader = encodeUtf8 . writeLink++-- | Construct a Link.+lnk ∷ (IsURI uri) ⇒ String → [(LinkParam, Text)] → Maybe (Link uri)+lnk u r = fmap (\x → Link x r) $ hush $ uriFromText $ pack u
library/Network/HTTP/Link/Parser.hs view
@@ -11,18 +11,6 @@ , parseLinkHeader , parseLinkHeaderBS' , parseLinkHeaderBS-  -- ** Generic links ('GLink')-  ---  -- | These functions are like the ones above, except they represent URLs as-  -- @('IsURI' uri) ⇒ uri@ values rather than concrete 'URI's from the-  -- network-uri package.  Use these if you need access to the raw URLs-  -- (@uri ~ Text@) or some other representation of URLs.-  ---  -- @since 1.1.0-, parseGLinkHeader'-, parseGLinkHeader-, parseGLinkHeaderBS'-, parseGLinkHeaderBS ) where  import           Prelude hiding (takeWhile, take)@@ -83,8 +71,8 @@   v ← paramValue n'   return (n', v) -glink ∷ (IsURI uri) ⇒ Parser (GLink uri)-glink = do+link ∷ (IsURI uri) ⇒ Parser (Link uri)+link = do   charWS '<'   linkText ← takeWhile1 $ allConditions [(/= '>'), not . isSpace]   charWS '>'@@ -94,45 +82,24 @@     Right u → return $ Link u params     Left e → fail $ "Couldn't parse the URI " ++ show linkText ++ if e == "" then "" else ": " ++ e -glinkHeader ∷ (IsURI uri) ⇒ Parser [GLink uri]-glinkHeader = glink `sepBy'` (char ',')- -- | The Attoparsec parser for the Link header.-linkHeader ∷ Parser [Link]-linkHeader = glinkHeader---- | Parses a GLink header, returns an Either, where Left is the Attoparsec--- error string (probably not a useful one).-parseGLinkHeader' ∷ (IsURI uri) ⇒ Text → Either String [GLink uri]-parseGLinkHeader' = parseOnly glinkHeader---- | Parses a GLink header, returns a Maybe.-parseGLinkHeader ∷ (IsURI uri) ⇒ Text → Maybe [GLink uri]-parseGLinkHeader = hush . parseGLinkHeader'---- | Parses a GLink header, returns an Either, where Left is the Attoparsec--- error string (probably not a useful one).-parseGLinkHeaderBS' ∷ (IsURI uri) ⇒ ByteString → Either String [GLink uri]-parseGLinkHeaderBS' = parseGLinkHeader' . decodeUtf8---- | Parses a GLink header, returns a Maybe.-parseGLinkHeaderBS ∷ (IsURI uri) ⇒ ByteString → Maybe [GLink uri]-parseGLinkHeaderBS = parseGLinkHeader . decodeUtf8+linkHeader ∷ (IsURI uri) ⇒ Parser [Link uri]+linkHeader = link `sepBy'` (char ',')  -- | Parses a Link header, returns an Either, where Left is the Attoparsec -- error string (probably not a useful one).-parseLinkHeader' ∷ Text → Either String [Link]-parseLinkHeader' = parseGLinkHeader'+parseLinkHeader' ∷ (IsURI uri) ⇒ Text → Either String [Link uri]+parseLinkHeader' = parseOnly linkHeader  -- | Parses a Link header, returns a Maybe.-parseLinkHeader ∷ Text → Maybe [Link]-parseLinkHeader = parseGLinkHeader+parseLinkHeader ∷ (IsURI uri) ⇒ Text → Maybe [Link uri]+parseLinkHeader = hush . parseLinkHeader'  -- | Parses a Link header, returns an Either, where Left is the Attoparsec -- error string (probably not a useful one).-parseLinkHeaderBS' ∷ ByteString → Either String [Link]-parseLinkHeaderBS' = parseGLinkHeaderBS'+parseLinkHeaderBS' ∷ (IsURI uri) ⇒ ByteString → Either String [Link uri]+parseLinkHeaderBS' = parseLinkHeader' . decodeUtf8  -- | Parses a Link header, returns a Maybe.-parseLinkHeaderBS ∷ ByteString → Maybe [Link]-parseLinkHeaderBS = parseGLinkHeaderBS+parseLinkHeaderBS ∷ (IsURI uri) ⇒ ByteString → Maybe [Link uri]+parseLinkHeaderBS = parseLinkHeader . decodeUtf8
library/Network/HTTP/Link/Types.hs view
@@ -11,41 +11,38 @@   deriving (Eq, Show)  -- | A single link containing some representation of a URL.------ @since 1.1.0-data GLink uri = Link uri [(LinkParam, Text)]+data Link uri = Link uri [(LinkParam, Text)]     deriving (Eq, Show)  -- | Types that can represent URLs. ----- For example, to parse links containing [@Text.URI.URI@ from the @modern-uri@ package](https://hackage.haskell.org/package/modern-uri-0.3.2.0/docs/Text-URI.html#t:URI), simply define:+-- For example, to parse links containing @Text.URI.URI@ from the+-- [modern-uri](https://hackage.haskell.org/package/modern-uri-0.3.2.0/docs/Text-URI.html#t:URI)+-- package, simply define the orphan instance: -- -- @ --    instance IsURI Modern.URI where --        uriFromText = left displayException . mkURI+--        uriToText = render -- @ -- -- @since 1.1.0 class IsURI uri where     uriFromText ∷ Text → Either String uri+    uriToText ∷ uri → Text  instance IsURI URI where     uriFromText = maybe (Left "") Right . parseURIReference . unpack+    uriToText = pack . show  instance IsURI Text where     uriFromText = Right---- | A single link containing a network-uri URI.  Most of this library is--- specialized to this case.-type Link = GLink URI+    uriToText = id  -- | Extracts the URI from the link.-href ∷ Link → URI+href ∷ (IsURI uri) ⇒ Link uri → uri href (Link h _) = h  -- | Extracts the parameters from the link.-linkParams ∷ Link → [(LinkParam, Text)]+linkParams ∷ Link uri → [(LinkParam, Text)] linkParams (Link _ ps) = ps--lnk ∷ String → [(LinkParam, Text)] → Maybe Link-lnk u r = parseURI u >>= return . \x → Link x r
library/Network/HTTP/Link/Writer.hs view
@@ -28,8 +28,8 @@   where escPar = pack . escapeURIString (/= '"') . unpack         -- maybe URI escaping is not what we should do here? eh, whatever -writeLink ∷ Link → Text-writeLink l = mconcat $ ["<", pack . show $ href l, ">"] ++ map writeParam (linkParams l)+writeLink ∷ (IsURI uri) ⇒ Link uri → Text+writeLink (Link u ps) = mconcat $ ["<", uriToText u, ">"] ++ map writeParam ps -writeLinkHeader ∷ [Link] → Text+writeLinkHeader ∷ (IsURI uri) ⇒ [Link uri] → Text writeLinkHeader = intercalate ", " . map writeLink
test-suite/Network/HTTP/Link/ParserSpec.hs view
@@ -6,8 +6,11 @@ import           Test.Hspec.Attoparsec import           Data.Text import           Data.Maybe (fromJust)+import           Network.HTTP.Link (lnk) import           Network.HTTP.Link.Types import           Network.HTTP.Link.Parser+import           Network.URI (URI)+import           Data.Attoparsec.Text (Parser)  spec ∷ Spec spec = do@@ -15,42 +18,45 @@     let l u r = fromJust $ lnk u r      it "parses a single link" $ do-      ("<http://example.com>; rel=\"example\"" ∷ Text) ~> linkHeader+      ("<http://example.com>; rel=\"example\"" ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Rel, "example")] ]      it "parses empty attributes" $ do-      ("<http://example.com>; title=\"\"" ∷ Text) ~> linkHeader+      ("<http://example.com>; title=\"\"" ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Title, "")] ]      it "parses custom attributes" $ do-      ("<http://example.com>; weirdThingy=\"something\"" ∷ Text) ~> linkHeader+      ("<http://example.com>; weirdThingy=\"something\"" ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Other "weirdThingy", "something")] ]      it "parses backslash escaped attributes" $ do-      ("<http://example.com>; title=\"some \\\" thing \\\"\"" ∷ Text) ~> linkHeader+      ("<http://example.com>; title=\"some \\\" thing \\\"\"" ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Title, "some \" thing \"")] ]      it "parses escaped attributes" $ do-      ("<http://example.com>; title=\"some %22 thing %22\"" ∷ Text) ~> linkHeader+      ("<http://example.com>; title=\"some %22 thing %22\"" ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Title, "some \" thing \"")] ]      it "parses multiple attributes" $ do-      ("<http://example.com>; rel=\"example\"; title=\"example dot com\"" ∷ Text) ~> linkHeader+      ("<http://example.com>; rel=\"example\"; title=\"example dot com\"" ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Rel, "example"), (Title, "example dot com")] ]      it "parses custom attributes named similarly to standard ones" $ do       -- this was caught by QuickCheck! <3-      ("<http://example.com>; rel=hello; relAtion=\"something\"; rev=next" ∷ Text) ~> linkHeader+      ("<http://example.com>; rel=hello; relAtion=\"something\"; rev=next" ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Rel, "hello"), (Other "relAtion", "something"), (Rev, "next")] ]      it "parses unquoted rel, rev attributes" $ do-      ("<http://example.com>; rel=next; rev=prev" ∷ Text) ~> linkHeader+      ("<http://example.com>; rel=next; rev=prev" ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Rel, "next"), (Rev, "prev")] ]      it "does not blow up on title*" $ do-      ("<http://example.com>; title*=UTF-8'de'n%c3%a4chstes%20Kapitel" ∷ Text) ~> linkHeader+      ("<http://example.com>; title*=UTF-8'de'n%c3%a4chstes%20Kapitel" ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Title', "UTF-8'de'n%c3%a4chstes%20Kapitel")] ]      it "parses weird whitespace all over the place" $ do-      ("\n\t   < http://example.com\t>;rel=\t\"example\";   \ttitle =\"example dot com\" \n " ∷ Text) ~> linkHeader+      ("\n\t   < http://example.com\t>;rel=\t\"example\";   \ttitle =\"example dot com\" \n " ∷ Text) ~> linkHeaderURI         `shouldParse` [ l "http://example.com" [(Rel, "example"), (Title, "example dot com")] ]++  where+    linkHeaderURI = linkHeader :: Parser [Link URI]
test-suite/Network/HTTP/Link/WriterSpec.hs view
@@ -4,13 +4,15 @@  import           Test.Hspec import           Data.Maybe (fromJust)+import           Network.HTTP.Link (lnk) import           Network.HTTP.Link.Types import           Network.HTTP.Link.Writer+import           Network.URI (URI)  spec ∷ Spec spec = do   describe "writeLinkHeader" $ do-    let l u r = fromJust $ lnk u r+    let l u r = fromJust $ lnk u r :: Link URI      it "writes a single link" $ do       writeLinkHeader [l "http://example.com" [(Rel, "next")]]
test-suite/Network/HTTP/LinkSpec.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE OverloadedStrings, UnicodeSyntax, CPP #-}-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, OverloadedStrings, UnicodeSyntax, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Network.HTTP.LinkSpec where@@ -12,8 +11,9 @@ import qualified Data.Text as T import           Data.Maybe (fromJust) import           Network.HTTP.Link+import           Network.URI (URI) -instance Arbitrary Link where+instance Arbitrary (Link URI) where   arbitrary = do     urlScheme ← elements ["http://", "https://", "ftp://", "git+ssh://"]     urlDomain ← listOf1 $ elements ['a'..'z']@@ -32,4 +32,4 @@ spec = do   describe "writeLinkHeader → parseLinkHeader" $     it "roundtrips successfully" $-      property $ \x → parseLinkHeader (writeLinkHeader x) == Just x+      property $ \x → parseLinkHeader (writeLinkHeader x) == Just (x :: [Link URI])