attoparsec-uri 0.0.7 → 0.0.8

raw patch · 4 files changed

+84/−64 lines, 4 filesdep −attoparsec-ipPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: attoparsec-ip

API changes (from Hackage documentation)

Files

• attoparsec-uri.cabal +5/−7
• src/Data/URI/Auth.hs +37/−25
• src/Data/URI/Auth/Host.hs +9/−9
• test/Spec.hs +33/−23

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.21.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack ----- hash: 4c6880fda99def0e3d086d09406f42a8fc03255b7dd64eb76559e6a62a49060f+-- hash: 9bf89fab31c2f7b67626edd4597a5dda854b4ba4bcc22c5859344879322502dd  name:           attoparsec-uri-version:        0.0.7+version:        0.0.8 synopsis:       URI parser / printer using attoparsec description:    Please see the README on GitHub at <https://github.com/githubuser/purescript-iso#readme> category:       Web@@ -17,8 +19,6 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10- extra-source-files:     README.md @@ -39,7 +39,6 @@   build-depends:       QuickCheck     , attoparsec-    , attoparsec-ip >=0.0.3     , base >=4.11 && <5     , bytedump     , ip >=1.4.0@@ -60,7 +59,6 @@   build-depends:       QuickCheck     , attoparsec-    , attoparsec-ip >=0.0.3     , attoparsec-uri     , base >=4.11 && <5     , bytedump

@@ -12,11 +12,11 @@ import Prelude hiding (Maybe (..), maybe) import qualified Prelude as P import Data.Strict.Maybe (Maybe (..), maybe)-import Data.Strict.Tuple (Pair (..)) import Data.Text (Text) import Data.Word (Word16) import qualified Data.Text as T-import Data.Attoparsec.Text (Parser, char, decimal, takeWhile1, (<?>))+import Data.Attoparsec.Text ( Parser, char, decimal, takeWhile1, (<?>)+                            , satisfy, peekChar') import Data.Monoid ((<>)) import Control.Monad (void) import Control.Applicative (optional)@@ -28,46 +28,58 @@   data URIAuth = URIAuth-  { uriAuthUser :: !(Maybe (Pair Text (Maybe Text))) -- ^ a designated user - @ssh://git:foo\@github.com@ is @Just ("git" :!: Just "foo")@-  , uriAuthHost :: !URIAuthHost-  , uriAuthPort :: !(Maybe Word16) -- ^ the port, if it exists - @foobar.com:3000@ is @3000@ as a 16-bit unsigned int.+  { uriAuthUser     :: !(Maybe Text) -- ^ a designated user - @ssh://git\@github.com@ is @git@+  , uriAuthPassword :: !(Maybe Text) -- ^ a designated password (this field is depricated in RFC 3986, passwords with an at-character will not parse) - @https://user:password\@github.com@ is @password@+  , uriAuthHost     :: !URIAuthHost+  , uriAuthPort     :: !(Maybe Word16) -- ^ the port, if it exists - @foobar.com:3000@ is @3000@ as a 16-bit unsigned int.   } deriving (Show, Eq, Typeable, Generic)  instance Arbitrary URIAuth where-  arbitrary = URIAuth <$> arbitraryUser <*> arbitrary <*> arbitraryPort+  arbitrary = do+    mUser <- arbitraryUser+    mPassword <- if mUser == Nothing then pure Nothing else Just <$> arbitraryNonEmptyText+    host <- arbitrary+    mPort <- arbitraryPort+    pure (URIAuth mUser mPassword host mPort)     where-      arbitraryUser = oneof-        [ pure Nothing-        , do u <- arbitraryNonEmptyText-             mp <- oneof [pure Nothing] -- , Just <$> arbitraryNonEmptyText]-             pure $ Just $ u :!: mp-        ]+      arbitraryUser = oneof [pure Nothing, Just <$> arbitraryNonEmptyText]       arbitraryPort = oneof [pure Nothing, Just <$> arbitrary]       arbitraryNonEmptyText = T.pack <$> listOf1 (elements ['a' .. 'z'])  +-- | Prints the URI auth but omits the password even if present. printURIAuth :: URIAuth -> Text printURIAuth URIAuth{..} =-     maybe "" (\(u :!: mp) -> u <> maybe "" (":" <>) mp <> "@") uriAuthUser+     ( case uriAuthPassword of+         Nothing -> maybe "" (<> "@") uriAuthUser+         Just p -> maybe ":" (<> ":") uriAuthUser <> p <> "@"+     )   <> printURIAuthHost uriAuthHost   <> maybe "" (\p -> ":" <> T.pack (show p)) uriAuthPort   parseURIAuth :: Parser URIAuth-parseURIAuth =-  URIAuth <$> (toStrictMaybe <$> optional parseUser)-          <*> parseURIAuthHost+parseURIAuth = do+  let withPassword = do+        void (char ':')+        parsePassword+      hasUsernameOrPassword = do+        u <- Just <$> parseUser+        p <- toStrictMaybe <$> optional withPassword+        void (char '@')+        pure (u,p)+  (u,p) <- do+    mUP <- optional hasUsernameOrPassword+    case mUP of+      P.Nothing -> pure (Nothing, Nothing)+      P.Just xs -> pure xs+  URIAuth u+          p+          <$> parseURIAuthHost           <*> (toStrictMaybe <$> optional parsePort)   where-    parseUser = do-      u <- takeWhile1 (\c -> c `notElem` ['@','.',':','/','?','&','=']) <?> "user value"-      p <--        let withPass = do-              _ <- char ':'-              takeWhile1 (\c -> c `notElem` ['@','.',':','/','?','&','=']) <?> "password value"-        in  toStrictMaybe <$> optional withPass-      void (char '@') <?> "user @"-      pure (u :!: p)+    parseUser = takeWhile1 (\c -> c `notElem` ['@','.',':','/','?','&','=','[']) <?> "user value"+    parsePassword = takeWhile1 (\c -> c `notElem` ['@','.',':','/','?','&','=','[']) <?> "password value"     parsePort = do       void (char ':') <?> "port delimiter"       decimal

@@ -14,11 +14,11 @@ 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.Monoid ((<>)) import Control.Monad (void) import Control.Applicative ((<|>)) import Net.Types (IPv4, IPv6)+import qualified Net.Types as NetTypes import qualified Net.IPv4 as IPv4 import qualified Net.IPv6 as IPv6 @@ -54,11 +54,9 @@     where       arbitraryNonEmptyText = T.pack <$> listOf1 (elements ['a' .. 'z'])       arbitraryNonEmptyVector x = V.fromList <$> listOf1 x-      arbitraryIPv4 =-        IPv4.ipv4 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary-      arbitraryIPv6 =-        IPv6.ipv6 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary-                  <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+      arbitraryIPv4 = NetTypes.IPv4 <$> arbitrary+      arbitraryIPv6 = IPv6.ipv6 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+        <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary  printURIAuthHost :: URIAuthHost -> Text printURIAuthHost x = case x of@@ -71,18 +69,20 @@  parseURIAuthHost :: Parser URIAuthHost parseURIAuthHost =-      (IPv4 <$> ipv4)+      (IPv4 <$> IPv4.parser)   <|> (IPv6 <$> ipv6')   <|> parseHost   where     ipv6' = do       void (char '[') <?> "init ipv6"-      x <- ipv6+      x <- IPv6.parser       void (char ']') <?> "end ipv6"       pure x     parseHost :: Parser URIAuthHost     parseHost = do-      xss@(x:xs) <- (takeWhile1 (\c -> c `notElem` ['.',':','/','?','#']) `sepBy1` char '.') <?> "host chunks"+      let hostChunk = takeWhile1 (\c -> c `notElem` ['.',':','/','?','#']) <?> "host chunk"+          hostChunks = hostChunk `sepBy1` char '.' <?> "host chunks"+      xss@(x:xs) <- hostChunks       if null xs         then case () of                _ | x == "localhost" -> pure Localhost

@@ -4,7 +4,7 @@  import Data.Text (Text) import qualified Data.Text as T-import Data.Attoparsec.Text (Parser, parseOnly)+import Data.Attoparsec.Text (Parser, parse, IResult (..), endOfInput) import Test.Tasty (testGroup, defaultMain) import qualified Test.Tasty.QuickCheck as Q import Test.QuickCheck.Property (Result, succeeded, failed)@@ -16,29 +16,39 @@ main = defaultMain $ testGroup "URI tests"   [ Q.testProperty "URIAuthHost" (parsePrintIso printURIAuthHost parseURIAuthHost)   , Q.testProperty "URIAuth" (parsePrintIso printURIAuth parseURIAuth)-  , Q.testProperty "URI" (parsePrintIso printURI parseURI)+  -- , Q.testProperty "URI" (parsePrintIso printURI parseURI)   ]   parsePrintIso :: Eq a => Show a => (a -> Text) -> Parser a -> a -> Result-parsePrintIso print' parser x = case parseOnly parser (print' x) of-  Left e ->-    let go = unsafePerformIO $ do-          putStr "Original value: "-          print x-          putStr "Printed Text: "-          putStrLn $ T.unpack $ print' x-          putStr "Parse Error: "-          print e-    in  seq go failed-  Right y-    | y == x -> succeeded-    | otherwise ->-      let go = unsafePerformIO $ do-            putStr "Original value: "-            print x-            putStr "Printed Text: "-            putStrLn $ T.unpack $ print' x-            putStr "Parsed Value: "-            print y-      in  seq go failed+parsePrintIso print' parser x =+  let value = parse (parser <* endOfInput) (print' x)+      run q = case q of+        Fail leftover es e ->+          let go = unsafePerformIO $ do+                putStr "Original value: "+                print x+                putStr "Printed Text: "+                putStrLn $ T.unpack $ print' x+                putStr "Parse Error: "+                print e+                putStr "Parse Error Stack: "+                print es+                putStr "Leftover text: "+                putStrLn $ T.unpack leftover+          in  seq go failed+        Partial f -> run (f T.empty)+        Done leftover y+          | y == x -> succeeded+          | otherwise ->+            let go = unsafePerformIO $ do+                  putStr "Original value: "+                  print x+                  putStr "Printed Text: "+                  putStrLn $ T.unpack $ print' x+                  putStr "Parsed Value: "+                  print y+                  putStr "Leftover text: "+                  putStrLn $ T.unpack leftover+            in  seq go failed+  in  run value