attoparsec-uri 0.0.3 → 0.0.4

raw patch · 4 files changed

+49/−45 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• attoparsec-uri.cabal +1/−1
• src/Data/URI.hs +29/−24
• src/Data/URI/Auth.hs +9/−10
• src/Data/URI/Auth/Host.hs +10/−10

@@ -1,5 +1,5 @@ name:                attoparsec-uri-version:             0.0.3+version:             0.0.4 synopsis:            URI parser / printer using attoparsec -- description: homepage:            https://github.com/athanclark/attoparsec-uri#readme

@@ -3,23 +3,22 @@   , RecordWildCards   , DeriveGeneric   , DeriveDataTypeable-  , StandaloneDeriving   #-}  module Data.URI where -import Data.URI.Auth (URIAuth, parseURIAuth)+import Data.URI.Auth (URIAuth, parseURIAuth, printURIAuth) -import Prelude hiding (Maybe (..), takeWhile)+import Prelude hiding (Maybe (..), takeWhile, maybe) import qualified Prelude as P-import Data.Strict.Maybe (Maybe (..), fromMaybe)+import Data.Strict.Maybe (Maybe (..), maybe) import Data.Strict.Tuple (Pair (..)) import Data.Text (Text) import qualified Data.Text as T import Data.Vector (Vector) import qualified Data.Vector as V+import Data.Monoid ((<>)) import Data.Attoparsec.Text (Parser, char, string, sepBy, takeWhile, takeWhile1)-import Data.List (intercalate) import Data.Char (isControl, isSpace) import Control.Monad (void) import Control.Applicative ((<|>), optional)@@ -39,21 +38,28 @@   } deriving (Eq, Typeable, Generic)  -instance Show URI where-  show URI{..} =-       fromMaybe "" ((\s -> T.unpack s ++ ":") <$> uriScheme)-    ++ (if uriSlashes then "//" else "")-    ++ show uriAuthority-    ++ "/" ++ intercalate "/" (V.toList $ T.unpack <$> uriPath)-    ++ ( if null uriQuery-           then ""-           else "?" ++ intercalate "&" (V.toList $ (\(k :!: mV) -> T.unpack k ++ ( case mV of-                                                                                     Nothing -> ""-                                                                                     Just v  -> "=" ++ T.unpack v)) <$> uriQuery)-       )-    ++ case uriFragment of-         Nothing -> ""-         Just f -> "#" ++ T.unpack f+printURI :: URI -> Text+printURI URI{..} =+     maybe "" (<> ":") uriScheme+  <> (if uriSlashes then "//" else "")+  <> printURIAuth uriAuthority+  <> "/" <> T.intercalate "/" (V.toList uriPath)+  <> ( if null uriQuery+          then ""+          else "?"+            <> T.intercalate "&"+                ( V.toList $+                  (\(k :!: mV) ->+                    let v' = case mV of+                              Nothing -> ""+                              Just v  -> "=" <> v+                    in  k <> v'+                  ) <$> uriQuery+                )+      )+  <> case uriFragment of+        Nothing -> ""+        Just f -> "#" <> f   @@ -67,7 +73,7 @@       <*> (toStrictMaybe <$> optional parseFragment)   where     parseScheme = do-      sch <- takeWhile1 (\c -> all (c /=) [':','/','@','.'])+      sch <- takeWhile1 (\c -> c `notElem` [':','/','@','.'])       _ <- char ':'       pure sch     parseSlashes = do@@ -86,8 +92,7 @@                   k <- parseChunkWithout ['=','&','#']                   mV <- ( Just <$> do void $ char '='                                       parseChunkWithout ['&','#']-                        ) <|> ( pure Nothing-                              )+                        ) <|> pure Nothing                   pure (k :!: mV)             qs <- parse1 `sepBy` char '&'             pure $ V.fromList qs@@ -97,7 +102,7 @@       parseChunkWithout []     parseChunkWithout :: [Char] -> Parser Text     parseChunkWithout xs =-      takeWhile (\c -> not (isControl c || isSpace c) && all (c /=) xs)+      takeWhile (\c -> not (isControl c || isSpace c) && c `notElem` xs)      toStrictMaybe P.Nothing = Nothing     toStrictMaybe (P.Just x) = Just x

@@ -3,16 +3,15 @@   , OverloadedStrings   , DeriveGeneric   , DeriveDataTypeable-  , StandaloneDeriving   #-}  module Data.URI.Auth where -import Data.URI.Auth.Host (URIAuthHost, parseURIAuthHost)+import Data.URI.Auth.Host (URIAuthHost, parseURIAuthHost, printURIAuthHost) -import Prelude hiding (Maybe (..))+import Prelude hiding (Maybe (..), maybe) import qualified Prelude as P-import Data.Strict.Maybe (Maybe (..), fromMaybe)+import Data.Strict.Maybe (Maybe (..), maybe) import Data.Text (Text) import Data.Word (Word16) import qualified Data.Text as T@@ -31,11 +30,11 @@   , uriAuthPort :: !(Maybe Word16) -- ^ the port, if it exists - @foobar.com:3000@ is @3000@ as a 16-bit unsigned int.   } deriving (Eq, Typeable, Generic) -instance Show URIAuth where-  show URIAuth{..} =-       fromMaybe "" ((\u -> T.unpack $ u <> "@") <$> uriAuthUser)-    ++ show uriAuthHost-    ++ fromMaybe "" ((\p -> ":" ++ show p) <$> uriAuthPort)+printURIAuth :: URIAuth -> Text+printURIAuth URIAuth{..} =+     maybe "" (<> "@") uriAuthUser+  <> printURIAuthHost uriAuthHost+  <> maybe "" (\p -> ":" <> T.pack (show p)) uriAuthPort   parseURIAuth :: Parser URIAuth@@ -45,7 +44,7 @@           <*> (toStrictMaybe <$> optional parsePort)   where     parseUser = do-      u <- takeWhile1 (\c -> all (c /=) ['@','.',':','/','?','&','='])+      u <- takeWhile1 (\c -> c `notElem` ['@','.',':','/','?','&','='])       mC <- peekChar       case mC of         P.Nothing -> fail "no user @ thing"

@@ -11,11 +11,10 @@  import Data.Vector (Vector) import qualified Data.Vector as V-import Data.Text (Text, unpack)+import Data.Text (Text) import qualified Data.Text as T import Data.Attoparsec.Text (Parser, char, sepBy1, takeWhile1) import Data.Attoparsec.IP (ipv4, ipv6)-import Data.List (intercalate) import Control.Applicative ((<|>)) import Net.Types (IPv4, IPv6) import qualified Net.IPv4 as IPv4@@ -37,11 +36,12 @@       , uriAuthHostSuffix :: !Text       } deriving (Eq, Typeable, Generic) -instance Show URIAuthHost where-  show (IPv4 l4) = unpack (IPv4.encode l4)-  show (IPv6 r6) = unpack (IPv6.encode r6)-  show Localhost = "localhost"-  show (Host ns c) = intercalate "." $ V.toList $ T.unpack <$> ns `V.snoc` c+printURIAuthHost :: URIAuthHost -> Text+printURIAuthHost x = case x of+  IPv4 l4 -> IPv4.encode l4+  IPv6 r6 -> IPv6.encode r6+  Localhost -> "localhost"+  Host ns c -> T.intercalate "." (V.toList (ns `V.snoc` c))   parseURIAuthHost :: Parser URIAuthHost@@ -52,7 +52,7 @@   where     parseHost :: Parser URIAuthHost     parseHost = do-      xss@(x:xs) <- takeWhile1 (\c -> all (c /=) ['.',':','/','?']) `sepBy1` char '.'+      xss@(x:xs) <- takeWhile1 (\c -> c `notElem` ['.',':','/','?']) `sepBy1` char '.'       if null xs         then if x == "localhost"              then pure Localhost@@ -60,8 +60,8 @@         else let xss' :: Vector Text                  xss' = V.fromList xss                  unsnoc :: Vector a -> (Vector a, a)-                 unsnoc x =-                   let (fs,l) = V.splitAt (V.length x - 1) x+                 unsnoc x' =+                   let (fs,l) = V.splitAt (V.length x' - 1) x'                    in  (fs, l V.! 0)                  (ns,c) = unsnoc xss'              in  pure (Host ns c)