URLb (empty) → 0.0.0
raw patch · 4 files changed
+292/−0 lines, 4 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, containers
Files
- LICENSE +28/−0
- Network/URLb.hs +232/−0
- Setup.hs +4/−0
- URLb.cabal +28/−0
+ LICENSE view
@@ -0,0 +1,28 @@++ ©2012 Jason Dusek.++ Redistribution and use in source and binary forms, with or without+ modification, are permitted provided that the following conditions are met:++ . Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++ . Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++ . Names of the contributors to this software may not be used to endorse or+ promote products derived from this software without specific prior written+ permission.++ This software is provided by the contributors "as is" and any express or+ implied warranties, including, but not limited to, the implied warranties of+ merchantability and fitness for a particular purpose are disclaimed. In no+ event shall the contributors be liable for any direct, indirect, incidental,+ special, exemplary, or consequential damages (including, but not limited to,+ procurement of substitute goods or services; loss of use, data, or profits;+ or business interruption) however caused and on any theory of liability,+ whether in contract, strict liability, or tort (including negligence or+ otherwise) arising in any way out of the use of this software, even if+ advised of the possibility of such damage.+
+ Network/URLb.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE OverloadedStrings+ , RecordWildCards #-}+-- | URL parser, following RFC 3986 (<http://tools.ietf.org/html/rfc3986>).+module Network.URLb where++import Control.Applicative+import Control.Monad+import Data.Bits+import Data.ByteString.Char8 (groupBy, pack)+import Data.ByteString hiding (groupBy, pack, take, takeWhile)+import Data.Either+import Data.Maybe+import Data.Monoid+import Data.String+import Data.Word+import Prelude hiding (concatMap, drop, null, take, takeWhile)++import Data.Attoparsec.ByteString+import Data.Attoparsec.ByteString.Char8 (hexadecimal, decimal, char)+++-- | URL \"...refers to the subset of URIs that, in addition to identifying a+-- resource, provide a means of locating the resource by describing its+-- primary access mechanism\".+--+-- A breakdown of URLs, per the diagram from RFC 3986:+--+-- > foo://example.com:8042/over/there?name=ferret#nose+-- > \_/ \______________/\_________/ \_________/ \__/+-- > | | | | |+-- > scheme authority path query fragment+-- > | _____________________|__+-- > / \ / \+-- > urn:example:animal:ferret:nose+--+-- For the most part, URL parts are made of strings with percent encoding+-- required of certain characters. The scheme is especially limited in the+-- allowable data:+--+-- > scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )+--+-- Note well that no percent encoding is allowed.+--+-- The authority section, nominally denoting @userinfo\@host:port@, is in+-- fact quite flexible, allowing percent encoding for the hostname and+-- userinfo section; only the port has a byte range restriction, to digits.+--+-- Since this datatype represents the /data/ in a URL and not its particular+-- encoded form, we use 'ByteString' liberally.+data URL = URL { scheme :: Scheme+ , authority :: Maybe Authority+ , path :: ByteString+ , query :: ByteString+ , fragment :: ByteString }+ deriving (Eq, Ord, Show)+instance IsString URL where fromString = fromRight . fromString'+instance Parse URL where parser = url <$> (parser <* string "://")+ <*> authorityPath+ <*> option "" (char '?' *> qf)+ <*> option "" (char '#' *> qf)+ where url a (b, c) d e = URL a b c d e+ qf = option "" queryFragmentP+instance Encode URL where+ encode URL{..} = mconcat+ [ encode scheme, "://"+ , maybe "" encode authority+ , "/" `concatNonEmpty` pathEncode path+ , "?" `concatNonEmpty` selectiveEncode queryFragmentOctet query+ , "#" `concatNonEmpty` selectiveEncode queryFragmentOctet fragment ]++-- | \"Many URI schemes include a hierarchical element for a naming authority+-- so that governance of the name space defined by the remainder of the URI+-- is delegated to that authority...\"+-- > authority = [ userinfo "@" ] host [ ":" port ]+-- > userinfo = *( unreserved / pct-encoded / sub-delims / ":" )+-- > host = IP-literal / IPv4address / reg-name+-- > reg-name = *( unreserved / pct-encoded / sub-delims )+-- The @reg-name@ production overlaps with the IP-based ones; and in fact+-- allows host to contain all bytes.+data Authority = Authority { userinfo :: ByteString+ , host :: ByteString+ , port :: Maybe Word16 }+ deriving (Eq, Ord, Show)+instance IsString Authority where fromString = fromRight . fromString'+instance Parse Authority where parser = Authority+ <$> option "" (userinfoP <* char '@')+ <*> regNameP+ <*> optional (char ':' *> decimal)+instance Encode Authority where+ encode Authority{..} = mconcat+ [ selectiveEncode userinfoOctet userinfo `concatNonEmpty` "@"+ , selectiveEncode regNameOctet host+ , maybe "" (mappend ":" . pack . show) port ]++-- | \"Each URI begins with a scheme name that refers to a specification for+-- assigning identifiers within that scheme. As such, the URI syntax is a+-- federated and extensible naming system wherein each scheme's+-- specification may further restrict the syntax and semantics of+-- identifiers using that scheme.\"+-- > scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )+newtype Scheme = Scheme ByteString deriving (Eq, Ord, Show)+instance IsString Scheme where fromString = fromRight . fromString'+instance Encode Scheme where encode (Scheme b) = b+instance Parse Scheme where parser = (Scheme .) . cons+ <$> satisfy (inClass "a-zA-Z")+ <*> takeWhile (inClass "a-zA-Z0-9.+-")++-- | Class for encoding items from this module as URLs.+class Encode t where encode :: t -> ByteString+-- | Class for parsing URL-related datatypes.+class Parse t where parser :: Parser t+++-- | > *( unreserved / pct-encoded / sub-delims / ":" )+userinfoOctet :: Word8 -> Bool+userinfoOctet = inClass "-a-zA-Z0-9._~!$&'()*+,;=:"++userinfoP :: Parser ByteString+userinfoP = withPercents userinfoOctet++-- | > *( unreserved / pct-encoded / sub-delims )+regNameOctet :: Word8 -> Bool+regNameOctet = inClass "-a-zA-Z0-9._~!$&'()*+,;="++regNameP :: Parser ByteString+regNameP = withPercents regNameOctet++percent :: Parser Word8+percent = char '%' *> usingOnly 2 hexadecimal++-- | Paths are quite sophisticated, with 5 productions to handle the different+-- URI contexts in which they appear. However, for the purpose of URL+-- parsing, we can assume that paths are always separated from the authority+-- (even the empty authority) with a @/@ and thus can work with a relatively+-- simple subset of the productions in the RFC.+--+-- > path-rootless = segment-nz *( "/" segment )+-- >+-- > ...+-- >+-- > segment-nz = 1*pchar+-- >+-- > ...+-- >+-- > pchar = unreserved / pct-encoded / sub-delims / ":" / "@"+--+-- Although literal slash runs are not permitted by the RFC, equivalent+-- content can be encoded with percent encoding.+pathRootlessP :: Parser ByteString+pathRootlessP = mappend <$> segment <*> option "" next+ where segment = withPercents segmentOctet+ next = char '/' *> (mappend "/" <$> pathRootlessP)++-- > unreserved / pct-encoded / sub-delims / ":" / "@"+segmentOctet :: Word8 -> Bool+segmentOctet = inClass "-a-zA-Z0-9._~!$&'()*+,;=:@"++-- ^ To parse the authority and path:+--+-- * we parse an authority and then optionally a slash and a path or+--+-- * we parse a single slash and then optionally a path.+authorityPath :: Parser (Maybe Authority, ByteString)+authorityPath = (,) <$> (Just <$> parser) <*> option "" (char '/' *> pathP)+ <|> (,) <$> (char '/' *> pure Nothing) <*> pathP+ where pathP = option "" pathRootlessP++-- | The query and fragment have identical productions in the RFC.+-- > *( pchar / "/" / "?" )+queryFragmentOctet :: Word8 -> Bool+queryFragmentOctet = inClass "-a-zA-Z0-9._~!$&'()*+,;=:@/?"++queryFragmentP :: Parser ByteString+queryFragmentP = withPercents queryFragmentOctet++usingOnly :: Int -> Parser t -> Parser t+usingOnly c p = either (const mzero) return . parseOnly p =<< take c++-- | Parse a bytestream, accepting either literal bytes matching the predicate+-- or any percent encoded characters.+withPercents :: (Word8 -> Bool) -> Parser ByteString+withPercents predicate = cons <$> one <*> (option "" more)+ where more = withPercents predicate+ one = satisfy predicate <|> percent++{-++sub-delims = "!" / "$" / "&" / "'" / "(" / ")" / "*" / "+" / "," / ";" / "="+pct-encoded = "%" HEXDIG HEXDIG+unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"++ -}++-- | Transform any octet to its percent encoded form.+percentEncode :: Word8 -> ByteString+percentEncode w = "%" `snoc` mod' (w `shiftR` 4) `snoc` mod' w+ where mod' w' = "0123456789ABCDEF" `index` fromIntegral (w' `mod` 16)++-- | Percent encode a 'ByteString', ignoring octets that match the predicate.+selectiveEncode :: (Word8 -> Bool) -> ByteString -> ByteString+selectiveEncode predicate bytes = unfoldr f ("", bytes)+ where f (queued, remaining) = dequeue <|> next+ where+ dequeue = do (w, queued') <- uncons queued+ Just (w, (queued', remaining))+ next = do (w, remaining') <- uncons remaining+ if predicate w then Just (w, (queued, remaining'))+ else f (percentEncode w, remaining')++concatNonEmpty a b | null a || null b = ""+ | otherwise = mappend a b++-- | Slash runs are not allowed in encoded paths. Here, this is interpreted to+-- mean that the first slash in path data, which would come after the slash+-- separating the path and the scheme or authority, should be escaped.+pathEncode :: ByteString -> ByteString+pathEncode = mconcat . fmap enc . groupBy neitherSlash+ where+ enc s | "/" == s = "/"+ | isPrefixOf "//" s = "/" `mappend` concatMap percentEncode (drop 1 s)+ | otherwise = selectiveEncode regNameOctet s+ neitherSlash a b = (a /= '/' && b /= '/') || (a == '/' && b == '/')+++fromString' s = parseOnly (parser <* endOfInput) (fromString s)++{-# WARNING fromRight+ "This unsafe function calls error and is only intended for internal use."+ #-}+fromRight (Right x) = x+fromRight (Left s) = error s+
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple++main = defaultMain+
+ URLb.cabal view
@@ -0,0 +1,28 @@+name : URLb+version : 0.0.0+category : Text+license : BSD3+license-file : LICENSE+author : Jason Dusek+maintainer : oss@solidsnack.be+homepage : http://github.com/solidsnack/URLb+synopsis : A liberal, simple URL parser.+description : A liberal, simple URL parser.++cabal-version : >= 1.6+build-type : Simple++source-repository head+ type : git+ location : git://github.com/solidsnack/URLb.git+++library+ build-depends : base >= 2 && <= 5+ , bytestring >= 0.9+ , containers+ , attoparsec >= 0.10.1.1+ exposed-modules : Network.URLb+ extensions : OverloadedStrings+ RecordWildCards+