attoparsec-uri 0.0.8.1 → 0.0.9

raw patch · 5 files changed

+66/−47 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• attoparsec-uri.cabal +2/−2
• src/Data/URI.hs +60/−38
• src/Data/URI/Auth.hs +1/−3
• src/Data/URI/Auth/Host.hs +0/−1
• test/Spec.hs +3/−3

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 07ffc6b69a931d7889f054fc0d6e305812310b32cd8122bd4190144bbced0dc0+-- hash: bdaa2e48589f1806d65a49d9fa241e83bc84e827bbe422e7f29f7a99f822fdee  name:           attoparsec-uri-version:        0.0.8.1+version:        0.0.9 synopsis:       URI parser / printer using attoparsec description:    Please see the README on GitHub at <https://github.com/athanclark/attoparsec-uri#readme> category:       Web

@@ -1,57 +1,72 @@-{-# LANGUAGE-    OverloadedStrings-  , RecordWildCards-  , DeriveGeneric-  , DeriveDataTypeable-  #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RecordWildCards    #-}  module Data.URI where -import Data.URI.Auth (URIAuth, parseURIAuth, printURIAuth)+import           Data.URI.Auth             (URIAuth (uriAuthPassword),+                                            parseURIAuth, printURIAuth) -import Prelude hiding (Maybe (..), takeWhile, maybe)-import qualified Prelude as P-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.Char (isControl, isSpace)-import Control.Monad (void, when)-import Control.Applicative ((<|>), optional)+import           Control.Applicative       (optional, (<|>))+import           Control.Monad             (void, when)+import           Data.Attoparsec.Text      (Parser, char, sepBy, string,+                                            takeWhile, takeWhile1, (<?>))+import           Data.Char                 (isControl, isSpace)+import           Data.Strict.Maybe         (Maybe (..), isJust, 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           Prelude                   hiding (Maybe (..), maybe, takeWhile)+import qualified Prelude                   as P -import Data.Data (Typeable)-import GHC.Generics (Generic)-import Test.QuickCheck (Arbitrary (..))-import Test.QuickCheck.Gen (oneof, listOf, listOf1, elements)-import Test.QuickCheck.Instances ()+import           Data.Data                 (Typeable)+import           GHC.Generics              (Generic)+import           Test.QuickCheck           (Arbitrary (..))+import           Test.QuickCheck.Gen       (elements, listOf, listOf1, oneof)+import           Test.QuickCheck.Instances ()  +data DirOrFile = Dir | File+  deriving (Show, Eq, Typeable, Generic)++instance Arbitrary DirOrFile where+  arbitrary = oneof [pure Dir, pure File]+ data URI = URI   { uriScheme    :: !(Maybe Text) -- ^ the scheme without the colon - @https://hackage.haskell.org/@ has a scheme of @https@   , uriSlashes   :: !Bool -- ^ are the slashes present? - @https://hackage.haskell.org/@ is @True@   , uriAuthority :: !URIAuth-  , uriPath      :: !(Maybe (Vector Text)) -- ^ slash-separated list - @https://hackage.haskell.org/foo@ is @["foo"]@+  , uriPath      :: !(Maybe (Vector Text, DirOrFile)) -- ^ slash-separated list - @https://hackage.haskell.org/foo@ is @["foo"]@, second value is if the path has a trailing slash   , uriQuery     :: !(Vector (Pair Text (Maybe Text))) -- ^ list of key-value pairs - @https://hackage.haskell.org/?foo=bar&baz&qux=@ is                                                        -- @[("foo", Just "bar"), ("baz", Nothing), ("qux", Just "")]@   , uriFragment  :: !(Maybe Text) -- ^ uri suffix - @https://hackage.haskell.org/#some-header@ is @Just "some-header"@   } deriving (Show, Eq, Typeable, Generic)  instance Arbitrary URI where-  arbitrary = URI <$> arbitraryScheme-                  <*> arbitrary-                  <*> arbitrary-                  <*> arbitraryPath-                  <*> arbitraryQuery-                  <*> arbitraryScheme+  arbitrary = do+    auth <- arbitrary+    scheme <- if isJust (uriAuthPassword auth)+      then Just <$> arbitraryNonEmptyText+      else arbitraryScheme+    slashes <- arbitrary+    path <- arbitraryPath+    query <- arbitraryQuery+    fragment <- arbitraryScheme+    pure $ URI scheme slashes auth path query fragment     where       arbitraryScheme = oneof [pure Nothing, Just <$> arbitraryNonEmptyText]       arbitraryNonEmptyText = T.pack <$> listOf1 (elements ['a' .. 'z'])       arbitraryPath =-        oneof [pure Nothing, Just . V.fromList <$> listOf1 arbitraryNonEmptyText]+        oneof+          [ pure Nothing+          , do+              xs <- V.fromList <$> listOf1 arbitraryNonEmptyText+              y <- arbitrary+              pure $ Just (xs, y)+          ]       arbitraryQuery =         V.fromList <$> listOf go         where@@ -68,7 +83,7 @@   <> (if uriSlashes then "//" else "")   <> printURIAuth uriAuthority   <> ( case uriPath of-         Just xs -> "/" <> T.intercalate "/" (V.toList xs)+         Just (xs, f) -> "/" <> T.intercalate "/" (V.toList xs) <> (if f == Dir && not (null xs) then "/" else "")          Nothing -> ""      )   <> ( if null uriQuery@@ -86,7 +101,7 @@       )   <> case uriFragment of         Nothing -> ""-        Just f -> "#" <> f+        Just f  -> "#" <> f   @@ -111,11 +126,18 @@       case mS of         P.Nothing -> pure False         P.Just _  -> pure True-    parsePath :: Parser (Maybe (Vector Text))+    parsePath :: Parser (Maybe (Vector Text, DirOrFile))     parsePath =       let withRoot = do             void (char '/') <?> "root"-            (Just . V.fromList <$> parseChunkWithout ['/', '?', '=', '&', '#'] `sepBy` char '/') <?> "path"+            (+              do+                xs <- V.fromList <$> parseChunkWithout ['/', '?', '=', '&', '#'] `sepBy` char '/'+                pure . Just $+                  if not (null xs) && V.last xs == ""+                  then (V.init xs, Dir)+                  else (xs, File)+              ) <?> "path"           withoutRoot = pure Nothing <?> "empty path"       in  withRoot <|> withoutRoot     parseQuery :: Parser (Vector (Pair Text (Maybe Text)))@@ -138,5 +160,5 @@     parseChunkWithout xs =       takeWhile (\c -> not (isControl c || isSpace c) && c `notElem` xs) -    toStrictMaybe P.Nothing = Nothing+    toStrictMaybe P.Nothing  = Nothing     toStrictMaybe (P.Just x) = Just x

@@ -15,9 +15,7 @@ import Data.Text (Text) import Data.Word (Word16) import qualified Data.Text as T-import Data.Attoparsec.Text ( Parser, char, decimal, takeWhile1, (<?>)-                            , satisfy, peekChar')-import Data.Monoid ((<>))+import Data.Attoparsec.Text ( Parser, char, decimal, takeWhile1, (<?>)) import Control.Monad (void) import Control.Applicative (optional) 

@@ -14,7 +14,6 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Attoparsec.Text (Parser, char, sepBy1, takeWhile1, (<?>))-import Data.Monoid ((<>)) import Control.Monad (void) import Control.Applicative ((<|>)) import Net.Types (IPv4, IPv6)

@@ -16,7 +16,7 @@ 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)   ]  @@ -26,7 +26,7 @@       run q = case q of         Fail leftover es e ->           let go = unsafePerformIO $ do-                putStr "Original value: "+                putStr "\nOriginal value: "                 print x                 putStr "Printed Text: "                 putStrLn $ T.unpack $ print' x@@ -42,7 +42,7 @@           | y == x -> succeeded           | otherwise ->             let go = unsafePerformIO $ do-                  putStr "Original value: "+                  putStr "\nOriginal value: "                   print x                   putStr "Printed Text: "                   putStrLn $ T.unpack $ print' x