diff --git a/http-link-header.cabal b/http-link-header.cabal --- a/http-link-header.cabal +++ b/http-link-header.cabal @@ -1,74 +1,91 @@ -name: http-link-header -version: 1.0.3.1 -synopsis: A parser and writer for the HTTP Link header as specified in RFC 5988 "Web Linking". -description: https://github.com/myfreeweb/http-link-header -category: Web -homepage: https://github.com/myfreeweb/http-link-header -author: Greg V -copyright: 2014-2018 Greg V -maintainer: greg@unrelenting.technology -license: PublicDomain -license-file: UNLICENSE -build-type: Simple -cabal-version: >= 1.10 -extra-source-files: - README.md -tested-with: - GHC == 8.4.3 +cabal-version: 1.12 +name: http-link-header +version: 1.1.1 +license: PublicDomain +license-file: UNLICENSE +copyright: 2014-2020 Greg V +maintainer: stevenjshuck@gmail.com +author: Greg V +tested-with: ghc ==8.4.3 ghc ==8.8.3 +homepage: https://github.com/myfreeweb/http-link-header#readme +bug-reports: https://github.com/myfreeweb/http-link-header/issues +synopsis: A parser and writer for the HTTP Link header per RFC 5988 +description: + Please see the README on GitHub at +category: Web +build-type: Simple +extra-source-files: README.md + source-repository head - type: git - location: git://github.com/myfreeweb/http-link-header.git + type: git + location: https://github.com/myfreeweb/http-link-header library - build-depends: - base >= 4.3.0.0 && < 5 - , text - , bytestring - , errors - , network-uri - , http-api-data - , attoparsec - , bytestring-conversion - default-language: Haskell2010 exposed-modules: Network.HTTP.Link - Network.HTTP.Link.Types Network.HTTP.Link.Parser + Network.HTTP.Link.Types Network.HTTP.Link.Writer - ghc-options: -Wall - hs-source-dirs: library -test-suite tests - build-depends: - base >= 4.3.0.0 && < 5 - , text - , http-link-header - , hspec - , QuickCheck - , hspec-attoparsec + hs-source-dirs: library + other-modules: Paths_http_link_header default-language: Haskell2010 - ghc-options: -threaded -Wall - hs-source-dirs: test-suite - main-is: Spec.hs + ghc-options: -Wall + build-depends: + attoparsec >=0.13.2.4 && <0.14, + base >=4.3 && <5, + bytestring >=0.10.10.0 && <0.11, + errors >=2.3.0 && <2.4, + http-api-data >=0.4.1.1 && <0.5, + network-uri >=2.6.3.0 && <2.7, + text >=1.2.4.0 && <1.3 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test-suite other-modules: Network.HTTP.Link.ParserSpec Network.HTTP.Link.WriterSpec Network.HTTP.LinkSpec - type: exitcode-stdio-1.0 + Paths_http_link_header -benchmark benchmarks + default-language: Haskell2010 + ghc-options: -threaded -Wall build-depends: - base >= 4.3.0.0 && < 5 - , text - , http-link-header - , directory - , network-uri - , transformers - , criterion + QuickCheck >=2.13.2 && <2.14, + attoparsec >=0.13.2.4 && <0.14, + base >=4.3 && <5, + bytestring >=0.10.10.0 && <0.11, + errors >=2.3.0 && <2.4, + hspec >=2.7.2 && <2.8, + hspec-attoparsec >=0.1.0.2 && <0.2, + http-api-data >=0.4.1.1 && <0.5, + http-link-header -any, + network-uri >=2.6.3.0 && <2.7, + text >=1.2.4.0 && <1.3 + +benchmark benchmarks + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: benchmark + other-modules: + ParserBench + WriterBench + Paths_http_link_header + default-language: Haskell2010 - hs-source-dirs: benchmark - main-is: Bench.hs - other-modules: ParserBench - WriterBench - type: exitcode-stdio-1.0 + ghc-options: -threaded -Wall + build-depends: + attoparsec >=0.13.2.4 && <0.14, + base >=4.3 && <5, + bytestring >=0.10.10.0 && <0.11, + criterion >=1.5.6.2 && <1.6, + directory >=1.3.6.0 && <1.4, + errors >=2.3.0 && <2.4, + http-api-data >=0.4.1.1 && <0.5, + http-link-header -any, + network-uri >=2.6.3.0 && <2.7, + text >=1.2.4.0 && <1.3, + transformers >=0.5.6.2 && <0.6 diff --git a/library/Network/HTTP/Link.hs b/library/Network/HTTP/Link.hs --- a/library/Network/HTTP/Link.hs +++ b/library/Network/HTTP/Link.hs @@ -8,22 +8,16 @@ , module Network.HTTP.Link.Parser ) where -import Data.ByteString.Conversion import Web.HttpApiData +import Data.Text.Encoding +import safe Network.HTTP.Link.Parser import safe Network.HTTP.Link.Types import safe Network.HTTP.Link.Writer -import safe Network.HTTP.Link.Parser -instance ToByteString [Link] where - builder = builder . writeLinkHeader - -instance ToByteString Link where - builder = builder . writeLink - instance ToHttpApiData [Link] where toUrlPiece = toUrlPiece . writeLinkHeader - toHeader = toByteString' + toHeader = encodeUtf8 . writeLinkHeader instance ToHttpApiData Link where toUrlPiece = toUrlPiece . writeLink - toHeader = toByteString' + toHeader = encodeUtf8 . writeLink diff --git a/library/Network/HTTP/Link/Parser.hs b/library/Network/HTTP/Link/Parser.hs --- a/library/Network/HTTP/Link/Parser.hs +++ b/library/Network/HTTP/Link/Parser.hs @@ -11,6 +11,18 @@ , 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) @@ -71,35 +83,56 @@ v ← paramValue n' return (n', v) -link ∷ Parser Link -link = do +glink ∷ (IsURI uri) ⇒ Parser (GLink uri) +glink = do charWS '<' linkText ← takeWhile1 $ allConditions [(/= '>'), not . isSpace] charWS '>' params ← many' $ param skipSpace - case parseURIReference $ unpack linkText of - Just u → return $ Link u params - Nothing → fail "Couldn't parse the URI" + case uriFromText linkText of + 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 = link `sepBy'` (char ',') +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 + -- | 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' = parseOnly linkHeader +parseLinkHeader' = parseGLinkHeader' -- | Parses a Link header, returns a Maybe. parseLinkHeader ∷ Text → Maybe [Link] -parseLinkHeader = hush . parseLinkHeader' +parseLinkHeader = parseGLinkHeader -- | 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' = parseLinkHeader' . decodeUtf8 +parseLinkHeaderBS' = parseGLinkHeaderBS' -- | Parses a Link header, returns a Maybe. parseLinkHeaderBS ∷ ByteString → Maybe [Link] -parseLinkHeaderBS = parseLinkHeader . decodeUtf8 +parseLinkHeaderBS = parseGLinkHeaderBS diff --git a/library/Network/HTTP/Link/Types.hs b/library/Network/HTTP/Link/Types.hs --- a/library/Network/HTTP/Link/Types.hs +++ b/library/Network/HTTP/Link/Types.hs @@ -10,9 +10,34 @@ data LinkParam = Rel | Anchor | Rev | Hreflang | Media | Title | Title' | ContentType | Other Text deriving (Eq, Show) --- | A single link. -data Link = Link URI [(LinkParam, Text)] - deriving (Eq, Show) +-- | A single link containing some representation of a URL. +-- +-- @since 1.1.0 +data GLink 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: +-- +-- @ +-- instance IsURI Modern.URI where +-- uriFromText = left displayException . mkURI +-- @ +-- +-- @since 1.1.0 +class IsURI uri where + uriFromText ∷ Text → Either String uri + +instance IsURI URI where + uriFromText = maybe (Left "") Right . parseURIReference . unpack + +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 -- | Extracts the URI from the link. href ∷ Link → URI diff --git a/test-suite/Network/HTTP/LinkSpec.hs b/test-suite/Network/HTTP/LinkSpec.hs --- a/test-suite/Network/HTTP/LinkSpec.hs +++ b/test-suite/Network/HTTP/LinkSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings, UnicodeSyntax, CPP #-} +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Network.HTTP.LinkSpec where