From 176af661a83760776ae3bf22ec766d3637ed2c74 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 26 Jan 2018 12:46:33 +0000 Subject: [PATCH 01/69] Make Sceheme requred for non-relative URIs --- src/Data/URI/AbsoluteURI.purs | 8 ++-- src/Data/URI/URI.purs | 8 ++-- test/Main.purs | 75 +++++++++++++++++------------------ 3 files changed, 45 insertions(+), 46 deletions(-) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index e58a079..f475453 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -31,7 +31,7 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | An absolute URI. -data AbsoluteURI = AbsoluteURI (Maybe Scheme) HierarchicalPart (Maybe Query) +data AbsoluteURI = AbsoluteURI Scheme HierarchicalPart (Maybe Query) derive instance eqAbsoluteURI ∷ Eq AbsoluteURI derive instance ordAbsoluteURI ∷ Ord AbsoluteURI @@ -43,7 +43,7 @@ parse = runParser parser parser ∷ Parser AbsoluteURI parser = AbsoluteURI - <$> optionMaybe Scheme.parser + <$> Scheme.parser <*> HPart.parser <*> optionMaybe Query.parser <* eof @@ -51,12 +51,12 @@ parser = AbsoluteURI print ∷ AbsoluteURI → String print (AbsoluteURI s h q) = S.joinWith "" $ catMaybes - [ Scheme.print <$> s + [ Just (Scheme.print s) , Just (HPart.print h) , Query.print <$> q ] -_scheme ∷ Lens' AbsoluteURI (Maybe Scheme) +_scheme ∷ Lens' AbsoluteURI Scheme _scheme = lens (\(AbsoluteURI s _ _) → s) diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 7a2ca5c..239455c 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -35,7 +35,7 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A generic URI -data URI = URI (Maybe Scheme) HierarchicalPart (Maybe Query) (Maybe Fragment) +data URI = URI Scheme HierarchicalPart (Maybe Query) (Maybe Fragment) derive instance eqURI ∷ Eq URI derive instance ordURI ∷ Ord URI @@ -47,7 +47,7 @@ parse = runParser parser parser ∷ Parser URI parser = URI - <$> optionMaybe Scheme.parser + <$> Scheme.parser <*> HPart.parser <*> optionMaybe Query.parser <*> optionMaybe Fragment.parser @@ -56,13 +56,13 @@ parser = URI print ∷ URI → String print (URI s h q f) = S.joinWith "" $ catMaybes - [ Scheme.print <$> s + [ Just (Scheme.print s) , Just (HPart.print h) , Query.print <$> q , Fragment.print <$> f ] -_scheme ∷ Lens' URI (Maybe Scheme) +_scheme ∷ Lens' URI Scheme _scheme = lens (\(URI s _ _ _) → s) diff --git a/test/Main.purs b/test/Main.purs index a92e9f0..e59fc80 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -146,7 +146,7 @@ main = runTest $ suite "Data.URI" do "sql2:///?q=foo&var.bar=baz" (Left (URI - (Just (Scheme "sql2")) + (Scheme "sql2") (HierarchicalPart (Just (Authority Nothing [])) (Just (Left rootDir))) @@ -156,7 +156,7 @@ main = runTest $ suite "Data.URI" do "mongodb://localhost" (Left (URI - (Just (Scheme "mongodb")) + (Scheme "mongodb") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "localhost") Nothing)])) Nothing) @@ -166,7 +166,7 @@ main = runTest $ suite "Data.URI" do "https://1a.example.com" (Left (URI - (Just (Scheme "https")) + (Scheme "https") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "1a.example.com") Nothing)])) Nothing) @@ -176,7 +176,7 @@ main = runTest $ suite "Data.URI" do "http://en.wikipedia.org/wiki/URI_scheme" (Left (URI - (Just (Scheme "http")) + (Scheme "http") (HierarchicalPart (Just (Authority Nothing [Tuple (NameAddress "en.wikipedia.org") Nothing])) ((Just (Right ((rootDir dir "wiki") file "URI_scheme"))))) @@ -186,7 +186,7 @@ main = runTest $ suite "Data.URI" do "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" (Left (URI - (Just (Scheme "mongodb")) + (Scheme "mongodb") (HierarchicalPart (Just (Authority @@ -202,7 +202,7 @@ main = runTest $ suite "Data.URI" do "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" (Left (URI - (Just (Scheme "mongodb")) + (Scheme "mongodb") (HierarchicalPart (Just (Authority (Just (UserInfo "foo:bar")) [(Tuple (NameAddress "db1.example.net") (Just (Port 6))),(Tuple (NameAddress "db2.example.net") (Just (Port 2500)))])) (Just (Right (rootDir file "authdb")))) @@ -212,7 +212,7 @@ main = runTest $ suite "Data.URI" do "mongodb://192.168.0.1" (Left (URI - (Just (Scheme "mongodb")) + (Scheme "mongodb") (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv4Address "192.168.0.1") Nothing)])) Nothing) Nothing Nothing)) @@ -220,7 +220,7 @@ main = runTest $ suite "Data.URI" do "mongodb://192.168.0.1,192.168.0.2" (Left (URI - (Just (Scheme "mongodb")) + (Scheme "mongodb") (HierarchicalPart (Just (Authority @@ -235,7 +235,7 @@ main = runTest $ suite "Data.URI" do "mongodb://sysop:moon@localhost" (Left (URI - (Just (Scheme "mongodb")) + (Scheme "mongodb") (HierarchicalPart (Just(Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) Nothing) @@ -245,7 +245,7 @@ main = runTest $ suite "Data.URI" do "mongodb://sysop:moon@localhost/" (Left (URI - (Just (Scheme "mongodb")) + (Scheme "mongodb") (HierarchicalPart (Just (Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) (Just (Left rootDir))) @@ -255,7 +255,7 @@ main = runTest $ suite "Data.URI" do "mongodb://sysop:moon@localhost/records" (Left (URI - (Just (Scheme "mongodb")) + (Scheme "mongodb") (HierarchicalPart (Just (Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) (Just (Right (rootDir file "records")))) @@ -265,7 +265,7 @@ main = runTest $ suite "Data.URI" do "foo://[2001:cdba:0000:0000:0000:0000:3257:9652]" (Left (URI - (Just (Scheme "foo")) + (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [Tuple (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") Nothing])) Nothing) @@ -275,7 +275,7 @@ main = runTest $ suite "Data.URI" do "foo://[FE80::0202:B3FF:FE1E:8329]" (Left (URI - (Just (Scheme "foo")) + (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv6Address "FE80::0202:B3FF:FE1E:8329") Nothing)])) Nothing) @@ -285,7 +285,7 @@ main = runTest $ suite "Data.URI" do "foo://[2001:db8::1]:80" (Left (URI - (Just (Scheme "foo")) + (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::1") (Just (Port 80)))])) Nothing) @@ -295,7 +295,7 @@ main = runTest $ suite "Data.URI" do "ftp://ftp.is.co.za/rfc/rfc1808.txt" (Left (URI - (Just (Scheme "ftp")) + (Scheme "ftp") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "ftp.is.co.za") Nothing)])) (Just (Right ((rootDir dir "rfc") file "rfc1808.txt")))) @@ -305,7 +305,7 @@ main = runTest $ suite "Data.URI" do "http://www.ietf.org/rfc/rfc2396.txt" (Left (URI - (Just (Scheme "http")) + (Scheme "http") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "www.ietf.org") Nothing)])) (Just (Right ((rootDir dir "rfc") file "rfc2396.txt")))) Nothing Nothing)) @@ -313,7 +313,7 @@ main = runTest $ suite "Data.URI" do "ldap://[2001:db8::7]/c=GB?objectClass?one" (Left (URI - (Just (Scheme "ldap")) + (Scheme "ldap") (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::7") Nothing)])) (Just (Right (rootDir file "c=GB")))) @@ -323,7 +323,7 @@ main = runTest $ suite "Data.URI" do "telnet://192.0.2.16:80/" (Left (URI - (Just (Scheme "telnet")) + (Scheme "telnet") (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv4Address "192.0.2.16") (Just (Port 80)))])) (Just (Left rootDir))) @@ -333,7 +333,7 @@ main = runTest $ suite "Data.URI" do "foo://example.com:8042/over/there?name=ferret#nose" (Left (URI - (Just (Scheme "foo")) + (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) (Just (Query (singleton (Tuple "name" (Just "ferret"))))) (Just (Fragment "nose")))) @@ -341,7 +341,7 @@ main = runTest $ suite "Data.URI" do "foo://example.com:8042/over/there?name=ferret#" (Left (URI - (Just (Scheme "foo")) + (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) (Just (Query (singleton (Tuple "name" (Just "ferret"))))) (Just (Fragment "")))) @@ -349,7 +349,7 @@ main = runTest $ suite "Data.URI" do "foo://info.example.com?fred" (Left (URI - (Just (Scheme "foo")) + (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "info.example.com") Nothing)])) Nothing) @@ -359,7 +359,7 @@ main = runTest $ suite "Data.URI" do "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" (Left (URI - (Just (Scheme "ftp")) + (Scheme "ftp") (HierarchicalPart (Just (Authority @@ -391,7 +391,7 @@ main = runTest $ suite "Data.URI" do AbsoluteURI.print "couchbase://localhost/testBucket?password=&docTypeKey=" (AbsoluteURI - (Just (Scheme "couchbase")) + (Scheme "couchbase") (HierarchicalPart (Just (Authority @@ -404,7 +404,7 @@ main = runTest $ suite "Data.URI" do AbsoluteURI.print "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (AbsoluteURI - (Just (Scheme "couchbase")) + (Scheme "couchbase") (HierarchicalPart (Just (Authority @@ -416,7 +416,7 @@ main = runTest $ suite "Data.URI" do "http://www.example.com/some%20invented/url%20with%20spaces.html" (Left (URI - (Just (Scheme "http")) + (Scheme "http") (HierarchicalPart (Just (Authority Nothing [Tuple (NameAddress "www.example.com") Nothing])) ((Just (Right ((rootDir dir "some invented") file "url with spaces.html"))))) @@ -426,22 +426,21 @@ main = runTest $ suite "Data.URI" do "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" (Left (URI - (Just (Scheme "http")) + (Scheme "http") (HierarchicalPart (Just (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 53174))])) ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) (Just mempty) Nothing)) - testIsoURIRef - "/top_story.htm" - (Left - (URI - Nothing - (HierarchicalPart - Nothing - (Just (Right (rootDir file "top_story.htm")))) - Nothing - Nothing)) + -- testIsoURIRef + -- "/top_story.htm" + -- (Right + -- (RelativeRef + -- (RelativePart + -- Nothing + -- (Just (Right (rootDir file "top_story.htm")))) + -- Nothing + -- Nothing)) testIsoURIRef "../top_story.htm" (Right @@ -457,7 +456,7 @@ main = runTest $ suite "Data.URI" do "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" (Left (URI - (Just (Scheme "http")) + (Scheme "http") (HierarchicalPart (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) ((Just (Left rootDir)))) @@ -468,7 +467,7 @@ main = runTest $ suite "Data.URI" do "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" (Left (URI - (Just (Scheme "http")) + (Scheme "http") (HierarchicalPart (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) ((Just (Left rootDir)))) From 4356849d04d07bb063743707ea439720172958d6 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 29 Jan 2018 10:05:21 +0000 Subject: [PATCH 02/69] WIP --- src/Data/URI/AbsoluteURI.purs | 62 +++--- src/Data/URI/Authority.purs | 30 +-- src/Data/URI/Fragment.purs | 10 +- src/Data/URI/HierarchicalPart.purs | 38 ++-- src/Data/URI/Path.purs | 13 +- src/Data/URI/Query.purs | 8 + src/Data/URI/RelativePart.purs | 36 ++-- src/Data/URI/RelativeRef.purs | 74 ++++--- src/Data/URI/URI.purs | 74 ++++--- src/Data/URI/URIRef.purs | 35 ++- src/Data/URI/UserInfo.purs | 10 +- test/Main.purs | 331 ++++++++++++++++------------- 12 files changed, 414 insertions(+), 307 deletions(-) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index f475453..08d4752 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -1,74 +1,84 @@ module Data.URI.AbsoluteURI ( AbsoluteURI(..) - , parse , parser , print , _scheme , _hierPart , _query , module Data.URI.HierarchicalPart - , module Data.URI.Query , module Data.URI.Scheme ) where import Prelude import Data.Array (catMaybes) -import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S import Data.URI.HierarchicalPart as HPart -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), URIPath, URIPathAbs, URIPathRel, UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.Query as Query -import Data.URI.Query (Query(..)) import Data.URI.Scheme as Scheme import Data.URI.Scheme (Scheme(..)) -import Text.Parsing.StringParser (ParseError, Parser, runParser) +import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) --- | An absolute URI. -data AbsoluteURI = AbsoluteURI Scheme HierarchicalPart (Maybe Query) +-- | An absolute AbsoluteURI. +data AbsoluteURI userInfo path query = AbsoluteURI Scheme (HierarchicalPart userInfo path) (Maybe query) -derive instance eqAbsoluteURI ∷ Eq AbsoluteURI -derive instance ordAbsoluteURI ∷ Ord AbsoluteURI -derive instance genericAbsoluteURI ∷ Generic AbsoluteURI _ -instance showAbsoluteURI ∷ Show AbsoluteURI where show = genericShow +derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq path, Eq query) ⇒ Eq (AbsoluteURI userInfo path query) +derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord path, Ord query) ⇒ Ord (AbsoluteURI userInfo path query) +derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo path query) _ +instance showAbsoluteURI ∷ (Show userInfo, Show path, Show query) ⇒ Show (AbsoluteURI userInfo path query) where show = genericShow -parse ∷ String → Either ParseError AbsoluteURI -parse = runParser parser - -parser ∷ Parser AbsoluteURI -parser = AbsoluteURI +parser + ∷ ∀ userInfo path query + . Parser userInfo + → Parser path + → Parser query + → Parser (AbsoluteURI userInfo path query) +parser parseUserInfo parsePath parseQuery = AbsoluteURI <$> Scheme.parser - <*> HPart.parser - <*> optionMaybe Query.parser + <*> HPart.parser parseUserInfo parsePath + <*> optionMaybe (Query.parser' parseQuery) <* eof -print ∷ AbsoluteURI → String -print (AbsoluteURI s h q) = +print + ∷ ∀ userInfo path query + . (userInfo → String) + → (path → String) + → (query → String) + → AbsoluteURI userInfo path query + → String +print printUserInfo printPath printQuery (AbsoluteURI s h q) = S.joinWith "" $ catMaybes [ Just (Scheme.print s) - , Just (HPart.print h) - , Query.print <$> q + , Just (HPart.print printUserInfo printPath h) + , Query.print' printQuery <$> q ] -_scheme ∷ Lens' AbsoluteURI Scheme +_scheme + ∷ ∀ userInfo path query + . Lens' (AbsoluteURI userInfo path query) Scheme _scheme = lens (\(AbsoluteURI s _ _) → s) (\(AbsoluteURI _ h q) s → AbsoluteURI s h q) -_hierPart ∷ Lens' AbsoluteURI HierarchicalPart +_hierPart + ∷ ∀ userInfo path query + . Lens' (AbsoluteURI userInfo path query) (HierarchicalPart userInfo path) _hierPart = lens (\(AbsoluteURI _ h _) → h) (\(AbsoluteURI s _ q) h → AbsoluteURI s h q) -_query ∷ Lens' AbsoluteURI (Maybe Query) +_query + ∷ ∀ userInfo path query + . Lens' (AbsoluteURI userInfo path query) (Maybe query) _query = lens (\(AbsoluteURI _ _ q) → q) diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index 7489474..82ca556 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -30,37 +30,37 @@ import Text.Parsing.StringParser.String (string) -- | The authority part of a URI. For example: `purescript.org`, -- | `localhost:3000`, `user@example.net` -data Authority = Authority (Maybe UserInfo) (Array (Tuple Host (Maybe Port))) +data Authority userInfo = Authority (Maybe userInfo) (Array (Tuple Host (Maybe Port))) -derive instance eqAuthority ∷ Eq Authority -derive instance ordAuthority ∷ Ord Authority -derive instance genericAuthority ∷ Generic Authority _ -instance showAuthority ∷ Show Authority where show = genericShow +derive instance eqAuthority ∷ Eq userInfo ⇒ Eq (Authority userInfo) +derive instance ordAuthority ∷ Ord userInfo ⇒ Ord (Authority userInfo) +derive instance genericAuthority ∷ Generic (Authority userInfo) _ +instance showAuthority ∷ Show userInfo ⇒ Show (Authority userInfo) where show = genericShow -parser ∷ Parser Authority -parser = do +parser ∷ ∀ userInfo. Parser userInfo → Parser (Authority userInfo) +parser parseUserInfo = do _ ← string "//" - ui ← optionMaybe $ try (UserInfo.parser <* string "@") + ui ← optionMaybe $ try (UserInfo.parser' parseUserInfo <* string "@") hosts ← flip sepBy (string ",") $ Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser) pure $ Authority ui (fromFoldable hosts) -print ∷ Authority → String -print (Authority ui hs) = - "//" <> printUserInfo <> S.joinWith "," (printHostAndPort <$> hs) +print ∷ ∀ userInfo. (userInfo → String) → Authority userInfo → String +print printUserInfo (Authority ui hs) = + "//" <> printUserInfo' ui <> S.joinWith "," (printHostAndPort <$> hs) where - printUserInfo = - maybe "" (\u → UserInfo.print u <> "@") ui + printUserInfo' = + maybe "" (\u → printUserInfo u <> "@") printHostAndPort (Tuple h p) = Host.print h <> maybe "" (\n → ":" <> Port.print n) p -_userInfo ∷ Lens' Authority (Maybe UserInfo) +_userInfo ∷ ∀ userInfo. Lens' (Authority userInfo) (Maybe userInfo) _userInfo = lens (\(Authority ui _) → ui) (\(Authority _ hs) ui → Authority ui hs) -_hosts ∷ Lens' Authority (Array (Tuple Host (Maybe Port))) +_hosts ∷ ∀ userInfo. Lens' (Authority userInfo) (Array (Tuple Host (Maybe Port))) _hosts = lens (\(Authority _ hs) → hs) diff --git a/src/Data/URI/Fragment.purs b/src/Data/URI/Fragment.purs index 5571e8b..ffa555e 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/Data/URI/Fragment.purs @@ -10,7 +10,7 @@ import Data.Newtype (class Newtype) import Data.String as S import Data.String.Regex as RX import Data.String.Regex.Flags as RXF -import Data.URI.Common (decodePCTComponent, joinWith, parsePChar) +import Data.URI.Common (decodePCTComponent, joinWith, parsePChar, wrapParser) import Global (encodeURIComponent) import Partial.Unsafe (unsafePartial) import Text.Parsing.StringParser (Parser) @@ -26,11 +26,19 @@ derive instance genericFragment ∷ Generic Fragment _ derive instance newtypeFragment ∷ Newtype Fragment _ instance showFragment ∷ Show Fragment where show = genericShow +parser' ∷ ∀ f. Parser f → Parser f +parser' parseF = string "#" *> + wrapParser parseF (joinWith "" + <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) + parser ∷ Parser Fragment parser = string "#" *> (Fragment <<< joinWith "" <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) +print' ∷ ∀ f. (f → String) → f → String +print' printF f = "#" <> printF f + print ∷ Fragment → String print (Fragment f) = "#" <> S.joinWith "" (map printChar $ S.split (S.Pattern "") f) diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index 9d23b55..2aec03e 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -5,7 +5,6 @@ module Data.URI.HierarchicalPart , _authority , _path , module Data.URI.Authority - , module Data.URI.Path ) where import Prelude @@ -19,44 +18,47 @@ import Data.Maybe (Maybe(..)) import Data.String as S import Data.URI.Authority (Authority(..), Host(..), Port(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority -import Data.URI.Path (URIPath, URIPathAbs, URIPathRel) import Data.URI.Path as Path import Text.Parsing.StringParser (Parser) -- | The "hierarchical part" of a generic or absolute URI. -data HierarchicalPart = HierarchicalPart (Maybe Authority) (Maybe URIPathAbs) +data HierarchicalPart userInfo path = HierarchicalPart (Maybe (Authority userInfo)) (Maybe path) -derive instance eqHierarchicalPart ∷ Eq HierarchicalPart -derive instance ordHierarchicalPart ∷ Ord HierarchicalPart -derive instance genericHierarchicalPart ∷ Generic HierarchicalPart _ -instance showHierarchicalPart ∷ Show HierarchicalPart where show = genericShow +derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq path) ⇒ Eq (HierarchicalPart userInfo path) +derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord path) ⇒ Ord (HierarchicalPart userInfo path) +derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo path) _ +instance showHierarchicalPart ∷ (Show userInfo, Show path) ⇒ Show (HierarchicalPart userInfo path) where show = genericShow -parser ∷ Parser HierarchicalPart -parser = withAuth <|> withoutAuth +parser ∷ ∀ userInfo path. Parser userInfo → Parser path → Parser (HierarchicalPart userInfo path) +parser parseUserInfo parsePath = withAuth <|> withoutAuth where withAuth = HierarchicalPart <<< Just - <$> Authority.parser - <*> Path.parsePathAbEmpty Path.parseURIPathAbs + <$> Authority.parser parseUserInfo + <*> Path.parsePathAbEmpty parsePath withoutAuth = HierarchicalPart Nothing <$> noAuthPath noAuthPath - = (Just <$> Path.parsePathAbsolute Path.parseURIPathAbs) - <|> (Just <$> Path.parsePathRootless Path.parseURIPathAbs) + = (Just <$> Path.parsePathAbsolute parsePath) + <|> (Just <$> Path.parsePathRootless parsePath) <|> pure Nothing -print ∷ HierarchicalPart → String -print (HierarchicalPart a p) = - S.joinWith "" (catMaybes [Authority.print <$> a, Path.printPath <$> p]) +print ∷ ∀ userInfo path. (userInfo → String) → (path → String) → HierarchicalPart userInfo path → String +print printUserInfo printPath (HierarchicalPart a p) = + S.joinWith "" $ + catMaybes + [ Authority.print printUserInfo <$> a + , printPath <$> p + ] -_authority ∷ Lens' HierarchicalPart (Maybe Authority) +_authority ∷ ∀ userInfo path. Lens' (HierarchicalPart userInfo path) (Maybe (Authority userInfo)) _authority = lens (\(HierarchicalPart a _) → a) (\(HierarchicalPart _ p) a → HierarchicalPart a p) -_path ∷ Lens' HierarchicalPart (Maybe URIPathAbs) +_path ∷ ∀ userInfo path. Lens' (HierarchicalPart userInfo path) (Maybe path) _path = lens (\(HierarchicalPart _ p) → p) diff --git a/src/Data/URI/Path.purs b/src/Data/URI/Path.purs index d757529..f838ffe 100644 --- a/src/Data/URI/Path.purs +++ b/src/Data/URI/Path.purs @@ -25,8 +25,9 @@ import Data.String as Str import Data.URI.Common (PCTEncoded, decodePCT, joinWith, parsePCTEncoded, parsePChar, parseSubDelims, parseUnreserved, wrapParser) import Global (encodeURI) import Text.Parsing.StringParser (Parser(..), ParseError(..), try) -import Text.Parsing.StringParser.Combinators (many, many1) +import Text.Parsing.StringParser.Combinators (many, many1, optionMaybe) import Text.Parsing.StringParser.String (string) +import Debug.Trace -- | A general URI path, can be used to represent relative or absolute paths -- | that are sandboxed or unsandboxed. @@ -47,14 +48,14 @@ parsePath p <|> pure Nothing parsePathAbEmpty ∷ ∀ p. Parser p → Parser (Maybe p) -parsePathAbEmpty p - = try (Just <$> wrapParser p - (joinWith "" <$> many (append <$> string "/" <*> parseSegment))) - <|> pure Nothing +parsePathAbEmpty p = + optionMaybe $ wrapParser p do + parts ← many1 (string "/" *> parseSegment) + pure ("/" <> joinWith "/" parts) parsePathAbsolute ∷ ∀ p. Parser p → Parser p parsePathAbsolute p = wrapParser p $ do - _ <- string "/" + _ ← string "/" start ← parseSegmentNonZero rest ← joinWith "" <$> many (append <$> string "/" <*> parseSegment) pure $ "/" <> start <> rest diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index 053410f..ba15a0f 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -1,7 +1,9 @@ module Data.URI.Query ( Query(..) , parser + , parser' , print + , print' ) where import Prelude @@ -36,6 +38,9 @@ instance showQuery ∷ Show Query where show = genericShow derive newtype instance semigroupQuery ∷ Semigroup Query derive newtype instance monoidQuery ∷ Monoid Query +parser' ∷ ∀ q. Parser q → Parser q +parser' parseQ = string "?" *> (wrapParser parseQ (try (rxPat "[^#]*"))) + parser ∷ Parser Query parser = string "?" *> (Query <$> wrapParser parseParts (try (rxPat "[^#]*"))) @@ -48,6 +53,9 @@ parsePart = do value ← optionMaybe $ decodeURIComponent <$> (string "=" *> rxPat "[^;&]*") pure $ Tuple key value +print' ∷ ∀ q. (q → String) → q → String +print' printQ q = "?" <> printQ q + print ∷ Query → String print (Query m) = case m of diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index d81a028..b7d1b73 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -5,7 +5,6 @@ module Data.URI.RelativePart , _authority , _path , module Data.URI.Authority - , module Data.URI.Path ) where import Prelude @@ -19,49 +18,48 @@ import Data.Maybe (Maybe(..)) import Data.String as S import Data.URI.Authority (Authority(..), Host(..), Port(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority -import Data.URI.Path (URIPath, URIPathAbs, URIPathRel) import Data.URI.Path as Path import Text.Parsing.StringParser (Parser) -- | The "relative part" of a relative reference. -data RelativePart = RelativePart (Maybe Authority) (Maybe URIPathRel) +data RelativePart userInfo path = RelativePart (Maybe (Authority userInfo)) (Maybe path) -derive instance eqRelativePart ∷ Eq RelativePart -derive instance ordRelativePart ∷ Ord RelativePart -derive instance genericRelativePart ∷ Generic RelativePart _ -instance showRelativePart ∷ Show RelativePart where show = genericShow +derive instance eqRelativePart ∷ (Eq userInfo, Eq path) ⇒ Eq (RelativePart userInfo path) +derive instance ordRelativePart ∷ (Ord userInfo, Ord path) ⇒ Ord (RelativePart userInfo path) +derive instance genericRelativePart ∷ Generic (RelativePart userInfo path) _ +instance showRelativePart ∷ (Show userInfo, Show path) ⇒ Show (RelativePart userInfo path) where show = genericShow -parser ∷ Parser RelativePart -parser = withAuth <|> withoutAuth +parser ∷ ∀ userInfo path. Parser userInfo → Parser path → Parser (RelativePart userInfo path) +parser parseUserInfo parsePath = withAuth <|> withoutAuth where withAuth = RelativePart - <$> Just <$> Authority.parser - <*> Path.parsePathAbEmpty Path.parseURIPathRel + <$> Just <$> Authority.parser parseUserInfo + <*> Path.parsePathAbEmpty parsePath withoutAuth = RelativePart Nothing <$> noAuthPath noAuthPath - = (Just <$> Path.parsePathAbsolute Path.parseURIPathRel) - <|> (Just <$> Path.parsePathNoScheme Path.parseURIPathRel) + = (Just <$> Path.parsePathAbsolute parsePath) + <|> (Just <$> Path.parsePathNoScheme parsePath) <|> pure Nothing -print ∷ RelativePart → String -print (RelativePart a p) = +print ∷ ∀ userInfo path. (userInfo → String) → (path → String) → RelativePart userInfo path → String +print printUserInfo printPath (RelativePart a p) = S.joinWith "" $ catMaybes - [ Authority.print <$> a - , Path.printPath <$> p + [ Authority.print printUserInfo <$> a + , printPath <$> p ] -_authority ∷ Lens' RelativePart (Maybe Authority) +_authority ∷ ∀ userInfo path. Lens' (RelativePart userInfo path) (Maybe (Authority userInfo)) _authority = lens (\(RelativePart a _) → a) (\(RelativePart _ p) a → RelativePart a p) -_path ∷ Lens' RelativePart (Maybe URIPathRel) +_path ∷ ∀ userInfo path. Lens' (RelativePart userInfo path) (Maybe path) _path = lens (\(RelativePart _ p) → p) diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 0d80d9e..16095d4 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -1,74 +1,88 @@ module Data.URI.RelativeRef ( RelativeRef(..) - , parse , parser , print , _relPart , _query , _fragment - , module Data.URI.Fragment - , module Data.URI.Query , module Data.URI.RelativePart ) where import Prelude import Data.Array (catMaybes) -import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S import Data.URI.Fragment as Fragment -import Data.URI.Fragment (Fragment(..)) import Data.URI.Query as Query -import Data.URI.Query (Query(..)) import Data.URI.RelativePart as RPart -import Data.URI.RelativePart (Authority(..), Host(..), Port(..), RelativePart(..), URIPath, URIPathAbs, URIPathRel, UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) -import Text.Parsing.StringParser (Parser, ParseError, runParser) +import Data.URI.RelativePart (Authority(..), Host(..), Port(..), RelativePart(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A relative reference for a URI. -data RelativeRef = RelativeRef RelativePart (Maybe Query) (Maybe Fragment) +data RelativeRef userInfo path query fragment = RelativeRef (RelativePart userInfo path) (Maybe query) (Maybe fragment) -derive instance eqRelativeRef ∷ Eq RelativeRef -derive instance ordRelativeRef ∷ Ord RelativeRef -derive instance genericRelativeRef ∷ Generic RelativeRef _ -instance showRelativeRef ∷ Show RelativeRef where show = genericShow +derive instance eqRelativeRef ∷ (Eq userInfo, Eq path, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo path query fragment) +derive instance ordRelativeRef ∷ (Ord userInfo, Ord path, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo path query fragment) +derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo path query fragment) _ +instance showRelativeRef ∷ (Show userInfo, Show path, Show query, Show fragment) ⇒ Show (RelativeRef userInfo path query fragment) where show = genericShow +-- +-- parse ∷ String → Either ParseError RelativeRef +-- parse = runParser parser -parse ∷ String → Either ParseError RelativeRef -parse = runParser parser +parser + ∷ ∀ userInfo path query fragment + . Parser userInfo + → Parser path + → Parser query + → Parser fragment + → Parser (RelativeRef userInfo path query fragment) +parser parseUserInfo parsePath parseQuery parseFragment = + RelativeRef + <$> RPart.parser parseUserInfo parsePath + <*> optionMaybe (Query.parser' parseQuery) + <*> optionMaybe (Fragment.parser' parseFragment) + <* eof -parser ∷ Parser RelativeRef -parser = RelativeRef - <$> RPart.parser - <*> optionMaybe Query.parser - <*> optionMaybe Fragment.parser - <* eof - -print ∷ RelativeRef → String -print (RelativeRef h q f) = +print + ∷ ∀ userInfo path query fragment + . (userInfo → String) + → (path → String) + → (query → String) + → (fragment → String) + → RelativeRef userInfo path query fragment + → String +print printUserInfo printPath printQuery printFragment (RelativeRef h q f) = S.joinWith "" $ catMaybes - [ Just (RPart.print h) - , Query.print <$> q - , Fragment.print <$> f + [ Just (RPart.print printUserInfo printPath h) + , Query.print' printQuery <$> q + , Fragment.print' printFragment <$> f ] -_relPart ∷ Lens' RelativeRef RelativePart +_relPart + ∷ ∀ userInfo path query fragment + . Lens' (RelativeRef userInfo path query fragment) (RelativePart userInfo path) _relPart = lens (\(RelativeRef r _ _) → r) (\(RelativeRef _ q f) r → RelativeRef r q f) -_query ∷ Lens' RelativeRef (Maybe Query) +_query + ∷ ∀ userInfo path query fragment + . Lens' (RelativeRef userInfo path query fragment) (Maybe query) _query = lens (\(RelativeRef _ q _) → q) (\(RelativeRef r _ f) q → RelativeRef r q f) -_fragment ∷ Lens' RelativeRef (Maybe Fragment) +_fragment + ∷ ∀ userInfo path query fragment + . Lens' (RelativeRef userInfo path query fragment) (Maybe fragment) _fragment = lens (\(RelativeRef _ _ f) → f) diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 239455c..ddfdc5a 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -1,86 +1,98 @@ module Data.URI.URI ( URI(..) - , parse , parser , print , _scheme , _hierPart , _query , _fragment - , module Data.URI.Fragment , module Data.URI.HierarchicalPart - , module Data.URI.Query , module Data.URI.Scheme ) where import Prelude import Data.Array (catMaybes) -import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S -import Data.URI.Fragment (Fragment(..)) import Data.URI.Fragment as Fragment -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), URIPath, URIPathAbs, URIPathRel, UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart -import Data.URI.Query (Query(..)) import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) import Data.URI.Scheme as Scheme -import Text.Parsing.StringParser (Parser, ParseError, runParser) +import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A generic URI -data URI = URI Scheme HierarchicalPart (Maybe Query) (Maybe Fragment) +data URI userInfo path query fragment = URI Scheme (HierarchicalPart userInfo path) (Maybe query) (Maybe fragment) -derive instance eqURI ∷ Eq URI -derive instance ordURI ∷ Ord URI -derive instance genericURI ∷ Generic URI _ -instance showURI ∷ Show URI where show = genericShow +derive instance eqURI ∷ (Eq userInfo, Eq path, Eq query, Eq fragment) ⇒ Eq (URI userInfo path query fragment) +derive instance ordURI ∷ (Ord userInfo, Ord path, Ord query, Ord fragment) ⇒ Ord (URI userInfo path query fragment) +derive instance genericURI ∷ Generic (URI userInfo path query fragment) _ +instance showURI ∷ (Show userInfo, Show path, Show query, Show fragment) ⇒ Show (URI userInfo path query fragment) where show = genericShow -parse ∷ String → Either ParseError URI -parse = runParser parser - -parser ∷ Parser URI -parser = URI +parser + ∷ ∀ userInfo path query fragment + . Parser userInfo + → Parser path + → Parser query + → Parser fragment + → Parser (URI userInfo path query fragment) +parser parseUserInfo parsePath parseQuery parseFragment = URI <$> Scheme.parser - <*> HPart.parser - <*> optionMaybe Query.parser - <*> optionMaybe Fragment.parser - <* eof + <*> HPart.parser parseUserInfo parsePath + <*> optionMaybe (Query.parser' parseQuery) + <*> optionMaybe (Fragment.parser' parseFragment) + -- <* eof -print ∷ URI → String -print (URI s h q f) = +print + ∷ ∀ userInfo path query fragment + . (userInfo → String) + → (path → String) + → (query → String) + → (fragment → String) + → URI userInfo path query fragment + → String +print printUserInfo printPath printQuery printFragment (URI s h q f) = S.joinWith "" $ catMaybes [ Just (Scheme.print s) - , Just (HPart.print h) - , Query.print <$> q - , Fragment.print <$> f + , Just (HPart.print printUserInfo printPath h) + , Query.print' printQuery <$> q + , Fragment.print' printFragment <$> f ] -_scheme ∷ Lens' URI Scheme +_scheme + ∷ ∀ userInfo path query fragment + . Lens' (URI userInfo path query fragment) Scheme _scheme = lens (\(URI s _ _ _) → s) (\(URI _ h q f) s → URI s h q f) -_hierPart ∷ Lens' URI HierarchicalPart +_hierPart + ∷ ∀ userInfo path query fragment + . Lens' (URI userInfo path query fragment) (HierarchicalPart userInfo path) _hierPart = lens (\(URI _ h _ _) → h) (\(URI s _ q f) h → URI s h q f) -_query ∷ Lens' URI (Maybe Query) +_query + ∷ ∀ userInfo path query fragment + . Lens' (URI userInfo path query fragment) (Maybe query) _query = lens (\(URI _ _ q _) → q) (\(URI s h _ f) q → URI s h q f) -_fragment ∷ Lens' URI (Maybe Fragment) +_fragment + ∷ ∀ userInfo path query fragment + . Lens' (URI userInfo path query fragment) (Maybe fragment) _fragment = lens (\(URI _ _ _ f) → f) diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index 72e85df..ef188f4 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -6,16 +6,33 @@ import Control.Alt ((<|>)) import Data.Either (Either(..), either) import Data.URI.RelativeRef as RelativeRef import Data.URI.URI as URI -import Text.Parsing.StringParser (Parser, ParseError, runParser, try) +import Text.Parsing.StringParser (Parser, try) -- | An alias for the most common use case of resource identifiers. -type URIRef = Either URI.URI RelativeRef.RelativeRef +type URIRef userInfo absPath relPath query fragment = Either (URI.URI userInfo absPath query fragment) (RelativeRef.RelativeRef userInfo relPath query fragment) -parse ∷ String → Either ParseError URIRef -parse = runParser parser +parser + ∷ ∀ userInfo absPath relPath query fragment + . Parser userInfo + → Parser absPath + → Parser relPath + → Parser query + → Parser fragment + → Parser (URIRef userInfo absPath relPath query fragment) +parser parseUserInfo parseAbsPath parseRelPath parseQuery parseFragment + = (Left <$> try (URI.parser parseUserInfo parseAbsPath parseQuery parseFragment)) + -- <|> (Right <$> RelativeRef.parser parseUserInfo parseRelPath parseQuery parseFragment) -parser ∷ Parser URIRef -parser = (Left <$> try URI.parser) <|> (Right <$> RelativeRef.parser) - -print ∷ URIRef → String -print = either URI.print RelativeRef.print +print + ∷ ∀ userInfo absPath relPath query fragment + . (userInfo → String) + → (absPath → String) + → (relPath → String) + → (query → String) + → (fragment → String) + → URIRef userInfo absPath relPath query fragment + → String +print printUserInfo printAbsPath printRelPath printQuery printFragment = + either + (URI.print printUserInfo printAbsPath printQuery printFragment) + (RelativeRef.print printUserInfo printRelPath printQuery printFragment) diff --git a/src/Data/URI/UserInfo.purs b/src/Data/URI/UserInfo.purs index 3ef4f6a..fef4e99 100644 --- a/src/Data/URI/UserInfo.purs +++ b/src/Data/URI/UserInfo.purs @@ -6,7 +6,7 @@ import Control.Alt ((<|>)) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Newtype (class Newtype) -import Data.URI.Common (decodePCT, joinWith, parsePCTEncoded, parseSubDelims, parseUnreserved) +import Data.URI.Common (decodePCT, joinWith, parsePCTEncoded, parseSubDelims, parseUnreserved, wrapParser) import Global (encodeURI) import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (many1) @@ -29,5 +29,13 @@ parser = UserInfo <<< joinWith "" <$> many1 p <|> parseSubDelims <|> string ":" +parser' ∷ ∀ userInfo. Parser userInfo → Parser userInfo +parser' p = wrapParser p (joinWith "" <$> many1 p') + where + p' = parseUnreserved + <|> parsePCTEncoded decodePCT + <|> parseSubDelims + <|> string ":" + print ∷ UserInfo → String print (UserInfo u) = encodeURI u diff --git a/test/Main.purs b/test/Main.purs index e59fc80..5a84338 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -13,18 +13,21 @@ import Data.List (List(..), singleton, (:)) import Data.Maybe (Maybe(Nothing, Just)) import Data.Monoid (mempty) import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) +import Data.String as String import Data.String.Regex (Regex, regex) import Data.String.Regex.Flags (global, noFlags) import Data.Tuple (Tuple(..)) -import Data.URI (AbsoluteURI(..), Authority(..), Fragment(..), HierarchicalPart(..), Host(..), Port(..), Query(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..), UserInfo(..)) +import Data.URI (AbsoluteURI(..), Authority(..), Fragment(..), HierarchicalPart(..), Host(..), Port(..), Query(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..), UserInfo(..), URIRef) import Data.URI.AbsoluteURI as AbsoluteURI import Data.URI.Authority as Authority import Data.URI.Common as Common import Data.URI.Host as Host import Data.URI.Host.Gen as Host.Gen +import Data.URI.Fragment as Fragment import Data.URI.Port as Port import Data.URI.Query as Query import Data.URI.Scheme as Scheme +import Data.URI.URI as URI import Data.URI.URIRef as URIRef import Data.URI.UserInfo as UserInfo import Test.QuickCheck ((===)) @@ -34,7 +37,13 @@ import Test.Unit (Test, suite, test, TestSuite) import Test.Unit.Assert (assert, equal) import Test.Unit.Console (TESTOUTPUT) import Test.Unit.Main (runTest) -import Text.Parsing.StringParser (Parser, runParser) +import Text.Parsing.StringParser (Parser(..), ParseError(..), runParser) + +idp ∷ Parser String +idp = Parser case _ of + { str, pos } + | String.null str → Left { pos, error: ParseError "empty string" } + | otherwise → Right { result: str, suffix: { str, pos: pos + String.length str }} testPrinter :: forall a b. Show b => (b -> String) -> String -> b -> TestSuite a testPrinter f expected uri = @@ -53,17 +62,20 @@ testIso p f uri expected = do testRunParseSuccess p uri expected testPrinter f uri expected -testIsoURIRef :: forall a. String -> Either URI RelativeRef -> TestSuite a -testIsoURIRef = testIso URIRef.parser URIRef.print +testIsoURI :: forall a. String -> URI.URI String String String String -> TestSuite a +testIsoURI = testIso (URI.parser idp idp idp idp) (URI.print id id id id) + +testIsoURIRef :: forall a. String -> URIRef.URIRef String String String String String -> TestSuite a +testIsoURIRef = testIso (URIRef.parser idp idp idp idp idp) (URIRef.print id id id id id) -testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a -testRunParseURIRefParses = testRunParseSuccess URIRef.parser +-- testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a +-- testRunParseURIRefParses = testRunParseSuccess URIRef.parser testRunParseURIRefFails :: forall a. String -> TestSuite a testRunParseURIRefFails uri = test ("fails to parse: " <> uri) - (assert ("parse should fail for: " <> uri) <<< isLeft <<< URIRef.parse $ uri) + (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParser (URIRef.parser idp idp idp idp idp) $ uri) testPrintQuerySerializes :: forall a. Query -> String -> TestSuite a testPrintQuerySerializes query expected = @@ -131,13 +143,16 @@ main = runTest $ suite "Data.URI" do testRunParseSuccess Port.parser "1234" (Port 1234) testRunParseSuccess Port.parser "63174" (Port 63174) + suite "Fragment' parser" do + testRunParseSuccess (Fragment.parser' idp) "#" "" + suite "Authority parser" do testRunParseSuccess - Authority.parser + (Authority.parser idp) "//localhost" (Authority Nothing [Tuple (NameAddress "localhost") Nothing]) testRunParseSuccess - Authority.parser + (Authority.parser idp) "//localhost:3000" (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 3000))]) @@ -149,8 +164,8 @@ main = runTest $ suite "Data.URI" do (Scheme "sql2") (HierarchicalPart (Just (Authority Nothing [])) - (Just (Left rootDir))) - (Just (Query (Tuple "q" (Just "foo") : Tuple "var.bar" (Just "baz") : Nil))) + (Just "/")) + (Just "q=foo&var.bar=baz") Nothing)) testIsoURIRef "mongodb://localhost" @@ -179,7 +194,7 @@ main = runTest $ suite "Data.URI" do (Scheme "http") (HierarchicalPart (Just (Authority Nothing [Tuple (NameAddress "en.wikipedia.org") Nothing])) - ((Just (Right ((rootDir dir "wiki") file "URI_scheme"))))) + (Just "/wiki/URI_scheme")) Nothing Nothing)) testIsoURIRef @@ -190,13 +205,11 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority - (Just (UserInfo "foo:bar")) + (Just "foo:bar") [ Tuple (NameAddress "db1.example.net") Nothing , Tuple (NameAddress "db2.example.net") (Just (Port 2500))])) - (Just (Right (rootDir file "authdb")))) - (Just - (Query - (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) + (Just "/authdb")) + (Just "replicaSet=test&connectTimeoutMS=300000") Nothing)) testIsoURIRef "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" @@ -204,9 +217,9 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just (UserInfo "foo:bar")) [(Tuple (NameAddress "db1.example.net") (Just (Port 6))),(Tuple (NameAddress "db2.example.net") (Just (Port 2500)))])) - (Just (Right (rootDir file "authdb")))) - (Just (Query (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) + (Just (Authority (Just "foo:bar") [(Tuple (NameAddress "db1.example.net") (Just (Port 6))),(Tuple (NameAddress "db2.example.net") (Just (Port 2500)))])) + (Just "/authdb")) + (Just "replicaSet=test&connectTimeoutMS=300000") Nothing)) testIsoURIRef "mongodb://192.168.0.1" @@ -237,7 +250,17 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just(Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Authority (Just "sysop:moon") [(Tuple (NameAddress "localhost") Nothing)])) + Nothing) + Nothing + Nothing)) + testIsoURIRef + "mongodb://user@localhost" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPart + (Just (Authority (Just "user") [(Tuple (NameAddress "localhost") Nothing)])) Nothing) Nothing Nothing)) @@ -247,8 +270,8 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) - (Just (Left rootDir))) + (Just (Authority (Just "sysop:moon") [(Tuple (NameAddress "localhost") Nothing)])) + (Just "/")) Nothing Nothing)) testIsoURIRef @@ -257,8 +280,8 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) - (Just (Right (rootDir file "records")))) + (Just (Authority (Just "sysop:moon") [(Tuple (NameAddress "localhost") Nothing)])) + (Just "/records")) Nothing Nothing)) testIsoURIRef @@ -298,7 +321,7 @@ main = runTest $ suite "Data.URI" do (Scheme "ftp") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "ftp.is.co.za") Nothing)])) - (Just (Right ((rootDir dir "rfc") file "rfc1808.txt")))) + (Just "/rfc/rfc1808.txt")) Nothing Nothing)) testIsoURIRef @@ -306,7 +329,9 @@ main = runTest $ suite "Data.URI" do (Left (URI (Scheme "http") - (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "www.ietf.org") Nothing)])) (Just (Right ((rootDir dir "rfc") file "rfc2396.txt")))) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (NameAddress "www.ietf.org") Nothing)])) + (Just "/rfc/rfc2396.txt")) Nothing Nothing)) testIsoURIRef @@ -316,8 +341,8 @@ main = runTest $ suite "Data.URI" do (Scheme "ldap") (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::7") Nothing)])) - (Just (Right (rootDir file "c=GB")))) - (Just (Query (singleton $ (Tuple "objectClass?one" Nothing)))) + (Just "/c=GB")) + (Just "objectClass?one") Nothing)) testIsoURIRef "telnet://192.0.2.16:80/" @@ -326,7 +351,7 @@ main = runTest $ suite "Data.URI" do (Scheme "telnet") (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv4Address "192.0.2.16") (Just (Port 80)))])) - (Just (Left rootDir))) + (Just "/")) Nothing Nothing)) testIsoURIRef @@ -334,17 +359,21 @@ main = runTest $ suite "Data.URI" do (Left (URI (Scheme "foo") - (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) - (Just (Query (singleton (Tuple "name" (Just "ferret"))))) - (Just (Fragment "nose")))) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) + (Just "/over/there")) + (Just "name=ferret") + (Just "nose"))) testIsoURIRef "foo://example.com:8042/over/there?name=ferret#" (Left (URI (Scheme "foo") - (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) - (Just (Query (singleton (Tuple "name" (Just "ferret"))))) - (Just (Fragment "")))) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) + (Just "/over/there")) + (Just "name=ferret") + (Just ""))) testIsoURIRef "foo://info.example.com?fred" (Left @@ -353,7 +382,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "info.example.com") Nothing)])) Nothing) - (Just (Query (singleton $ Tuple "fred" Nothing))) + (Just "fred") Nothing)) testIsoURIRef "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" @@ -363,9 +392,9 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority - (Just (UserInfo "cnn.example.com&story=breaking_news")) + (Just "cnn.example.com&story=breaking_news") [(Tuple (IPv4Address "10.0.0.1") Nothing)])) - (Just (Right (rootDir file "top_story.htm")))) + (Just "/top_story.htm")) Nothing Nothing)) testIsoURIRef @@ -374,7 +403,7 @@ main = runTest $ suite "Data.URI" do (RelativeRef (RelativePart Nothing - (Just (Right ((parentDir' currentDir) file "top_story.htm")))) + (Just "../top_story.htm")) Nothing Nothing)) testIsoURIRef @@ -383,12 +412,21 @@ main = runTest $ suite "Data.URI" do (RelativeRef (RelativePart Nothing - (Just (Right (currentDir file "top_story.htm")))) + (Just "top_story.htm")) + Nothing + Nothing)) + testIsoURIRef + "/top_story.htm" + (Right + (RelativeRef + (RelativePart + Nothing + (Just ("/top_story.htm"))) Nothing Nothing)) testIso - AbsoluteURI.parser - AbsoluteURI.print + (AbsoluteURI.parser idp idp idp) + (AbsoluteURI.print id id id) "couchbase://localhost/testBucket?password=&docTypeKey=" (AbsoluteURI (Scheme "couchbase") @@ -397,11 +435,11 @@ main = runTest $ suite "Data.URI" do (Authority Nothing [(Tuple (NameAddress "localhost") Nothing)])) - (Just (Right (rootDir file "testBucket")))) - (Just (Query (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)))) + (Just "/testBucket")) + (Just "password=&docTypeKey=")) testIso - AbsoluteURI.parser - AbsoluteURI.print + (AbsoluteURI.parser idp idp idp) + (AbsoluteURI.print id id id) "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (AbsoluteURI (Scheme "couchbase") @@ -410,118 +448,109 @@ main = runTest $ suite "Data.URI" do (Authority Nothing [(Tuple (NameAddress "localhost") (Just (Port 99999)))])) - (Just (Right (rootDir file "testBucket")))) - (Just (Query (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)))) - testIsoURIRef - "http://www.example.com/some%20invented/url%20with%20spaces.html" - (Left - (URI - (Scheme "http") - (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress "www.example.com") Nothing])) - ((Just (Right ((rootDir dir "some invented") file "url with spaces.html"))))) - Nothing - Nothing)) - testIsoURIRef - "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" - (Left - (URI - (Scheme "http") - (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 53174))])) - ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) - (Just mempty) - Nothing)) + (Just "/testBucket")) + (Just "password=pass&docTypeKey=type&queryTimeoutSeconds=20")) -- testIsoURIRef - -- "/top_story.htm" - -- (Right - -- (RelativeRef - -- (RelativePart - -- Nothing - -- (Just (Right (rootDir file "top_story.htm")))) + -- "http://www.example.com/some%20invented/url%20with%20spaces.html" + -- (Left + -- (URI + -- (Scheme "http") + -- (HierarchicalPart + -- (Just (Authority Nothing [Tuple (NameAddress "www.example.com") Nothing])) + -- ((Just "/some invented/url with spaces.html"))) -- Nothing -- Nothing)) - testIsoURIRef - "../top_story.htm" - (Right - (RelativeRef - (RelativePart - Nothing - (Just (Right (parentDir' currentDir file "top_story.htm")))) - Nothing - Nothing)) + -- testIsoURIRef + -- "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" + -- (Left + -- (URI + -- (Scheme "http") + -- (HierarchicalPart + -- (Just (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 53174))])) + -- ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) + -- (Just mempty) + -- Nothing)) + -- + -- -- Not an iso in this case as the printed path is normalised + -- testRunParseURIRefParses + -- "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" + -- (Left + -- (URI + -- (Scheme "http") + -- (HierarchicalPart + -- (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) + -- ((Just (Left rootDir)))) + -- ((Just mempty)) + -- ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) + -- testPrinter + -- URIRef.print + -- "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" + -- (Left + -- (URI + -- (Scheme "http") + -- (HierarchicalPart + -- (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) + -- ((Just (Left rootDir)))) + -- ((Just mempty)) + -- ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) - -- Not an iso in this case as the printed path is normalised - testRunParseURIRefParses - "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" - (Left - (URI - (Scheme "http") - (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) - ((Just (Left rootDir)))) - ((Just mempty)) - ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) - testPrinter - URIRef.print - "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" + -- testRunParseURIRefFails "news:comp.infosystems.www.servers.unix" + -- testRunParseURIRefFails "tel:+1-816-555-1212" + -- testRunParseURIRefFails "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" + -- testRunParseURIRefFails "mailto:John.Doe@example.com" + testIsoURIRef + "mailto:fred@example.com" (Left (URI - (Scheme "http") + (Scheme "mailto") (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) - ((Just (Left rootDir)))) - ((Just mempty)) - ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) - - testRunParseURIRefFails "news:comp.infosystems.www.servers.unix" - testRunParseURIRefFails "tel:+1-816-555-1212" - testRunParseURIRefFails "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" - testRunParseURIRefFails "mailto:John.Doe@example.com" - testRunParseURIRefFails "mailto:fred@example.com" - - suite "Query.print" do - testPrintQuerySerializes - (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) - "?key1=value1&key2=value2&key1=value3" - testPrintQuerySerializes - (Query (Tuple "k=ey" (Just "value=1") : Nil)) - "?k%3Dey=value%3D1" - testPrintQuerySerializes (Query Nil) "?" - testPrintQuerySerializes - (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) - "?key1=&key2=" - testPrintQuerySerializes - (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) - "?key1&key2" - testPrintQuerySerializes - (Query (Tuple "key1" (Just "foo;bar") : Nil)) - "?key1=foo%3Bbar" - - suite "Query.parser" do - testParseQueryParses - "?key1=value1&key2=value2&key1=value3" - (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) - testParseQueryParses - "?key1&key2" - (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) - testParseQueryParses - "?key1=&key2=" - (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) - testParseQueryParses - "?key1=foo%3Bbar" - (Query (Tuple "key1" (Just "foo;bar") : Nil)) - - suite "Common.match1From" do - testMatch1FromMisses (regex "key1" noFlags) 0 "" - testMatch1FromMisses (regex "key1" noFlags) 1 "key1" - testMatch1FromMisses (regex "key1" noFlags) 1 "key1=&key1=" - testMatch1FromMisses (regex "key1" global) 1 "key1=&key1=" - testMatch1FromMisses (regex "key1|key2" noFlags) 1 "key1=&key2=" + Nothing + (Just "fred@example.com")) + Nothing + Nothing)) - testMatch1FromMatches (regex "key1" noFlags) 0 "key1" (Just "key1") - testMatch1FromMatches (regex "key1" noFlags) 6 "key1=&key1=" (Just "key1") - testMatch1FromMatches (regex "key1|key2" noFlags) 6 "key1=&key2=" (Just "key2") + -- suite "Query.print" do + -- testPrintQuerySerializes + -- (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + -- "?key1=value1&key2=value2&key1=value3" + -- testPrintQuerySerializes + -- (Query (Tuple "k=ey" (Just "value=1") : Nil)) + -- "?k%3Dey=value%3D1" + -- testPrintQuerySerializes (Query Nil) "?" + -- testPrintQuerySerializes + -- (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + -- "?key1=&key2=" + -- testPrintQuerySerializes + -- (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + -- "?key1&key2" + -- testPrintQuerySerializes + -- (Query (Tuple "key1" (Just "foo;bar") : Nil)) + -- "?key1=foo%3Bbar" + -- + -- suite "Query.parser" do + -- testParseQueryParses + -- "?key1=value1&key2=value2&key1=value3" + -- (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + -- testParseQueryParses + -- "?key1&key2" + -- (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + -- testParseQueryParses + -- "?key1=&key2=" + -- (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + -- testParseQueryParses + -- "?key1=foo%3Bbar" + -- (Query (Tuple "key1" (Just "foo;bar") : Nil)) + -- + -- suite "Common.match1From" do + -- testMatch1FromMisses (regex "key1" noFlags) 0 "" + -- testMatch1FromMisses (regex "key1" noFlags) 1 "key1" + -- testMatch1FromMisses (regex "key1" noFlags) 1 "key1=&key1=" + -- testMatch1FromMisses (regex "key1" global) 1 "key1=&key1=" + -- testMatch1FromMisses (regex "key1|key2" noFlags) 1 "key1=&key2=" + -- + -- testMatch1FromMatches (regex "key1" noFlags) 0 "key1" (Just "key1") + -- testMatch1FromMatches (regex "key1" noFlags) 6 "key1=&key1=" (Just "key1") + -- testMatch1FromMatches (regex "key1|key2" noFlags) 6 "key1=&key2=" (Just "key2") forAll :: forall eff prop. QC.Testable prop => QCG.Gen prop -> Test (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) forAll = quickCheck From 15b80781ecf2ece0a5a17938db0b4ec960eb5d9d Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 29 Jan 2018 11:12:18 +0000 Subject: [PATCH 03/69] WIP --- src/Data/URI/URI.purs | 2 +- src/Data/URI/URIRef.purs | 2 +- test/Main.purs | 132 ++++++++++++++++++++++++--------------- 3 files changed, 85 insertions(+), 51 deletions(-) diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index ddfdc5a..82c09bb 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -48,7 +48,7 @@ parser parseUserInfo parsePath parseQuery parseFragment = URI <*> HPart.parser parseUserInfo parsePath <*> optionMaybe (Query.parser' parseQuery) <*> optionMaybe (Fragment.parser' parseFragment) - -- <* eof + <* eof print ∷ ∀ userInfo path query fragment diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index ef188f4..0443524 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -21,7 +21,7 @@ parser → Parser (URIRef userInfo absPath relPath query fragment) parser parseUserInfo parseAbsPath parseRelPath parseQuery parseFragment = (Left <$> try (URI.parser parseUserInfo parseAbsPath parseQuery parseFragment)) - -- <|> (Right <$> RelativeRef.parser parseUserInfo parseRelPath parseQuery parseFragment) + <|> (Right <$> RelativeRef.parser parseUserInfo parseRelPath parseQuery parseFragment) print ∷ ∀ userInfo absPath relPath query fragment diff --git a/test/Main.purs b/test/Main.purs index 5a84338..bef3db4 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -41,9 +41,7 @@ import Text.Parsing.StringParser (Parser(..), ParseError(..), runParser) idp ∷ Parser String idp = Parser case _ of - { str, pos } - | String.null str → Left { pos, error: ParseError "empty string" } - | otherwise → Right { result: str, suffix: { str, pos: pos + String.length str }} + { str, pos } → Right { result: str, suffix: { str, pos: pos + String.length str }} testPrinter :: forall a b. Show b => (b -> String) -> String -> b -> TestSuite a testPrinter f expected uri = @@ -494,10 +492,46 @@ main = runTest $ suite "Data.URI" do -- ((Just mempty)) -- ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) - -- testRunParseURIRefFails "news:comp.infosystems.www.servers.unix" - -- testRunParseURIRefFails "tel:+1-816-555-1212" - -- testRunParseURIRefFails "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" - -- testRunParseURIRefFails "mailto:John.Doe@example.com" + testIsoURIRef + "news:comp.infosystems.www.servers.unix" + (Left + (URI + (Scheme "news") + (HierarchicalPart + Nothing + (Just "comp.infosystems.www.servers.unix")) + Nothing + Nothing)) + testIsoURIRef + "tel:+1-816-555-1212" + (Left + (URI + (Scheme "tel") + (HierarchicalPart + Nothing + (Just "+1-816-555-1212")) + Nothing + Nothing)) + testIsoURIRef + "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" + (Left + (URI + (Scheme "urn") + (HierarchicalPart + Nothing + (Just "oasis:names:specification:docbook:dtd:xml:4.1.2")) + Nothing + Nothing)) + testIsoURIRef + "mailto:John.Doe@example.com" + (Left + (URI + (Scheme "mailto") + (HierarchicalPart + Nothing + (Just "John.Doe@example.com")) + Nothing + Nothing)) testIsoURIRef "mailto:fred@example.com" (Left @@ -509,48 +543,48 @@ main = runTest $ suite "Data.URI" do Nothing Nothing)) - -- suite "Query.print" do - -- testPrintQuerySerializes - -- (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) - -- "?key1=value1&key2=value2&key1=value3" - -- testPrintQuerySerializes - -- (Query (Tuple "k=ey" (Just "value=1") : Nil)) - -- "?k%3Dey=value%3D1" - -- testPrintQuerySerializes (Query Nil) "?" - -- testPrintQuerySerializes - -- (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) - -- "?key1=&key2=" - -- testPrintQuerySerializes - -- (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) - -- "?key1&key2" - -- testPrintQuerySerializes - -- (Query (Tuple "key1" (Just "foo;bar") : Nil)) - -- "?key1=foo%3Bbar" - -- - -- suite "Query.parser" do - -- testParseQueryParses - -- "?key1=value1&key2=value2&key1=value3" - -- (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) - -- testParseQueryParses - -- "?key1&key2" - -- (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) - -- testParseQueryParses - -- "?key1=&key2=" - -- (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) - -- testParseQueryParses - -- "?key1=foo%3Bbar" - -- (Query (Tuple "key1" (Just "foo;bar") : Nil)) - -- - -- suite "Common.match1From" do - -- testMatch1FromMisses (regex "key1" noFlags) 0 "" - -- testMatch1FromMisses (regex "key1" noFlags) 1 "key1" - -- testMatch1FromMisses (regex "key1" noFlags) 1 "key1=&key1=" - -- testMatch1FromMisses (regex "key1" global) 1 "key1=&key1=" - -- testMatch1FromMisses (regex "key1|key2" noFlags) 1 "key1=&key2=" - -- - -- testMatch1FromMatches (regex "key1" noFlags) 0 "key1" (Just "key1") - -- testMatch1FromMatches (regex "key1" noFlags) 6 "key1=&key1=" (Just "key1") - -- testMatch1FromMatches (regex "key1|key2" noFlags) 6 "key1=&key2=" (Just "key2") + suite "Query.print" do + testPrintQuerySerializes + (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + "?key1=value1&key2=value2&key1=value3" + testPrintQuerySerializes + (Query (Tuple "k=ey" (Just "value=1") : Nil)) + "?k%3Dey=value%3D1" + testPrintQuerySerializes (Query Nil) "?" + testPrintQuerySerializes + (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + "?key1=&key2=" + testPrintQuerySerializes + (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + "?key1&key2" + testPrintQuerySerializes + (Query (Tuple "key1" (Just "foo;bar") : Nil)) + "?key1=foo%3Bbar" + + suite "Query.parser" do + testParseQueryParses + "?key1=value1&key2=value2&key1=value3" + (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + testParseQueryParses + "?key1&key2" + (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + testParseQueryParses + "?key1=&key2=" + (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + testParseQueryParses + "?key1=foo%3Bbar" + (Query (Tuple "key1" (Just "foo;bar") : Nil)) + + suite "Common.match1From" do + testMatch1FromMisses (regex "key1" noFlags) 0 "" + testMatch1FromMisses (regex "key1" noFlags) 1 "key1" + testMatch1FromMisses (regex "key1" noFlags) 1 "key1=&key1=" + testMatch1FromMisses (regex "key1" global) 1 "key1=&key1=" + testMatch1FromMisses (regex "key1|key2" noFlags) 1 "key1=&key2=" + + testMatch1FromMatches (regex "key1" noFlags) 0 "key1" (Just "key1") + testMatch1FromMatches (regex "key1" noFlags) 6 "key1=&key1=" (Just "key1") + testMatch1FromMatches (regex "key1|key2" noFlags) 6 "key1=&key2=" (Just "key2") forAll :: forall eff prop. QC.Testable prop => QCG.Gen prop -> Test (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) forAll = quickCheck From df02b9ef1e949721f9fcc9a585375ed34d6b029c Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 29 Jan 2018 11:45:12 +0000 Subject: [PATCH 04/69] WIP --- src/Data/URI/Common.purs | 4 + src/Data/URI/Fragment.purs | 9 +- src/Data/URI/Query.purs | 9 +- test/Main.purs | 312 ++++++++++++++++++------------------- 4 files changed, 158 insertions(+), 176 deletions(-) diff --git a/src/Data/URI/Common.purs b/src/Data/URI/Common.purs index fa779d2..6c93ab7 100644 --- a/src/Data/URI/Common.purs +++ b/src/Data/URI/Common.purs @@ -17,6 +17,10 @@ import Partial.Unsafe (unsafePartial) import Text.Parsing.StringParser (ParseError(..), Parser(..), unParser) import Text.Parsing.StringParser.String (string) +anyString ∷ Parser String +anyString = Parser case _ of + { str, pos } → Right { result: str, suffix: { str, pos: pos + S.length str }} + joinWith ∷ String → List String → String joinWith x y = S.joinWith x $ fromFoldable y diff --git a/src/Data/URI/Fragment.purs b/src/Data/URI/Fragment.purs index ffa555e..88ed35e 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/Data/URI/Fragment.purs @@ -10,7 +10,7 @@ import Data.Newtype (class Newtype) import Data.String as S import Data.String.Regex as RX import Data.String.Regex.Flags as RXF -import Data.URI.Common (decodePCTComponent, joinWith, parsePChar, wrapParser) +import Data.URI.Common (anyString, decodePCTComponent, joinWith, parsePChar, wrapParser) import Global (encodeURIComponent) import Partial.Unsafe (unsafePartial) import Text.Parsing.StringParser (Parser) @@ -32,16 +32,13 @@ parser' parseF = string "#" *> <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) parser ∷ Parser Fragment -parser = string "#" *> - (Fragment <<< joinWith "" - <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) +parser = Fragment <$> anyString print' ∷ ∀ f. (f → String) → f → String print' printF f = "#" <> printF f print ∷ Fragment → String -print (Fragment f) = - "#" <> S.joinWith "" (map printChar $ S.split (S.Pattern "") f) +print (Fragment f) = S.joinWith "" (map printChar $ S.split (S.Pattern "") f) where -- Fragments & queries have a bunch of characters that don't need escaping printChar ∷ String → String diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index ba15a0f..cf8e234 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -12,7 +12,7 @@ import Control.Alt ((<|>)) import Data.Either (fromRight) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) -import Data.List (List(..)) +import Data.List (List) import Data.Maybe (Maybe(..)) import Data.Monoid (class Monoid) import Data.Newtype (class Newtype) @@ -42,7 +42,7 @@ parser' ∷ ∀ q. Parser q → Parser q parser' parseQ = string "?" *> (wrapParser parseQ (try (rxPat "[^#]*"))) parser ∷ Parser Query -parser = string "?" *> (Query <$> wrapParser parseParts (try (rxPat "[^#]*"))) +parser = Query <$> parseParts parseParts ∷ Parser (List (Tuple String (Maybe String))) parseParts = sepBy parsePart (string ";" <|> string "&") @@ -57,10 +57,7 @@ print' ∷ ∀ q. (q → String) → q → String print' printQ q = "?" <> printQ q print ∷ Query → String -print (Query m) = - case m of - Nil → "?" - items → "?" <> joinWith "&" (printPart <$> items) +print (Query m) = joinWith "&" (printPart <$> m) where printPart ∷ Tuple String (Maybe String) → String printPart (Tuple k Nothing) = diff --git a/test/Main.purs b/test/Main.purs index bef3db4..090ad08 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -13,17 +13,18 @@ import Data.List (List(..), singleton, (:)) import Data.Maybe (Maybe(Nothing, Just)) import Data.Monoid (mempty) import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) -import Data.String as String import Data.String.Regex (Regex, regex) import Data.String.Regex.Flags (global, noFlags) import Data.Tuple (Tuple(..)) -import Data.URI (AbsoluteURI(..), Authority(..), Fragment(..), HierarchicalPart(..), Host(..), Port(..), Query(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..), UserInfo(..), URIRef) +import Data.URI (AbsoluteURI(..), Authority(..), Fragment(..), HierarchicalPart(..), Host(..), Port(..), Query(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..), URIPathAbs, UserInfo(..), URIPathRel) import Data.URI.AbsoluteURI as AbsoluteURI import Data.URI.Authority as Authority +import Data.URI.Common (anyString) import Data.URI.Common as Common +import Data.URI.Fragment as Fragment import Data.URI.Host as Host import Data.URI.Host.Gen as Host.Gen -import Data.URI.Fragment as Fragment +import Data.URI.Path as Path import Data.URI.Port as Port import Data.URI.Query as Query import Data.URI.Scheme as Scheme @@ -37,11 +38,7 @@ import Test.Unit (Test, suite, test, TestSuite) import Test.Unit.Assert (assert, equal) import Test.Unit.Console (TESTOUTPUT) import Test.Unit.Main (runTest) -import Text.Parsing.StringParser (Parser(..), ParseError(..), runParser) - -idp ∷ Parser String -idp = Parser case _ of - { str, pos } → Right { result: str, suffix: { str, pos: pos + String.length str }} +import Text.Parsing.StringParser (Parser, runParser) testPrinter :: forall a b. Show b => (b -> String) -> String -> b -> TestSuite a testPrinter f expected uri = @@ -60,11 +57,11 @@ testIso p f uri expected = do testRunParseSuccess p uri expected testPrinter f uri expected -testIsoURI :: forall a. String -> URI.URI String String String String -> TestSuite a -testIsoURI = testIso (URI.parser idp idp idp idp) (URI.print id id id id) +testIsoURI :: forall a. String -> URI.URI UserInfo URIPathAbs Query Fragment -> TestSuite a +testIsoURI = testIso (URI.parser UserInfo.parser Path.parseURIPathAbs Query.parser Fragment.parser) (URI.print UserInfo.print Path.printPath Query.print Fragment.print) -testIsoURIRef :: forall a. String -> URIRef.URIRef String String String String String -> TestSuite a -testIsoURIRef = testIso (URIRef.parser idp idp idp idp idp) (URIRef.print id id id id id) +testIsoURIRef :: forall a. String -> URIRef.URIRef UserInfo URIPathAbs URIPathRel Query Fragment -> TestSuite a +testIsoURIRef = testIso (URIRef.parser UserInfo.parser Path.parseURIPathAbs Path.parseURIPathRel Query.parser Fragment.parser) (URIRef.print UserInfo.print Path.printPath Path.printPath Query.print Fragment.print) -- testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a -- testRunParseURIRefParses = testRunParseSuccess URIRef.parser @@ -73,19 +70,19 @@ testRunParseURIRefFails :: forall a. String -> TestSuite a testRunParseURIRefFails uri = test ("fails to parse: " <> uri) - (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParser (URIRef.parser idp idp idp idp idp) $ uri) + (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParser (URIRef.parser anyString anyString anyString anyString anyString) $ uri) testPrintQuerySerializes :: forall a. Query -> String -> TestSuite a testPrintQuerySerializes query expected = test ("serializes: " <> show query) - (equal expected (Query.print query)) + (equal expected (Query.print' Query.print query)) testParseQueryParses :: forall a. String -> Query -> TestSuite a testParseQueryParses uri query = test ("parses: \"" <> uri <> "\"") - (equal (Right query) (runParser Query.parser uri)) + (equal (Right query) (runParser (Query.parser' Query.parser) uri)) testMatch1FromMatches :: forall a. Either String Regex -> Int -> String -> Maybe String -> TestSuite a testMatch1FromMatches rx' n str expected = case rx' of @@ -142,15 +139,15 @@ main = runTest $ suite "Data.URI" do testRunParseSuccess Port.parser "63174" (Port 63174) suite "Fragment' parser" do - testRunParseSuccess (Fragment.parser' idp) "#" "" + testRunParseSuccess (Fragment.parser' anyString) "#" "" suite "Authority parser" do testRunParseSuccess - (Authority.parser idp) + (Authority.parser anyString) "//localhost" (Authority Nothing [Tuple (NameAddress "localhost") Nothing]) testRunParseSuccess - (Authority.parser idp) + (Authority.parser anyString) "//localhost:3000" (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 3000))]) @@ -162,8 +159,8 @@ main = runTest $ suite "Data.URI" do (Scheme "sql2") (HierarchicalPart (Just (Authority Nothing [])) - (Just "/")) - (Just "q=foo&var.bar=baz") + (Just (Left rootDir))) + (Just (Query (Tuple "q" (Just "foo") : Tuple "var.bar" (Just "baz") : Nil))) Nothing)) testIsoURIRef "mongodb://localhost" @@ -192,7 +189,7 @@ main = runTest $ suite "Data.URI" do (Scheme "http") (HierarchicalPart (Just (Authority Nothing [Tuple (NameAddress "en.wikipedia.org") Nothing])) - (Just "/wiki/URI_scheme")) + ((Just (Right ((rootDir dir "wiki") file "URI_scheme"))))) Nothing Nothing)) testIsoURIRef @@ -203,11 +200,13 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority - (Just "foo:bar") + (Just (UserInfo "foo:bar")) [ Tuple (NameAddress "db1.example.net") Nothing , Tuple (NameAddress "db2.example.net") (Just (Port 2500))])) - (Just "/authdb")) - (Just "replicaSet=test&connectTimeoutMS=300000") + (Just (Right (rootDir file "authdb")))) + (Just + (Query + (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) Nothing)) testIsoURIRef "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" @@ -215,9 +214,9 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just "foo:bar") [(Tuple (NameAddress "db1.example.net") (Just (Port 6))),(Tuple (NameAddress "db2.example.net") (Just (Port 2500)))])) - (Just "/authdb")) - (Just "replicaSet=test&connectTimeoutMS=300000") + (Just (Authority (Just (UserInfo "foo:bar")) [(Tuple (NameAddress "db1.example.net") (Just (Port 6))),(Tuple (NameAddress "db2.example.net") (Just (Port 2500)))])) + (Just (Right (rootDir file "authdb")))) + (Just (Query (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) Nothing)) testIsoURIRef "mongodb://192.168.0.1" @@ -248,17 +247,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just "sysop:moon") [(Tuple (NameAddress "localhost") Nothing)])) - Nothing) - Nothing - Nothing)) - testIsoURIRef - "mongodb://user@localhost" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPart - (Just (Authority (Just "user") [(Tuple (NameAddress "localhost") Nothing)])) + (Just(Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) Nothing) Nothing Nothing)) @@ -268,8 +257,8 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just "sysop:moon") [(Tuple (NameAddress "localhost") Nothing)])) - (Just "/")) + (Just (Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Left rootDir))) Nothing Nothing)) testIsoURIRef @@ -278,8 +267,8 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just "sysop:moon") [(Tuple (NameAddress "localhost") Nothing)])) - (Just "/records")) + (Just (Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Right (rootDir file "records")))) Nothing Nothing)) testIsoURIRef @@ -319,7 +308,7 @@ main = runTest $ suite "Data.URI" do (Scheme "ftp") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "ftp.is.co.za") Nothing)])) - (Just "/rfc/rfc1808.txt")) + (Just (Right ((rootDir dir "rfc") file "rfc1808.txt")))) Nothing Nothing)) testIsoURIRef @@ -327,9 +316,7 @@ main = runTest $ suite "Data.URI" do (Left (URI (Scheme "http") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress "www.ietf.org") Nothing)])) - (Just "/rfc/rfc2396.txt")) + (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "www.ietf.org") Nothing)])) (Just (Right ((rootDir dir "rfc") file "rfc2396.txt")))) Nothing Nothing)) testIsoURIRef @@ -339,8 +326,8 @@ main = runTest $ suite "Data.URI" do (Scheme "ldap") (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::7") Nothing)])) - (Just "/c=GB")) - (Just "objectClass?one") + (Just (Right (rootDir file "c=GB")))) + (Just (Query (singleton $ (Tuple "objectClass?one" Nothing)))) Nothing)) testIsoURIRef "telnet://192.0.2.16:80/" @@ -349,7 +336,7 @@ main = runTest $ suite "Data.URI" do (Scheme "telnet") (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv4Address "192.0.2.16") (Just (Port 80)))])) - (Just "/")) + (Just (Left rootDir))) Nothing Nothing)) testIsoURIRef @@ -357,21 +344,17 @@ main = runTest $ suite "Data.URI" do (Left (URI (Scheme "foo") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) - (Just "/over/there")) - (Just "name=ferret") - (Just "nose"))) + (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) + (Just (Query (singleton (Tuple "name" (Just "ferret"))))) + (Just (Fragment "nose")))) testIsoURIRef "foo://example.com:8042/over/there?name=ferret#" (Left (URI (Scheme "foo") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) - (Just "/over/there")) - (Just "name=ferret") - (Just ""))) + (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) + (Just (Query (singleton (Tuple "name" (Just "ferret"))))) + (Just (Fragment "")))) testIsoURIRef "foo://info.example.com?fred" (Left @@ -380,7 +363,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "info.example.com") Nothing)])) Nothing) - (Just "fred") + (Just (Query (singleton $ Tuple "fred" Nothing))) Nothing)) testIsoURIRef "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" @@ -390,9 +373,9 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority - (Just "cnn.example.com&story=breaking_news") + (Just (UserInfo "cnn.example.com&story=breaking_news")) [(Tuple (IPv4Address "10.0.0.1") Nothing)])) - (Just "/top_story.htm")) + (Just (Right (rootDir file "top_story.htm")))) Nothing Nothing)) testIsoURIRef @@ -401,7 +384,7 @@ main = runTest $ suite "Data.URI" do (RelativeRef (RelativePart Nothing - (Just "../top_story.htm")) + (Just (Right ((parentDir' currentDir) file "top_story.htm")))) Nothing Nothing)) testIsoURIRef @@ -410,21 +393,12 @@ main = runTest $ suite "Data.URI" do (RelativeRef (RelativePart Nothing - (Just "top_story.htm")) - Nothing - Nothing)) - testIsoURIRef - "/top_story.htm" - (Right - (RelativeRef - (RelativePart - Nothing - (Just ("/top_story.htm"))) + (Just (Right (currentDir file "top_story.htm")))) Nothing Nothing)) testIso - (AbsoluteURI.parser idp idp idp) - (AbsoluteURI.print id id id) + (AbsoluteURI.parser UserInfo.parser Path.parseURIPathAbs Query.parser) + (AbsoluteURI.print UserInfo.print Path.printPath Query.print) "couchbase://localhost/testBucket?password=&docTypeKey=" (AbsoluteURI (Scheme "couchbase") @@ -433,11 +407,11 @@ main = runTest $ suite "Data.URI" do (Authority Nothing [(Tuple (NameAddress "localhost") Nothing)])) - (Just "/testBucket")) - (Just "password=&docTypeKey=")) + (Just (Right (rootDir file "testBucket")))) + (Just (Query (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)))) testIso - (AbsoluteURI.parser idp idp idp) - (AbsoluteURI.print id id id) + (AbsoluteURI.parser UserInfo.parser Path.parseURIPathAbs Query.parser) + (AbsoluteURI.print UserInfo.print Path.printPath Query.print) "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (AbsoluteURI (Scheme "couchbase") @@ -446,103 +420,113 @@ main = runTest $ suite "Data.URI" do (Authority Nothing [(Tuple (NameAddress "localhost") (Just (Port 99999)))])) - (Just "/testBucket")) - (Just "password=pass&docTypeKey=type&queryTimeoutSeconds=20")) - -- testIsoURIRef - -- "http://www.example.com/some%20invented/url%20with%20spaces.html" - -- (Left - -- (URI - -- (Scheme "http") - -- (HierarchicalPart - -- (Just (Authority Nothing [Tuple (NameAddress "www.example.com") Nothing])) - -- ((Just "/some invented/url with spaces.html"))) - -- Nothing - -- Nothing)) - -- testIsoURIRef - -- "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" - -- (Left - -- (URI - -- (Scheme "http") - -- (HierarchicalPart - -- (Just (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 53174))])) - -- ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) - -- (Just mempty) - -- Nothing)) - -- - -- -- Not an iso in this case as the printed path is normalised - -- testRunParseURIRefParses - -- "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" - -- (Left - -- (URI - -- (Scheme "http") - -- (HierarchicalPart - -- (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) - -- ((Just (Left rootDir)))) - -- ((Just mempty)) - -- ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) - -- testPrinter - -- URIRef.print - -- "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" - -- (Left - -- (URI - -- (Scheme "http") - -- (HierarchicalPart - -- (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) - -- ((Just (Left rootDir)))) - -- ((Just mempty)) - -- ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) - - testIsoURIRef - "news:comp.infosystems.www.servers.unix" - (Left - (URI - (Scheme "news") - (HierarchicalPart - Nothing - (Just "comp.infosystems.www.servers.unix")) - Nothing - Nothing)) - testIsoURIRef - "tel:+1-816-555-1212" - (Left - (URI - (Scheme "tel") - (HierarchicalPart - Nothing - (Just "+1-816-555-1212")) - Nothing - Nothing)) - testIsoURIRef - "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" - (Left - (URI - (Scheme "urn") - (HierarchicalPart - Nothing - (Just "oasis:names:specification:docbook:dtd:xml:4.1.2")) - Nothing - Nothing)) + (Just (Right (rootDir file "testBucket")))) + (Just (Query (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)))) testIsoURIRef - "mailto:John.Doe@example.com" + "http://www.example.com/some%20invented/url%20with%20spaces.html" (Left (URI - (Scheme "mailto") + (Scheme "http") (HierarchicalPart - Nothing - (Just "John.Doe@example.com")) + (Just (Authority Nothing [Tuple (NameAddress "www.example.com") Nothing])) + ((Just (Right ((rootDir dir "some invented") file "url with spaces.html"))))) Nothing Nothing)) testIsoURIRef - "mailto:fred@example.com" + "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" (Left (URI - (Scheme "mailto") + (Scheme "http") (HierarchicalPart - Nothing - (Just "fred@example.com")) - Nothing + (Just (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 53174))])) + ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) + (Just mempty) Nothing)) + -- testIsoURIRef + -- "../top_story.htm" + -- (Right + -- (RelativeRef + -- (RelativePart + -- Nothing + -- (Just (Right (parentDir' currentDir file "top_story.htm")))) + -- Nothing + -- Nothing)) + + -- Not an iso in this case as the printed path is normalised + -- testRunParseURIRefParses + -- "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" + -- (Left + -- (URI + -- (Scheme "http") + -- (HierarchicalPart + -- (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) + -- ((Just (Left rootDir)))) + -- ((Just mempty)) + -- ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) + -- testPrinter + -- URIRef.print + -- "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" + -- (Left + -- (URI + -- (Scheme "http") + -- (HierarchicalPart + -- (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) + -- ((Just (Left rootDir)))) + -- ((Just mempty)) + -- ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) + + -- testIsoURIRef + -- "news:comp.infosystems.www.servers.unix" + -- (Left + -- (URI + -- (Scheme "news") + -- (HierarchicalPart + -- Nothing + -- (Just "comp.infosystems.www.servers.unix")) + -- Nothing + -- Nothing)) + -- testIsoURIRef + -- "tel:+1-816-555-1212" + -- (Left + -- (URI + -- (Scheme "tel") + -- (HierarchicalPart + -- Nothing + -- (Just "+1-816-555-1212")) + -- Nothing + -- Nothing)) + -- testIsoURIRef + -- "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" + -- (Left + -- (URI + -- (Scheme "urn") + -- (HierarchicalPart + -- Nothing + -- (Just "oasis:names:specification:docbook:dtd:xml:4.1.2")) + -- Nothing + -- Nothing)) + -- testIsoURIRef + -- "mailto:John.Doe@example.com" + -- (Left + -- (URI + -- (Scheme "mailto") + -- (HierarchicalPart + -- Nothing + -- (Just "John.Doe@example.com")) + -- Nothing + -- Nothing)) + -- testIsoURIRef + -- "mailto:fred@example.com" + -- (Left + -- (URI + -- (Scheme "mailto") + -- (HierarchicalPart + -- Nothing + -- (Just "fred@example.com")) + -- Nothing + -- Nothing)) + suite "Query.print" do testPrintQuerySerializes (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) From b843e7f0cb0eb49679f1f0d62606e8139923b0a3 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 29 Jan 2018 12:12:09 +0000 Subject: [PATCH 05/69] Split "nonstandard" types out --- src/Data/URI.purs | 8 --- src/Data/URI/AbsoluteURI.purs | 6 +- src/Data/URI/Authority.purs | 4 +- src/Data/URI/Fragment.purs | 43 ++---------- src/Data/URI/HierarchicalPart.purs | 2 +- src/Data/URI/NonStandard/Fragment.purs | 39 +++++++++++ src/Data/URI/NonStandard/Path.purs | 55 +++++++++++++++ src/Data/URI/NonStandard/Query.purs | 70 +++++++++++++++++++ src/Data/URI/NonStandard/UserInfo.purs | 25 +++++++ src/Data/URI/Path.purs | 64 ++--------------- src/Data/URI/Query.purs | 77 ++------------------- src/Data/URI/RelativePart.purs | 2 +- src/Data/URI/RelativeRef.purs | 10 +-- src/Data/URI/URI.purs | 10 +-- src/Data/URI/UserInfo.purs | 29 ++------ test/Main.purs | 95 +++++++++++++------------- 16 files changed, 274 insertions(+), 265 deletions(-) create mode 100644 src/Data/URI/NonStandard/Fragment.purs create mode 100644 src/Data/URI/NonStandard/Path.purs create mode 100644 src/Data/URI/NonStandard/Query.purs create mode 100644 src/Data/URI/NonStandard/UserInfo.purs diff --git a/src/Data/URI.purs b/src/Data/URI.purs index c2a162b..9acbabb 100755 --- a/src/Data/URI.purs +++ b/src/Data/URI.purs @@ -1,31 +1,23 @@ module Data.URI ( module Data.URI.AbsoluteURI , module Data.URI.Authority - , module Data.URI.Fragment , module Data.URI.HierarchicalPart , module Data.URI.Host - , module Data.URI.Path , module Data.URI.Port - , module Data.URI.Query , module Data.URI.RelativePart , module Data.URI.RelativeRef , module Data.URI.Scheme , module Data.URI.URI , module Data.URI.URIRef - , module Data.URI.UserInfo ) where import Data.URI.AbsoluteURI (AbsoluteURI(..)) import Data.URI.Authority (Authority(..)) -import Data.URI.Fragment (Fragment(..)) import Data.URI.HierarchicalPart (HierarchicalPart(..)) import Data.URI.Host (Host(..)) -import Data.URI.Path (URIPath, URIPathAbs, URIPathRel) import Data.URI.Port (Port(..)) -import Data.URI.Query (Query(..)) import Data.URI.RelativePart (RelativePart(..)) import Data.URI.RelativeRef (RelativeRef(..)) import Data.URI.Scheme (Scheme(..)) import Data.URI.URI (URI(..)) import Data.URI.URIRef (URIRef) -import Data.URI.UserInfo (UserInfo(..)) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 08d4752..c0cb842 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -18,7 +18,7 @@ import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S import Data.URI.HierarchicalPart as HPart -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.Query as Query import Data.URI.Scheme as Scheme import Data.URI.Scheme (Scheme(..)) @@ -43,7 +43,7 @@ parser parser parseUserInfo parsePath parseQuery = AbsoluteURI <$> Scheme.parser <*> HPart.parser parseUserInfo parsePath - <*> optionMaybe (Query.parser' parseQuery) + <*> optionMaybe (Query.parser parseQuery) <* eof print @@ -57,7 +57,7 @@ print printUserInfo printPath printQuery (AbsoluteURI s h q) = S.joinWith "" $ catMaybes [ Just (Scheme.print s) , Just (HPart.print printUserInfo printPath h) - , Query.print' printQuery <$> q + , Query.print printQuery <$> q ] _scheme diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index 82ca556..eeff5e0 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -6,7 +6,6 @@ module Data.URI.Authority , _hosts , module Data.URI.Host , module Data.URI.Port - , module Data.URI.UserInfo ) where import Prelude @@ -22,7 +21,6 @@ import Data.URI.Host (Host(..), _IPv4Address, _IPv6Address, _NameAddress) import Data.URI.Host as Host import Data.URI.Port (Port(..)) import Data.URI.Port as Port -import Data.URI.UserInfo (UserInfo(..)) import Data.URI.UserInfo as UserInfo import Text.Parsing.StringParser (Parser, try) import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy) @@ -40,7 +38,7 @@ instance showAuthority ∷ Show userInfo ⇒ Show (Authority userInfo) where sho parser ∷ ∀ userInfo. Parser userInfo → Parser (Authority userInfo) parser parseUserInfo = do _ ← string "//" - ui ← optionMaybe $ try (UserInfo.parser' parseUserInfo <* string "@") + ui ← optionMaybe $ try (UserInfo.parser parseUserInfo <* string "@") hosts ← flip sepBy (string ",") $ Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser) pure $ Authority ui (fromFoldable hosts) diff --git a/src/Data/URI/Fragment.purs b/src/Data/URI/Fragment.purs index 88ed35e..032b6b9 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/Data/URI/Fragment.purs @@ -3,48 +3,15 @@ module Data.URI.Fragment where import Prelude import Control.Alt ((<|>)) -import Data.Either (fromRight) -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.Newtype (class Newtype) -import Data.String as S -import Data.String.Regex as RX -import Data.String.Regex.Flags as RXF -import Data.URI.Common (anyString, decodePCTComponent, joinWith, parsePChar, wrapParser) -import Global (encodeURIComponent) -import Partial.Unsafe (unsafePartial) +import Data.URI.Common (decodePCTComponent, joinWith, parsePChar, wrapParser) import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (many) import Text.Parsing.StringParser.String (string) --- | The hash fragment of a URI. -newtype Fragment = Fragment String - -derive newtype instance eqFragment ∷ Eq Fragment -derive newtype instance ordFragment ∷ Ord Fragment -derive instance genericFragment ∷ Generic Fragment _ -derive instance newtypeFragment ∷ Newtype Fragment _ -instance showFragment ∷ Show Fragment where show = genericShow - -parser' ∷ ∀ f. Parser f → Parser f -parser' parseF = string "#" *> +parser ∷ ∀ f. Parser f → Parser f +parser parseF = string "#" *> wrapParser parseF (joinWith "" <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) -parser ∷ Parser Fragment -parser = Fragment <$> anyString - -print' ∷ ∀ f. (f → String) → f → String -print' printF f = "#" <> printF f - -print ∷ Fragment → String -print (Fragment f) = S.joinWith "" (map printChar $ S.split (S.Pattern "") f) - where - -- Fragments & queries have a bunch of characters that don't need escaping - printChar ∷ String → String - printChar s - | RX.test rxPrintable s = s - | otherwise = encodeURIComponent s - -rxPrintable ∷ RX.Regex -rxPrintable = unsafePartial fromRight $ RX.regex "[&;$+=/?:@]" RXF.global +print ∷ ∀ f. (f → String) → f → String +print printF f = "#" <> printF f diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index 2aec03e..d2122df 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -16,7 +16,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S -import Data.URI.Authority (Authority(..), Host(..), Port(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.URI.Authority (Authority(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Path as Path import Text.Parsing.StringParser (Parser) diff --git a/src/Data/URI/NonStandard/Fragment.purs b/src/Data/URI/NonStandard/Fragment.purs new file mode 100644 index 0000000..9bb4ec5 --- /dev/null +++ b/src/Data/URI/NonStandard/Fragment.purs @@ -0,0 +1,39 @@ +module Data.URI.NonStandard.Fragment where + +import Prelude + +import Data.Either (fromRight) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Newtype (class Newtype) +import Data.String as S +import Data.String.Regex as RX +import Data.String.Regex.Flags as RXF +import Data.URI.Common (anyString) +import Global (encodeURIComponent) +import Partial.Unsafe (unsafePartial) +import Text.Parsing.StringParser (Parser) + +-- | The hash fragment of a URI. +newtype Fragment = Fragment String + +derive newtype instance eqFragment ∷ Eq Fragment +derive newtype instance ordFragment ∷ Ord Fragment +derive instance genericFragment ∷ Generic Fragment _ +derive instance newtypeFragment ∷ Newtype Fragment _ +instance showFragment ∷ Show Fragment where show = genericShow + +parser ∷ Parser Fragment +parser = Fragment <$> anyString + +print ∷ Fragment → String +print (Fragment f) = S.joinWith "" (map printChar $ S.split (S.Pattern "") f) + where + -- Fragments & queries have a bunch of characters that don't need escaping + printChar ∷ String → String + printChar s + | RX.test rxPrintable s = s + | otherwise = encodeURIComponent s + +rxPrintable ∷ RX.Regex +rxPrintable = unsafePartial fromRight $ RX.regex "[&;$+=/?:@]" RXF.global diff --git a/src/Data/URI/NonStandard/Path.purs b/src/Data/URI/NonStandard/Path.purs new file mode 100644 index 0000000..2b673de --- /dev/null +++ b/src/Data/URI/NonStandard/Path.purs @@ -0,0 +1,55 @@ +module Data.URI.NonStandard.Path + ( URIPath + , URIPathAbs + , URIPathRel + , parseURIPathAbs + , parseURIPathRel + , printPath + ) where + +import Prelude + +import Data.Either (Either(..), either) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Path.Pathy (Abs, Dir, Escaper(..), File, Path, Rel, Sandboxed, Unsandboxed, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile, rootDir, sandbox, unsafePrintPath', ()) +import Data.String as Str +import Global (encodeURI) +import Text.Parsing.StringParser (ParseError(..), Parser(..)) + +-- | A general URI path, can be used to represent relative or absolute paths +-- | that are sandboxed or unsandboxed. +type URIPath a s = Either (Path a Dir s) (Path a File s) + +-- | The path part for a generic or absolute URI. +type URIPathAbs = URIPath Abs Sandboxed + +-- | The path part for a relative reference. +type URIPathRel = URIPath Rel Unsandboxed + +parseURIPathAbs ∷ Parser URIPathAbs +parseURIPathAbs = Parser \{ str: str, pos: i } → + case sandbox rootDir =<< parseAbsFile (Str.drop i str) of + Just file → Right { result: (Right $ rootDir file), suffix: { str: str, pos: Str.length str }} + Nothing → case sandbox rootDir =<< parseAbsDir (Str.drop i str) of + Just dir → Right { result: (Left $ rootDir dir), suffix: { str: str, pos: Str.length str }} + Nothing → Left { error: (ParseError $ "Expected a valid path"), pos: i } + +parseURIPathRel ∷ Parser URIPathRel +parseURIPathRel = Parser \{ str: str, pos: i } → + case parseRelFile (Str.drop i str) of + Just file → Right { result : Right file, suffix: { str: str, pos: Str.length str }} + Nothing → case parseRelDir (Str.drop i str) of + Just dir → Right { result : Left dir, suffix: { str: str, pos: Str.length str }} + Nothing → Left { error: (ParseError $ "Expected a valid path"), pos: i} + +printPath ∷ ∀ a s. URIPath a s → String +printPath = either printPath' printPath' + +printPath' ∷ ∀ a' b s'. Path a' b s' → String +printPath' path = + let printed = unsafePrintPath' escaper path + in fromMaybe printed $ Str.stripPrefix (Str.Pattern "./") printed + +escaper ∷ Escaper +escaper = Escaper $ + Str.replaceAll (Str.Pattern "#") (Str.Replacement "%23") <<< encodeURI diff --git a/src/Data/URI/NonStandard/Query.purs b/src/Data/URI/NonStandard/Query.purs new file mode 100644 index 0000000..858637a --- /dev/null +++ b/src/Data/URI/NonStandard/Query.purs @@ -0,0 +1,70 @@ +module Data.URI.NonStandard.Query + ( Query(..) + , parser + , print + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Either (fromRight) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.List (List) +import Data.Maybe (Maybe(..)) +import Data.Monoid (class Monoid) +import Data.Newtype (class Newtype) +import Data.String as S +import Data.String.Regex as RX +import Data.String.Regex.Flags as RXF +import Data.Tuple (Tuple(..)) +import Data.URI.Common (joinWith, rxPat) +import Global (decodeURIComponent, encodeURIComponent) +import Partial.Unsafe (unsafePartial) +import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy) +import Text.Parsing.StringParser.String (string) + +-- | The query component of a URI. +newtype Query = Query (List (Tuple String (Maybe String))) + +derive newtype instance eqQuery ∷ Eq Query +derive newtype instance ordQuery ∷ Ord Query +derive instance genericQuery ∷ Generic Query _ +derive instance newtypeQuery ∷ Newtype Query _ +instance showQuery ∷ Show Query where show = genericShow +derive newtype instance semigroupQuery ∷ Semigroup Query +derive newtype instance monoidQuery ∷ Monoid Query + +parser ∷ Parser Query +parser = Query <$> parseParts + +parseParts ∷ Parser (List (Tuple String (Maybe String))) +parseParts = sepBy parsePart (string ";" <|> string "&") + +parsePart ∷ Parser (Tuple String (Maybe String)) +parsePart = do + key ← decodeURIComponent <$> rxPat "[^=;&]+" + value ← optionMaybe $ decodeURIComponent <$> (string "=" *> rxPat "[^;&]*") + pure $ Tuple key value + +print ∷ Query → String +print (Query m) = joinWith "&" (printPart <$> m) + where + printPart ∷ Tuple String (Maybe String) → String + printPart (Tuple k Nothing) = + printQueryPart k + printPart (Tuple k (Just v)) = + printQueryPart k <> "=" <> printQueryPart v + +printQueryPart ∷ String → String +printQueryPart = S.joinWith "" <<< map printChar <<< S.split (S.Pattern "") + where + -- Fragments & queries have a bunch of characters that don't need escaping + printChar ∷ String → String + printChar s + | RX.test rxPrintable s = s + | otherwise = encodeURIComponent s + +rxPrintable ∷ RX.Regex +rxPrintable = unsafePartial fromRight $ RX.regex "[$+/?:@]" RXF.global diff --git a/src/Data/URI/NonStandard/UserInfo.purs b/src/Data/URI/NonStandard/UserInfo.purs new file mode 100644 index 0000000..77b91b6 --- /dev/null +++ b/src/Data/URI/NonStandard/UserInfo.purs @@ -0,0 +1,25 @@ +module Data.URI.NonStandard.UserInfo where + +import Prelude + +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Newtype (class Newtype) +import Data.URI.Common (anyString) +import Global (encodeURI) +import Text.Parsing.StringParser (Parser) + +-- | The user info part of an `Authority`. For example: `user`, `foo:bar`. +newtype UserInfo = UserInfo String + +derive newtype instance eqUserInfo ∷ Eq UserInfo +derive newtype instance ordUserInfo ∷ Ord UserInfo +derive instance genericUserInfo ∷ Generic UserInfo _ +derive instance newtypeUserInfo ∷ Newtype UserInfo _ +instance showUserInfo ∷ Show UserInfo where show = genericShow + +parser ∷ Parser UserInfo +parser = UserInfo <$> anyString + +print ∷ UserInfo → String +print (UserInfo u) = encodeURI u diff --git a/src/Data/URI/Path.purs b/src/Data/URI/Path.purs index f838ffe..cbc3402 100644 --- a/src/Data/URI/Path.purs +++ b/src/Data/URI/Path.purs @@ -1,43 +1,14 @@ -module Data.URI.Path - ( URIPath - , URIPathAbs - , URIPathRel - , parsePath - , parsePathAbEmpty - , parsePathAbsolute - , parsePathNoScheme - , parsePathRootless - , parseSegment - , parseSegmentNonZero - , parseSegmentNonZeroNoColon - , parseURIPathAbs - , parseURIPathRel - , printPath - ) where +module Data.URI.Path where import Prelude import Control.Alt ((<|>)) -import Data.Either (Either(..), either) -import Data.Maybe (Maybe(..), fromMaybe) -import Data.Path.Pathy (Abs, Dir, Escaper(..), File, Path, Rel, Sandboxed, Unsandboxed, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile, rootDir, sandbox, unsafePrintPath', ()) +import Data.Maybe (Maybe(..)) import Data.String as Str import Data.URI.Common (PCTEncoded, decodePCT, joinWith, parsePCTEncoded, parsePChar, parseSubDelims, parseUnreserved, wrapParser) -import Global (encodeURI) -import Text.Parsing.StringParser (Parser(..), ParseError(..), try) +import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (many, many1, optionMaybe) import Text.Parsing.StringParser.String (string) -import Debug.Trace - --- | A general URI path, can be used to represent relative or absolute paths --- | that are sandboxed or unsandboxed. -type URIPath a s = Either (Path a Dir s) (Path a File s) - --- | The path part for a generic or absolute URI. -type URIPathAbs = URIPath Abs Sandboxed - --- | The path part for a relative reference. -type URIPathRel = URIPath Rel Unsandboxed parsePath ∷ ∀ p. Parser p → Parser (Maybe p) parsePath p @@ -83,33 +54,8 @@ parseSegmentNonZeroNoColon = joinWith "" <$> many1 (parseUnreserved <|> parsePCTEncoded decoder <|> parseSubDelims <|> string "@") -parseURIPathAbs ∷ Parser URIPathAbs -parseURIPathAbs = Parser \{ str: str, pos: i } → - case sandbox rootDir =<< parseAbsFile (Str.drop i str) of - Just file → Right { result: (Right $ rootDir file), suffix: { str: str, pos: Str.length str }} - Nothing → case sandbox rootDir =<< parseAbsDir (Str.drop i str) of - Just dir → Right { result: (Left $ rootDir dir), suffix: { str: str, pos: Str.length str }} - Nothing → Left { error: (ParseError $ "Expected a valid path"), pos: i } - -parseURIPathRel ∷ Parser URIPathRel -parseURIPathRel = Parser \{ str: str, pos: i } → - case parseRelFile (Str.drop i str) of - Just file → Right { result : Right file, suffix: { str: str, pos: Str.length str }} - Nothing → case parseRelDir (Str.drop i str) of - Just dir → Right { result : Left dir, suffix: { str: str, pos: Str.length str }} - Nothing → Left { error: (ParseError $ "Expected a valid path"), pos: i} - -printPath ∷ ∀ a s. URIPath a s → String -printPath = either printPath' printPath' - -printPath' ∷ ∀ a' b s'. Path a' b s' → String -printPath' path = - let printed = unsafePrintPath' escaper path - in fromMaybe printed $ Str.stripPrefix (Str.Pattern "./") printed - decoder ∷ PCTEncoded → String decoder = Str.replaceAll (Str.Pattern "%23") (Str.Replacement "#") <<< decodePCT -escaper ∷ Escaper -escaper = Escaper $ - Str.replaceAll (Str.Pattern "#") (Str.Replacement "%23") <<< encodeURI +printPath ∷ ∀ p. (p → String) → p → String +printPath = id diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index cf8e234..a84aa32 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -1,78 +1,13 @@ -module Data.URI.Query - ( Query(..) - , parser - , parser' - , print - , print' - ) where +module Data.URI.Query where import Prelude -import Control.Alt ((<|>)) -import Data.Either (fromRight) -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.List (List) -import Data.Maybe (Maybe(..)) -import Data.Monoid (class Monoid) -import Data.Newtype (class Newtype) -import Data.String as S -import Data.String.Regex as RX -import Data.String.Regex.Flags as RXF -import Data.Tuple (Tuple(..)) -import Data.URI.Common (joinWith, rxPat, wrapParser) -import Global (decodeURIComponent, encodeURIComponent) -import Partial.Unsafe (unsafePartial) +import Data.URI.Common (rxPat, wrapParser) import Text.Parsing.StringParser (Parser, try) -import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy) import Text.Parsing.StringParser.String (string) --- | The query component of a URI. -newtype Query = Query (List (Tuple String (Maybe String))) +parser ∷ ∀ q. Parser q → Parser q +parser parseQ = string "?" *> (wrapParser parseQ (try (rxPat "[^#]*"))) -derive newtype instance eqQuery ∷ Eq Query -derive newtype instance ordQuery ∷ Ord Query -derive instance genericQuery ∷ Generic Query _ -derive instance newtypeQuery ∷ Newtype Query _ -instance showQuery ∷ Show Query where show = genericShow -derive newtype instance semigroupQuery ∷ Semigroup Query -derive newtype instance monoidQuery ∷ Monoid Query - -parser' ∷ ∀ q. Parser q → Parser q -parser' parseQ = string "?" *> (wrapParser parseQ (try (rxPat "[^#]*"))) - -parser ∷ Parser Query -parser = Query <$> parseParts - -parseParts ∷ Parser (List (Tuple String (Maybe String))) -parseParts = sepBy parsePart (string ";" <|> string "&") - -parsePart ∷ Parser (Tuple String (Maybe String)) -parsePart = do - key ← decodeURIComponent <$> rxPat "[^=;&]+" - value ← optionMaybe $ decodeURIComponent <$> (string "=" *> rxPat "[^;&]*") - pure $ Tuple key value - -print' ∷ ∀ q. (q → String) → q → String -print' printQ q = "?" <> printQ q - -print ∷ Query → String -print (Query m) = joinWith "&" (printPart <$> m) - where - printPart ∷ Tuple String (Maybe String) → String - printPart (Tuple k Nothing) = - printQueryPart k - printPart (Tuple k (Just v)) = - printQueryPart k <> "=" <> printQueryPart v - -printQueryPart ∷ String → String -printQueryPart = S.joinWith "" <<< map printChar <<< S.split (S.Pattern "") - where - -- Fragments & queries have a bunch of characters that don't need escaping - printChar ∷ String → String - printChar s - | RX.test rxPrintable s = s - | otherwise = encodeURIComponent s - -rxPrintable ∷ RX.Regex -rxPrintable = unsafePartial fromRight $ RX.regex "[$+/?:@]" RXF.global +print ∷ ∀ q. (q → String) → q → String +print printQ q = "?" <> printQ q diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index b7d1b73..0fc0e4b 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -16,7 +16,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S -import Data.URI.Authority (Authority(..), Host(..), Port(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.URI.Authority (Authority(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Path as Path import Text.Parsing.StringParser (Parser) diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 16095d4..66bf6a1 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -19,7 +19,7 @@ import Data.String as S import Data.URI.Fragment as Fragment import Data.URI.Query as Query import Data.URI.RelativePart as RPart -import Data.URI.RelativePart (Authority(..), Host(..), Port(..), RelativePart(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.RelativePart (Authority(..), Host(..), Port(..), RelativePart(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) @@ -45,8 +45,8 @@ parser parser parseUserInfo parsePath parseQuery parseFragment = RelativeRef <$> RPart.parser parseUserInfo parsePath - <*> optionMaybe (Query.parser' parseQuery) - <*> optionMaybe (Fragment.parser' parseFragment) + <*> optionMaybe (Query.parser parseQuery) + <*> optionMaybe (Fragment.parser parseFragment) <* eof print @@ -60,8 +60,8 @@ print print printUserInfo printPath printQuery printFragment (RelativeRef h q f) = S.joinWith "" $ catMaybes [ Just (RPart.print printUserInfo printPath h) - , Query.print' printQuery <$> q - , Fragment.print' printFragment <$> f + , Query.print printQuery <$> q + , Fragment.print printFragment <$> f ] _relPart diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 82c09bb..ead0bd4 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -19,7 +19,7 @@ import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as S import Data.URI.Fragment as Fragment -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) @@ -46,8 +46,8 @@ parser parser parseUserInfo parsePath parseQuery parseFragment = URI <$> Scheme.parser <*> HPart.parser parseUserInfo parsePath - <*> optionMaybe (Query.parser' parseQuery) - <*> optionMaybe (Fragment.parser' parseFragment) + <*> optionMaybe (Query.parser parseQuery) + <*> optionMaybe (Fragment.parser parseFragment) <* eof print @@ -62,8 +62,8 @@ print printUserInfo printPath printQuery printFragment (URI s h q f) = S.joinWith "" $ catMaybes [ Just (Scheme.print s) , Just (HPart.print printUserInfo printPath h) - , Query.print' printQuery <$> q - , Fragment.print' printFragment <$> f + , Query.print printQuery <$> q + , Fragment.print printFragment <$> f ] _scheme diff --git a/src/Data/URI/UserInfo.purs b/src/Data/URI/UserInfo.purs index fef4e99..3850b36 100644 --- a/src/Data/URI/UserInfo.purs +++ b/src/Data/URI/UserInfo.purs @@ -3,39 +3,18 @@ module Data.URI.UserInfo where import Prelude import Control.Alt ((<|>)) -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.Newtype (class Newtype) import Data.URI.Common (decodePCT, joinWith, parsePCTEncoded, parseSubDelims, parseUnreserved, wrapParser) -import Global (encodeURI) import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (many1) import Text.Parsing.StringParser.String (string) --- | The user info part of an `Authority`. For example: `user`, `foo:bar`. -newtype UserInfo = UserInfo String - -derive newtype instance eqUserInfo ∷ Eq UserInfo -derive newtype instance ordUserInfo ∷ Ord UserInfo -derive instance genericUserInfo ∷ Generic UserInfo _ -derive instance newtypeUserInfo ∷ Newtype UserInfo _ -instance showUserInfo ∷ Show UserInfo where show = genericShow - -parser ∷ Parser UserInfo -parser = UserInfo <<< joinWith "" <$> many1 p - where - p = parseUnreserved - <|> parsePCTEncoded decodePCT - <|> parseSubDelims - <|> string ":" - -parser' ∷ ∀ userInfo. Parser userInfo → Parser userInfo -parser' p = wrapParser p (joinWith "" <$> many1 p') +parser ∷ ∀ userInfo. Parser userInfo → Parser userInfo +parser p = wrapParser p (joinWith "" <$> many1 p') where p' = parseUnreserved <|> parsePCTEncoded decodePCT <|> parseSubDelims <|> string ":" -print ∷ UserInfo → String -print (UserInfo u) = encodeURI u +print ∷ ∀ userInfo. (userInfo → String) → userInfo → String +print = id diff --git a/test/Main.purs b/test/Main.purs index 090ad08..65cb100 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -16,7 +16,7 @@ import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) import Data.String.Regex (Regex, regex) import Data.String.Regex.Flags (global, noFlags) import Data.Tuple (Tuple(..)) -import Data.URI (AbsoluteURI(..), Authority(..), Fragment(..), HierarchicalPart(..), Host(..), Port(..), Query(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..), URIPathAbs, UserInfo(..), URIPathRel) +import Data.URI (AbsoluteURI(..), Authority(..), HierarchicalPart(..), Host(..), Port(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..)) import Data.URI.AbsoluteURI as AbsoluteURI import Data.URI.Authority as Authority import Data.URI.Common (anyString) @@ -24,7 +24,10 @@ import Data.URI.Common as Common import Data.URI.Fragment as Fragment import Data.URI.Host as Host import Data.URI.Host.Gen as Host.Gen -import Data.URI.Path as Path +import Data.URI.NonStandard.Fragment as NF +import Data.URI.NonStandard.Path as NP +import Data.URI.NonStandard.Query as NQ +import Data.URI.NonStandard.UserInfo as NU import Data.URI.Port as Port import Data.URI.Query as Query import Data.URI.Scheme as Scheme @@ -57,11 +60,11 @@ testIso p f uri expected = do testRunParseSuccess p uri expected testPrinter f uri expected -testIsoURI :: forall a. String -> URI.URI UserInfo URIPathAbs Query Fragment -> TestSuite a -testIsoURI = testIso (URI.parser UserInfo.parser Path.parseURIPathAbs Query.parser Fragment.parser) (URI.print UserInfo.print Path.printPath Query.print Fragment.print) +testIsoURI :: forall a. String -> URI.URI NU.UserInfo NP.URIPathAbs NQ.Query NF.Fragment -> TestSuite a +testIsoURI = testIso (URI.parser NU.parser NP.parseURIPathAbs NQ.parser NF.parser) (URI.print NU.print NP.printPath NQ.print NF.print) -testIsoURIRef :: forall a. String -> URIRef.URIRef UserInfo URIPathAbs URIPathRel Query Fragment -> TestSuite a -testIsoURIRef = testIso (URIRef.parser UserInfo.parser Path.parseURIPathAbs Path.parseURIPathRel Query.parser Fragment.parser) (URIRef.print UserInfo.print Path.printPath Path.printPath Query.print Fragment.print) +testIsoURIRef :: forall a. String -> URIRef.URIRef NU.UserInfo NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment -> TestSuite a +testIsoURIRef = testIso (URIRef.parser NU.parser NP.parseURIPathAbs NP.parseURIPathRel NQ.parser NF.parser) (URIRef.print NU.print NP.printPath NP.printPath NQ.print NF.print) -- testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a -- testRunParseURIRefParses = testRunParseSuccess URIRef.parser @@ -72,17 +75,17 @@ testRunParseURIRefFails uri = ("fails to parse: " <> uri) (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParser (URIRef.parser anyString anyString anyString anyString anyString) $ uri) -testPrintQuerySerializes :: forall a. Query -> String -> TestSuite a +testPrintQuerySerializes :: forall a. NQ.Query -> String -> TestSuite a testPrintQuerySerializes query expected = test ("serializes: " <> show query) - (equal expected (Query.print' Query.print query)) + (equal expected (Query.print NQ.print query)) -testParseQueryParses :: forall a. String -> Query -> TestSuite a +testParseQueryParses :: forall a. String -> NQ.Query -> TestSuite a testParseQueryParses uri query = test ("parses: \"" <> uri <> "\"") - (equal (Right query) (runParser (Query.parser' Query.parser) uri)) + (equal (Right query) (runParser (Query.parser NQ.parser) uri)) testMatch1FromMatches :: forall a. Either String Regex -> Int -> String -> Maybe String -> TestSuite a testMatch1FromMatches rx' n str expected = case rx' of @@ -121,10 +124,10 @@ main = runTest $ suite "Data.URI" do testRunParseSuccess Scheme.parser "git+ssh:" (Scheme "git+ssh") suite "UserInfo parser" do - testRunParseSuccess UserInfo.parser "user" (UserInfo "user") - testRunParseSuccess UserInfo.parser "spaced%20user" (UserInfo "spaced user") - testRunParseSuccess UserInfo.parser "user:password" (UserInfo "user:password") - testRunParseSuccess UserInfo.parser "spaced%20user:password%25%C2%A3" (UserInfo "spaced user:password%£") + testRunParseSuccess (UserInfo.parser NU.parser) "user" (NU.UserInfo "user") + testRunParseSuccess (UserInfo.parser NU.parser) "spaced%20user" (NU.UserInfo "spaced user") + testRunParseSuccess (UserInfo.parser NU.parser) "user:password" (NU.UserInfo "user:password") + testRunParseSuccess (UserInfo.parser NU.parser) "spaced%20user:password%25%C2%A3" (NU.UserInfo "spaced user:password%£") suite "Host parser" do testRunParseSuccess Host.parser "localhost" (NameAddress "localhost") @@ -139,7 +142,7 @@ main = runTest $ suite "Data.URI" do testRunParseSuccess Port.parser "63174" (Port 63174) suite "Fragment' parser" do - testRunParseSuccess (Fragment.parser' anyString) "#" "" + testRunParseSuccess (Fragment.parser anyString) "#" "" suite "Authority parser" do testRunParseSuccess @@ -160,7 +163,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [])) (Just (Left rootDir))) - (Just (Query (Tuple "q" (Just "foo") : Tuple "var.bar" (Just "baz") : Nil))) + (Just (NQ.Query (Tuple "q" (Just "foo") : Tuple "var.bar" (Just "baz") : Nil))) Nothing)) testIsoURIRef "mongodb://localhost" @@ -200,12 +203,12 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority - (Just (UserInfo "foo:bar")) + (Just (NU.UserInfo "foo:bar")) [ Tuple (NameAddress "db1.example.net") Nothing , Tuple (NameAddress "db2.example.net") (Just (Port 2500))])) (Just (Right (rootDir file "authdb")))) (Just - (Query + (NQ.Query (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) Nothing)) testIsoURIRef @@ -214,9 +217,9 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just (UserInfo "foo:bar")) [(Tuple (NameAddress "db1.example.net") (Just (Port 6))),(Tuple (NameAddress "db2.example.net") (Just (Port 2500)))])) + (Just (Authority (Just (NU.UserInfo "foo:bar")) [(Tuple (NameAddress "db1.example.net") (Just (Port 6))),(Tuple (NameAddress "db2.example.net") (Just (Port 2500)))])) (Just (Right (rootDir file "authdb")))) - (Just (Query (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) + (Just (NQ.Query (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) Nothing)) testIsoURIRef "mongodb://192.168.0.1" @@ -247,7 +250,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just(Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) + (Just(Authority (Just (NU.UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) Nothing) Nothing Nothing)) @@ -257,7 +260,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Authority (Just (NU.UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) (Just (Left rootDir))) Nothing Nothing)) @@ -267,7 +270,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just (UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Authority (Just (NU.UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) (Just (Right (rootDir file "records")))) Nothing Nothing)) @@ -327,7 +330,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::7") Nothing)])) (Just (Right (rootDir file "c=GB")))) - (Just (Query (singleton $ (Tuple "objectClass?one" Nothing)))) + (Just (NQ.Query (singleton $ (Tuple "objectClass?one" Nothing)))) Nothing)) testIsoURIRef "telnet://192.0.2.16:80/" @@ -345,16 +348,16 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) - (Just (Query (singleton (Tuple "name" (Just "ferret"))))) - (Just (Fragment "nose")))) + (Just (NQ.Query (singleton (Tuple "name" (Just "ferret"))))) + (Just (NF.Fragment "nose")))) testIsoURIRef "foo://example.com:8042/over/there?name=ferret#" (Left (URI (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) - (Just (Query (singleton (Tuple "name" (Just "ferret"))))) - (Just (Fragment "")))) + (Just (NQ.Query (singleton (Tuple "name" (Just "ferret"))))) + (Just (NF.Fragment "")))) testIsoURIRef "foo://info.example.com?fred" (Left @@ -363,7 +366,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "info.example.com") Nothing)])) Nothing) - (Just (Query (singleton $ Tuple "fred" Nothing))) + (Just (NQ.Query (singleton $ Tuple "fred" Nothing))) Nothing)) testIsoURIRef "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" @@ -373,7 +376,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority - (Just (UserInfo "cnn.example.com&story=breaking_news")) + (Just (NU.UserInfo "cnn.example.com&story=breaking_news")) [(Tuple (IPv4Address "10.0.0.1") Nothing)])) (Just (Right (rootDir file "top_story.htm")))) Nothing @@ -397,8 +400,8 @@ main = runTest $ suite "Data.URI" do Nothing Nothing)) testIso - (AbsoluteURI.parser UserInfo.parser Path.parseURIPathAbs Query.parser) - (AbsoluteURI.print UserInfo.print Path.printPath Query.print) + (AbsoluteURI.parser NU.parser NP.parseURIPathAbs NQ.parser) + (AbsoluteURI.print NU.print NP.printPath NQ.print) "couchbase://localhost/testBucket?password=&docTypeKey=" (AbsoluteURI (Scheme "couchbase") @@ -408,10 +411,10 @@ main = runTest $ suite "Data.URI" do Nothing [(Tuple (NameAddress "localhost") Nothing)])) (Just (Right (rootDir file "testBucket")))) - (Just (Query (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)))) + (Just (NQ.Query (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)))) testIso - (AbsoluteURI.parser UserInfo.parser Path.parseURIPathAbs Query.parser) - (AbsoluteURI.print UserInfo.print Path.printPath Query.print) + (AbsoluteURI.parser NU.parser NP.parseURIPathAbs NQ.parser) + (AbsoluteURI.print NU.print NP.printPath NQ.print) "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (AbsoluteURI (Scheme "couchbase") @@ -421,7 +424,7 @@ main = runTest $ suite "Data.URI" do Nothing [(Tuple (NameAddress "localhost") (Just (Port 99999)))])) (Just (Right (rootDir file "testBucket")))) - (Just (Query (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)))) + (Just (NQ.Query (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)))) testIsoURIRef "http://www.example.com/some%20invented/url%20with%20spaces.html" (Left @@ -529,35 +532,35 @@ main = runTest $ suite "Data.URI" do suite "Query.print" do testPrintQuerySerializes - (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + (NQ.Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) "?key1=value1&key2=value2&key1=value3" testPrintQuerySerializes - (Query (Tuple "k=ey" (Just "value=1") : Nil)) + (NQ.Query (Tuple "k=ey" (Just "value=1") : Nil)) "?k%3Dey=value%3D1" - testPrintQuerySerializes (Query Nil) "?" + testPrintQuerySerializes (NQ.Query Nil) "?" testPrintQuerySerializes - (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + (NQ.Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) "?key1=&key2=" testPrintQuerySerializes - (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + (NQ.Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) "?key1&key2" testPrintQuerySerializes - (Query (Tuple "key1" (Just "foo;bar") : Nil)) + (NQ.Query (Tuple "key1" (Just "foo;bar") : Nil)) "?key1=foo%3Bbar" suite "Query.parser" do testParseQueryParses "?key1=value1&key2=value2&key1=value3" - (Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + (NQ.Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) testParseQueryParses "?key1&key2" - (Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + (NQ.Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) testParseQueryParses "?key1=&key2=" - (Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + (NQ.Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) testParseQueryParses "?key1=foo%3Bbar" - (Query (Tuple "key1" (Just "foo;bar") : Nil)) + (NQ.Query (Tuple "key1" (Just "foo;bar") : Nil)) suite "Common.match1From" do testMatch1FromMisses (regex "key1" noFlags) 0 "" From 8b316dedaf09f31d7efbb6ae1dd9604f7f1e9544 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 29 Jan 2018 13:08:36 +0000 Subject: [PATCH 06/69] Record for parser/printer components --- src/Data/URI/AbsoluteURI.purs | 66 ++++++++++++++---------- src/Data/URI/Authority.purs | 23 ++++++--- src/Data/URI/HierarchicalPart.purs | 46 ++++++++++------- src/Data/URI/RelativePart.purs | 46 ++++++++++------- src/Data/URI/RelativeRef.purs | 69 ++++++++++++------------- src/Data/URI/URI.purs | 82 ++++++++++++++++++------------ src/Data/URI/URIRef.purs | 58 +++++++++++++-------- test/Main.purs | 32 ++++++++---- 8 files changed, 256 insertions(+), 166 deletions(-) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index c0cb842..63f688c 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -1,6 +1,8 @@ module Data.URI.AbsoluteURI ( AbsoluteURI(..) + , AbsoluteURIParseOptions , parser + , AbsoluteURIPrintOptions , print , _scheme , _hierPart @@ -27,58 +29,68 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | An absolute AbsoluteURI. -data AbsoluteURI userInfo path query = AbsoluteURI Scheme (HierarchicalPart userInfo path) (Maybe query) +data AbsoluteURI userInfo hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hierPath) (Maybe query) -derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq path, Eq query) ⇒ Eq (AbsoluteURI userInfo path query) -derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord path, Ord query) ⇒ Ord (AbsoluteURI userInfo path query) -derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo path query) _ -instance showAbsoluteURI ∷ (Show userInfo, Show path, Show query) ⇒ Show (AbsoluteURI userInfo path query) where show = genericShow +derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hierPath query) +derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hierPath query) +derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hierPath query) _ +instance showAbsoluteURI ∷ (Show userInfo, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hierPath query) where show = genericShow + +type AbsoluteURIParseOptions userInfo hierPath query r = + ( parseUserInfo ∷ Parser userInfo + , parseHierPath ∷ Parser hierPath + , parseQuery ∷ Parser query + | r + ) parser - ∷ ∀ userInfo path query - . Parser userInfo - → Parser path - → Parser query - → Parser (AbsoluteURI userInfo path query) -parser parseUserInfo parsePath parseQuery = AbsoluteURI + ∷ ∀ userInfo hierPath query r + . Record (AbsoluteURIParseOptions userInfo hierPath query r) + → Parser (AbsoluteURI userInfo hierPath query) +parser opts = AbsoluteURI <$> Scheme.parser - <*> HPart.parser parseUserInfo parsePath - <*> optionMaybe (Query.parser parseQuery) + <*> HPart.parser opts + <*> optionMaybe (Query.parser opts.parseQuery) <* eof +type AbsoluteURIPrintOptions userInfo hierPath query r = + ( printUserInfo ∷ userInfo → String + , printHierPath ∷ hierPath → String + , printQuery ∷ query → String + | r + ) + print - ∷ ∀ userInfo path query - . (userInfo → String) - → (path → String) - → (query → String) - → AbsoluteURI userInfo path query + ∷ ∀ userInfo hierPath query r + . Record (AbsoluteURIPrintOptions userInfo hierPath query r) + → AbsoluteURI userInfo hierPath query → String -print printUserInfo printPath printQuery (AbsoluteURI s h q) = +print opts (AbsoluteURI s h q) = S.joinWith "" $ catMaybes [ Just (Scheme.print s) - , Just (HPart.print printUserInfo printPath h) - , Query.print printQuery <$> q + , Just (HPart.print opts h) + , Query.print opts.printQuery <$> q ] _scheme - ∷ ∀ userInfo path query - . Lens' (AbsoluteURI userInfo path query) Scheme + ∷ ∀ userInfo hierPath query + . Lens' (AbsoluteURI userInfo hierPath query) Scheme _scheme = lens (\(AbsoluteURI s _ _) → s) (\(AbsoluteURI _ h q) s → AbsoluteURI s h q) _hierPart - ∷ ∀ userInfo path query - . Lens' (AbsoluteURI userInfo path query) (HierarchicalPart userInfo path) + ∷ ∀ userInfo hierPath query + . Lens' (AbsoluteURI userInfo hierPath query) (HierarchicalPart userInfo hierPath) _hierPart = lens (\(AbsoluteURI _ h _) → h) (\(AbsoluteURI s _ q) h → AbsoluteURI s h q) _query - ∷ ∀ userInfo path query - . Lens' (AbsoluteURI userInfo path query) (Maybe query) + ∷ ∀ userInfo hierPath query + . Lens' (AbsoluteURI userInfo hierPath query) (Maybe query) _query = lens (\(AbsoluteURI _ _ q) → q) diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index eeff5e0..0cf0550 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -35,20 +35,27 @@ derive instance ordAuthority ∷ Ord userInfo ⇒ Ord (Authority userInfo) derive instance genericAuthority ∷ Generic (Authority userInfo) _ instance showAuthority ∷ Show userInfo ⇒ Show (Authority userInfo) where show = genericShow -parser ∷ ∀ userInfo. Parser userInfo → Parser (Authority userInfo) -parser parseUserInfo = do +parser + ∷ ∀ userInfo r + . { parseUserInfo ∷ Parser userInfo | r } + → Parser (Authority userInfo) +parser opts = do _ ← string "//" - ui ← optionMaybe $ try (UserInfo.parser parseUserInfo <* string "@") + ui ← optionMaybe $ try (UserInfo.parser opts.parseUserInfo <* string "@") hosts ← flip sepBy (string ",") $ Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser) pure $ Authority ui (fromFoldable hosts) -print ∷ ∀ userInfo. (userInfo → String) → Authority userInfo → String -print printUserInfo (Authority ui hs) = - "//" <> printUserInfo' ui <> S.joinWith "," (printHostAndPort <$> hs) +print + ∷ ∀ userInfo r + . { printUserInfo ∷ userInfo → String | r } + → Authority userInfo + → String +print opts (Authority ui hs) = + "//" <> printUserInfo ui <> S.joinWith "," (printHostAndPort <$> hs) where - printUserInfo' = - maybe "" (\u → printUserInfo u <> "@") + printUserInfo = + maybe "" (\u → opts.printUserInfo u <> "@") printHostAndPort (Tuple h p) = Host.print h <> maybe "" (\n → ":" <> Port.print n) p diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index d2122df..f501f42 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -22,43 +22,55 @@ import Data.URI.Path as Path import Text.Parsing.StringParser (Parser) -- | The "hierarchical part" of a generic or absolute URI. -data HierarchicalPart userInfo path = HierarchicalPart (Maybe (Authority userInfo)) (Maybe path) +data HierarchicalPart userInfo hierPath = HierarchicalPart (Maybe (Authority userInfo)) (Maybe hierPath) -derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq path) ⇒ Eq (HierarchicalPart userInfo path) -derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord path) ⇒ Ord (HierarchicalPart userInfo path) -derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo path) _ -instance showHierarchicalPart ∷ (Show userInfo, Show path) ⇒ Show (HierarchicalPart userInfo path) where show = genericShow +derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hierPath) +derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hierPath) +derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hierPath) _ +instance showHierarchicalPart ∷ (Show userInfo, Show hierPath) ⇒ Show (HierarchicalPart userInfo hierPath) where show = genericShow -parser ∷ ∀ userInfo path. Parser userInfo → Parser path → Parser (HierarchicalPart userInfo path) -parser parseUserInfo parsePath = withAuth <|> withoutAuth +parser + ∷ ∀ userInfo hierPath r + . { parseUserInfo ∷ Parser userInfo + , parseHierPath ∷ Parser hierPath + | r + } + → Parser (HierarchicalPart userInfo hierPath) +parser opts = withAuth <|> withoutAuth where withAuth = HierarchicalPart <<< Just - <$> Authority.parser parseUserInfo - <*> Path.parsePathAbEmpty parsePath + <$> Authority.parser opts + <*> Path.parsePathAbEmpty opts.parseHierPath withoutAuth = HierarchicalPart Nothing <$> noAuthPath noAuthPath - = (Just <$> Path.parsePathAbsolute parsePath) - <|> (Just <$> Path.parsePathRootless parsePath) + = (Just <$> Path.parsePathAbsolute opts.parseHierPath) + <|> (Just <$> Path.parsePathRootless opts.parseHierPath) <|> pure Nothing -print ∷ ∀ userInfo path. (userInfo → String) → (path → String) → HierarchicalPart userInfo path → String -print printUserInfo printPath (HierarchicalPart a p) = +print + ∷ ∀ userInfo hierPath r + . { printUserInfo ∷ userInfo → String + , printHierPath ∷ hierPath → String + | r + } + → HierarchicalPart userInfo hierPath → String +print opts (HierarchicalPart a p) = S.joinWith "" $ catMaybes - [ Authority.print printUserInfo <$> a - , printPath <$> p + [ Authority.print opts <$> a + , opts.printHierPath <$> p ] -_authority ∷ ∀ userInfo path. Lens' (HierarchicalPart userInfo path) (Maybe (Authority userInfo)) +_authority ∷ ∀ userInfo hierPath. Lens' (HierarchicalPart userInfo hierPath) (Maybe (Authority userInfo)) _authority = lens (\(HierarchicalPart a _) → a) (\(HierarchicalPart _ p) a → HierarchicalPart a p) -_path ∷ ∀ userInfo path. Lens' (HierarchicalPart userInfo path) (Maybe path) +_path ∷ ∀ userInfo hierPath. Lens' (HierarchicalPart userInfo hierPath) (Maybe hierPath) _path = lens (\(HierarchicalPart _ p) → p) diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index 0fc0e4b..81118ed 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -22,44 +22,56 @@ import Data.URI.Path as Path import Text.Parsing.StringParser (Parser) -- | The "relative part" of a relative reference. -data RelativePart userInfo path = RelativePart (Maybe (Authority userInfo)) (Maybe path) +data RelativePart userInfo relPath = RelativePart (Maybe (Authority userInfo)) (Maybe relPath) -derive instance eqRelativePart ∷ (Eq userInfo, Eq path) ⇒ Eq (RelativePart userInfo path) -derive instance ordRelativePart ∷ (Ord userInfo, Ord path) ⇒ Ord (RelativePart userInfo path) -derive instance genericRelativePart ∷ Generic (RelativePart userInfo path) _ -instance showRelativePart ∷ (Show userInfo, Show path) ⇒ Show (RelativePart userInfo path) where show = genericShow +derive instance eqRelativePart ∷ (Eq userInfo, Eq relPath) ⇒ Eq (RelativePart userInfo relPath) +derive instance ordRelativePart ∷ (Ord userInfo, Ord relPath) ⇒ Ord (RelativePart userInfo relPath) +derive instance genericRelativePart ∷ Generic (RelativePart userInfo relPath) _ +instance showRelativePart ∷ (Show userInfo, Show relPath) ⇒ Show (RelativePart userInfo relPath) where show = genericShow -parser ∷ ∀ userInfo path. Parser userInfo → Parser path → Parser (RelativePart userInfo path) -parser parseUserInfo parsePath = withAuth <|> withoutAuth +parser + ∷ ∀ userInfo relPath r + . { parseUserInfo ∷ Parser userInfo + , parseRelPath ∷ Parser relPath + | r + } + → Parser (RelativePart userInfo relPath) +parser opts = withAuth <|> withoutAuth where withAuth = RelativePart - <$> Just <$> Authority.parser parseUserInfo - <*> Path.parsePathAbEmpty parsePath + <$> Just <$> Authority.parser opts + <*> Path.parsePathAbEmpty opts.parseRelPath withoutAuth = RelativePart Nothing <$> noAuthPath noAuthPath - = (Just <$> Path.parsePathAbsolute parsePath) - <|> (Just <$> Path.parsePathNoScheme parsePath) + = (Just <$> Path.parsePathAbsolute opts.parseRelPath) + <|> (Just <$> Path.parsePathNoScheme opts.parseRelPath) <|> pure Nothing -print ∷ ∀ userInfo path. (userInfo → String) → (path → String) → RelativePart userInfo path → String -print printUserInfo printPath (RelativePart a p) = +print + ∷ ∀ userInfo relPath r + . { printUserInfo ∷ userInfo → String + , printRelPath ∷ relPath → String + | r + } + → RelativePart userInfo relPath → String +print opts (RelativePart a p) = S.joinWith "" $ catMaybes - [ Authority.print printUserInfo <$> a - , printPath <$> p + [ Authority.print opts <$> a + , opts.printRelPath <$> p ] -_authority ∷ ∀ userInfo path. Lens' (RelativePart userInfo path) (Maybe (Authority userInfo)) +_authority ∷ ∀ userInfo relPath. Lens' (RelativePart userInfo relPath) (Maybe (Authority userInfo)) _authority = lens (\(RelativePart a _) → a) (\(RelativePart _ p) a → RelativePart a p) -_path ∷ ∀ userInfo path. Lens' (RelativePart userInfo path) (Maybe path) +_path ∷ ∀ userInfo relPath. Lens' (RelativePart userInfo relPath) (Maybe relPath) _path = lens (\(RelativePart _ p) → p) diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 66bf6a1..184b75f 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -25,64 +25,65 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A relative reference for a URI. -data RelativeRef userInfo path query fragment = RelativeRef (RelativePart userInfo path) (Maybe query) (Maybe fragment) +data RelativeRef userInfo relPath query fragment = RelativeRef (RelativePart userInfo relPath) (Maybe query) (Maybe fragment) -derive instance eqRelativeRef ∷ (Eq userInfo, Eq path, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo path query fragment) -derive instance ordRelativeRef ∷ (Ord userInfo, Ord path, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo path query fragment) -derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo path query fragment) _ -instance showRelativeRef ∷ (Show userInfo, Show path, Show query, Show fragment) ⇒ Show (RelativeRef userInfo path query fragment) where show = genericShow --- --- parse ∷ String → Either ParseError RelativeRef --- parse = runParser parser +derive instance eqRelativeRef ∷ (Eq userInfo, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo relPath query fragment) +derive instance ordRelativeRef ∷ (Ord userInfo, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo relPath query fragment) +derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo relPath query fragment) _ +instance showRelativeRef ∷ (Show userInfo, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo relPath query fragment) where show = genericShow parser - ∷ ∀ userInfo path query fragment - . Parser userInfo - → Parser path - → Parser query - → Parser fragment - → Parser (RelativeRef userInfo path query fragment) -parser parseUserInfo parsePath parseQuery parseFragment = + ∷ ∀ userInfo relPath query fragment r + . { parseUserInfo ∷ Parser userInfo + , parseRelPath ∷ Parser relPath + , parseQuery ∷ Parser query + , parseFragment ∷ Parser fragment + | r + } + → Parser (RelativeRef userInfo relPath query fragment) +parser opts = RelativeRef - <$> RPart.parser parseUserInfo parsePath - <*> optionMaybe (Query.parser parseQuery) - <*> optionMaybe (Fragment.parser parseFragment) + <$> RPart.parser opts + <*> optionMaybe (Query.parser opts.parseQuery) + <*> optionMaybe (Fragment.parser opts.parseFragment) <* eof print - ∷ ∀ userInfo path query fragment - . (userInfo → String) - → (path → String) - → (query → String) - → (fragment → String) - → RelativeRef userInfo path query fragment + ∷ ∀ userInfo relPath query fragment r + . { printUserInfo ∷ userInfo → String + , printRelPath ∷ relPath → String + , printQuery ∷ query → String + , printFragment ∷ fragment → String + | r + } + → RelativeRef userInfo relPath query fragment → String -print printUserInfo printPath printQuery printFragment (RelativeRef h q f) = +print opts (RelativeRef h q f) = S.joinWith "" $ catMaybes - [ Just (RPart.print printUserInfo printPath h) - , Query.print printQuery <$> q - , Fragment.print printFragment <$> f + [ Just (RPart.print opts h) + , Query.print opts.printQuery <$> q + , Fragment.print opts.printFragment <$> f ] _relPart - ∷ ∀ userInfo path query fragment - . Lens' (RelativeRef userInfo path query fragment) (RelativePart userInfo path) + ∷ ∀ userInfo relPath query fragment + . Lens' (RelativeRef userInfo relPath query fragment) (RelativePart userInfo relPath) _relPart = lens (\(RelativeRef r _ _) → r) (\(RelativeRef _ q f) r → RelativeRef r q f) _query - ∷ ∀ userInfo path query fragment - . Lens' (RelativeRef userInfo path query fragment) (Maybe query) + ∷ ∀ userInfo relPath query fragment + . Lens' (RelativeRef userInfo relPath query fragment) (Maybe query) _query = lens (\(RelativeRef _ q _) → q) (\(RelativeRef r _ f) q → RelativeRef r q f) _fragment - ∷ ∀ userInfo path query fragment - . Lens' (RelativeRef userInfo path query fragment) (Maybe fragment) + ∷ ∀ userInfo relPath query fragment + . Lens' (RelativeRef userInfo relPath query fragment) (Maybe fragment) _fragment = lens (\(RelativeRef _ _ f) → f) diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index ead0bd4..2281f89 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -1,6 +1,9 @@ module Data.URI.URI ( URI(..) + , URIOptions + , URIParseOptions , parser + , URIPrintOptions , print , _scheme , _hierPart @@ -29,70 +32,83 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A generic URI -data URI userInfo path query fragment = URI Scheme (HierarchicalPart userInfo path) (Maybe query) (Maybe fragment) +data URI userInfo hierPath query fragment = URI Scheme (HierarchicalPart userInfo hierPath) (Maybe query) (Maybe fragment) -derive instance eqURI ∷ (Eq userInfo, Eq path, Eq query, Eq fragment) ⇒ Eq (URI userInfo path query fragment) -derive instance ordURI ∷ (Ord userInfo, Ord path, Ord query, Ord fragment) ⇒ Ord (URI userInfo path query fragment) -derive instance genericURI ∷ Generic (URI userInfo path query fragment) _ -instance showURI ∷ (Show userInfo, Show path, Show query, Show fragment) ⇒ Show (URI userInfo path query fragment) where show = genericShow +derive instance eqURI ∷ (Eq userInfo, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hierPath query fragment) +derive instance ordURI ∷ (Ord userInfo, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hierPath query fragment) +derive instance genericURI ∷ Generic (URI userInfo hierPath query fragment) _ +instance showURI ∷ (Show userInfo, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hierPath query fragment) where show = genericShow + +type URIOptions userInfo hierPath query fragment = + URIParseOptions userInfo hierPath query fragment (URIPrintOptions userInfo hierPath query fragment ()) + +type URIParseOptions userInfo hierPath query fragment r = + ( parseUserInfo ∷ Parser userInfo + , parseHierPath ∷ Parser hierPath + , parseQuery ∷ Parser query + , parseFragment ∷ Parser fragment + | r + ) parser - ∷ ∀ userInfo path query fragment - . Parser userInfo - → Parser path - → Parser query - → Parser fragment - → Parser (URI userInfo path query fragment) -parser parseUserInfo parsePath parseQuery parseFragment = URI + ∷ ∀ userInfo hierPath query fragment r + . Record (URIParseOptions userInfo hierPath query fragment r) + → Parser (URI userInfo hierPath query fragment) +parser opts = URI <$> Scheme.parser - <*> HPart.parser parseUserInfo parsePath - <*> optionMaybe (Query.parser parseQuery) - <*> optionMaybe (Fragment.parser parseFragment) + <*> HPart.parser opts + <*> optionMaybe (Query.parser opts.parseQuery) + <*> optionMaybe (Fragment.parser opts.parseFragment) <* eof +type URIPrintOptions userInfo hierPath query fragment r = + ( printUserInfo ∷ userInfo → String + , printHierPath ∷ hierPath → String + , printQuery ∷ query → String + , printFragment ∷ fragment → String + | r + ) + print - ∷ ∀ userInfo path query fragment - . (userInfo → String) - → (path → String) - → (query → String) - → (fragment → String) - → URI userInfo path query fragment + ∷ ∀ userInfo hierPath query fragment r + . Record (URIPrintOptions userInfo hierPath query fragment r) + → URI userInfo hierPath query fragment → String -print printUserInfo printPath printQuery printFragment (URI s h q f) = +print opts (URI s h q f) = S.joinWith "" $ catMaybes [ Just (Scheme.print s) - , Just (HPart.print printUserInfo printPath h) - , Query.print printQuery <$> q - , Fragment.print printFragment <$> f + , Just (HPart.print opts h) + , Query.print opts.printQuery <$> q + , Fragment.print opts.printFragment <$> f ] _scheme - ∷ ∀ userInfo path query fragment - . Lens' (URI userInfo path query fragment) Scheme + ∷ ∀ userInfo hierPath query fragment + . Lens' (URI userInfo hierPath query fragment) Scheme _scheme = lens (\(URI s _ _ _) → s) (\(URI _ h q f) s → URI s h q f) _hierPart - ∷ ∀ userInfo path query fragment - . Lens' (URI userInfo path query fragment) (HierarchicalPart userInfo path) + ∷ ∀ userInfo hierPath query fragment + . Lens' (URI userInfo hierPath query fragment) (HierarchicalPart userInfo hierPath) _hierPart = lens (\(URI _ h _ _) → h) (\(URI s _ q f) h → URI s h q f) _query - ∷ ∀ userInfo path query fragment - . Lens' (URI userInfo path query fragment) (Maybe query) + ∷ ∀ userInfo hierPath query fragment + . Lens' (URI userInfo hierPath query fragment) (Maybe query) _query = lens (\(URI _ _ q _) → q) (\(URI s h _ f) q → URI s h q f) _fragment - ∷ ∀ userInfo path query fragment - . Lens' (URI userInfo path query fragment) (Maybe fragment) + ∷ ∀ userInfo hierPath query fragment + . Lens' (URI userInfo hierPath query fragment) (Maybe fragment) _fragment = lens (\(URI _ _ _ f) → f) diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index 0443524..19c1377 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -9,30 +9,46 @@ import Data.URI.URI as URI import Text.Parsing.StringParser (Parser, try) -- | An alias for the most common use case of resource identifiers. -type URIRef userInfo absPath relPath query fragment = Either (URI.URI userInfo absPath query fragment) (RelativeRef.RelativeRef userInfo relPath query fragment) +type URIRef userInfo hierPath relPath query fragment = + Either + (URI.URI userInfo hierPath query fragment) + (RelativeRef.RelativeRef userInfo relPath query fragment) + +type URIRefOptions userInfo hierPath relPath query fragment = + URIRefParseOptions userInfo hierPath relPath query fragment (URIRefPrintOptions userInfo hierPath relPath query fragment ()) + +type URIRefParseOptions userInfo hierPath relPath query fragment r = + ( parseUserInfo ∷ Parser userInfo + , parseHierPath ∷ Parser hierPath + , parseRelPath ∷ Parser relPath + , parseQuery ∷ Parser query + , parseFragment ∷ Parser fragment + | r + ) parser - ∷ ∀ userInfo absPath relPath query fragment - . Parser userInfo - → Parser absPath - → Parser relPath - → Parser query - → Parser fragment - → Parser (URIRef userInfo absPath relPath query fragment) -parser parseUserInfo parseAbsPath parseRelPath parseQuery parseFragment - = (Left <$> try (URI.parser parseUserInfo parseAbsPath parseQuery parseFragment)) - <|> (Right <$> RelativeRef.parser parseUserInfo parseRelPath parseQuery parseFragment) + ∷ ∀ userInfo hierPath relPath query fragment r + . Record (URIRefParseOptions userInfo hierPath relPath query fragment r) + → Parser (URIRef userInfo hierPath relPath query fragment) +parser opts + = (Left <$> try (URI.parser opts)) + <|> (Right <$> RelativeRef.parser opts) + +type URIRefPrintOptions userInfo hierPath relPath query fragment r = + ( printUserInfo ∷ userInfo → String + , printHierPath ∷ hierPath → String + , printRelPath ∷ relPath → String + , printQuery ∷ query → String + , printFragment ∷ fragment → String + | r + ) print - ∷ ∀ userInfo absPath relPath query fragment - . (userInfo → String) - → (absPath → String) - → (relPath → String) - → (query → String) - → (fragment → String) - → URIRef userInfo absPath relPath query fragment + ∷ ∀ userInfo hierPath relPath query fragment r + . Record (URIRefPrintOptions userInfo hierPath relPath query fragment r) + → URIRef userInfo hierPath relPath query fragment → String -print printUserInfo printAbsPath printRelPath printQuery printFragment = +print opts = either - (URI.print printUserInfo printAbsPath printQuery printFragment) - (RelativeRef.print printUserInfo printRelPath printQuery printFragment) + (URI.print opts) + (RelativeRef.print opts) diff --git a/test/Main.purs b/test/Main.purs index 65cb100..8613736 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -43,6 +43,20 @@ import Test.Unit.Console (TESTOUTPUT) import Test.Unit.Main (runTest) import Text.Parsing.StringParser (Parser, runParser) +options ∷ Record (URIRef.URIRefOptions NU.UserInfo NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment) +options = + { parseUserInfo: NU.parser + , printUserInfo: NU.print + , parseHierPath: NP.parseURIPathAbs + , printHierPath: NP.printPath + , parseRelPath: NP.parseURIPathRel + , printRelPath: NP.printPath + , parseQuery: NQ.parser + , printQuery: NQ.print + , parseFragment: NF.parser + , printFragment: NF.print + } + testPrinter :: forall a b. Show b => (b -> String) -> String -> b -> TestSuite a testPrinter f expected uri = test @@ -61,10 +75,10 @@ testIso p f uri expected = do testPrinter f uri expected testIsoURI :: forall a. String -> URI.URI NU.UserInfo NP.URIPathAbs NQ.Query NF.Fragment -> TestSuite a -testIsoURI = testIso (URI.parser NU.parser NP.parseURIPathAbs NQ.parser NF.parser) (URI.print NU.print NP.printPath NQ.print NF.print) +testIsoURI = testIso (URI.parser options) (URI.print options) testIsoURIRef :: forall a. String -> URIRef.URIRef NU.UserInfo NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment -> TestSuite a -testIsoURIRef = testIso (URIRef.parser NU.parser NP.parseURIPathAbs NP.parseURIPathRel NQ.parser NF.parser) (URIRef.print NU.print NP.printPath NP.printPath NQ.print NF.print) +testIsoURIRef = testIso (URIRef.parser options) (URIRef.print options) -- testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a -- testRunParseURIRefParses = testRunParseSuccess URIRef.parser @@ -73,7 +87,7 @@ testRunParseURIRefFails :: forall a. String -> TestSuite a testRunParseURIRefFails uri = test ("fails to parse: " <> uri) - (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParser (URIRef.parser anyString anyString anyString anyString anyString) $ uri) + (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParser (URIRef.parser options) $ uri) testPrintQuerySerializes :: forall a. NQ.Query -> String -> TestSuite a testPrintQuerySerializes query expected = @@ -146,11 +160,11 @@ main = runTest $ suite "Data.URI" do suite "Authority parser" do testRunParseSuccess - (Authority.parser anyString) + (Authority.parser options) "//localhost" (Authority Nothing [Tuple (NameAddress "localhost") Nothing]) testRunParseSuccess - (Authority.parser anyString) + (Authority.parser options) "//localhost:3000" (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 3000))]) @@ -400,8 +414,8 @@ main = runTest $ suite "Data.URI" do Nothing Nothing)) testIso - (AbsoluteURI.parser NU.parser NP.parseURIPathAbs NQ.parser) - (AbsoluteURI.print NU.print NP.printPath NQ.print) + (AbsoluteURI.parser options) + (AbsoluteURI.print options) "couchbase://localhost/testBucket?password=&docTypeKey=" (AbsoluteURI (Scheme "couchbase") @@ -413,8 +427,8 @@ main = runTest $ suite "Data.URI" do (Just (Right (rootDir file "testBucket")))) (Just (NQ.Query (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)))) testIso - (AbsoluteURI.parser NU.parser NP.parseURIPathAbs NQ.parser) - (AbsoluteURI.print NU.print NP.printPath NQ.print) + (AbsoluteURI.parser options) + (AbsoluteURI.print options) "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (AbsoluteURI (Scheme "couchbase") From aeae89547574a19215e89191ff174f6fd1c5750a Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 29 Jan 2018 14:31:29 +0000 Subject: [PATCH 07/69] Free hosts from being an array It's not actually spec conformant to have that, but if we make it a functor then `Identity` or an array/list can be substituted in as appropriate --- src/Data/URI/AbsoluteURI.purs | 70 +++++++++++++++------------- src/Data/URI/Authority.purs | 62 +++++++++++++++++-------- src/Data/URI/HierarchicalPart.purs | 52 +++++++++++++-------- src/Data/URI/RelativePart.purs | 57 +++++++++++++---------- src/Data/URI/RelativeRef.purs | 66 +++++++++++++++----------- src/Data/URI/URI.purs | 74 +++++++++++++++--------------- src/Data/URI/URIRef.purs | 61 ++++++++++++------------ test/Main.purs | 12 +++-- 8 files changed, 265 insertions(+), 189 deletions(-) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 63f688c..bb700d6 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -1,5 +1,6 @@ module Data.URI.AbsoluteURI ( AbsoluteURI(..) + , AbsoluteURIOptions , AbsoluteURIParseOptions , parser , AbsoluteURIPrintOptions @@ -14,56 +15,61 @@ module Data.URI.AbsoluteURI import Prelude import Data.Array (catMaybes) +import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) +import Data.Ord (class Ord1) import Data.String as S +import Data.Tuple (Tuple) +import Data.URI.HierarchicalPart (Authority(..), AuthorityParseOptions, AuthorityPrintOptions, HierarchicalPart(..), HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.Query as Query -import Data.URI.Scheme as Scheme import Data.URI.Scheme (Scheme(..)) +import Data.URI.Scheme as Scheme import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) --- | An absolute AbsoluteURI. -data AbsoluteURI userInfo hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hierPath) (Maybe query) +-- | A generic AbsoluteURI +data AbsoluteURI userInfo hosts hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts hierPath) (Maybe query) + +derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq1 hosts, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts hierPath query) +derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord1 hosts, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hosts hierPath query) +derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts hierPath query) _ +instance showAbsoluteURI ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts hierPath query) where show = genericShow -derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hierPath query) -derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hierPath query) -derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hierPath query) _ -instance showAbsoluteURI ∷ (Show userInfo, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hierPath query) where show = genericShow +type AbsoluteURIOptions userInfo hosts hierPath query = + AbsoluteURIParseOptions userInfo hosts hierPath query (AbsoluteURIPrintOptions userInfo hosts hierPath query ()) -type AbsoluteURIParseOptions userInfo hierPath query r = - ( parseUserInfo ∷ Parser userInfo - , parseHierPath ∷ Parser hierPath - , parseQuery ∷ Parser query - | r - ) +type AbsoluteURIParseOptions userInfo hosts hierPath query r = + HierarchicalPartParseOptions userInfo hosts hierPath + ( parseQuery ∷ Parser query + | r + ) parser - ∷ ∀ userInfo hierPath query r - . Record (AbsoluteURIParseOptions userInfo hierPath query r) - → Parser (AbsoluteURI userInfo hierPath query) + ∷ ∀ userInfo hosts hierPath query r + . Record (AbsoluteURIParseOptions userInfo hosts hierPath query r) + → Parser (AbsoluteURI userInfo hosts hierPath query) parser opts = AbsoluteURI <$> Scheme.parser <*> HPart.parser opts <*> optionMaybe (Query.parser opts.parseQuery) <* eof -type AbsoluteURIPrintOptions userInfo hierPath query r = - ( printUserInfo ∷ userInfo → String - , printHierPath ∷ hierPath → String - , printQuery ∷ query → String - | r - ) +type AbsoluteURIPrintOptions userInfo hosts hierPath query r = + HierarchicalPartPrintOptions userInfo hosts hierPath + ( printQuery ∷ query → String + | r + ) print - ∷ ∀ userInfo hierPath query r - . Record (AbsoluteURIPrintOptions userInfo hierPath query r) - → AbsoluteURI userInfo hierPath query + ∷ ∀ userInfo hosts hierPath query r + . Functor hosts + ⇒ Record (AbsoluteURIPrintOptions userInfo hosts hierPath query r) + → AbsoluteURI userInfo hosts hierPath query → String print opts (AbsoluteURI s h q) = S.joinWith "" $ catMaybes @@ -73,24 +79,24 @@ print opts (AbsoluteURI s h q) = ] _scheme - ∷ ∀ userInfo hierPath query - . Lens' (AbsoluteURI userInfo hierPath query) Scheme + ∷ ∀ userInfo hosts hierPath query + . Lens' (AbsoluteURI userInfo hosts hierPath query) Scheme _scheme = lens (\(AbsoluteURI s _ _) → s) (\(AbsoluteURI _ h q) s → AbsoluteURI s h q) _hierPart - ∷ ∀ userInfo hierPath query - . Lens' (AbsoluteURI userInfo hierPath query) (HierarchicalPart userInfo hierPath) + ∷ ∀ userInfo hosts hierPath query + . Lens' (AbsoluteURI userInfo hosts hierPath query) (HierarchicalPart userInfo hosts hierPath) _hierPart = lens (\(AbsoluteURI _ h _) → h) (\(AbsoluteURI s _ q) h → AbsoluteURI s h q) _query - ∷ ∀ userInfo hierPath query - . Lens' (AbsoluteURI userInfo hierPath query) (Maybe query) + ∷ ∀ userInfo hosts hierPath query + . Lens' (AbsoluteURI userInfo hosts hierPath query) (Maybe query) _query = lens (\(AbsoluteURI _ _ q) → q) diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index 0cf0550..b2d6e7c 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -1,5 +1,7 @@ module Data.URI.Authority ( Authority(..) + , AuthorityParseOptions + , AuthorityPrintOptions , parser , print , _userInfo @@ -10,12 +12,12 @@ module Data.URI.Authority import Prelude -import Data.Array (fromFoldable) +import Data.Eq (class Eq1, eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe, maybe) -import Data.String as S +import Data.Ord (class Ord1, compare1) import Data.Tuple (Tuple(..)) import Data.URI.Host (Host(..), _IPv4Address, _IPv6Address, _NameAddress) import Data.URI.Host as Host @@ -23,49 +25,69 @@ import Data.URI.Port (Port(..)) import Data.URI.Port as Port import Data.URI.UserInfo as UserInfo import Text.Parsing.StringParser (Parser, try) -import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy) +import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (string) -- | The authority part of a URI. For example: `purescript.org`, -- | `localhost:3000`, `user@example.net` -data Authority userInfo = Authority (Maybe userInfo) (Array (Tuple Host (Maybe Port))) +data Authority userInfo hosts = Authority (Maybe userInfo) (hosts (Tuple Host (Maybe Port))) -derive instance eqAuthority ∷ Eq userInfo ⇒ Eq (Authority userInfo) -derive instance ordAuthority ∷ Ord userInfo ⇒ Ord (Authority userInfo) -derive instance genericAuthority ∷ Generic (Authority userInfo) _ -instance showAuthority ∷ Show userInfo ⇒ Show (Authority userInfo) where show = genericShow +instance eqAuthority ∷ (Eq userInfo, Eq1 hosts) ⇒ Eq (Authority userInfo hosts) where + eq (Authority ui1 hs1) (Authority ui2 hs2) = eq ui1 ui2 && eq1 hs1 hs2 + +instance ordAuthority ∷ (Ord userInfo, Ord1 hosts) ⇒ Ord (Authority userInfo hosts) where + compare (Authority ui1 hs1) (Authority ui2 hs2) = + case compare ui1 ui2 of + EQ → compare1 hs1 hs2 + o → o + +derive instance genericAuthority ∷ Generic (Authority userInfo hosts) _ + +instance showAuthority ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port)))) ⇒ Show (Authority userInfo hosts) where show = genericShow + +type AuthorityParseOptions userInfo hosts r = + ( parseUserInfo ∷ Parser userInfo + , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + | r + ) parser - ∷ ∀ userInfo r - . { parseUserInfo ∷ Parser userInfo | r } - → Parser (Authority userInfo) + ∷ ∀ userInfo hosts r + . Record (AuthorityParseOptions userInfo hosts r) + → Parser (Authority userInfo hosts) parser opts = do _ ← string "//" ui ← optionMaybe $ try (UserInfo.parser opts.parseUserInfo <* string "@") - hosts ← flip sepBy (string ",") $ - Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser) - pure $ Authority ui (fromFoldable hosts) + hosts ← opts.parseHosts $ Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser) + pure $ Authority ui hosts + +type AuthorityPrintOptions userInfo hosts r = + ( printUserInfo ∷ userInfo → String + , printHosts ∷ hosts String → String + | r + ) print - ∷ ∀ userInfo r - . { printUserInfo ∷ userInfo → String | r } - → Authority userInfo + ∷ ∀ userInfo hosts r + . Functor hosts + ⇒ Record (AuthorityPrintOptions userInfo hosts r) + → Authority userInfo hosts → String print opts (Authority ui hs) = - "//" <> printUserInfo ui <> S.joinWith "," (printHostAndPort <$> hs) + "//" <> printUserInfo ui <> opts.printHosts (printHostAndPort <$> hs) where printUserInfo = maybe "" (\u → opts.printUserInfo u <> "@") printHostAndPort (Tuple h p) = Host.print h <> maybe "" (\n → ":" <> Port.print n) p -_userInfo ∷ ∀ userInfo. Lens' (Authority userInfo) (Maybe userInfo) +_userInfo ∷ ∀ userInfo hosts. Lens' (Authority userInfo hosts) (Maybe userInfo) _userInfo = lens (\(Authority ui _) → ui) (\(Authority _ hs) ui → Authority ui hs) -_hosts ∷ ∀ userInfo. Lens' (Authority userInfo) (Array (Tuple Host (Maybe Port))) +_hosts ∷ ∀ userInfo hosts. Lens' (Authority userInfo hosts) (hosts (Tuple Host (Maybe Port))) _hosts = lens (\(Authority _ hs) → hs) diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index f501f42..a2411e8 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -1,6 +1,8 @@ module Data.URI.HierarchicalPart ( HierarchicalPart(..) + , HierarchicalPartParseOptions , parser + , HierarchicalPartPrintOptions , print , _authority , _path @@ -11,31 +13,37 @@ import Prelude import Control.Alt ((<|>)) import Data.Array (catMaybes) +import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) +import Data.Ord (class Ord1) import Data.String as S -import Data.URI.Authority (Authority(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.Tuple (Tuple) +import Data.URI.Authority (Authority(..), AuthorityPrintOptions, Host(..), Port(..), AuthorityParseOptions, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Path as Path import Text.Parsing.StringParser (Parser) -- | The "hierarchical part" of a generic or absolute URI. -data HierarchicalPart userInfo hierPath = HierarchicalPart (Maybe (Authority userInfo)) (Maybe hierPath) +data HierarchicalPart userInfo hosts hierPath = HierarchicalPart (Maybe (Authority userInfo hosts)) (Maybe hierPath) -derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hierPath) -derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hierPath) -derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hierPath) _ -instance showHierarchicalPart ∷ (Show userInfo, Show hierPath) ⇒ Show (HierarchicalPart userInfo hierPath) where show = genericShow +derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq1 hosts, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hosts hierPath) +derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord1 hosts, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hosts hierPath) +derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts hierPath) _ +instance showHierarchicalPart ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts hierPath) where show = genericShow -parser - ∷ ∀ userInfo hierPath r - . { parseUserInfo ∷ Parser userInfo - , parseHierPath ∷ Parser hierPath +type HierarchicalPartParseOptions userInfo hosts hierPath r = + AuthorityParseOptions userInfo hosts + ( parseHierPath ∷ Parser hierPath | r - } - → Parser (HierarchicalPart userInfo hierPath) + ) + +parser + ∷ ∀ userInfo hosts hierPath r + . Record (HierarchicalPartParseOptions userInfo hosts hierPath r) + → Parser (HierarchicalPart userInfo hosts hierPath) parser opts = withAuth <|> withoutAuth where withAuth = @@ -50,13 +58,17 @@ parser opts = withAuth <|> withoutAuth <|> (Just <$> Path.parsePathRootless opts.parseHierPath) <|> pure Nothing -print - ∷ ∀ userInfo hierPath r - . { printUserInfo ∷ userInfo → String - , printHierPath ∷ hierPath → String +type HierarchicalPartPrintOptions userInfo hosts hierPath r = + AuthorityPrintOptions userInfo hosts + ( printHierPath ∷ hierPath → String | r - } - → HierarchicalPart userInfo hierPath → String + ) + +print + ∷ ∀ userInfo hosts hierPath r + . Functor hosts + ⇒ Record (HierarchicalPartPrintOptions userInfo hosts hierPath r) + → HierarchicalPart userInfo hosts hierPath → String print opts (HierarchicalPart a p) = S.joinWith "" $ catMaybes @@ -64,13 +76,13 @@ print opts (HierarchicalPart a p) = , opts.printHierPath <$> p ] -_authority ∷ ∀ userInfo hierPath. Lens' (HierarchicalPart userInfo hierPath) (Maybe (Authority userInfo)) +_authority ∷ ∀ userInfo hosts hierPath. Lens' (HierarchicalPart userInfo hosts hierPath) (Maybe (Authority userInfo hosts)) _authority = lens (\(HierarchicalPart a _) → a) (\(HierarchicalPart _ p) a → HierarchicalPart a p) -_path ∷ ∀ userInfo hierPath. Lens' (HierarchicalPart userInfo hierPath) (Maybe hierPath) +_path ∷ ∀ userInfo hosts hierPath. Lens' (HierarchicalPart userInfo hosts hierPath) (Maybe hierPath) _path = lens (\(HierarchicalPart _ p) → p) diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index 81118ed..0a9cbce 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -1,6 +1,8 @@ module Data.URI.RelativePart ( RelativePart(..) + , RelativePartParseOptions , parser + , RelativePartPrintOptions , print , _authority , _path @@ -11,37 +13,42 @@ import Prelude import Control.Alt ((<|>)) import Data.Array (catMaybes) +import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) +import Data.Ord (class Ord1) import Data.String as S -import Data.URI.Authority (Authority(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.Tuple (Tuple) +import Data.URI.Authority (Authority(..), AuthorityPrintOptions, Host(..), Port(..), AuthorityParseOptions, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Path as Path import Text.Parsing.StringParser (Parser) -- | The "relative part" of a relative reference. -data RelativePart userInfo relPath = RelativePart (Maybe (Authority userInfo)) (Maybe relPath) +data RelativePart userInfo hosts relPath = RelativePart (Maybe (Authority userInfo hosts)) (Maybe relPath) -derive instance eqRelativePart ∷ (Eq userInfo, Eq relPath) ⇒ Eq (RelativePart userInfo relPath) -derive instance ordRelativePart ∷ (Ord userInfo, Ord relPath) ⇒ Ord (RelativePart userInfo relPath) -derive instance genericRelativePart ∷ Generic (RelativePart userInfo relPath) _ -instance showRelativePart ∷ (Show userInfo, Show relPath) ⇒ Show (RelativePart userInfo relPath) where show = genericShow +derive instance eqRelativePart ∷ (Eq userInfo, Eq1 hosts, Eq relPath) ⇒ Eq (RelativePart userInfo hosts relPath) +derive instance ordRelativePart ∷ (Ord userInfo, Ord1 hosts, Ord relPath) ⇒ Ord (RelativePart userInfo hosts relPath) +derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts relPath) _ +instance showRelativePart ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show relPath) ⇒ Show (RelativePart userInfo hosts relPath) where show = genericShow -parser - ∷ ∀ userInfo relPath r - . { parseUserInfo ∷ Parser userInfo - , parseRelPath ∷ Parser relPath +type RelativePartParseOptions userInfo hosts relPath r = + AuthorityParseOptions userInfo hosts + ( parseRelPath ∷ Parser relPath | r - } - → Parser (RelativePart userInfo relPath) + ) + +parser + ∷ ∀ userInfo hosts relPath r + . Record (RelativePartParseOptions userInfo hosts relPath r) + → Parser (RelativePart userInfo hosts relPath) parser opts = withAuth <|> withoutAuth where - withAuth = - RelativePart - <$> Just <$> Authority.parser opts + RelativePart <<< Just + <$> Authority.parser opts <*> Path.parsePathAbEmpty opts.parseRelPath withoutAuth = RelativePart Nothing <$> noAuthPath @@ -51,13 +58,17 @@ parser opts = withAuth <|> withoutAuth <|> (Just <$> Path.parsePathNoScheme opts.parseRelPath) <|> pure Nothing -print - ∷ ∀ userInfo relPath r - . { printUserInfo ∷ userInfo → String - , printRelPath ∷ relPath → String +type RelativePartPrintOptions userInfo hosts relPath r = + AuthorityPrintOptions userInfo hosts + ( printRelPath ∷ relPath → String | r - } - → RelativePart userInfo relPath → String + ) + +print + ∷ ∀ userInfo hosts relPath r + . Functor hosts + ⇒ Record (RelativePartPrintOptions userInfo hosts relPath r) + → RelativePart userInfo hosts relPath → String print opts (RelativePart a p) = S.joinWith "" $ catMaybes @@ -65,13 +76,13 @@ print opts (RelativePart a p) = , opts.printRelPath <$> p ] -_authority ∷ ∀ userInfo relPath. Lens' (RelativePart userInfo relPath) (Maybe (Authority userInfo)) +_authority ∷ ∀ userInfo hosts relPath. Lens' (RelativePart userInfo hosts relPath) (Maybe (Authority userInfo hosts)) _authority = lens (\(RelativePart a _) → a) (\(RelativePart _ p) a → RelativePart a p) -_path ∷ ∀ userInfo relPath. Lens' (RelativePart userInfo relPath) (Maybe relPath) +_path ∷ ∀ userInfo hosts relPath. Lens' (RelativePart userInfo hosts relPath) (Maybe relPath) _path = lens (\(RelativePart _ p) → p) diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 184b75f..1866d46 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -1,6 +1,9 @@ module Data.URI.RelativeRef ( RelativeRef(..) + , RelativeRefOptions + , RelativeRefParseOptions , parser + , RelativeRefPrintOptions , print , _relPart , _query @@ -11,36 +14,44 @@ module Data.URI.RelativeRef import Prelude import Data.Array (catMaybes) +import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) +import Data.Ord (class Ord1) import Data.String as S +import Data.Tuple (Tuple) import Data.URI.Fragment as Fragment import Data.URI.Query as Query +import Data.URI.RelativePart (Authority(..), AuthorityParseOptions, AuthorityPrintOptions, Host(..), Port(..), RelativePart(..), RelativePartParseOptions, RelativePartPrintOptions, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.RelativePart as RPart -import Data.URI.RelativePart (Authority(..), Host(..), Port(..), RelativePart(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Text.Parsing.StringParser (Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A relative reference for a URI. -data RelativeRef userInfo relPath query fragment = RelativeRef (RelativePart userInfo relPath) (Maybe query) (Maybe fragment) +data RelativeRef userInfo hosts relPath query fragment = RelativeRef (RelativePart userInfo hosts relPath) (Maybe query) (Maybe fragment) -derive instance eqRelativeRef ∷ (Eq userInfo, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo relPath query fragment) -derive instance ordRelativeRef ∷ (Ord userInfo, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo relPath query fragment) -derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo relPath query fragment) _ -instance showRelativeRef ∷ (Show userInfo, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo relPath query fragment) where show = genericShow +derive instance eqRelativeRef ∷ (Eq userInfo, Eq1 hosts, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo hosts relPath query fragment) +derive instance ordRelativeRef ∷ (Ord userInfo, Ord1 hosts, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo hosts relPath query fragment) +derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts relPath query fragment) _ +instance showRelativeRef ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts relPath query fragment) where show = genericShow -parser - ∷ ∀ userInfo relPath query fragment r - . { parseUserInfo ∷ Parser userInfo - , parseRelPath ∷ Parser relPath - , parseQuery ∷ Parser query +type RelativeRefOptions userInfo hosts relPath query fragment = + RelativeRefParseOptions userInfo hosts relPath query fragment (RelativeRefPrintOptions userInfo hosts relPath query fragment ()) + +type RelativeRefParseOptions userInfo hosts relPath query fragment r = + RelativePartParseOptions userInfo hosts relPath + ( parseQuery ∷ Parser query , parseFragment ∷ Parser fragment | r - } - → Parser (RelativeRef userInfo relPath query fragment) + ) + +parser + ∷ ∀ userInfo hosts relPath query fragment r + . Record (RelativeRefParseOptions userInfo hosts relPath query fragment r) + → Parser (RelativeRef userInfo hosts relPath query fragment) parser opts = RelativeRef <$> RPart.parser opts @@ -48,15 +59,18 @@ parser opts = <*> optionMaybe (Fragment.parser opts.parseFragment) <* eof -print - ∷ ∀ userInfo relPath query fragment r - . { printUserInfo ∷ userInfo → String - , printRelPath ∷ relPath → String - , printQuery ∷ query → String +type RelativeRefPrintOptions userInfo hosts relPath query fragment r = + RelativePartPrintOptions userInfo hosts relPath + ( printQuery ∷ query → String , printFragment ∷ fragment → String | r - } - → RelativeRef userInfo relPath query fragment + ) + +print + ∷ ∀ userInfo hosts relPath query fragment r + . Functor hosts + ⇒ Record (RelativeRefPrintOptions userInfo hosts relPath query fragment r) + → RelativeRef userInfo hosts relPath query fragment → String print opts (RelativeRef h q f) = S.joinWith "" $ catMaybes @@ -66,24 +80,24 @@ print opts (RelativeRef h q f) = ] _relPart - ∷ ∀ userInfo relPath query fragment - . Lens' (RelativeRef userInfo relPath query fragment) (RelativePart userInfo relPath) + ∷ ∀ userInfo hosts relPath query fragment + . Lens' (RelativeRef userInfo hosts relPath query fragment) (RelativePart userInfo hosts relPath) _relPart = lens (\(RelativeRef r _ _) → r) (\(RelativeRef _ q f) r → RelativeRef r q f) _query - ∷ ∀ userInfo relPath query fragment - . Lens' (RelativeRef userInfo relPath query fragment) (Maybe query) + ∷ ∀ userInfo hosts relPath query fragment + . Lens' (RelativeRef userInfo hosts relPath query fragment) (Maybe query) _query = lens (\(RelativeRef _ q _) → q) (\(RelativeRef r _ f) q → RelativeRef r q f) _fragment - ∷ ∀ userInfo relPath query fragment - . Lens' (RelativeRef userInfo relPath query fragment) (Maybe fragment) + ∷ ∀ userInfo hosts relPath query fragment + . Lens' (RelativeRef userInfo hosts relPath query fragment) (Maybe fragment) _fragment = lens (\(RelativeRef _ _ f) → f) diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 2281f89..9ab04d5 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -16,13 +16,16 @@ module Data.URI.URI import Prelude import Data.Array (catMaybes) +import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) +import Data.Ord (class Ord1) import Data.String as S +import Data.Tuple (Tuple) import Data.URI.Fragment as Fragment -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), AuthorityParseOptions, AuthorityPrintOptions, HierarchicalPart(..), HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) @@ -32,28 +35,27 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A generic URI -data URI userInfo hierPath query fragment = URI Scheme (HierarchicalPart userInfo hierPath) (Maybe query) (Maybe fragment) +data URI userInfo hosts hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts hierPath) (Maybe query) (Maybe fragment) -derive instance eqURI ∷ (Eq userInfo, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hierPath query fragment) -derive instance ordURI ∷ (Ord userInfo, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hierPath query fragment) -derive instance genericURI ∷ Generic (URI userInfo hierPath query fragment) _ -instance showURI ∷ (Show userInfo, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hierPath query fragment) where show = genericShow +derive instance eqURI ∷ (Eq userInfo, Eq1 hosts, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hosts hierPath query fragment) +derive instance ordURI ∷ (Ord userInfo, Ord1 hosts, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hosts hierPath query fragment) +derive instance genericURI ∷ Generic (URI userInfo hosts hierPath query fragment) _ +instance showURI ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts hierPath query fragment) where show = genericShow -type URIOptions userInfo hierPath query fragment = - URIParseOptions userInfo hierPath query fragment (URIPrintOptions userInfo hierPath query fragment ()) +type URIOptions userInfo hosts hierPath query fragment = + URIParseOptions userInfo hosts hierPath query fragment (URIPrintOptions userInfo hosts hierPath query fragment ()) -type URIParseOptions userInfo hierPath query fragment r = - ( parseUserInfo ∷ Parser userInfo - , parseHierPath ∷ Parser hierPath - , parseQuery ∷ Parser query - , parseFragment ∷ Parser fragment - | r - ) +type URIParseOptions userInfo hosts hierPath query fragment r = + HierarchicalPartParseOptions userInfo hosts hierPath + ( parseQuery ∷ Parser query + , parseFragment ∷ Parser fragment + | r + ) parser - ∷ ∀ userInfo hierPath query fragment r - . Record (URIParseOptions userInfo hierPath query fragment r) - → Parser (URI userInfo hierPath query fragment) + ∷ ∀ userInfo hosts hierPath query fragment r + . Record (URIParseOptions userInfo hosts hierPath query fragment r) + → Parser (URI userInfo hosts hierPath query fragment) parser opts = URI <$> Scheme.parser <*> HPart.parser opts @@ -61,18 +63,18 @@ parser opts = URI <*> optionMaybe (Fragment.parser opts.parseFragment) <* eof -type URIPrintOptions userInfo hierPath query fragment r = - ( printUserInfo ∷ userInfo → String - , printHierPath ∷ hierPath → String - , printQuery ∷ query → String - , printFragment ∷ fragment → String - | r - ) +type URIPrintOptions userInfo hosts hierPath query fragment r = + HierarchicalPartPrintOptions userInfo hosts hierPath + ( printQuery ∷ query → String + , printFragment ∷ fragment → String + | r + ) print - ∷ ∀ userInfo hierPath query fragment r - . Record (URIPrintOptions userInfo hierPath query fragment r) - → URI userInfo hierPath query fragment + ∷ ∀ userInfo hosts hierPath query fragment r + . Functor hosts + ⇒ Record (URIPrintOptions userInfo hosts hierPath query fragment r) + → URI userInfo hosts hierPath query fragment → String print opts (URI s h q f) = S.joinWith "" $ catMaybes @@ -83,32 +85,32 @@ print opts (URI s h q f) = ] _scheme - ∷ ∀ userInfo hierPath query fragment - . Lens' (URI userInfo hierPath query fragment) Scheme + ∷ ∀ userInfo hosts hierPath query fragment + . Lens' (URI userInfo hosts hierPath query fragment) Scheme _scheme = lens (\(URI s _ _ _) → s) (\(URI _ h q f) s → URI s h q f) _hierPart - ∷ ∀ userInfo hierPath query fragment - . Lens' (URI userInfo hierPath query fragment) (HierarchicalPart userInfo hierPath) + ∷ ∀ userInfo hosts hierPath query fragment + . Lens' (URI userInfo hosts hierPath query fragment) (HierarchicalPart userInfo hosts hierPath) _hierPart = lens (\(URI _ h _ _) → h) (\(URI s _ q f) h → URI s h q f) _query - ∷ ∀ userInfo hierPath query fragment - . Lens' (URI userInfo hierPath query fragment) (Maybe query) + ∷ ∀ userInfo hosts hierPath query fragment + . Lens' (URI userInfo hosts hierPath query fragment) (Maybe query) _query = lens (\(URI _ _ q _) → q) (\(URI s h _ f) q → URI s h q f) _fragment - ∷ ∀ userInfo hierPath query fragment - . Lens' (URI userInfo hierPath query fragment) (Maybe fragment) + ∷ ∀ userInfo hosts hierPath query fragment + . Lens' (URI userInfo hosts hierPath query fragment) (Maybe fragment) _fragment = lens (\(URI _ _ _ f) → f) diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index 19c1377..5f16e2c 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -4,49 +4,52 @@ import Prelude import Control.Alt ((<|>)) import Data.Either (Either(..), either) +import Data.URI.RelativeRef (AuthorityParseOptions, AuthorityPrintOptions) import Data.URI.RelativeRef as RelativeRef import Data.URI.URI as URI import Text.Parsing.StringParser (Parser, try) -- | An alias for the most common use case of resource identifiers. -type URIRef userInfo hierPath relPath query fragment = +type URIRef userInfo hosts hierPath relPath query fragment = Either - (URI.URI userInfo hierPath query fragment) - (RelativeRef.RelativeRef userInfo relPath query fragment) - -type URIRefOptions userInfo hierPath relPath query fragment = - URIRefParseOptions userInfo hierPath relPath query fragment (URIRefPrintOptions userInfo hierPath relPath query fragment ()) - -type URIRefParseOptions userInfo hierPath relPath query fragment r = - ( parseUserInfo ∷ Parser userInfo - , parseHierPath ∷ Parser hierPath - , parseRelPath ∷ Parser relPath - , parseQuery ∷ Parser query - , parseFragment ∷ Parser fragment - | r - ) + (URI.URI userInfo hosts hierPath query fragment) + (RelativeRef.RelativeRef userInfo hosts relPath query fragment) + +type URIRefOptions userInfo hosts hierPath relPath query fragment = + URIRefParseOptions userInfo hosts hierPath relPath query fragment + (URIRefPrintOptions userInfo hosts hierPath relPath query fragment ()) + +type URIRefParseOptions userInfo hosts hierPath relPath query fragment r = + AuthorityParseOptions userInfo hosts + ( parseHierPath ∷ Parser hierPath + , parseRelPath ∷ Parser relPath + , parseQuery ∷ Parser query + , parseFragment ∷ Parser fragment + | r + ) parser - ∷ ∀ userInfo hierPath relPath query fragment r - . Record (URIRefParseOptions userInfo hierPath relPath query fragment r) - → Parser (URIRef userInfo hierPath relPath query fragment) + ∷ ∀ userInfo hosts hierPath relPath query fragment r + . Record (URIRefParseOptions userInfo hosts hierPath relPath query fragment r) + → Parser (URIRef userInfo hosts hierPath relPath query fragment) parser opts = (Left <$> try (URI.parser opts)) <|> (Right <$> RelativeRef.parser opts) -type URIRefPrintOptions userInfo hierPath relPath query fragment r = - ( printUserInfo ∷ userInfo → String - , printHierPath ∷ hierPath → String - , printRelPath ∷ relPath → String - , printQuery ∷ query → String - , printFragment ∷ fragment → String - | r - ) +type URIRefPrintOptions userInfo hosts hierPath relPath query fragment r = + AuthorityPrintOptions userInfo hosts + ( printHierPath ∷ hierPath → String + , printRelPath ∷ relPath → String + , printQuery ∷ query → String + , printFragment ∷ fragment → String + | r + ) print - ∷ ∀ userInfo hierPath relPath query fragment r - . Record (URIRefPrintOptions userInfo hierPath relPath query fragment r) - → URIRef userInfo hierPath relPath query fragment + ∷ ∀ userInfo hosts hierPath relPath query fragment r + . Functor hosts + ⇒ Record (URIRefPrintOptions userInfo hosts hierPath relPath query fragment r) + → URIRef userInfo hosts hierPath relPath query fragment → String print opts = either diff --git a/test/Main.purs b/test/Main.purs index 8613736..a107ff6 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -8,11 +8,13 @@ import Control.Monad.Eff.Class (liftEff) import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) +import Data.Array as Array import Data.Either (isLeft, Either(..)) import Data.List (List(..), singleton, (:)) import Data.Maybe (Maybe(Nothing, Just)) import Data.Monoid (mempty) import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) +import Data.String as String import Data.String.Regex (Regex, regex) import Data.String.Regex.Flags (global, noFlags) import Data.Tuple (Tuple(..)) @@ -42,11 +44,15 @@ import Test.Unit.Assert (assert, equal) import Test.Unit.Console (TESTOUTPUT) import Test.Unit.Main (runTest) import Text.Parsing.StringParser (Parser, runParser) +import Text.Parsing.StringParser.Combinators as SP +import Text.Parsing.StringParser.String as SP -options ∷ Record (URIRef.URIRefOptions NU.UserInfo NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment) +options ∷ Record (URIRef.URIRefOptions NU.UserInfo Array NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment) options = { parseUserInfo: NU.parser , printUserInfo: NU.print + , parseHosts: map Array.fromFoldable <<< flip SP.sepBy (SP.string ",") + , printHosts: String.joinWith "," , parseHierPath: NP.parseURIPathAbs , printHierPath: NP.printPath , parseRelPath: NP.parseURIPathRel @@ -74,10 +80,10 @@ testIso p f uri expected = do testRunParseSuccess p uri expected testPrinter f uri expected -testIsoURI :: forall a. String -> URI.URI NU.UserInfo NP.URIPathAbs NQ.Query NF.Fragment -> TestSuite a +testIsoURI :: forall a. String -> URI.URI NU.UserInfo Array NP.URIPathAbs NQ.Query NF.Fragment -> TestSuite a testIsoURI = testIso (URI.parser options) (URI.print options) -testIsoURIRef :: forall a. String -> URIRef.URIRef NU.UserInfo NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment -> TestSuite a +testIsoURIRef :: forall a. String -> URIRef.URIRef NU.UserInfo Array NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment -> TestSuite a testIsoURIRef = testIso (URIRef.parser options) (URIRef.print options) -- testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a From c3decaf88c00c0ee11889ba14cd8d48640d3864e Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 30 Jan 2018 12:06:42 +0000 Subject: [PATCH 08/69] Use functions for component parsing --- src/Data/URI/AbsoluteURI.purs | 32 +++++++++++++--------- src/Data/URI/Authority.purs | 22 +++++++++------ src/Data/URI/Common.purs | 11 ++++---- src/Data/URI/Fragment.purs | 5 ++-- src/Data/URI/HierarchicalPart.purs | 34 ++++++++++++++--------- src/Data/URI/NonStandard/Fragment.purs | 8 ++---- src/Data/URI/NonStandard/Path.purs | 32 +++++++++++----------- src/Data/URI/NonStandard/Query.purs | 10 +++---- src/Data/URI/NonStandard/UserInfo.purs | 7 ++--- src/Data/URI/Path.purs | 13 +++++---- src/Data/URI/Query.purs | 5 ++-- src/Data/URI/RelativePart.purs | 32 ++++++++++++++-------- src/Data/URI/RelativeRef.purs | 36 ++++++++++++++---------- src/Data/URI/URI.purs | 38 +++++++++++++++----------- src/Data/URI/URIRef.purs | 37 +++++++++++++------------ src/Data/URI/UserInfo.purs | 7 +++-- test/Main.purs | 22 +++++++-------- 17 files changed, 197 insertions(+), 154 deletions(-) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index bb700d6..e87deda 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -15,6 +15,7 @@ module Data.URI.AbsoluteURI import Prelude import Data.Array (catMaybes) +import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -23,12 +24,12 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as S import Data.Tuple (Tuple) -import Data.URI.HierarchicalPart (Authority(..), AuthorityParseOptions, AuthorityPrintOptions, HierarchicalPart(..), HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) import Data.URI.Scheme as Scheme -import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) @@ -41,13 +42,24 @@ derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts hierP instance showAbsoluteURI ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts hierPath query) where show = genericShow type AbsoluteURIOptions userInfo hosts hierPath query = - AbsoluteURIParseOptions userInfo hosts hierPath query (AbsoluteURIPrintOptions userInfo hosts hierPath query ()) + AbsoluteURIParseOptions userInfo hosts hierPath query + (AbsoluteURIPrintOptions userInfo hosts hierPath query ()) type AbsoluteURIParseOptions userInfo hosts hierPath query r = - HierarchicalPartParseOptions userInfo hosts hierPath - ( parseQuery ∷ Parser query - | r - ) + ( parseUserInfo ∷ String → Either ParseError userInfo + , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHierPath ∷ String → Either ParseError hierPath + , parseQuery ∷ String → Either ParseError query + | r + ) + +type AbsoluteURIPrintOptions userInfo hosts hierPath query r = + ( printUserInfo ∷ userInfo → String + , printHosts ∷ hosts String → String + , printHierPath ∷ hierPath → String + , printQuery ∷ query → String + | r + ) parser ∷ ∀ userInfo hosts hierPath query r @@ -59,12 +71,6 @@ parser opts = AbsoluteURI <*> optionMaybe (Query.parser opts.parseQuery) <* eof -type AbsoluteURIPrintOptions userInfo hosts hierPath query r = - HierarchicalPartPrintOptions userInfo hosts hierPath - ( printQuery ∷ query → String - | r - ) - print ∷ ∀ userInfo hosts hierPath query r . Functor hosts diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index b2d6e7c..e22a6ab 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -1,5 +1,6 @@ module Data.URI.Authority ( Authority(..) + , AuthorityOptions , AuthorityParseOptions , AuthorityPrintOptions , parser @@ -12,6 +13,7 @@ module Data.URI.Authority import Prelude +import Data.Either (Either) import Data.Eq (class Eq1, eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -24,7 +26,7 @@ import Data.URI.Host as Host import Data.URI.Port (Port(..)) import Data.URI.Port as Port import Data.URI.UserInfo as UserInfo -import Text.Parsing.StringParser (Parser, try) +import Text.Parsing.StringParser (ParseError, Parser, try) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (string) @@ -45,12 +47,22 @@ derive instance genericAuthority ∷ Generic (Authority userInfo hosts) _ instance showAuthority ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port)))) ⇒ Show (Authority userInfo hosts) where show = genericShow +type AuthorityOptions userInfo hosts = + AuthorityParseOptions userInfo hosts + (AuthorityPrintOptions userInfo hosts ()) + type AuthorityParseOptions userInfo hosts r = - ( parseUserInfo ∷ Parser userInfo + ( parseUserInfo ∷ String → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) | r ) +type AuthorityPrintOptions userInfo hosts r = + ( printUserInfo ∷ userInfo → String + , printHosts ∷ hosts String → String + | r + ) + parser ∷ ∀ userInfo hosts r . Record (AuthorityParseOptions userInfo hosts r) @@ -61,12 +73,6 @@ parser opts = do hosts ← opts.parseHosts $ Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser) pure $ Authority ui hosts -type AuthorityPrintOptions userInfo hosts r = - ( printUserInfo ∷ userInfo → String - , printHosts ∷ hosts String → String - | r - ) - print ∷ ∀ userInfo hosts r . Functor hosts diff --git a/src/Data/URI/Common.purs b/src/Data/URI/Common.purs index 6c93ab7..f7234a8 100644 --- a/src/Data/URI/Common.purs +++ b/src/Data/URI/Common.purs @@ -31,11 +31,12 @@ rxPat ∷ String → Parser String rxPat rx = unsafePartial $ fromRight $ anyMatch <$> RX.regex rx RXF.ignoreCase -wrapParser ∷ ∀ a. Parser a → Parser String → Parser a -wrapParser outer inner = Parser \ps → do - r ← unParser inner ps - r' ← unParser outer {str : r.result, pos: 0} - pure { result: r'.result, suffix: r.suffix } +wrapParser ∷ ∀ a. (String → Either ParseError a) → Parser String → Parser a +wrapParser parseA p = Parser \ps → do + pr ← unParser p ps + case parseA pr.result of + Left error → Left { error, pos: ps.pos } + Right result → Right { result, suffix: pr.suffix } parsePChar ∷ (PCTEncoded → String) → Parser String parsePChar f diff --git a/src/Data/URI/Fragment.purs b/src/Data/URI/Fragment.purs index 032b6b9..b501c79 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/Data/URI/Fragment.purs @@ -3,12 +3,13 @@ module Data.URI.Fragment where import Prelude import Control.Alt ((<|>)) +import Data.Either (Either) import Data.URI.Common (decodePCTComponent, joinWith, parsePChar, wrapParser) -import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (many) import Text.Parsing.StringParser.String (string) -parser ∷ ∀ f. Parser f → Parser f +parser ∷ ∀ f. (String → Either ParseError f) → Parser f parser parseF = string "#" *> wrapParser parseF (joinWith "" <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index a2411e8..a76f4ac 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -1,8 +1,9 @@ module Data.URI.HierarchicalPart ( HierarchicalPart(..) + , HierarchicalPartOptions , HierarchicalPartParseOptions - , parser , HierarchicalPartPrintOptions + , parser , print , _authority , _path @@ -13,6 +14,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Array (catMaybes) +import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -21,10 +23,10 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as S import Data.Tuple (Tuple) -import Data.URI.Authority (Authority(..), AuthorityPrintOptions, Host(..), Port(..), AuthorityParseOptions, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.URI.Authority (Authority(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Path as Path -import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser (ParseError, Parser) -- | The "hierarchical part" of a generic or absolute URI. data HierarchicalPart userInfo hosts hierPath = HierarchicalPart (Maybe (Authority userInfo hosts)) (Maybe hierPath) @@ -34,11 +36,23 @@ derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord1 hosts, Ord hierPath) derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts hierPath) _ instance showHierarchicalPart ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts hierPath) where show = genericShow +type HierarchicalPartOptions userInfo hosts hierPath = + HierarchicalPartParseOptions userInfo hosts hierPath + (HierarchicalPartPrintOptions userInfo hosts hierPath ()) + type HierarchicalPartParseOptions userInfo hosts hierPath r = - AuthorityParseOptions userInfo hosts - ( parseHierPath ∷ Parser hierPath - | r - ) + ( parseUserInfo ∷ String → Either ParseError userInfo + , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHierPath ∷ String → Either ParseError hierPath + | r + ) + +type HierarchicalPartPrintOptions userInfo hosts hierPath r = + ( printUserInfo ∷ userInfo → String + , printHosts ∷ hosts String → String + , printHierPath ∷ hierPath → String + | r + ) parser ∷ ∀ userInfo hosts hierPath r @@ -58,12 +72,6 @@ parser opts = withAuth <|> withoutAuth <|> (Just <$> Path.parsePathRootless opts.parseHierPath) <|> pure Nothing -type HierarchicalPartPrintOptions userInfo hosts hierPath r = - AuthorityPrintOptions userInfo hosts - ( printHierPath ∷ hierPath → String - | r - ) - print ∷ ∀ userInfo hosts hierPath r . Functor hosts diff --git a/src/Data/URI/NonStandard/Fragment.purs b/src/Data/URI/NonStandard/Fragment.purs index 9bb4ec5..a3fb2e7 100644 --- a/src/Data/URI/NonStandard/Fragment.purs +++ b/src/Data/URI/NonStandard/Fragment.purs @@ -2,17 +2,15 @@ module Data.URI.NonStandard.Fragment where import Prelude -import Data.Either (fromRight) +import Data.Either (Either, fromRight) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Newtype (class Newtype) import Data.String as S import Data.String.Regex as RX import Data.String.Regex.Flags as RXF -import Data.URI.Common (anyString) import Global (encodeURIComponent) import Partial.Unsafe (unsafePartial) -import Text.Parsing.StringParser (Parser) -- | The hash fragment of a URI. newtype Fragment = Fragment String @@ -23,8 +21,8 @@ derive instance genericFragment ∷ Generic Fragment _ derive instance newtypeFragment ∷ Newtype Fragment _ instance showFragment ∷ Show Fragment where show = genericShow -parser ∷ Parser Fragment -parser = Fragment <$> anyString +parse ∷ ∀ e. String → Either e Fragment +parse = pure <<< Fragment print ∷ Fragment → String print (Fragment f) = S.joinWith "" (map printChar $ S.split (S.Pattern "") f) diff --git a/src/Data/URI/NonStandard/Path.purs b/src/Data/URI/NonStandard/Path.purs index 2b673de..76821d4 100644 --- a/src/Data/URI/NonStandard/Path.purs +++ b/src/Data/URI/NonStandard/Path.purs @@ -14,7 +14,7 @@ import Data.Maybe (Maybe(..), fromMaybe) import Data.Path.Pathy (Abs, Dir, Escaper(..), File, Path, Rel, Sandboxed, Unsandboxed, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile, rootDir, sandbox, unsafePrintPath', ()) import Data.String as Str import Global (encodeURI) -import Text.Parsing.StringParser (ParseError(..), Parser(..)) +import Text.Parsing.StringParser (ParseError(..)) -- | A general URI path, can be used to represent relative or absolute paths -- | that are sandboxed or unsandboxed. @@ -26,21 +26,21 @@ type URIPathAbs = URIPath Abs Sandboxed -- | The path part for a relative reference. type URIPathRel = URIPath Rel Unsandboxed -parseURIPathAbs ∷ Parser URIPathAbs -parseURIPathAbs = Parser \{ str: str, pos: i } → - case sandbox rootDir =<< parseAbsFile (Str.drop i str) of - Just file → Right { result: (Right $ rootDir file), suffix: { str: str, pos: Str.length str }} - Nothing → case sandbox rootDir =<< parseAbsDir (Str.drop i str) of - Just dir → Right { result: (Left $ rootDir dir), suffix: { str: str, pos: Str.length str }} - Nothing → Left { error: (ParseError $ "Expected a valid path"), pos: i } - -parseURIPathRel ∷ Parser URIPathRel -parseURIPathRel = Parser \{ str: str, pos: i } → - case parseRelFile (Str.drop i str) of - Just file → Right { result : Right file, suffix: { str: str, pos: Str.length str }} - Nothing → case parseRelDir (Str.drop i str) of - Just dir → Right { result : Left dir, suffix: { str: str, pos: Str.length str }} - Nothing → Left { error: (ParseError $ "Expected a valid path"), pos: i} +parseURIPathAbs ∷ String → Either ParseError URIPathAbs +parseURIPathAbs str = + case sandbox rootDir =<< parseAbsFile str of + Just file → Right $ Right (rootDir file) + Nothing → case sandbox rootDir =<< parseAbsDir str of + Just dir → Right $ Left (rootDir dir) + Nothing → Left (ParseError "Expected a valid path") + +parseURIPathRel ∷ String → Either ParseError URIPathRel +parseURIPathRel str = + case parseRelFile str of + Just file → Right (Right file) + Nothing → case parseRelDir str of + Just dir → Right (Left dir) + Nothing → Left (ParseError "Expected a valid path") printPath ∷ ∀ a s. URIPath a s → String printPath = either printPath' printPath' diff --git a/src/Data/URI/NonStandard/Query.purs b/src/Data/URI/NonStandard/Query.purs index 858637a..5d45db4 100644 --- a/src/Data/URI/NonStandard/Query.purs +++ b/src/Data/URI/NonStandard/Query.purs @@ -1,13 +1,13 @@ module Data.URI.NonStandard.Query ( Query(..) - , parser + , parse , print ) where import Prelude import Control.Alt ((<|>)) -import Data.Either (fromRight) +import Data.Either (Either, fromRight) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.List (List) @@ -21,7 +21,7 @@ import Data.Tuple (Tuple(..)) import Data.URI.Common (joinWith, rxPat) import Global (decodeURIComponent, encodeURIComponent) import Partial.Unsafe (unsafePartial) -import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser (ParseError, Parser, runParser) import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy) import Text.Parsing.StringParser.String (string) @@ -36,8 +36,8 @@ instance showQuery ∷ Show Query where show = genericShow derive newtype instance semigroupQuery ∷ Semigroup Query derive newtype instance monoidQuery ∷ Monoid Query -parser ∷ Parser Query -parser = Query <$> parseParts +parse ∷ String → Either ParseError Query +parse = runParser (Query <$> parseParts) parseParts ∷ Parser (List (Tuple String (Maybe String))) parseParts = sepBy parsePart (string ";" <|> string "&") diff --git a/src/Data/URI/NonStandard/UserInfo.purs b/src/Data/URI/NonStandard/UserInfo.purs index 77b91b6..75a8b97 100644 --- a/src/Data/URI/NonStandard/UserInfo.purs +++ b/src/Data/URI/NonStandard/UserInfo.purs @@ -2,12 +2,11 @@ module Data.URI.NonStandard.UserInfo where import Prelude +import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Newtype (class Newtype) -import Data.URI.Common (anyString) import Global (encodeURI) -import Text.Parsing.StringParser (Parser) -- | The user info part of an `Authority`. For example: `user`, `foo:bar`. newtype UserInfo = UserInfo String @@ -18,8 +17,8 @@ derive instance genericUserInfo ∷ Generic UserInfo _ derive instance newtypeUserInfo ∷ Newtype UserInfo _ instance showUserInfo ∷ Show UserInfo where show = genericShow -parser ∷ Parser UserInfo -parser = UserInfo <$> anyString +parse ∷ ∀ e. String → Either e UserInfo +parse = pure <<< UserInfo print ∷ UserInfo → String print (UserInfo u) = encodeURI u diff --git a/src/Data/URI/Path.purs b/src/Data/URI/Path.purs index cbc3402..538128a 100644 --- a/src/Data/URI/Path.purs +++ b/src/Data/URI/Path.purs @@ -3,14 +3,15 @@ module Data.URI.Path where import Prelude import Control.Alt ((<|>)) +import Data.Either (Either) import Data.Maybe (Maybe(..)) import Data.String as Str import Data.URI.Common (PCTEncoded, decodePCT, joinWith, parsePCTEncoded, parsePChar, parseSubDelims, parseUnreserved, wrapParser) -import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (many, many1, optionMaybe) import Text.Parsing.StringParser.String (string) -parsePath ∷ ∀ p. Parser p → Parser (Maybe p) +parsePath ∷ ∀ p. (String → Either ParseError p) → Parser (Maybe p) parsePath p = parsePathAbEmpty p <|> (Just <$> parsePathAbsolute p) @@ -18,26 +19,26 @@ parsePath p <|> (Just <$> parsePathRootless p) <|> pure Nothing -parsePathAbEmpty ∷ ∀ p. Parser p → Parser (Maybe p) +parsePathAbEmpty ∷ ∀ p. (String → Either ParseError p) → Parser (Maybe p) parsePathAbEmpty p = optionMaybe $ wrapParser p do parts ← many1 (string "/" *> parseSegment) pure ("/" <> joinWith "/" parts) -parsePathAbsolute ∷ ∀ p. Parser p → Parser p +parsePathAbsolute ∷ ∀ p. (String → Either ParseError p) → Parser p parsePathAbsolute p = wrapParser p $ do _ ← string "/" start ← parseSegmentNonZero rest ← joinWith "" <$> many (append <$> string "/" <*> parseSegment) pure $ "/" <> start <> rest -parsePathNoScheme ∷ ∀ p. Parser p → Parser p +parsePathNoScheme ∷ ∀ p. (String → Either ParseError p) → Parser p parsePathNoScheme p = wrapParser p $ append <$> parseSegmentNonZeroNoColon <*> (joinWith "" <$> many (append <$> string "/" <*> parseSegment)) -parsePathRootless ∷ ∀ p. Parser p → Parser p +parsePathRootless ∷ ∀ p. (String → Either ParseError p) → Parser p parsePathRootless p = wrapParser p $ append <$> parseSegmentNonZero diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index a84aa32..ddc8fe8 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -2,11 +2,12 @@ module Data.URI.Query where import Prelude +import Data.Either (Either) import Data.URI.Common (rxPat, wrapParser) -import Text.Parsing.StringParser (Parser, try) +import Text.Parsing.StringParser (ParseError, Parser, try) import Text.Parsing.StringParser.String (string) -parser ∷ ∀ q. Parser q → Parser q +parser ∷ ∀ q. (String → Either ParseError q) → Parser q parser parseQ = string "?" *> (wrapParser parseQ (try (rxPat "[^#]*"))) print ∷ ∀ q. (q → String) → q → String diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index 0a9cbce..6f12368 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -1,8 +1,9 @@ module Data.URI.RelativePart ( RelativePart(..) + , RelativePartOptions , RelativePartParseOptions - , parser , RelativePartPrintOptions + , parser , print , _authority , _path @@ -13,6 +14,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Array (catMaybes) +import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -24,7 +26,7 @@ import Data.Tuple (Tuple) import Data.URI.Authority (Authority(..), AuthorityPrintOptions, Host(..), Port(..), AuthorityParseOptions, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Path as Path -import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser (ParseError, Parser) -- | The "relative part" of a relative reference. data RelativePart userInfo hosts relPath = RelativePart (Maybe (Authority userInfo hosts)) (Maybe relPath) @@ -34,11 +36,23 @@ derive instance ordRelativePart ∷ (Ord userInfo, Ord1 hosts, Ord relPath) ⇒ derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts relPath) _ instance showRelativePart ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show relPath) ⇒ Show (RelativePart userInfo hosts relPath) where show = genericShow +type RelativePartOptions userInfo hosts relPath = + RelativePartParseOptions userInfo hosts relPath + (RelativePartPrintOptions userInfo hosts relPath ()) + type RelativePartParseOptions userInfo hosts relPath r = - AuthorityParseOptions userInfo hosts - ( parseRelPath ∷ Parser relPath - | r - ) + ( parseUserInfo ∷ String → Either ParseError userInfo + , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseRelPath ∷ String → Either ParseError relPath + | r + ) + +type RelativePartPrintOptions userInfo hosts relPath r = + ( printUserInfo ∷ userInfo → String + , printHosts ∷ hosts String → String + , printRelPath ∷ relPath → String + | r + ) parser ∷ ∀ userInfo hosts relPath r @@ -58,12 +72,6 @@ parser opts = withAuth <|> withoutAuth <|> (Just <$> Path.parsePathNoScheme opts.parseRelPath) <|> pure Nothing -type RelativePartPrintOptions userInfo hosts relPath r = - AuthorityPrintOptions userInfo hosts - ( printRelPath ∷ relPath → String - | r - ) - print ∷ ∀ userInfo hosts relPath r . Functor hosts diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 1866d46..c9e4ae8 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -2,8 +2,8 @@ module Data.URI.RelativeRef ( RelativeRef(..) , RelativeRefOptions , RelativeRefParseOptions - , parser , RelativeRefPrintOptions + , parser , print , _relPart , _query @@ -14,6 +14,7 @@ module Data.URI.RelativeRef import Prelude import Data.Array (catMaybes) +import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -26,7 +27,7 @@ import Data.URI.Fragment as Fragment import Data.URI.Query as Query import Data.URI.RelativePart (Authority(..), AuthorityParseOptions, AuthorityPrintOptions, Host(..), Port(..), RelativePart(..), RelativePartParseOptions, RelativePartPrintOptions, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.RelativePart as RPart -import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) @@ -39,14 +40,26 @@ derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts relPa instance showRelativeRef ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts relPath query fragment) where show = genericShow type RelativeRefOptions userInfo hosts relPath query fragment = - RelativeRefParseOptions userInfo hosts relPath query fragment (RelativeRefPrintOptions userInfo hosts relPath query fragment ()) + RelativeRefParseOptions userInfo hosts relPath query fragment + (RelativeRefPrintOptions userInfo hosts relPath query fragment ()) type RelativeRefParseOptions userInfo hosts relPath query fragment r = - RelativePartParseOptions userInfo hosts relPath - ( parseQuery ∷ Parser query - , parseFragment ∷ Parser fragment - | r - ) + ( parseUserInfo ∷ String → Either ParseError userInfo + , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseRelPath ∷ String → Either ParseError relPath + , parseQuery ∷ String → Either ParseError query + , parseFragment ∷ String → Either ParseError fragment + | r + ) + +type RelativeRefPrintOptions userInfo hosts relPath query fragment r = + ( printUserInfo ∷ userInfo → String + , printHosts ∷ hosts String → String + , printRelPath ∷ relPath → String + , printQuery ∷ query → String + , printFragment ∷ fragment → String + | r + ) parser ∷ ∀ userInfo hosts relPath query fragment r @@ -59,13 +72,6 @@ parser opts = <*> optionMaybe (Fragment.parser opts.parseFragment) <* eof -type RelativeRefPrintOptions userInfo hosts relPath query fragment r = - RelativePartPrintOptions userInfo hosts relPath - ( printQuery ∷ query → String - , printFragment ∷ fragment → String - | r - ) - print ∷ ∀ userInfo hosts relPath query fragment r . Functor hosts diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 9ab04d5..2ac94ad 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -2,8 +2,8 @@ module Data.URI.URI ( URI(..) , URIOptions , URIParseOptions - , parser , URIPrintOptions + , parser , print , _scheme , _hierPart @@ -16,6 +16,7 @@ module Data.URI.URI import Prelude import Data.Array (catMaybes) +import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -25,12 +26,12 @@ import Data.Ord (class Ord1) import Data.String as S import Data.Tuple (Tuple) import Data.URI.Fragment as Fragment -import Data.URI.HierarchicalPart (Authority(..), AuthorityParseOptions, AuthorityPrintOptions, HierarchicalPart(..), HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) import Data.URI.Scheme as Scheme -import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) @@ -43,14 +44,26 @@ derive instance genericURI ∷ Generic (URI userInfo hosts hierPath query fragme instance showURI ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts hierPath query fragment) where show = genericShow type URIOptions userInfo hosts hierPath query fragment = - URIParseOptions userInfo hosts hierPath query fragment (URIPrintOptions userInfo hosts hierPath query fragment ()) + URIParseOptions userInfo hosts hierPath query fragment + (URIPrintOptions userInfo hosts hierPath query fragment ()) type URIParseOptions userInfo hosts hierPath query fragment r = - HierarchicalPartParseOptions userInfo hosts hierPath - ( parseQuery ∷ Parser query - , parseFragment ∷ Parser fragment - | r - ) + ( parseUserInfo ∷ String → Either ParseError userInfo + , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHierPath ∷ String → Either ParseError hierPath + , parseQuery ∷ String → Either ParseError query + , parseFragment ∷ String → Either ParseError fragment + | r + ) + +type URIPrintOptions userInfo hosts hierPath query fragment r = + ( printUserInfo ∷ userInfo → String + , printHosts ∷ hosts String → String + , printHierPath ∷ hierPath → String + , printQuery ∷ query → String + , printFragment ∷ fragment → String + | r + ) parser ∷ ∀ userInfo hosts hierPath query fragment r @@ -63,13 +76,6 @@ parser opts = URI <*> optionMaybe (Fragment.parser opts.parseFragment) <* eof -type URIPrintOptions userInfo hosts hierPath query fragment r = - HierarchicalPartPrintOptions userInfo hosts hierPath - ( printQuery ∷ query → String - , printFragment ∷ fragment → String - | r - ) - print ∷ ∀ userInfo hosts hierPath query fragment r . Functor hosts diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index 5f16e2c..ca01c01 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -4,10 +4,9 @@ import Prelude import Control.Alt ((<|>)) import Data.Either (Either(..), either) -import Data.URI.RelativeRef (AuthorityParseOptions, AuthorityPrintOptions) import Data.URI.RelativeRef as RelativeRef import Data.URI.URI as URI -import Text.Parsing.StringParser (Parser, try) +import Text.Parsing.StringParser (ParseError, Parser, try) -- | An alias for the most common use case of resource identifiers. type URIRef userInfo hosts hierPath relPath query fragment = @@ -20,13 +19,24 @@ type URIRefOptions userInfo hosts hierPath relPath query fragment = (URIRefPrintOptions userInfo hosts hierPath relPath query fragment ()) type URIRefParseOptions userInfo hosts hierPath relPath query fragment r = - AuthorityParseOptions userInfo hosts - ( parseHierPath ∷ Parser hierPath - , parseRelPath ∷ Parser relPath - , parseQuery ∷ Parser query - , parseFragment ∷ Parser fragment - | r - ) + ( parseUserInfo ∷ String → Either ParseError userInfo + , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseRelPath ∷ String → Either ParseError relPath + , parseHierPath ∷ String → Either ParseError hierPath + , parseQuery ∷ String → Either ParseError query + , parseFragment ∷ String → Either ParseError fragment + | r + ) + +type URIRefPrintOptions userInfo hosts hierPath relPath query fragment r = + ( printUserInfo ∷ userInfo → String + , printHosts ∷ hosts String → String + , printRelPath ∷ relPath → String + , printHierPath ∷ hierPath → String + , printQuery ∷ query → String + , printFragment ∷ fragment → String + | r + ) parser ∷ ∀ userInfo hosts hierPath relPath query fragment r @@ -36,15 +46,6 @@ parser opts = (Left <$> try (URI.parser opts)) <|> (Right <$> RelativeRef.parser opts) -type URIRefPrintOptions userInfo hosts hierPath relPath query fragment r = - AuthorityPrintOptions userInfo hosts - ( printHierPath ∷ hierPath → String - , printRelPath ∷ relPath → String - , printQuery ∷ query → String - , printFragment ∷ fragment → String - | r - ) - print ∷ ∀ userInfo hosts hierPath relPath query fragment r . Functor hosts diff --git a/src/Data/URI/UserInfo.purs b/src/Data/URI/UserInfo.purs index 3850b36..803b112 100644 --- a/src/Data/URI/UserInfo.purs +++ b/src/Data/URI/UserInfo.purs @@ -3,12 +3,13 @@ module Data.URI.UserInfo where import Prelude import Control.Alt ((<|>)) +import Data.Either (Either) import Data.URI.Common (decodePCT, joinWith, parsePCTEncoded, parseSubDelims, parseUnreserved, wrapParser) -import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (many1) import Text.Parsing.StringParser.String (string) -parser ∷ ∀ userInfo. Parser userInfo → Parser userInfo +parser ∷ ∀ ui. (String → Either ParseError ui) → Parser ui parser p = wrapParser p (joinWith "" <$> many1 p') where p' = parseUnreserved @@ -16,5 +17,5 @@ parser p = wrapParser p (joinWith "" <$> many1 p') <|> parseSubDelims <|> string ":" -print ∷ ∀ userInfo. (userInfo → String) → userInfo → String +print ∷ ∀ ui. (ui → String) → ui → String print = id diff --git a/test/Main.purs b/test/Main.purs index a107ff6..f083994 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -44,12 +44,12 @@ import Test.Unit.Assert (assert, equal) import Test.Unit.Console (TESTOUTPUT) import Test.Unit.Main (runTest) import Text.Parsing.StringParser (Parser, runParser) -import Text.Parsing.StringParser.Combinators as SP -import Text.Parsing.StringParser.String as SP +import Text.Parsing.StringParser.Combinators (sepBy) as SP +import Text.Parsing.StringParser.String (string) as SP options ∷ Record (URIRef.URIRefOptions NU.UserInfo Array NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment) options = - { parseUserInfo: NU.parser + { parseUserInfo: NU.parse , printUserInfo: NU.print , parseHosts: map Array.fromFoldable <<< flip SP.sepBy (SP.string ",") , printHosts: String.joinWith "," @@ -57,9 +57,9 @@ options = , printHierPath: NP.printPath , parseRelPath: NP.parseURIPathRel , printRelPath: NP.printPath - , parseQuery: NQ.parser + , parseQuery: NQ.parse , printQuery: NQ.print - , parseFragment: NF.parser + , parseFragment: NF.parse , printFragment: NF.print } @@ -105,7 +105,7 @@ testParseQueryParses :: forall a. String -> NQ.Query -> TestSuite a testParseQueryParses uri query = test ("parses: \"" <> uri <> "\"") - (equal (Right query) (runParser (Query.parser NQ.parser) uri)) + (equal (Right query) (runParser (Query.parser NQ.parse) uri)) testMatch1FromMatches :: forall a. Either String Regex -> Int -> String -> Maybe String -> TestSuite a testMatch1FromMatches rx' n str expected = case rx' of @@ -144,10 +144,10 @@ main = runTest $ suite "Data.URI" do testRunParseSuccess Scheme.parser "git+ssh:" (Scheme "git+ssh") suite "UserInfo parser" do - testRunParseSuccess (UserInfo.parser NU.parser) "user" (NU.UserInfo "user") - testRunParseSuccess (UserInfo.parser NU.parser) "spaced%20user" (NU.UserInfo "spaced user") - testRunParseSuccess (UserInfo.parser NU.parser) "user:password" (NU.UserInfo "user:password") - testRunParseSuccess (UserInfo.parser NU.parser) "spaced%20user:password%25%C2%A3" (NU.UserInfo "spaced user:password%£") + testRunParseSuccess (UserInfo.parser NU.parse) "user" (NU.UserInfo "user") + testRunParseSuccess (UserInfo.parser NU.parse) "spaced%20user" (NU.UserInfo "spaced user") + testRunParseSuccess (UserInfo.parser NU.parse) "user:password" (NU.UserInfo "user:password") + testRunParseSuccess (UserInfo.parser NU.parse) "spaced%20user:password%25%C2%A3" (NU.UserInfo "spaced user:password%£") suite "Host parser" do testRunParseSuccess Host.parser "localhost" (NameAddress "localhost") @@ -162,7 +162,7 @@ main = runTest $ suite "Data.URI" do testRunParseSuccess Port.parser "63174" (Port 63174) suite "Fragment' parser" do - testRunParseSuccess (Fragment.parser anyString) "#" "" + testRunParseSuccess (Fragment.parser Right) "#" "" suite "Authority parser" do testRunParseSuccess From f528b7a2d5be7dc2557ec805e1a83c04b654828b Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 30 Jan 2018 13:39:31 +0000 Subject: [PATCH 09/69] Remove some junk from Common, avoid regex parsers (mostly) --- src/Data/URI/Common.purs | 71 +++++++++++------------------ src/Data/URI/Fragment.purs | 9 ++-- src/Data/URI/Host.purs | 32 ++++++++----- src/Data/URI/NonStandard/Query.purs | 10 ++-- src/Data/URI/Path.purs | 21 +++++---- src/Data/URI/Port.purs | 10 ++-- src/Data/URI/Query.purs | 13 ++++-- src/Data/URI/Scheme.purs | 13 ++++-- src/Data/URI/UserInfo.purs | 7 +-- test/Main.purs | 45 ++++++------------ 10 files changed, 112 insertions(+), 119 deletions(-) diff --git a/src/Data/URI/Common.purs b/src/Data/URI/Common.purs index f7234a8..b16c838 100644 --- a/src/Data/URI/Common.purs +++ b/src/Data/URI/Common.purs @@ -1,35 +1,23 @@ -module Data.URI.Common where +module Data.URI.Common + ( wrapParser + , parsePChar + , parseUnreserved + , PCTEncoded + , decodePCT + , decodePCTComponent + , parsePCTEncoded + , parseSubDelims + ) where import Prelude import Control.Alt ((<|>)) -import Control.MonadZero (guard) -import Data.Array (fromFoldable, head) -import Data.Either (Either(..), fromRight) -import Data.List (List) -import Data.Maybe (Maybe(..)) +import Data.Array as Array +import Data.Either (Either(..)) import Data.String as S -import Data.String.Regex as RX -import Data.String.Regex.Flags as RXF -import Data.Unfoldable (replicateA) import Global (decodeURI, decodeURIComponent) -import Partial.Unsafe (unsafePartial) -import Text.Parsing.StringParser (ParseError(..), Parser(..), unParser) -import Text.Parsing.StringParser.String (string) - -anyString ∷ Parser String -anyString = Parser case _ of - { str, pos } → Right { result: str, suffix: { str, pos: pos + S.length str }} - -joinWith ∷ String → List String → String -joinWith x y = S.joinWith x $ fromFoldable y - -rep ∷ Int → Parser String → Parser String -rep n p = S.joinWith "" <$> replicateA n p - -rxPat ∷ String → Parser String -rxPat rx = - unsafePartial $ fromRight $ anyMatch <$> RX.regex rx RXF.ignoreCase +import Text.Parsing.StringParser (ParseError, Parser(..), unParser) +import Text.Parsing.StringParser.String (alphaNum, char, oneOf, string) wrapParser ∷ ∀ a. (String → Either ParseError a) → Parser String → Parser a wrapParser parseA p = Parser \ps → do @@ -47,7 +35,8 @@ parsePChar f <|> string "@" parseUnreserved ∷ Parser String -parseUnreserved = rxPat "[0-9a-z\\-\\._~]+" +parseUnreserved = + S.singleton <$> (alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~') newtype PCTEncoded = PCTEncoded String @@ -58,23 +47,15 @@ decodePCTComponent ∷ PCTEncoded → String decodePCTComponent (PCTEncoded s) = decodeURIComponent s parsePCTEncoded ∷ (PCTEncoded → String) → Parser String -parsePCTEncoded f = f <<< PCTEncoded <$> rxPat "(%[0-9a-f]{2})+" +parsePCTEncoded f = f <<< PCTEncoded <$> parseHex + where + parseHex = S.joinWith "" <$> Array.some do + d0 ← char '%' + d1 ← alphaNum + d2 ← alphaNum + pure $ S.fromCharArray [d0, d1, d2] parseSubDelims ∷ Parser String -parseSubDelims = rxPat "[!$&'()*+;=]" - -anyMatch ∷ RX.Regex → Parser String -anyMatch rx = Parser \{ str: str, pos: i } → case match1From rx i str of - Just m → pure { result : m, suffix: { str: str, pos: i + (S.length m) }} - Nothing → Left { error: (ParseError $ "Expected " <> show rx), pos: i } - -match1From ∷ RX.Regex → Int → String → Maybe String -match1From rx' n str' = - case RX.regex (RX.source rx') (RXF.global <> RX.flags rx') of - Left _ -> Nothing - Right rx -> do - let str = S.drop n str' - i <- RX.search rx str - guard $ i == 0 - matches <- RX.match rx str - join $ head matches +parseSubDelims = + -- TODO: resolve the `,` situation + S.singleton <$> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', {- ',', -} ';', '='] diff --git a/src/Data/URI/Fragment.purs b/src/Data/URI/Fragment.purs index b501c79..019b082 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/Data/URI/Fragment.purs @@ -3,16 +3,17 @@ module Data.URI.Fragment where import Prelude import Control.Alt ((<|>)) +import Data.Array as Array import Data.Either (Either) -import Data.URI.Common (decodePCTComponent, joinWith, parsePChar, wrapParser) +import Data.String as String +import Data.URI.Common (decodePCTComponent, parsePChar, wrapParser) import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (many) import Text.Parsing.StringParser.String (string) parser ∷ ∀ f. (String → Either ParseError f) → Parser f parser parseF = string "#" *> - wrapParser parseF (joinWith "" - <$> many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) + wrapParser parseF (String.joinWith "" + <$> Array.many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) print ∷ ∀ f. (f → String) → f → String print printF f = "#" <> printF f diff --git a/src/Data/URI/Host.purs b/src/Data/URI/Host.purs index f0b0908..99445cb 100644 --- a/src/Data/URI/Host.purs +++ b/src/Data/URI/Host.purs @@ -13,16 +13,19 @@ module Data.URI.Host import Prelude import Control.Alt ((<|>)) +import Data.Array as Array +import Data.Either (Either(..)) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Int as Int import Data.Lens (Prism', prism') import Data.Maybe (Maybe(..)) -import Data.URI.Common (decodePCT, joinWith, parsePCTEncoded, parseSubDelims, parseUnreserved, rxPat) +import Data.String as String +import Data.URI.Common (decodePCT, parsePCTEncoded, parseSubDelims, parseUnreserved, wrapParser) import Global (encodeURI) -import Text.Parsing.StringParser (Parser, try, fail) -import Text.Parsing.StringParser.Combinators ((), many1) -import Text.Parsing.StringParser.String (string, char) +import Text.Parsing.StringParser (ParseError(..), Parser, try) +import Text.Parsing.StringParser.Combinators (()) +import Text.Parsing.StringParser.String (anyDigit, char, regex, satisfy, string) -- | A host address. data Host @@ -36,11 +39,11 @@ derive instance genericHost ∷ Generic Host _ instance showHost ∷ Show Host where show = genericShow parser ∷ Parser Host -parser = try ipv6AddressParser <|> try ipv4AddressParser <|> regNameParser +parser = ipv6AddressParser <|> try ipv4AddressParser <|> regNameParser -- TODO: this is much too forgiving right now ipv6AddressParser ∷ Parser Host -ipv6AddressParser = IPv6Address <$> (string "[" *> rxPat "[a-f0-9\\.:]+" <* string "]") "IPv6 address" +ipv6AddressParser = IPv6Address <$> (string "[" *> regex "[a-fA-F0-9\\.:]+" <* string "]") "IPv6 address" ipv4AddressParser ∷ Parser Host ipv4AddressParser = IPv4Address <$> addr "IPv4 address" @@ -56,14 +59,19 @@ ipv4AddressParser = IPv4Address <$> addr "IPv4 address" o4 <- octet pure $ show o1 <> "." <> show o2 <> "." <> show o3 <> "." <> show o4 octet ∷ Parser Int - octet = do - s <- rxPat "0|([1-9][0-9]{0,2})" - case Int.fromString s of - Just n | n >= 0 && n <= 255 -> pure n - _ -> fail "Invalid IPv4 address octet" + octet = wrapParser toInt + $ try ((\x y z → String.fromCharArray [x, y, z]) <$> nzDigit <*> anyDigit <*> anyDigit) + <|> try ((\x y → String.fromCharArray [x, y]) <$> nzDigit <*> anyDigit) + <|> (String.singleton <$> anyDigit) + nzDigit ∷ Parser Char + nzDigit = satisfy (\c → c >= '1' && c <= '9') + toInt ∷ String → Either ParseError Int + toInt s = case Int.fromString s of + Just n | n >= 0 && n <= 255 → Right n + _ → Left (ParseError "Invalid IPv4 address octet") regNameParser ∷ Parser Host -regNameParser = NameAddress <<< joinWith "" <$> many1 p +regNameParser = NameAddress <<< String.joinWith "" <$> Array.some p where p = parseUnreserved <|> parsePCTEncoded decodePCT <|> parseSubDelims diff --git a/src/Data/URI/NonStandard/Query.purs b/src/Data/URI/NonStandard/Query.purs index 5d45db4..9179352 100644 --- a/src/Data/URI/NonStandard/Query.purs +++ b/src/Data/URI/NonStandard/Query.purs @@ -7,6 +7,7 @@ module Data.URI.NonStandard.Query import Prelude import Control.Alt ((<|>)) +import Data.Array as Array import Data.Either (Either, fromRight) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -18,12 +19,11 @@ import Data.String as S import Data.String.Regex as RX import Data.String.Regex.Flags as RXF import Data.Tuple (Tuple(..)) -import Data.URI.Common (joinWith, rxPat) import Global (decodeURIComponent, encodeURIComponent) import Partial.Unsafe (unsafePartial) import Text.Parsing.StringParser (ParseError, Parser, runParser) import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy) -import Text.Parsing.StringParser.String (string) +import Text.Parsing.StringParser.String (regex, string) -- | The query component of a URI. newtype Query = Query (List (Tuple String (Maybe String))) @@ -44,12 +44,12 @@ parseParts = sepBy parsePart (string ";" <|> string "&") parsePart ∷ Parser (Tuple String (Maybe String)) parsePart = do - key ← decodeURIComponent <$> rxPat "[^=;&]+" - value ← optionMaybe $ decodeURIComponent <$> (string "=" *> rxPat "[^;&]*") + key ← decodeURIComponent <$> regex "[^=;&]+" + value ← optionMaybe $ decodeURIComponent <$> (string "=" *> regex "[^;&]*") pure $ Tuple key value print ∷ Query → String -print (Query m) = joinWith "&" (printPart <$> m) +print (Query m) = S.joinWith "&" $ Array.fromFoldable (printPart <$> m) where printPart ∷ Tuple String (Maybe String) → String printPart (Tuple k Nothing) = diff --git a/src/Data/URI/Path.purs b/src/Data/URI/Path.purs index 538128a..772d001 100644 --- a/src/Data/URI/Path.purs +++ b/src/Data/URI/Path.purs @@ -3,12 +3,13 @@ module Data.URI.Path where import Prelude import Control.Alt ((<|>)) +import Data.Array as Array import Data.Either (Either) import Data.Maybe (Maybe(..)) import Data.String as Str -import Data.URI.Common (PCTEncoded, decodePCT, joinWith, parsePCTEncoded, parsePChar, parseSubDelims, parseUnreserved, wrapParser) +import Data.URI.Common (PCTEncoded, decodePCT, parsePCTEncoded, parsePChar, parseSubDelims, parseUnreserved, wrapParser) import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (many, many1, optionMaybe) +import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (string) parsePath ∷ ∀ p. (String → Either ParseError p) → Parser (Maybe p) @@ -22,37 +23,37 @@ parsePath p parsePathAbEmpty ∷ ∀ p. (String → Either ParseError p) → Parser (Maybe p) parsePathAbEmpty p = optionMaybe $ wrapParser p do - parts ← many1 (string "/" *> parseSegment) - pure ("/" <> joinWith "/" parts) + parts ← Array.some (string "/" *> parseSegment) + pure ("/" <> Str.joinWith "/" parts) parsePathAbsolute ∷ ∀ p. (String → Either ParseError p) → Parser p parsePathAbsolute p = wrapParser p $ do _ ← string "/" start ← parseSegmentNonZero - rest ← joinWith "" <$> many (append <$> string "/" <*> parseSegment) + rest ← Str.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment) pure $ "/" <> start <> rest parsePathNoScheme ∷ ∀ p. (String → Either ParseError p) → Parser p parsePathNoScheme p = wrapParser p $ append <$> parseSegmentNonZeroNoColon - <*> (joinWith "" <$> many (append <$> string "/" <*> parseSegment)) + <*> (Str.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment)) parsePathRootless ∷ ∀ p. (String → Either ParseError p) → Parser p parsePathRootless p = wrapParser p $ append <$> parseSegmentNonZero - <*> (joinWith "" <$> many (append <$> string "/" <*> parseSegment)) + <*> (Str.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment)) parseSegment ∷ Parser String -parseSegment = joinWith "" <$> many (parsePChar decoder) +parseSegment = Str.joinWith "" <$> Array.many (parsePChar decoder) parseSegmentNonZero ∷ Parser String -parseSegmentNonZero = joinWith "" <$> many1 (parsePChar decoder) +parseSegmentNonZero = Str.joinWith "" <$> Array.some (parsePChar decoder) parseSegmentNonZeroNoColon ∷ Parser String parseSegmentNonZeroNoColon = - joinWith "" <$> many1 + Str.joinWith "" <$> Array.some (parseUnreserved <|> parsePCTEncoded decoder <|> parseSubDelims <|> string "@") decoder ∷ PCTEncoded → String diff --git a/src/Data/URI/Port.purs b/src/Data/URI/Port.purs index 3aff77f..1785a57 100644 --- a/src/Data/URI/Port.purs +++ b/src/Data/URI/Port.purs @@ -2,14 +2,16 @@ module Data.URI.Port where import Prelude +import Data.Array as Array import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Int (fromNumber) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) -import Data.URI.Common (rxPat) +import Data.String as String import Global (readInt) import Text.Parsing.StringParser (Parser, fail) +import Text.Parsing.StringParser.String (anyDigit) -- | A port number. newtype Port = Port Int @@ -22,9 +24,9 @@ instance showPort ∷ Show Port where show = genericShow parser ∷ Parser Port parser = do - s ← rxPat "[0-9]+" - case fromNumber $ readInt 10 s of - Just x → pure (Port x) + s ← String.fromCharArray <$> Array.some anyDigit + case fromNumber $ readInt 10 s of + Just x → pure (Port x) _ → fail "Expected valid port number" print ∷ Port → String diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index ddc8fe8..fd1b040 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -2,13 +2,20 @@ module Data.URI.Query where import Prelude +import Control.Alt ((<|>)) +import Data.Array as Array import Data.Either (Either) -import Data.URI.Common (rxPat, wrapParser) -import Text.Parsing.StringParser (ParseError, Parser, try) +import Data.String as String +import Data.URI.Common (decodePCT, parsePChar, wrapParser) +import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.String (string) parser ∷ ∀ q. (String → Either ParseError q) → Parser q -parser parseQ = string "?" *> (wrapParser parseQ (try (rxPat "[^#]*"))) +parser parseQ = string "?" *> (wrapParser parseQ query) + where + query = + String.joinWith "" + <$> Array.many (parsePChar decodePCT <|> string "/" <|> string "?") print ∷ ∀ q. (q → String) → q → String print printQ q = "?" <> printQ q diff --git a/src/Data/URI/Scheme.purs b/src/Data/URI/Scheme.purs index f741df0..7d5475d 100644 --- a/src/Data/URI/Scheme.purs +++ b/src/Data/URI/Scheme.purs @@ -2,12 +2,14 @@ module Data.URI.Scheme where import Prelude +import Control.Alt ((<|>)) +import Data.Array as Array import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Newtype (class Newtype) -import Data.URI.Common (rxPat) +import Data.String as String import Text.Parsing.StringParser (Parser) -import Text.Parsing.StringParser.String (string) +import Text.Parsing.StringParser.String (alphaNum, anyLetter, char, string) -- | The scheme part of an absolute URI. For example: `http`, `ftp`, `git`. newtype Scheme = Scheme String @@ -19,7 +21,12 @@ derive instance newtypeScheme ∷ Newtype Scheme _ instance showScheme ∷ Show Scheme where show = genericShow parser ∷ Parser Scheme -parser = Scheme <$> rxPat "[a-z][a-z0-9+\\.\\-]+" <* string ":" +parser = Scheme <$> parseScheme <* string ":" + where + parseScheme = do + init ← anyLetter + rest ← Array.many (alphaNum <|> char '+' <|> char '-' <|> char '.') + pure $ String.singleton init <> String.fromCharArray rest print ∷ Scheme → String print (Scheme s) = s <> ":" diff --git a/src/Data/URI/UserInfo.purs b/src/Data/URI/UserInfo.purs index 803b112..de48cb4 100644 --- a/src/Data/URI/UserInfo.purs +++ b/src/Data/URI/UserInfo.purs @@ -3,14 +3,15 @@ module Data.URI.UserInfo where import Prelude import Control.Alt ((<|>)) +import Data.Array as Array import Data.Either (Either) -import Data.URI.Common (decodePCT, joinWith, parsePCTEncoded, parseSubDelims, parseUnreserved, wrapParser) +import Data.String as String +import Data.URI.Common (decodePCT, parsePCTEncoded, parseSubDelims, parseUnreserved, wrapParser) import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (many1) import Text.Parsing.StringParser.String (string) parser ∷ ∀ ui. (String → Either ParseError ui) → Parser ui -parser p = wrapParser p (joinWith "" <$> many1 p') +parser p = wrapParser p (String.joinWith "" <$> Array.some p') where p' = parseUnreserved <|> parsePCTEncoded decodePCT diff --git a/test/Main.purs b/test/Main.purs index f083994..c0b2142 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -15,14 +15,10 @@ import Data.Maybe (Maybe(Nothing, Just)) import Data.Monoid (mempty) import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) import Data.String as String -import Data.String.Regex (Regex, regex) -import Data.String.Regex.Flags (global, noFlags) import Data.Tuple (Tuple(..)) import Data.URI (AbsoluteURI(..), Authority(..), HierarchicalPart(..), Host(..), Port(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..)) import Data.URI.AbsoluteURI as AbsoluteURI import Data.URI.Authority as Authority -import Data.URI.Common (anyString) -import Data.URI.Common as Common import Data.URI.Fragment as Fragment import Data.URI.Host as Host import Data.URI.Host.Gen as Host.Gen @@ -107,21 +103,21 @@ testParseQueryParses uri query = ("parses: \"" <> uri <> "\"") (equal (Right query) (runParser (Query.parser NQ.parse) uri)) -testMatch1FromMatches :: forall a. Either String Regex -> Int -> String -> Maybe String -> TestSuite a -testMatch1FromMatches rx' n str expected = case rx' of - Left error -> test "faulty regex given" (assert error false) - Right rx -> - test - ("matches: " <> show rx <> " at " <> show n <> " in " <> show str) - (equal expected $ Common.match1From rx n str) - -testMatch1FromMisses :: forall a. Either String Regex -> Int -> String -> TestSuite a -testMatch1FromMisses rx' n str = case rx' of - Left error -> test "faulty regex given" (assert error false) - Right rx -> - test - ("does not match: " <> show rx <> " at " <> show n <> " in " <> show str) - (equal Nothing $ Common.match1From rx n str) +-- testMatch1FromMatches :: forall a. Either String Regex -> Int -> String -> Maybe String -> TestSuite a +-- testMatch1FromMatches rx' n str expected = case rx' of +-- Left error -> test "faulty regex given" (assert error false) +-- Right rx -> +-- test +-- ("matches: " <> show rx <> " at " <> show n <> " in " <> show str) +-- (equal expected $ Common.match1From rx n str) +-- +-- testMatch1FromMisses :: forall a. Either String Regex -> Int -> String -> TestSuite a +-- testMatch1FromMisses rx' n str = case rx' of +-- Left error -> test "faulty regex given" (assert error false) +-- Right rx -> +-- test +-- ("does not match: " <> show rx <> " at " <> show n <> " in " <> show str) +-- (equal Nothing $ Common.match1From rx n str) main :: forall eff. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR, exception :: EXCEPTION, random :: RANDOM | eff) Unit main = runTest $ suite "Data.URI" do @@ -582,17 +578,6 @@ main = runTest $ suite "Data.URI" do "?key1=foo%3Bbar" (NQ.Query (Tuple "key1" (Just "foo;bar") : Nil)) - suite "Common.match1From" do - testMatch1FromMisses (regex "key1" noFlags) 0 "" - testMatch1FromMisses (regex "key1" noFlags) 1 "key1" - testMatch1FromMisses (regex "key1" noFlags) 1 "key1=&key1=" - testMatch1FromMisses (regex "key1" global) 1 "key1=&key1=" - testMatch1FromMisses (regex "key1|key2" noFlags) 1 "key1=&key2=" - - testMatch1FromMatches (regex "key1" noFlags) 0 "key1" (Just "key1") - testMatch1FromMatches (regex "key1" noFlags) 6 "key1=&key1=" (Just "key1") - testMatch1FromMatches (regex "key1|key2" noFlags) 6 "key1=&key2=" (Just "key2") - forAll :: forall eff prop. QC.Testable prop => QCG.Gen prop -> Test (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) forAll = quickCheck From 372b3af5efb7519df8d45b85db6ec9e83d67a105 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 30 Jan 2018 13:44:08 +0000 Subject: [PATCH 10/69] Style consistency for imports --- src/Data/URI/AbsoluteURI.purs | 8 ++++---- src/Data/URI/Common.purs | 10 +++++----- src/Data/URI/HierarchicalPart.purs | 13 ++++++------- src/Data/URI/Host/Gen.purs | 4 ++-- src/Data/URI/NonStandard/Fragment.purs | 4 ++-- src/Data/URI/NonStandard/Path.purs | 6 +++--- src/Data/URI/NonStandard/Query.purs | 6 +++--- src/Data/URI/Path.purs | 18 +++++++++--------- src/Data/URI/RelativePart.purs | 13 ++++++------- src/Data/URI/RelativeRef.purs | 6 +++--- src/Data/URI/URI.purs | 6 +++--- 11 files changed, 46 insertions(+), 48 deletions(-) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index e87deda..8fe5deb 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -2,8 +2,8 @@ module Data.URI.AbsoluteURI ( AbsoluteURI(..) , AbsoluteURIOptions , AbsoluteURIParseOptions - , parser , AbsoluteURIPrintOptions + , parser , print , _scheme , _hierPart @@ -14,7 +14,7 @@ module Data.URI.AbsoluteURI import Prelude -import Data.Array (catMaybes) +import Data.Array as Array import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) @@ -22,7 +22,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) -import Data.String as S +import Data.String as String import Data.Tuple (Tuple) import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart @@ -78,7 +78,7 @@ print → AbsoluteURI userInfo hosts hierPath query → String print opts (AbsoluteURI s h q) = - S.joinWith "" $ catMaybes + String.joinWith "" $ Array.catMaybes [ Just (Scheme.print s) , Just (HPart.print opts h) , Query.print opts.printQuery <$> q diff --git a/src/Data/URI/Common.purs b/src/Data/URI/Common.purs index b16c838..c1c4f9e 100644 --- a/src/Data/URI/Common.purs +++ b/src/Data/URI/Common.purs @@ -14,7 +14,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either(..)) -import Data.String as S +import Data.String as String import Global (decodeURI, decodeURIComponent) import Text.Parsing.StringParser (ParseError, Parser(..), unParser) import Text.Parsing.StringParser.String (alphaNum, char, oneOf, string) @@ -36,7 +36,7 @@ parsePChar f parseUnreserved ∷ Parser String parseUnreserved = - S.singleton <$> (alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~') + String.singleton <$> (alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~') newtype PCTEncoded = PCTEncoded String @@ -49,13 +49,13 @@ decodePCTComponent (PCTEncoded s) = decodeURIComponent s parsePCTEncoded ∷ (PCTEncoded → String) → Parser String parsePCTEncoded f = f <<< PCTEncoded <$> parseHex where - parseHex = S.joinWith "" <$> Array.some do + parseHex = String.joinWith "" <$> Array.some do d0 ← char '%' d1 ← alphaNum d2 ← alphaNum - pure $ S.fromCharArray [d0, d1, d2] + pure $ String.fromCharArray [d0, d1, d2] parseSubDelims ∷ Parser String parseSubDelims = -- TODO: resolve the `,` situation - S.singleton <$> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', {- ',', -} ';', '='] + String.singleton <$> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', {- ',', -} ';', '='] diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index a76f4ac..07d6893 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -13,7 +13,7 @@ module Data.URI.HierarchicalPart import Prelude import Control.Alt ((<|>)) -import Data.Array (catMaybes) +import Data.Array as Array import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) @@ -21,7 +21,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) -import Data.String as S +import Data.String as String import Data.Tuple (Tuple) import Data.URI.Authority (Authority(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority @@ -78,11 +78,10 @@ print ⇒ Record (HierarchicalPartPrintOptions userInfo hosts hierPath r) → HierarchicalPart userInfo hosts hierPath → String print opts (HierarchicalPart a p) = - S.joinWith "" $ - catMaybes - [ Authority.print opts <$> a - , opts.printHierPath <$> p - ] + String.joinWith "" $ Array.catMaybes + [ Authority.print opts <$> a + , opts.printHierPath <$> p + ] _authority ∷ ∀ userInfo hosts hierPath. Lens' (HierarchicalPart userInfo hosts hierPath) (Maybe (Authority userInfo hosts)) _authority = diff --git a/src/Data/URI/Host/Gen.purs b/src/Data/URI/Host/Gen.purs index 7a31e00..7d91888 100644 --- a/src/Data/URI/Host/Gen.purs +++ b/src/Data/URI/Host/Gen.purs @@ -3,7 +3,7 @@ module Data.URI.Host.Gen where import Prelude import Control.Monad.Gen as Gen -import Data.String as S +import Data.String as String import Data.URI.Host (Host(..)) genIPv4 :: forall m. Gen.MonadGen m => m Host @@ -12,4 +12,4 @@ genIPv4 = do b <- Gen.chooseInt 0 255 c <- Gen.chooseInt 0 255 d <- Gen.chooseInt 0 255 - pure $ IPv4Address $ S.joinWith "." $ show <$> [a, b, c, d] + pure $ IPv4Address $ String.joinWith "." $ show <$> [a, b, c, d] diff --git a/src/Data/URI/NonStandard/Fragment.purs b/src/Data/URI/NonStandard/Fragment.purs index a3fb2e7..4f259e1 100644 --- a/src/Data/URI/NonStandard/Fragment.purs +++ b/src/Data/URI/NonStandard/Fragment.purs @@ -6,7 +6,7 @@ import Data.Either (Either, fromRight) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Newtype (class Newtype) -import Data.String as S +import Data.String as String import Data.String.Regex as RX import Data.String.Regex.Flags as RXF import Global (encodeURIComponent) @@ -25,7 +25,7 @@ parse ∷ ∀ e. String → Either e Fragment parse = pure <<< Fragment print ∷ Fragment → String -print (Fragment f) = S.joinWith "" (map printChar $ S.split (S.Pattern "") f) +print (Fragment f) = String.joinWith "" (map printChar $ String.split (String.Pattern "") f) where -- Fragments & queries have a bunch of characters that don't need escaping printChar ∷ String → String diff --git a/src/Data/URI/NonStandard/Path.purs b/src/Data/URI/NonStandard/Path.purs index 76821d4..45ece1d 100644 --- a/src/Data/URI/NonStandard/Path.purs +++ b/src/Data/URI/NonStandard/Path.purs @@ -12,7 +12,7 @@ import Prelude import Data.Either (Either(..), either) import Data.Maybe (Maybe(..), fromMaybe) import Data.Path.Pathy (Abs, Dir, Escaper(..), File, Path, Rel, Sandboxed, Unsandboxed, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile, rootDir, sandbox, unsafePrintPath', ()) -import Data.String as Str +import Data.String as String import Global (encodeURI) import Text.Parsing.StringParser (ParseError(..)) @@ -48,8 +48,8 @@ printPath = either printPath' printPath' printPath' ∷ ∀ a' b s'. Path a' b s' → String printPath' path = let printed = unsafePrintPath' escaper path - in fromMaybe printed $ Str.stripPrefix (Str.Pattern "./") printed + in fromMaybe printed $ String.stripPrefix (String.Pattern "./") printed escaper ∷ Escaper escaper = Escaper $ - Str.replaceAll (Str.Pattern "#") (Str.Replacement "%23") <<< encodeURI + String.replaceAll (String.Pattern "#") (String.Replacement "%23") <<< encodeURI diff --git a/src/Data/URI/NonStandard/Query.purs b/src/Data/URI/NonStandard/Query.purs index 9179352..1db25a1 100644 --- a/src/Data/URI/NonStandard/Query.purs +++ b/src/Data/URI/NonStandard/Query.purs @@ -15,7 +15,7 @@ import Data.List (List) import Data.Maybe (Maybe(..)) import Data.Monoid (class Monoid) import Data.Newtype (class Newtype) -import Data.String as S +import Data.String as String import Data.String.Regex as RX import Data.String.Regex.Flags as RXF import Data.Tuple (Tuple(..)) @@ -49,7 +49,7 @@ parsePart = do pure $ Tuple key value print ∷ Query → String -print (Query m) = S.joinWith "&" $ Array.fromFoldable (printPart <$> m) +print (Query m) = String.joinWith "&" $ Array.fromFoldable (printPart <$> m) where printPart ∷ Tuple String (Maybe String) → String printPart (Tuple k Nothing) = @@ -58,7 +58,7 @@ print (Query m) = S.joinWith "&" $ Array.fromFoldable (printPart <$> m) printQueryPart k <> "=" <> printQueryPart v printQueryPart ∷ String → String -printQueryPart = S.joinWith "" <<< map printChar <<< S.split (S.Pattern "") +printQueryPart = String.joinWith "" <<< map printChar <<< String.split (String.Pattern "") where -- Fragments & queries have a bunch of characters that don't need escaping printChar ∷ String → String diff --git a/src/Data/URI/Path.purs b/src/Data/URI/Path.purs index 772d001..e8b8737 100644 --- a/src/Data/URI/Path.purs +++ b/src/Data/URI/Path.purs @@ -6,7 +6,7 @@ import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either) import Data.Maybe (Maybe(..)) -import Data.String as Str +import Data.String as String import Data.URI.Common (PCTEncoded, decodePCT, parsePCTEncoded, parsePChar, parseSubDelims, parseUnreserved, wrapParser) import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) @@ -24,40 +24,40 @@ parsePathAbEmpty ∷ ∀ p. (String → Either ParseError p) → Parser (Maybe p parsePathAbEmpty p = optionMaybe $ wrapParser p do parts ← Array.some (string "/" *> parseSegment) - pure ("/" <> Str.joinWith "/" parts) + pure ("/" <> String.joinWith "/" parts) parsePathAbsolute ∷ ∀ p. (String → Either ParseError p) → Parser p parsePathAbsolute p = wrapParser p $ do _ ← string "/" start ← parseSegmentNonZero - rest ← Str.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment) + rest ← String.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment) pure $ "/" <> start <> rest parsePathNoScheme ∷ ∀ p. (String → Either ParseError p) → Parser p parsePathNoScheme p = wrapParser p $ append <$> parseSegmentNonZeroNoColon - <*> (Str.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment)) + <*> (String.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment)) parsePathRootless ∷ ∀ p. (String → Either ParseError p) → Parser p parsePathRootless p = wrapParser p $ append <$> parseSegmentNonZero - <*> (Str.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment)) + <*> (String.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment)) parseSegment ∷ Parser String -parseSegment = Str.joinWith "" <$> Array.many (parsePChar decoder) +parseSegment = String.joinWith "" <$> Array.many (parsePChar decoder) parseSegmentNonZero ∷ Parser String -parseSegmentNonZero = Str.joinWith "" <$> Array.some (parsePChar decoder) +parseSegmentNonZero = String.joinWith "" <$> Array.some (parsePChar decoder) parseSegmentNonZeroNoColon ∷ Parser String parseSegmentNonZeroNoColon = - Str.joinWith "" <$> Array.some + String.joinWith "" <$> Array.some (parseUnreserved <|> parsePCTEncoded decoder <|> parseSubDelims <|> string "@") decoder ∷ PCTEncoded → String -decoder = Str.replaceAll (Str.Pattern "%23") (Str.Replacement "#") <<< decodePCT +decoder = String.replaceAll (String.Pattern "%23") (String.Replacement "#") <<< decodePCT printPath ∷ ∀ p. (p → String) → p → String printPath = id diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index 6f12368..83fbfdf 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -13,7 +13,7 @@ module Data.URI.RelativePart import Prelude import Control.Alt ((<|>)) -import Data.Array (catMaybes) +import Data.Array as Array import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) @@ -21,7 +21,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) -import Data.String as S +import Data.String as String import Data.Tuple (Tuple) import Data.URI.Authority (Authority(..), AuthorityPrintOptions, Host(..), Port(..), AuthorityParseOptions, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority @@ -78,11 +78,10 @@ print ⇒ Record (RelativePartPrintOptions userInfo hosts relPath r) → RelativePart userInfo hosts relPath → String print opts (RelativePart a p) = - S.joinWith "" $ - catMaybes - [ Authority.print opts <$> a - , opts.printRelPath <$> p - ] + String.joinWith "" $ Array.catMaybes + [ Authority.print opts <$> a + , opts.printRelPath <$> p + ] _authority ∷ ∀ userInfo hosts relPath. Lens' (RelativePart userInfo hosts relPath) (Maybe (Authority userInfo hosts)) _authority = diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index c9e4ae8..0449a7c 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -13,7 +13,7 @@ module Data.URI.RelativeRef import Prelude -import Data.Array (catMaybes) +import Data.Array as Array import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) @@ -21,7 +21,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) -import Data.String as S +import Data.String as String import Data.Tuple (Tuple) import Data.URI.Fragment as Fragment import Data.URI.Query as Query @@ -79,7 +79,7 @@ print → RelativeRef userInfo hosts relPath query fragment → String print opts (RelativeRef h q f) = - S.joinWith "" $ catMaybes + String.joinWith "" $ Array.catMaybes [ Just (RPart.print opts h) , Query.print opts.printQuery <$> q , Fragment.print opts.printFragment <$> f diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 2ac94ad..4df6b3a 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -15,7 +15,7 @@ module Data.URI.URI import Prelude -import Data.Array (catMaybes) +import Data.Array as Array import Data.Either (Either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) @@ -23,7 +23,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) -import Data.String as S +import Data.String as String import Data.Tuple (Tuple) import Data.URI.Fragment as Fragment import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) @@ -83,7 +83,7 @@ print → URI userInfo hosts hierPath query fragment → String print opts (URI s h q f) = - S.joinWith "" $ catMaybes + String.joinWith "" $ Array.catMaybes [ Just (Scheme.print s) , Just (HPart.print opts h) , Query.print opts.printQuery <$> q From 8fbf064e069ac5c3e48c3426c9ab6518658438b2 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 30 Jan 2018 13:45:51 +0000 Subject: [PATCH 11/69] Delete old test for now-deleted `match1` --- test/Main.purs | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/test/Main.purs b/test/Main.purs index c0b2142..881e8f2 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -103,22 +103,6 @@ testParseQueryParses uri query = ("parses: \"" <> uri <> "\"") (equal (Right query) (runParser (Query.parser NQ.parse) uri)) --- testMatch1FromMatches :: forall a. Either String Regex -> Int -> String -> Maybe String -> TestSuite a --- testMatch1FromMatches rx' n str expected = case rx' of --- Left error -> test "faulty regex given" (assert error false) --- Right rx -> --- test --- ("matches: " <> show rx <> " at " <> show n <> " in " <> show str) --- (equal expected $ Common.match1From rx n str) --- --- testMatch1FromMisses :: forall a. Either String Regex -> Int -> String -> TestSuite a --- testMatch1FromMisses rx' n str = case rx' of --- Left error -> test "faulty regex given" (assert error false) --- Right rx -> --- test --- ("does not match: " <> show rx <> " at " <> show n <> " in " <> show str) --- (equal Nothing $ Common.match1From rx n str) - main :: forall eff. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR, exception :: EXCEPTION, random :: RANDOM | eff) Unit main = runTest $ suite "Data.URI" do From 14273b0e069e2502fb1ddf8d322fe5e886935b90 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Feb 2018 11:09:59 +0000 Subject: [PATCH 12/69] Add host/port parameters, introduce some encoded-value types --- src/Data/URI.purs | 6 +- src/Data/URI/AbsoluteURI.purs | 60 +++++----- src/Data/URI/Authority.purs | 66 +++++++---- src/Data/URI/Common.purs | 50 ++++++--- src/Data/URI/Fragment.purs | 55 +++++++-- src/Data/URI/HierarchicalPart.purs | 54 +++++---- src/Data/URI/Host.purs | 41 ++++--- src/Data/URI/Host/RegName.purs | 61 ++++++++++ src/Data/URI/NonStandard/Fragment.purs | 37 ------- src/Data/URI/NonStandard/UserInfo.purs | 24 ---- src/Data/URI/Path.purs | 3 +- src/Data/URI/Port.purs | 18 ++- src/Data/URI/RelativePart.purs | 54 +++++---- src/Data/URI/RelativeRef.purs | 65 ++++++----- src/Data/URI/URI.purs | 71 +++++++----- src/Data/URI/URIRef.purs | 63 +++++++---- src/Data/URI/UserInfo.purs | 70 ++++++++++-- test/Main.purs | 148 ++++++++++++++----------- 18 files changed, 586 insertions(+), 360 deletions(-) create mode 100644 src/Data/URI/Host/RegName.purs delete mode 100644 src/Data/URI/NonStandard/Fragment.purs delete mode 100644 src/Data/URI/NonStandard/UserInfo.purs diff --git a/src/Data/URI.purs b/src/Data/URI.purs index 9acbabb..d6b8753 100755 --- a/src/Data/URI.purs +++ b/src/Data/URI.purs @@ -3,21 +3,25 @@ module Data.URI , module Data.URI.Authority , module Data.URI.HierarchicalPart , module Data.URI.Host + , module Data.URI.Fragment , module Data.URI.Port , module Data.URI.RelativePart , module Data.URI.RelativeRef , module Data.URI.Scheme , module Data.URI.URI , module Data.URI.URIRef + , module Data.URI.UserInfo ) where import Data.URI.AbsoluteURI (AbsoluteURI(..)) import Data.URI.Authority (Authority(..)) import Data.URI.HierarchicalPart (HierarchicalPart(..)) -import Data.URI.Host (Host(..)) +import Data.URI.Host (Host(..), RegName) +import Data.URI.Fragment (Fragment) import Data.URI.Port (Port(..)) import Data.URI.RelativePart (RelativePart(..)) import Data.URI.RelativeRef (RelativeRef(..)) import Data.URI.Scheme (Scheme(..)) import Data.URI.URI (URI(..)) import Data.URI.URIRef (URIRef) +import Data.URI.UserInfo (UserInfo) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 8fe5deb..0cfedfd 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -24,7 +24,7 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) @@ -34,37 +34,41 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A generic AbsoluteURI -data AbsoluteURI userInfo hosts hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts hierPath) (Maybe query) +data AbsoluteURI userInfo hosts host port hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts host port hierPath) (Maybe query) -derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq1 hosts, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts hierPath query) -derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord1 hosts, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hosts hierPath query) -derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts hierPath query) _ -instance showAbsoluteURI ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts hierPath query) where show = genericShow +derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts host port hierPath query) +derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hosts host port hierPath query) +derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts host port hierPath query) _ +instance showAbsoluteURI ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts host port hierPath query) where show = genericShow -type AbsoluteURIOptions userInfo hosts hierPath query = - AbsoluteURIParseOptions userInfo hosts hierPath query - (AbsoluteURIPrintOptions userInfo hosts hierPath query ()) +type AbsoluteURIOptions userInfo hosts host port hierPath query = + AbsoluteURIParseOptions userInfo hosts host port hierPath query + (AbsoluteURIPrintOptions userInfo hosts host port hierPath query ()) -type AbsoluteURIParseOptions userInfo hosts hierPath query r = - ( parseUserInfo ∷ String → Either ParseError userInfo +type AbsoluteURIParseOptions userInfo hosts host port hierPath query r = + ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHost ∷ Host → Either ParseError host + , parsePort ∷ Port → Either ParseError port , parseHierPath ∷ String → Either ParseError hierPath , parseQuery ∷ String → Either ParseError query | r ) -type AbsoluteURIPrintOptions userInfo hosts hierPath query r = - ( printUserInfo ∷ userInfo → String +type AbsoluteURIPrintOptions userInfo hosts host port hierPath query r = + ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String + , printHost ∷ host → Host + , printPort ∷ port → Port , printHierPath ∷ hierPath → String , printQuery ∷ query → String | r ) parser - ∷ ∀ userInfo hosts hierPath query r - . Record (AbsoluteURIParseOptions userInfo hosts hierPath query r) - → Parser (AbsoluteURI userInfo hosts hierPath query) + ∷ ∀ userInfo hosts host port hierPath query r + . Record (AbsoluteURIParseOptions userInfo hosts host port hierPath query r) + → Parser (AbsoluteURI userInfo hosts host port hierPath query) parser opts = AbsoluteURI <$> Scheme.parser <*> HPart.parser opts @@ -72,10 +76,10 @@ parser opts = AbsoluteURI <* eof print - ∷ ∀ userInfo hosts hierPath query r + ∷ ∀ userInfo hosts host port hierPath query r . Functor hosts - ⇒ Record (AbsoluteURIPrintOptions userInfo hosts hierPath query r) - → AbsoluteURI userInfo hosts hierPath query + ⇒ Record (AbsoluteURIPrintOptions userInfo hosts host port hierPath query r) + → AbsoluteURI userInfo hosts host port hierPath query → String print opts (AbsoluteURI s h q) = String.joinWith "" $ Array.catMaybes @@ -85,24 +89,30 @@ print opts (AbsoluteURI s h q) = ] _scheme - ∷ ∀ userInfo hosts hierPath query - . Lens' (AbsoluteURI userInfo hosts hierPath query) Scheme + ∷ ∀ userInfo hosts host port hierPath query + . Lens' + (AbsoluteURI userInfo hosts host port hierPath query) + Scheme _scheme = lens (\(AbsoluteURI s _ _) → s) (\(AbsoluteURI _ h q) s → AbsoluteURI s h q) _hierPart - ∷ ∀ userInfo hosts hierPath query - . Lens' (AbsoluteURI userInfo hosts hierPath query) (HierarchicalPart userInfo hosts hierPath) + ∷ ∀ userInfo hosts host port hierPath query + . Lens' + (AbsoluteURI userInfo hosts host port hierPath query) + (HierarchicalPart userInfo hosts host port hierPath) _hierPart = lens (\(AbsoluteURI _ h _) → h) (\(AbsoluteURI s _ q) h → AbsoluteURI s h q) _query - ∷ ∀ userInfo hosts hierPath query - . Lens' (AbsoluteURI userInfo hosts hierPath query) (Maybe query) + ∷ ∀ userInfo hosts host port hierPath query + . Lens' + (AbsoluteURI userInfo hosts host port hierPath query) + (Maybe query) _query = lens (\(AbsoluteURI _ _ q) → q) diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index e22a6ab..f0b93d2 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -9,6 +9,7 @@ module Data.URI.Authority , _hosts , module Data.URI.Host , module Data.URI.Port + , module Data.URI.UserInfo ) where import Prelude @@ -21,10 +22,11 @@ import Data.Lens (Lens', lens) import Data.Maybe (Maybe, maybe) import Data.Ord (class Ord1, compare1) import Data.Tuple (Tuple(..)) -import Data.URI.Host (Host(..), _IPv4Address, _IPv6Address, _NameAddress) +import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) import Data.URI.Host as Host import Data.URI.Port (Port(..)) import Data.URI.Port as Port +import Data.URI.UserInfo (UserInfo) import Data.URI.UserInfo as UserInfo import Text.Parsing.StringParser (ParseError, Parser, try) import Text.Parsing.StringParser.Combinators (optionMaybe) @@ -32,68 +34,84 @@ import Text.Parsing.StringParser.String (string) -- | The authority part of a URI. For example: `purescript.org`, -- | `localhost:3000`, `user@example.net` -data Authority userInfo hosts = Authority (Maybe userInfo) (hosts (Tuple Host (Maybe Port))) +data Authority userInfo hosts host port = Authority (Maybe userInfo) (hosts (Tuple host (Maybe port))) -instance eqAuthority ∷ (Eq userInfo, Eq1 hosts) ⇒ Eq (Authority userInfo hosts) where +instance eqAuthority ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port) ⇒ Eq (Authority userInfo hosts host port) where eq (Authority ui1 hs1) (Authority ui2 hs2) = eq ui1 ui2 && eq1 hs1 hs2 -instance ordAuthority ∷ (Ord userInfo, Ord1 hosts) ⇒ Ord (Authority userInfo hosts) where +instance ordAuthority ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port) ⇒ Ord (Authority userInfo hosts host port) where compare (Authority ui1 hs1) (Authority ui2 hs2) = case compare ui1 ui2 of EQ → compare1 hs1 hs2 o → o -derive instance genericAuthority ∷ Generic (Authority userInfo hosts) _ +derive instance genericAuthority ∷ Generic (Authority userInfo hosts host port) _ -instance showAuthority ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port)))) ⇒ Show (Authority userInfo hosts) where show = genericShow +instance showAuthority ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show port) ⇒ Show (Authority userInfo hosts host port) where show = genericShow -type AuthorityOptions userInfo hosts = - AuthorityParseOptions userInfo hosts - (AuthorityPrintOptions userInfo hosts ()) +type AuthorityOptions userInfo hosts host port = + AuthorityParseOptions userInfo hosts host port + (AuthorityPrintOptions userInfo hosts host port ()) -type AuthorityParseOptions userInfo hosts r = - ( parseUserInfo ∷ String → Either ParseError userInfo +type AuthorityParseOptions userInfo hosts host port r = + ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHost ∷ Host → Either ParseError host + , parsePort ∷ Port → Either ParseError port | r ) -type AuthorityPrintOptions userInfo hosts r = - ( printUserInfo ∷ userInfo → String +type AuthorityPrintOptions userInfo hosts host port r = + ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String + , printHost ∷ host → Host + , printPort ∷ port → Port | r ) parser - ∷ ∀ userInfo hosts r - . Record (AuthorityParseOptions userInfo hosts r) - → Parser (Authority userInfo hosts) + ∷ ∀ userInfo hosts host port r + . Record (AuthorityParseOptions userInfo hosts host port r) + → Parser (Authority userInfo hosts host port) parser opts = do _ ← string "//" ui ← optionMaybe $ try (UserInfo.parser opts.parseUserInfo <* string "@") - hosts ← opts.parseHosts $ Tuple <$> Host.parser <*> optionMaybe (string ":" *> Port.parser) + hosts ← opts.parseHosts $ + Tuple + <$> Host.parser opts.parseHost + <*> optionMaybe (string ":" *> Port.parser opts.parsePort) pure $ Authority ui hosts print - ∷ ∀ userInfo hosts r + ∷ ∀ userInfo hosts host port r . Functor hosts - ⇒ Record (AuthorityPrintOptions userInfo hosts r) - → Authority userInfo hosts + ⇒ Record (AuthorityPrintOptions userInfo hosts host port r) + → Authority userInfo hosts host port → String print opts (Authority ui hs) = "//" <> printUserInfo ui <> opts.printHosts (printHostAndPort <$> hs) where printUserInfo = - maybe "" (\u → opts.printUserInfo u <> "@") + maybe "" (\u → UserInfo.print opts.printUserInfo u <> "@") printHostAndPort (Tuple h p) = - Host.print h <> maybe "" (\n → ":" <> Port.print n) p + Host.print opts.printHost h + <> maybe "" (\n → ":" <> Port.print opts.printPort n) p -_userInfo ∷ ∀ userInfo hosts. Lens' (Authority userInfo hosts) (Maybe userInfo) +_userInfo + ∷ ∀ userInfo hosts host port + . Lens' + (Authority userInfo hosts host port) + (Maybe userInfo) _userInfo = lens (\(Authority ui _) → ui) (\(Authority _ hs) ui → Authority ui hs) -_hosts ∷ ∀ userInfo hosts. Lens' (Authority userInfo hosts) (hosts (Tuple Host (Maybe Port))) +_hosts + ∷ ∀ userInfo hosts host port + . Lens' + (Authority userInfo hosts host port) + (hosts (Tuple host (Maybe port))) _hosts = lens (\(Authority _ hs) → hs) diff --git a/src/Data/URI/Common.purs b/src/Data/URI/Common.purs index c1c4f9e..be96df5 100644 --- a/src/Data/URI/Common.purs +++ b/src/Data/URI/Common.purs @@ -4,22 +4,23 @@ module Data.URI.Common , parseUnreserved , PCTEncoded , decodePCT - , decodePCTComponent , parsePCTEncoded + , newParsePCTEncoded , parseSubDelims + , printEncoded ) where import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Either (Either(..)) +import Data.Either (Either(..), either) import Data.String as String -import Global (decodeURI, decodeURIComponent) -import Text.Parsing.StringParser (ParseError, Parser(..), unParser) -import Text.Parsing.StringParser.String (alphaNum, char, oneOf, string) +import Global (decodeURI, encodeURIComponent) +import Text.Parsing.StringParser (ParseError, Parser(..), runParser, unParser) +import Text.Parsing.StringParser.String (alphaNum, anyChar, char, eof, oneOf, string) -wrapParser ∷ ∀ a. (String → Either ParseError a) → Parser String → Parser a +wrapParser ∷ ∀ a b. (a → Either ParseError b) → Parser a → Parser b wrapParser parseA p = Parser \ps → do pr ← unParser p ps case parseA pr.result of @@ -28,24 +29,32 @@ wrapParser parseA p = Parser \ps → do parsePChar ∷ (PCTEncoded → String) → Parser String parsePChar f - = parseUnreserved + = String.singleton <$> parseUnreserved <|> parsePCTEncoded f - <|> parseSubDelims + <|> String.singleton <$> parseSubDelims <|> string ":" <|> string "@" -parseUnreserved ∷ Parser String -parseUnreserved = - String.singleton <$> (alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~') +parseUnreserved ∷ Parser Char +parseUnreserved = alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~' + +newParsePCTEncoded ∷ Parser String +newParsePCTEncoded = do + d0 ← char '%' + d1 ← alphaNum + d2 ← alphaNum + pure $ String.fromCharArray [d0, d1, d2] + +parseSubDelims ∷ Parser Char +parseSubDelims = + -- TODO: resolve the `,` situation + oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', {- ',', -} ';', '='] newtype PCTEncoded = PCTEncoded String decodePCT ∷ PCTEncoded → String decodePCT (PCTEncoded s) = decodeURI s -decodePCTComponent ∷ PCTEncoded → String -decodePCTComponent (PCTEncoded s) = decodeURIComponent s - parsePCTEncoded ∷ (PCTEncoded → String) → Parser String parsePCTEncoded f = f <<< PCTEncoded <$> parseHex where @@ -55,7 +64,12 @@ parsePCTEncoded f = f <<< PCTEncoded <$> parseHex d2 ← alphaNum pure $ String.fromCharArray [d0, d1, d2] -parseSubDelims ∷ Parser String -parseSubDelims = - -- TODO: resolve the `,` situation - String.singleton <$> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', {- ',', -} ';', '='] +printEncoded ∷ Parser Char → String → String +printEncoded p s = either (const s) id (runParser parse s) + where + parse ∷ Parser String + parse = (String.joinWith "" <$> Array.many (simpleChar <|> encodedChar)) <* eof + simpleChar ∷ Parser String + simpleChar = String.singleton <$> p + encodedChar ∷ Parser String + encodedChar = encodeURIComponent <<< String.singleton <$> anyChar diff --git a/src/Data/URI/Fragment.purs b/src/Data/URI/Fragment.purs index 019b082..685e3df 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/Data/URI/Fragment.purs @@ -1,19 +1,58 @@ -module Data.URI.Fragment where +module Data.URI.Fragment + ( Fragment + , fromString + , toString + , unsafeFromString + , unsafeToString + , parser + , print + ) where import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either) +import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (decodePCTComponent, parsePChar, wrapParser) +import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded, wrapParser) +import Global (decodeURIComponent) import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.String (string) +import Text.Parsing.StringParser.String (char, string) -parser ∷ ∀ f. (String → Either ParseError f) → Parser f +-- | The hash fragment of a URI. +newtype Fragment = Fragment String + +derive newtype instance eqFragment ∷ Eq Fragment +derive newtype instance ordFragment ∷ Ord Fragment +derive newtype instance semigroupFragment ∷ Semigroup Fragment +derive newtype instance monoidFragment ∷ Monoid Fragment + +instance showFragment ∷ Show Fragment where + show (Fragment s) = "(Fragment.unsafeFromString " <> show s <> ")" + +fromString ∷ String → Fragment +fromString = Fragment <<< printEncoded fragmentChar + +toString ∷ Fragment → String +toString (Fragment s) = decodeURIComponent s + +unsafeFromString ∷ String → Fragment +unsafeFromString = Fragment + +unsafeToString ∷ Fragment → String +unsafeToString (Fragment s) = s + +parser ∷ ∀ f. (Fragment → Either ParseError f) → Parser f parser parseF = string "#" *> - wrapParser parseF (String.joinWith "" - <$> Array.many (parsePChar decodePCTComponent <|> string "/" <|> string "?")) + wrapParser parseF (Fragment <<< String.joinWith "" + <$> Array.many (newParsePCTEncoded <|> String.singleton <$> fragmentChar)) + +print ∷ ∀ f. (f → Fragment) → f → String +print printF f = "#" <> unsafeToString (printF f) -print ∷ ∀ f. (f → String) → f → String -print printF f = "#" <> printF f +-- | The supported fragment characters, excluding percent-encodings. +fragmentChar ∷ Parser Char +fragmentChar = + parseUnreserved <|> parseSubDelims + <|> char ':' <|> char '@' <|> char '/' <|> char '?' diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index 07d6893..8b00576 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -23,41 +23,45 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) -import Data.URI.Authority (Authority(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.URI.Authority (Authority(..), Host(..), Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Path as Path import Text.Parsing.StringParser (ParseError, Parser) -- | The "hierarchical part" of a generic or absolute URI. -data HierarchicalPart userInfo hosts hierPath = HierarchicalPart (Maybe (Authority userInfo hosts)) (Maybe hierPath) +data HierarchicalPart userInfo hosts host port hierPath = HierarchicalPart (Maybe (Authority userInfo hosts host port)) (Maybe hierPath) -derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq1 hosts, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hosts hierPath) -derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord1 hosts, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hosts hierPath) -derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts hierPath) _ -instance showHierarchicalPart ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts hierPath) where show = genericShow +derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hosts host port hierPath) +derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hosts host port hierPath) +derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts host port hierPath) _ +instance showHierarchicalPart ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts host port hierPath) where show = genericShow -type HierarchicalPartOptions userInfo hosts hierPath = - HierarchicalPartParseOptions userInfo hosts hierPath - (HierarchicalPartPrintOptions userInfo hosts hierPath ()) +type HierarchicalPartOptions userInfo hosts host port hierPath = + HierarchicalPartParseOptions userInfo hosts host port hierPath + (HierarchicalPartPrintOptions userInfo hosts host port hierPath ()) -type HierarchicalPartParseOptions userInfo hosts hierPath r = - ( parseUserInfo ∷ String → Either ParseError userInfo +type HierarchicalPartParseOptions userInfo hosts host port hierPath r = + ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHost ∷ Host → Either ParseError host + , parsePort ∷ Port → Either ParseError port , parseHierPath ∷ String → Either ParseError hierPath | r ) -type HierarchicalPartPrintOptions userInfo hosts hierPath r = - ( printUserInfo ∷ userInfo → String +type HierarchicalPartPrintOptions userInfo hosts host port hierPath r = + ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String + , printHost ∷ host → Host + , printPort ∷ port → Port , printHierPath ∷ hierPath → String | r ) parser - ∷ ∀ userInfo hosts hierPath r - . Record (HierarchicalPartParseOptions userInfo hosts hierPath r) - → Parser (HierarchicalPart userInfo hosts hierPath) + ∷ ∀ userInfo hosts host port hierPath r + . Record (HierarchicalPartParseOptions userInfo hosts host port hierPath r) + → Parser (HierarchicalPart userInfo hosts host port hierPath) parser opts = withAuth <|> withoutAuth where withAuth = @@ -73,23 +77,31 @@ parser opts = withAuth <|> withoutAuth <|> pure Nothing print - ∷ ∀ userInfo hosts hierPath r + ∷ ∀ userInfo hosts host port hierPath r . Functor hosts - ⇒ Record (HierarchicalPartPrintOptions userInfo hosts hierPath r) - → HierarchicalPart userInfo hosts hierPath → String + ⇒ Record (HierarchicalPartPrintOptions userInfo hosts host port hierPath r) + → HierarchicalPart userInfo hosts host port hierPath → String print opts (HierarchicalPart a p) = String.joinWith "" $ Array.catMaybes [ Authority.print opts <$> a , opts.printHierPath <$> p ] -_authority ∷ ∀ userInfo hosts hierPath. Lens' (HierarchicalPart userInfo hosts hierPath) (Maybe (Authority userInfo hosts)) +_authority + ∷ ∀ userInfo hosts host port hierPath + . Lens' + (HierarchicalPart userInfo hosts host port hierPath) + (Maybe (Authority userInfo hosts host port)) _authority = lens (\(HierarchicalPart a _) → a) (\(HierarchicalPart _ p) a → HierarchicalPart a p) -_path ∷ ∀ userInfo hosts hierPath. Lens' (HierarchicalPart userInfo hosts hierPath) (Maybe hierPath) +_path + ∷ ∀ userInfo hosts host port hierPath + . Lens' + (HierarchicalPart userInfo hosts host port hierPath) + (Maybe hierPath) _path = lens (\(HierarchicalPart _ p) → p) diff --git a/src/Data/URI/Host.purs b/src/Data/URI/Host.purs index 99445cb..7cf1f83 100644 --- a/src/Data/URI/Host.purs +++ b/src/Data/URI/Host.purs @@ -1,19 +1,16 @@ module Data.URI.Host ( Host(..) , parser - , ipv6AddressParser - , ipv4AddressParser - , regNameParser , print , _IPv6Address , _IPv4Address , _NameAddress + , module Data.URI.Host.RegName ) where import Prelude import Control.Alt ((<|>)) -import Data.Array as Array import Data.Either (Either(..)) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -21,8 +18,9 @@ import Data.Int as Int import Data.Lens (Prism', prism') import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (decodePCT, parsePCTEncoded, parseSubDelims, parseUnreserved, wrapParser) -import Global (encodeURI) +import Data.URI.Common (wrapParser) +import Data.URI.Host.RegName (RegName) +import Data.URI.Host.RegName as RegName import Text.Parsing.StringParser (ParseError(..), Parser, try) import Text.Parsing.StringParser.Combinators (()) import Text.Parsing.StringParser.String (anyDigit, char, regex, satisfy, string) @@ -31,15 +29,18 @@ import Text.Parsing.StringParser.String (anyDigit, char, regex, satisfy, string) data Host = IPv6Address String | IPv4Address String - | NameAddress String + | NameAddress RegName derive instance eqHost ∷ Eq Host derive instance ordHost ∷ Ord Host derive instance genericHost ∷ Generic Host _ instance showHost ∷ Show Host where show = genericShow -parser ∷ Parser Host -parser = ipv6AddressParser <|> try ipv4AddressParser <|> regNameParser +parser ∷ ∀ h. (Host → Either ParseError h) → Parser h +parser p = wrapParser p + $ ipv6AddressParser + <|> try ipv4AddressParser + <|> (NameAddress <$> RegName.parser) -- TODO: this is much too forgiving right now ipv6AddressParser ∷ Parser Host @@ -70,27 +71,23 @@ ipv4AddressParser = IPv4Address <$> addr "IPv4 address" Just n | n >= 0 && n <= 255 → Right n _ → Left (ParseError "Invalid IPv4 address octet") -regNameParser ∷ Parser Host -regNameParser = NameAddress <<< String.joinWith "" <$> Array.some p - where - p = parseUnreserved <|> parsePCTEncoded decodePCT <|> parseSubDelims - -print ∷ Host → String -print (IPv6Address i) = "[" <> i <> "]" -print (IPv4Address i) = i -print (NameAddress i) = encodeURI i +print ∷ ∀ h. (h → Host) → h → String +print f = f >>> case _ of + IPv6Address addr → "[" <> addr <> "]" + IPv4Address addr → addr + NameAddress addr → RegName.unsafeToString addr _IPv6Address ∷ Prism' Host String _IPv6Address = prism' IPv6Address case _ of - IPv6Address s → Just s + IPv6Address addr → Just addr _ → Nothing _IPv4Address ∷ Prism' Host String _IPv4Address = prism' IPv4Address case _ of - IPv4Address s → Just s + IPv4Address addr → Just addr _ → Nothing -_NameAddress ∷ Prism' Host String +_NameAddress ∷ Prism' Host RegName _NameAddress = prism' NameAddress case _ of - NameAddress s → Just s + NameAddress addr → Just addr _ → Nothing diff --git a/src/Data/URI/Host/RegName.purs b/src/Data/URI/Host/RegName.purs new file mode 100644 index 0000000..aea84bc --- /dev/null +++ b/src/Data/URI/Host/RegName.purs @@ -0,0 +1,61 @@ +module Data.URI.Host.RegName + ( RegName + , fromString + , toString + , unsafeFromString + , unsafeToString + , parser + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Array as Array +import Data.Monoid (class Monoid) +import Data.String as String +import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded) +import Global (decodeURIComponent) +import Text.Parsing.StringParser (Parser) + +newtype RegName = RegName String + +derive newtype instance eqRegName ∷ Eq RegName +derive newtype instance ordRegName ∷ Ord RegName +derive newtype instance semigroupRegName ∷ Semigroup RegName +derive newtype instance monoidRegName ∷ Monoid RegName + +instance showRegName ∷ Show RegName where + show (RegName s) = "(RegName.unsafeFromString " <> show s <> ")" + +-- | Constructs a `RegName` part safely: percent-encoding will be +-- | applied to any character that requires it for the user-info component of a +-- | URI. +fromString ∷ String → RegName +fromString = RegName <<< printEncoded regNameChar + +-- | Prints `RegName` as a string, decoding any percent-encoded +-- | characters contained within. +toString ∷ RegName → String +toString (RegName s) = decodeURIComponent s + +-- | Constructs a `RegName` part unsafely: no encoding will be applied +-- | to the value. If an incorrect value is provided, the URI will be invalid +-- | when printed back. +unsafeFromString ∷ String → RegName +unsafeFromString = RegName + +-- | Prints `RegName` as a string without performing any decoding of +-- | percent-encoded octets. Only "unsafe" in the sense that values this +-- | produces will need further decoding, the name is more for symmetry with +-- | the `fromString`/`toString` and `unsafeFromString`/`unsafeToString` +-- | pairings. +unsafeToString ∷ RegName → String +unsafeToString (RegName s) = s + +parser ∷ Parser RegName +parser = RegName <<< String.joinWith "" <$> Array.some p + where + p = newParsePCTEncoded <|> String.singleton <$> regNameChar + +regNameChar ∷ Parser Char +regNameChar = parseUnreserved <|> parseSubDelims diff --git a/src/Data/URI/NonStandard/Fragment.purs b/src/Data/URI/NonStandard/Fragment.purs deleted file mode 100644 index 4f259e1..0000000 --- a/src/Data/URI/NonStandard/Fragment.purs +++ /dev/null @@ -1,37 +0,0 @@ -module Data.URI.NonStandard.Fragment where - -import Prelude - -import Data.Either (Either, fromRight) -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.Newtype (class Newtype) -import Data.String as String -import Data.String.Regex as RX -import Data.String.Regex.Flags as RXF -import Global (encodeURIComponent) -import Partial.Unsafe (unsafePartial) - --- | The hash fragment of a URI. -newtype Fragment = Fragment String - -derive newtype instance eqFragment ∷ Eq Fragment -derive newtype instance ordFragment ∷ Ord Fragment -derive instance genericFragment ∷ Generic Fragment _ -derive instance newtypeFragment ∷ Newtype Fragment _ -instance showFragment ∷ Show Fragment where show = genericShow - -parse ∷ ∀ e. String → Either e Fragment -parse = pure <<< Fragment - -print ∷ Fragment → String -print (Fragment f) = String.joinWith "" (map printChar $ String.split (String.Pattern "") f) - where - -- Fragments & queries have a bunch of characters that don't need escaping - printChar ∷ String → String - printChar s - | RX.test rxPrintable s = s - | otherwise = encodeURIComponent s - -rxPrintable ∷ RX.Regex -rxPrintable = unsafePartial fromRight $ RX.regex "[&;$+=/?:@]" RXF.global diff --git a/src/Data/URI/NonStandard/UserInfo.purs b/src/Data/URI/NonStandard/UserInfo.purs deleted file mode 100644 index 75a8b97..0000000 --- a/src/Data/URI/NonStandard/UserInfo.purs +++ /dev/null @@ -1,24 +0,0 @@ -module Data.URI.NonStandard.UserInfo where - -import Prelude - -import Data.Either (Either) -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.Newtype (class Newtype) -import Global (encodeURI) - --- | The user info part of an `Authority`. For example: `user`, `foo:bar`. -newtype UserInfo = UserInfo String - -derive newtype instance eqUserInfo ∷ Eq UserInfo -derive newtype instance ordUserInfo ∷ Ord UserInfo -derive instance genericUserInfo ∷ Generic UserInfo _ -derive instance newtypeUserInfo ∷ Newtype UserInfo _ -instance showUserInfo ∷ Show UserInfo where show = genericShow - -parse ∷ ∀ e. String → Either e UserInfo -parse = pure <<< UserInfo - -print ∷ UserInfo → String -print (UserInfo u) = encodeURI u diff --git a/src/Data/URI/Path.purs b/src/Data/URI/Path.purs index e8b8737..0a754cc 100644 --- a/src/Data/URI/Path.purs +++ b/src/Data/URI/Path.purs @@ -6,6 +6,7 @@ import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either) import Data.Maybe (Maybe(..)) +import Data.Monoid (class Monoid) import Data.String as String import Data.URI.Common (PCTEncoded, decodePCT, parsePCTEncoded, parsePChar, parseSubDelims, parseUnreserved, wrapParser) import Text.Parsing.StringParser (ParseError, Parser) @@ -54,7 +55,7 @@ parseSegmentNonZero = String.joinWith "" <$> Array.some (parsePChar decoder) parseSegmentNonZeroNoColon ∷ Parser String parseSegmentNonZeroNoColon = String.joinWith "" <$> Array.some - (parseUnreserved <|> parsePCTEncoded decoder <|> parseSubDelims <|> string "@") + (String.singleton <$> parseUnreserved <|> parsePCTEncoded decoder <|> String.singleton <$> parseSubDelims <|> string "@") decoder ∷ PCTEncoded → String decoder = String.replaceAll (String.Pattern "%23") (String.Replacement "#") <<< decodePCT diff --git a/src/Data/URI/Port.purs b/src/Data/URI/Port.purs index 1785a57..dbb1ef9 100644 --- a/src/Data/URI/Port.purs +++ b/src/Data/URI/Port.purs @@ -1,16 +1,22 @@ -module Data.URI.Port where +module Data.URI.Port + ( Port(..) + , parser + , print + ) where import Prelude import Data.Array as Array +import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Int (fromNumber) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) import Data.String as String +import Data.URI.Common (wrapParser) import Global (readInt) -import Text.Parsing.StringParser (Parser, fail) +import Text.Parsing.StringParser (ParseError, Parser, fail) import Text.Parsing.StringParser.String (anyDigit) -- | A port number. @@ -22,12 +28,12 @@ derive instance genericPort ∷ Generic Port _ derive instance newtypePort ∷ Newtype Port _ instance showPort ∷ Show Port where show = genericShow -parser ∷ Parser Port -parser = do +parser ∷ ∀ p. (Port → Either ParseError p) → Parser p +parser p = wrapParser p do s ← String.fromCharArray <$> Array.some anyDigit case fromNumber $ readInt 10 s of Just x → pure (Port x) _ → fail "Expected valid port number" -print ∷ Port → String -print (Port p) = show p +print ∷ ∀ p. (p → Port) → p → String +print = map (\(Port x) → show x) diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index 83fbfdf..2eaf4c3 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -23,41 +23,45 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) -import Data.URI.Authority (Authority(..), AuthorityPrintOptions, Host(..), Port(..), AuthorityParseOptions, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.URI.Authority (Authority(..), Host(..), Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Path as Path import Text.Parsing.StringParser (ParseError, Parser) -- | The "relative part" of a relative reference. -data RelativePart userInfo hosts relPath = RelativePart (Maybe (Authority userInfo hosts)) (Maybe relPath) +data RelativePart userInfo hosts host port relPath = RelativePart (Maybe (Authority userInfo hosts host port)) (Maybe relPath) -derive instance eqRelativePart ∷ (Eq userInfo, Eq1 hosts, Eq relPath) ⇒ Eq (RelativePart userInfo hosts relPath) -derive instance ordRelativePart ∷ (Ord userInfo, Ord1 hosts, Ord relPath) ⇒ Ord (RelativePart userInfo hosts relPath) -derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts relPath) _ -instance showRelativePart ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show relPath) ⇒ Show (RelativePart userInfo hosts relPath) where show = genericShow +derive instance eqRelativePart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq relPath) ⇒ Eq (RelativePart userInfo hosts host port relPath) +derive instance ordRelativePart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord relPath) ⇒ Ord (RelativePart userInfo hosts host port relPath) +derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts host port relPath) _ +instance showRelativePart ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show port, Show relPath) ⇒ Show (RelativePart userInfo hosts host port relPath) where show = genericShow -type RelativePartOptions userInfo hosts relPath = - RelativePartParseOptions userInfo hosts relPath - (RelativePartPrintOptions userInfo hosts relPath ()) +type RelativePartOptions userInfo hosts host port relPath = + RelativePartParseOptions userInfo hosts host port relPath + (RelativePartPrintOptions userInfo hosts host port relPath ()) -type RelativePartParseOptions userInfo hosts relPath r = - ( parseUserInfo ∷ String → Either ParseError userInfo +type RelativePartParseOptions userInfo hosts host port relPath r = + ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHost ∷ Host → Either ParseError host + , parsePort ∷ Port → Either ParseError port , parseRelPath ∷ String → Either ParseError relPath | r ) -type RelativePartPrintOptions userInfo hosts relPath r = - ( printUserInfo ∷ userInfo → String +type RelativePartPrintOptions userInfo hosts host port relPath r = + ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String + , printHost ∷ host → Host + , printPort ∷ port → Port , printRelPath ∷ relPath → String | r ) parser - ∷ ∀ userInfo hosts relPath r - . Record (RelativePartParseOptions userInfo hosts relPath r) - → Parser (RelativePart userInfo hosts relPath) + ∷ ∀ userInfo hosts host port relPath r + . Record (RelativePartParseOptions userInfo hosts host port relPath r) + → Parser (RelativePart userInfo hosts host port relPath) parser opts = withAuth <|> withoutAuth where withAuth = @@ -73,23 +77,31 @@ parser opts = withAuth <|> withoutAuth <|> pure Nothing print - ∷ ∀ userInfo hosts relPath r + ∷ ∀ userInfo hosts host port relPath r . Functor hosts - ⇒ Record (RelativePartPrintOptions userInfo hosts relPath r) - → RelativePart userInfo hosts relPath → String + ⇒ Record (RelativePartPrintOptions userInfo hosts host port relPath r) + → RelativePart userInfo hosts host port relPath → String print opts (RelativePart a p) = String.joinWith "" $ Array.catMaybes [ Authority.print opts <$> a , opts.printRelPath <$> p ] -_authority ∷ ∀ userInfo hosts relPath. Lens' (RelativePart userInfo hosts relPath) (Maybe (Authority userInfo hosts)) +_authority + ∷ ∀ userInfo hosts host port relPath + . Lens' + (RelativePart userInfo hosts host port relPath) + (Maybe (Authority userInfo hosts host port)) _authority = lens (\(RelativePart a _) → a) (\(RelativePart _ p) a → RelativePart a p) -_path ∷ ∀ userInfo hosts relPath. Lens' (RelativePart userInfo hosts relPath) (Maybe relPath) +_path + ∷ ∀ userInfo hosts host port relPath + . Lens' + (RelativePart userInfo hosts host port relPath) + (Maybe relPath) _path = lens (\(RelativePart _ p) → p) diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 0449a7c..1050feb 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -23,48 +23,53 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) +import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment import Data.URI.Query as Query -import Data.URI.RelativePart (Authority(..), AuthorityParseOptions, AuthorityPrintOptions, Host(..), Port(..), RelativePart(..), RelativePartParseOptions, RelativePartPrintOptions, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.RelativePart (Authority(..), Host(..), Port(..), RelativePart(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.RelativePart as RPart import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A relative reference for a URI. -data RelativeRef userInfo hosts relPath query fragment = RelativeRef (RelativePart userInfo hosts relPath) (Maybe query) (Maybe fragment) +data RelativeRef userInfo hosts host port relPath query fragment = RelativeRef (RelativePart userInfo hosts host port relPath) (Maybe query) (Maybe fragment) -derive instance eqRelativeRef ∷ (Eq userInfo, Eq1 hosts, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo hosts relPath query fragment) -derive instance ordRelativeRef ∷ (Ord userInfo, Ord1 hosts, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo hosts relPath query fragment) -derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts relPath query fragment) _ -instance showRelativeRef ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts relPath query fragment) where show = genericShow +derive instance eqRelativeRef ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo hosts host port relPath query fragment) +derive instance ordRelativeRef ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo hosts host port relPath query fragment) +derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts host port relPath query fragment) _ +instance showRelativeRef ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts host port relPath query fragment) where show = genericShow -type RelativeRefOptions userInfo hosts relPath query fragment = - RelativeRefParseOptions userInfo hosts relPath query fragment - (RelativeRefPrintOptions userInfo hosts relPath query fragment ()) +type RelativeRefOptions userInfo hosts host port relPath query fragment = + RelativeRefParseOptions userInfo hosts host port relPath query fragment + (RelativeRefPrintOptions userInfo hosts host port relPath query fragment ()) -type RelativeRefParseOptions userInfo hosts relPath query fragment r = - ( parseUserInfo ∷ String → Either ParseError userInfo +type RelativeRefParseOptions userInfo hosts host port relPath query fragment r = + ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHost ∷ Host → Either ParseError host + , parsePort ∷ Port → Either ParseError port , parseRelPath ∷ String → Either ParseError relPath , parseQuery ∷ String → Either ParseError query - , parseFragment ∷ String → Either ParseError fragment + , parseFragment ∷ Fragment → Either ParseError fragment | r ) -type RelativeRefPrintOptions userInfo hosts relPath query fragment r = - ( printUserInfo ∷ userInfo → String +type RelativeRefPrintOptions userInfo hosts host port relPath query fragment r = + ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String + , printHost ∷ host → Host + , printPort ∷ port → Port , printRelPath ∷ relPath → String , printQuery ∷ query → String - , printFragment ∷ fragment → String + , printFragment ∷ fragment → Fragment | r ) parser - ∷ ∀ userInfo hosts relPath query fragment r - . Record (RelativeRefParseOptions userInfo hosts relPath query fragment r) - → Parser (RelativeRef userInfo hosts relPath query fragment) + ∷ ∀ userInfo hosts host port relPath query fragment r + . Record (RelativeRefParseOptions userInfo hosts host port relPath query fragment r) + → Parser (RelativeRef userInfo hosts host port relPath query fragment) parser opts = RelativeRef <$> RPart.parser opts @@ -73,10 +78,10 @@ parser opts = <* eof print - ∷ ∀ userInfo hosts relPath query fragment r + ∷ ∀ userInfo hosts host port relPath query fragment r . Functor hosts - ⇒ Record (RelativeRefPrintOptions userInfo hosts relPath query fragment r) - → RelativeRef userInfo hosts relPath query fragment + ⇒ Record (RelativeRefPrintOptions userInfo hosts host port relPath query fragment r) + → RelativeRef userInfo hosts host port relPath query fragment → String print opts (RelativeRef h q f) = String.joinWith "" $ Array.catMaybes @@ -86,24 +91,30 @@ print opts (RelativeRef h q f) = ] _relPart - ∷ ∀ userInfo hosts relPath query fragment - . Lens' (RelativeRef userInfo hosts relPath query fragment) (RelativePart userInfo hosts relPath) + ∷ ∀ userInfo hosts host port relPath query fragment + . Lens' + (RelativeRef userInfo hosts host port relPath query fragment) + (RelativePart userInfo hosts host port relPath) _relPart = lens (\(RelativeRef r _ _) → r) (\(RelativeRef _ q f) r → RelativeRef r q f) _query - ∷ ∀ userInfo hosts relPath query fragment - . Lens' (RelativeRef userInfo hosts relPath query fragment) (Maybe query) + ∷ ∀ userInfo hosts host port relPath query fragment + . Lens' + (RelativeRef userInfo hosts host port relPath query fragment) + (Maybe query) _query = lens (\(RelativeRef _ q _) → q) (\(RelativeRef r _ f) q → RelativeRef r q f) _fragment - ∷ ∀ userInfo hosts relPath query fragment - . Lens' (RelativeRef userInfo hosts relPath query fragment) (Maybe fragment) + ∷ ∀ userInfo hosts host port relPath query fragment + . Lens' + (RelativeRef userInfo hosts host port relPath query fragment) + (Maybe fragment) _fragment = lens (\(RelativeRef _ _ f) → f) diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 4df6b3a..2e72ae7 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -25,8 +25,9 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) +import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) @@ -36,39 +37,43 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A generic URI -data URI userInfo hosts hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts hierPath) (Maybe query) (Maybe fragment) +data URI userInfo hosts host port hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts host port hierPath) (Maybe query) (Maybe fragment) -derive instance eqURI ∷ (Eq userInfo, Eq1 hosts, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hosts hierPath query fragment) -derive instance ordURI ∷ (Ord userInfo, Ord1 hosts, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hosts hierPath query fragment) -derive instance genericURI ∷ Generic (URI userInfo hosts hierPath query fragment) _ -instance showURI ∷ (Show userInfo, Show (hosts (Tuple Host (Maybe Port))), Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts hierPath query fragment) where show = genericShow +derive instance eqURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hosts host port hierPath query fragment) +derive instance ordURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hosts host port hierPath query fragment) +derive instance genericURI ∷ Generic (URI userInfo hosts host port hierPath query fragment) _ +instance showURI ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts host port hierPath query fragment) where show = genericShow -type URIOptions userInfo hosts hierPath query fragment = - URIParseOptions userInfo hosts hierPath query fragment - (URIPrintOptions userInfo hosts hierPath query fragment ()) +type URIOptions userInfo hosts host port hierPath query fragment = + URIParseOptions userInfo hosts host port hierPath query fragment + (URIPrintOptions userInfo hosts host port hierPath query fragment ()) -type URIParseOptions userInfo hosts hierPath query fragment r = - ( parseUserInfo ∷ String → Either ParseError userInfo +type URIParseOptions userInfo hosts host port hierPath query fragment r = + ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHost ∷ Host → Either ParseError host + , parsePort ∷ Port → Either ParseError port , parseHierPath ∷ String → Either ParseError hierPath , parseQuery ∷ String → Either ParseError query - , parseFragment ∷ String → Either ParseError fragment + , parseFragment ∷ Fragment → Either ParseError fragment | r ) -type URIPrintOptions userInfo hosts hierPath query fragment r = - ( printUserInfo ∷ userInfo → String +type URIPrintOptions userInfo hosts host port hierPath query fragment r = + ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String + , printHost ∷ host → Host + , printPort ∷ port → Port , printHierPath ∷ hierPath → String , printQuery ∷ query → String - , printFragment ∷ fragment → String + , printFragment ∷ fragment → Fragment | r ) parser - ∷ ∀ userInfo hosts hierPath query fragment r - . Record (URIParseOptions userInfo hosts hierPath query fragment r) - → Parser (URI userInfo hosts hierPath query fragment) + ∷ ∀ userInfo hosts host port hierPath query fragment r + . Record (URIParseOptions userInfo hosts host port hierPath query fragment r) + → Parser (URI userInfo hosts host port hierPath query fragment) parser opts = URI <$> Scheme.parser <*> HPart.parser opts @@ -77,10 +82,10 @@ parser opts = URI <* eof print - ∷ ∀ userInfo hosts hierPath query fragment r + ∷ ∀ userInfo hosts host port hierPath query fragment r . Functor hosts - ⇒ Record (URIPrintOptions userInfo hosts hierPath query fragment r) - → URI userInfo hosts hierPath query fragment + ⇒ Record (URIPrintOptions userInfo hosts host port hierPath query fragment r) + → URI userInfo hosts host port hierPath query fragment → String print opts (URI s h q f) = String.joinWith "" $ Array.catMaybes @@ -91,32 +96,40 @@ print opts (URI s h q f) = ] _scheme - ∷ ∀ userInfo hosts hierPath query fragment - . Lens' (URI userInfo hosts hierPath query fragment) Scheme + ∷ ∀ userInfo hosts host port hierPath query fragment + . Lens' + (URI userInfo hosts host port hierPath query fragment) + Scheme _scheme = lens (\(URI s _ _ _) → s) (\(URI _ h q f) s → URI s h q f) _hierPart - ∷ ∀ userInfo hosts hierPath query fragment - . Lens' (URI userInfo hosts hierPath query fragment) (HierarchicalPart userInfo hosts hierPath) + ∷ ∀ userInfo hosts host port hierPath query fragment + . Lens' + (URI userInfo hosts host port hierPath query fragment) + (HierarchicalPart userInfo hosts host port hierPath) _hierPart = lens (\(URI _ h _ _) → h) (\(URI s _ q f) h → URI s h q f) _query - ∷ ∀ userInfo hosts hierPath query fragment - . Lens' (URI userInfo hosts hierPath query fragment) (Maybe query) + ∷ ∀ userInfo hosts host port hierPath query fragment + . Lens' + (URI userInfo hosts host port hierPath query fragment) + (Maybe query) _query = lens (\(URI _ _ q _) → q) (\(URI s h _ f) q → URI s h q f) _fragment - ∷ ∀ userInfo hosts hierPath query fragment - . Lens' (URI userInfo hosts hierPath query fragment) (Maybe fragment) + ∷ ∀ userInfo hosts host port hierPath query fragment + . Lens' + (URI userInfo hosts host port hierPath query fragment) + (Maybe fragment) _fragment = lens (\(URI _ _ _ f) → f) diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index ca01c01..82e7585 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -1,56 +1,81 @@ -module Data.URI.URIRef where +module Data.URI.URIRef + ( URIRef + , URIRefOptions + , URIRefParseOptions + , URIRefPrintOptions + , parser + , print + , module Data.URI.Authority + , module Data.URI.Fragment + , module Data.URI.Host + , module Data.URI.Port + , module Data.URI.UserInfo + , module Data.URI.RelativeRef + , module Data.URI.URI + ) where import Prelude import Control.Alt ((<|>)) import Data.Either (Either(..), either) +import Data.URI.Authority (Authority(..)) +import Data.URI.Fragment (Fragment) +import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) +import Data.URI.Port (Port(..)) +import Data.URI.RelativeRef (RelativeRef(..), RelativePart(..)) import Data.URI.RelativeRef as RelativeRef +import Data.URI.URI (URI(..), HierarchicalPart(..)) import Data.URI.URI as URI +import Data.URI.UserInfo (UserInfo) import Text.Parsing.StringParser (ParseError, Parser, try) -- | An alias for the most common use case of resource identifiers. -type URIRef userInfo hosts hierPath relPath query fragment = +type URIRef userInfo hosts host port hierPath relPath query fragment = Either - (URI.URI userInfo hosts hierPath query fragment) - (RelativeRef.RelativeRef userInfo hosts relPath query fragment) + (URI.URI userInfo hosts host port hierPath query fragment) + (RelativeRef.RelativeRef userInfo hosts host port relPath query fragment) -type URIRefOptions userInfo hosts hierPath relPath query fragment = - URIRefParseOptions userInfo hosts hierPath relPath query fragment - (URIRefPrintOptions userInfo hosts hierPath relPath query fragment ()) +type URIRefOptions userInfo hosts host port hierPath relPath query fragment = + URIRefParseOptions userInfo hosts host port hierPath relPath query fragment + (URIRefPrintOptions userInfo hosts host port hierPath relPath query fragment ()) -type URIRefParseOptions userInfo hosts hierPath relPath query fragment r = - ( parseUserInfo ∷ String → Either ParseError userInfo +type URIRefParseOptions userInfo hosts host port hierPath relPath query fragment r = + ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) + , parseHost ∷ Host → Either ParseError host + , parsePort ∷ Port → Either ParseError port , parseRelPath ∷ String → Either ParseError relPath , parseHierPath ∷ String → Either ParseError hierPath , parseQuery ∷ String → Either ParseError query - , parseFragment ∷ String → Either ParseError fragment + , parseFragment ∷ Fragment → Either ParseError fragment | r ) -type URIRefPrintOptions userInfo hosts hierPath relPath query fragment r = - ( printUserInfo ∷ userInfo → String +type URIRefPrintOptions userInfo hosts host port hierPath relPath query fragment r = + ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String + , printHost ∷ host → Host + , printPort ∷ port → Port , printRelPath ∷ relPath → String , printHierPath ∷ hierPath → String , printQuery ∷ query → String - , printFragment ∷ fragment → String + , printFragment ∷ fragment → Fragment | r ) parser - ∷ ∀ userInfo hosts hierPath relPath query fragment r - . Record (URIRefParseOptions userInfo hosts hierPath relPath query fragment r) - → Parser (URIRef userInfo hosts hierPath relPath query fragment) + ∷ ∀ userInfo hosts host port hierPath relPath query fragment r + . Record (URIRefParseOptions userInfo hosts host port hierPath relPath query fragment r) + → Parser (URIRef userInfo hosts host port hierPath relPath query fragment) parser opts = (Left <$> try (URI.parser opts)) <|> (Right <$> RelativeRef.parser opts) print - ∷ ∀ userInfo hosts hierPath relPath query fragment r + ∷ ∀ userInfo hosts host port hierPath relPath query fragment r . Functor hosts - ⇒ Record (URIRefPrintOptions userInfo hosts hierPath relPath query fragment r) - → URIRef userInfo hosts hierPath relPath query fragment + ⇒ Record (URIRefPrintOptions userInfo hosts host port hierPath relPath query fragment r) + → URIRef userInfo hosts host port hierPath relPath query fragment → String print opts = either diff --git a/src/Data/URI/UserInfo.purs b/src/Data/URI/UserInfo.purs index de48cb4..1da2a8c 100644 --- a/src/Data/URI/UserInfo.purs +++ b/src/Data/URI/UserInfo.purs @@ -1,22 +1,70 @@ -module Data.URI.UserInfo where +module Data.URI.UserInfo + ( UserInfo + , fromString + , toString + , unsafeFromString + , unsafeToString + , parser + , print + ) where import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either) +import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (decodePCT, parsePCTEncoded, parseSubDelims, parseUnreserved, wrapParser) +import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded, wrapParser) +import Global (decodeURIComponent) import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.String (string) +import Text.Parsing.StringParser.String (char) -parser ∷ ∀ ui. (String → Either ParseError ui) → Parser ui -parser p = wrapParser p (String.joinWith "" <$> Array.some p') +-- | The user info part of an `Authority`. For example: `user`, `foo:bar`. +newtype UserInfo = UserInfo String + +derive newtype instance eqUserInfo ∷ Eq UserInfo +derive newtype instance ordUserInfo ∷ Ord UserInfo +derive newtype instance semigroupUserInfo ∷ Semigroup UserInfo +derive newtype instance monoidUserInfo ∷ Monoid UserInfo + +instance showUserInfo ∷ Show UserInfo where + show (UserInfo s) = "(UserInfo.unsafeFromString " <> show s <> ")" + +-- | Constructs a `UserInfo` part safely: percent-encoding will be +-- | applied to any character that requires it for the user-info component of a +-- | URI. +fromString ∷ String → UserInfo +fromString = UserInfo <<< printEncoded userInfoChar + +-- | Prints `UserInfo` as a string, decoding any percent-encoded +-- | characters contained within. +toString ∷ UserInfo → String +toString (UserInfo s) = decodeURIComponent s + +-- | Constructs a `UserInfo` part unsafely: no encoding will be applied +-- | to the value. If an incorrect value is provided, the URI will be invalid +-- | when printed back. +unsafeFromString ∷ String → UserInfo +unsafeFromString = UserInfo + +-- | Prints `UserInfo` as a string without performing any decoding of +-- | percent-encoded octets. Only "unsafe" in the sense that values this +-- | produces will need further decoding, the name is more for symmetry with +-- | the `fromString`/`toString` and `unsafeFromString`/`unsafeToString` +-- | pairings. +unsafeToString ∷ UserInfo → String +unsafeToString (UserInfo s) = s + +parser ∷ ∀ ui. (UserInfo → Either ParseError ui) → Parser ui +parser p = wrapParser p (UserInfo <<< String.joinWith "" <$> Array.some parse) where - p' = parseUnreserved - <|> parsePCTEncoded decodePCT - <|> parseSubDelims - <|> string ":" + parse ∷ Parser String + parse = String.singleton <$> userInfoChar <|> newParsePCTEncoded + +print ∷ ∀ ui. (ui → UserInfo) → ui → String +print = map unsafeToString -print ∷ ∀ ui. (ui → String) → ui → String -print = id +-- | The supported user info characters, excluding percent-encodings. +userInfoChar ∷ Parser Char +userInfoChar = parseUnreserved <|> parseSubDelims <|> char ':' diff --git a/test/Main.purs b/test/Main.purs index 881e8f2..c69499c 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -16,16 +16,15 @@ import Data.Monoid (mempty) import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) import Data.String as String import Data.Tuple (Tuple(..)) -import Data.URI (AbsoluteURI(..), Authority(..), HierarchicalPart(..), Host(..), Port(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..)) +import Data.URI (AbsoluteURI(..), Authority(..), HierarchicalPart(..), Host(..), Fragment, Port(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..), UserInfo) import Data.URI.AbsoluteURI as AbsoluteURI import Data.URI.Authority as Authority import Data.URI.Fragment as Fragment import Data.URI.Host as Host +import Data.URI.Host.RegName as RegName import Data.URI.Host.Gen as Host.Gen -import Data.URI.NonStandard.Fragment as NF import Data.URI.NonStandard.Path as NP import Data.URI.NonStandard.Query as NQ -import Data.URI.NonStandard.UserInfo as NU import Data.URI.Port as Port import Data.URI.Query as Query import Data.URI.Scheme as Scheme @@ -43,20 +42,24 @@ import Text.Parsing.StringParser (Parser, runParser) import Text.Parsing.StringParser.Combinators (sepBy) as SP import Text.Parsing.StringParser.String (string) as SP -options ∷ Record (URIRef.URIRefOptions NU.UserInfo Array NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment) +options ∷ Record (URIRef.URIRefOptions UserInfo Array Host Port NP.URIPathAbs NP.URIPathRel NQ.Query Fragment) options = - { parseUserInfo: NU.parse - , printUserInfo: NU.print + { parseUserInfo: pure + , printUserInfo: id , parseHosts: map Array.fromFoldable <<< flip SP.sepBy (SP.string ",") , printHosts: String.joinWith "," + , parseHost: pure + , printHost: id + , parsePort: pure + , printPort: id , parseHierPath: NP.parseURIPathAbs , printHierPath: NP.printPath , parseRelPath: NP.parseURIPathRel , printRelPath: NP.printPath , parseQuery: NQ.parse , printQuery: NQ.print - , parseFragment: NF.parse - , printFragment: NF.print + , parseFragment: pure + , printFragment: id } testPrinter :: forall a b. Show b => (b -> String) -> String -> b -> TestSuite a @@ -76,10 +79,10 @@ testIso p f uri expected = do testRunParseSuccess p uri expected testPrinter f uri expected -testIsoURI :: forall a. String -> URI.URI NU.UserInfo Array NP.URIPathAbs NQ.Query NF.Fragment -> TestSuite a +testIsoURI :: forall a. String -> URI.URI UserInfo Array Host Port NP.URIPathAbs NQ.Query Fragment -> TestSuite a testIsoURI = testIso (URI.parser options) (URI.print options) -testIsoURIRef :: forall a. String -> URIRef.URIRef NU.UserInfo Array NP.URIPathAbs NP.URIPathRel NQ.Query NF.Fragment -> TestSuite a +testIsoURIRef :: forall a. String -> URIRef.URIRef UserInfo Array Host Port NP.URIPathAbs NP.URIPathRel NQ.Query Fragment -> TestSuite a testIsoURIRef = testIso (URIRef.parser options) (URIRef.print options) -- testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a @@ -111,48 +114,53 @@ main = runTest $ suite "Data.URI" do test "parseIPv4Address / Host.print roundtrip" do forAll do ipv4 <- Host.Gen.genIPv4 - let printed = Host.print ipv4 - let parsed = runParser Host.ipv4AddressParser printed + let printed = Host.print id ipv4 + let parsed = runParser (Host.parser pure) printed pure $ pure ipv4 === parsed - test "0-lead octets should not parse" do - assert ("parse should fail for 192.168.001.1") $ - isLeft $ runParser Host.ipv4AddressParser "192.168.001.1" + test "0-lead octets should not parse as an IP address" do + equal + (Right (NameAddress (RegName.unsafeFromString "192.168.001.1"))) + (runParser (Host.parser pure) "192.168.001.1") suite "Scheme parser" do testRunParseSuccess Scheme.parser "http:" (Scheme "http") testRunParseSuccess Scheme.parser "git+ssh:" (Scheme "git+ssh") suite "UserInfo parser" do - testRunParseSuccess (UserInfo.parser NU.parse) "user" (NU.UserInfo "user") - testRunParseSuccess (UserInfo.parser NU.parse) "spaced%20user" (NU.UserInfo "spaced user") - testRunParseSuccess (UserInfo.parser NU.parse) "user:password" (NU.UserInfo "user:password") - testRunParseSuccess (UserInfo.parser NU.parse) "spaced%20user:password%25%C2%A3" (NU.UserInfo "spaced user:password%£") + testRunParseSuccess (UserInfo.parser pure) "user" (UserInfo.fromString "user") + testRunParseSuccess (UserInfo.parser pure) "spaced%20user" (UserInfo.fromString "spaced user") + testRunParseSuccess (UserInfo.parser pure) "user:password" (UserInfo.fromString "user:password") + testRunParseSuccess (UserInfo.parser pure) "spaced%20user:password%25%C2%A3" (UserInfo.fromString "spaced user:password%£") + testRunParseSuccess (UserInfo.parser pure) "a:b:c" (UserInfo.fromString "a:b:c") suite "Host parser" do - testRunParseSuccess Host.parser "localhost" (NameAddress "localhost") - testRunParseSuccess Host.parser "github.com" (NameAddress "github.com") - testRunParseSuccess Host.parser "www.multipart.domain.example.com" (NameAddress "www.multipart.domain.example.com") - testRunParseSuccess Host.parser "192.168.0.1" (IPv4Address "192.168.0.1") - testRunParseSuccess Host.parser "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") + testRunParseSuccess (Host.parser pure) "localhost" (NameAddress (RegName.fromString "localhost")) + testRunParseSuccess (Host.parser pure) "github.com" (NameAddress (RegName.fromString "github.com")) + testRunParseSuccess (Host.parser pure) "www.multipart.domain.example.com" (NameAddress (RegName.fromString "www.multipart.domain.example.com")) + testRunParseSuccess (Host.parser pure) "192.168.0.1" (IPv4Address "192.168.0.1") + testRunParseSuccess (Host.parser pure) "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") suite "Port parser" do - testRunParseSuccess Port.parser "0" (Port 0) - testRunParseSuccess Port.parser "1234" (Port 1234) - testRunParseSuccess Port.parser "63174" (Port 63174) + testRunParseSuccess (Port.parser pure) "0" (Port 0) + testRunParseSuccess (Port.parser pure) "1234" (Port 1234) + testRunParseSuccess (Port.parser pure) "63174" (Port 63174) - suite "Fragment' parser" do - testRunParseSuccess (Fragment.parser Right) "#" "" + suite "Fragment parser" do + testRunParseSuccess (Fragment.parser pure) "#" (Fragment.fromString "") + testRunParseSuccess (Fragment.parser pure) "#foo" (Fragment.fromString "foo") + testRunParseSuccess (Fragment.parser pure) "#foo%23bar" (Fragment.fromString "foo#bar") + testRunParseSuccess (Fragment.parser pure) "#foo%23bar" (Fragment.unsafeFromString "foo%23bar") suite "Authority parser" do testRunParseSuccess (Authority.parser options) "//localhost" - (Authority Nothing [Tuple (NameAddress "localhost") Nothing]) + (Authority Nothing [Tuple (NameAddress (RegName.fromString "localhost")) Nothing]) testRunParseSuccess (Authority.parser options) "//localhost:3000" - (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 3000))]) + (Authority Nothing [Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 3000))]) suite "URIRef.parse" do testIsoURIRef @@ -171,7 +179,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) Nothing) Nothing Nothing)) @@ -181,7 +189,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "https") (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress "1a.example.com") Nothing)])) + (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "1a.example.com")) Nothing)])) Nothing) Nothing Nothing)) @@ -191,7 +199,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "http") (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress "en.wikipedia.org") Nothing])) + (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "en.wikipedia.org")) Nothing])) ((Just (Right ((rootDir dir "wiki") file "URI_scheme"))))) Nothing Nothing)) @@ -203,9 +211,9 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority - (Just (NU.UserInfo "foo:bar")) - [ Tuple (NameAddress "db1.example.net") Nothing - , Tuple (NameAddress "db2.example.net") (Just (Port 2500))])) + (Just (UserInfo.unsafeFromString "foo:bar")) + [ Tuple (NameAddress (RegName.fromString "db1.example.net")) Nothing + , Tuple (NameAddress (RegName.fromString "db2.example.net")) (Just (Port 2500))])) (Just (Right (rootDir file "authdb")))) (Just (NQ.Query @@ -217,7 +225,11 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just (NU.UserInfo "foo:bar")) [(Tuple (NameAddress "db1.example.net") (Just (Port 6))),(Tuple (NameAddress "db2.example.net") (Just (Port 2500)))])) + (Just + (Authority + (Just (UserInfo.unsafeFromString "foo:bar")) + [ (Tuple (NameAddress (RegName.fromString "db1.example.net")) (Just (Port 6))) + , (Tuple (NameAddress (RegName.fromString "db2.example.net")) (Just (Port 2500)))])) (Just (Right (rootDir file "authdb")))) (Just (NQ.Query (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) Nothing)) @@ -250,7 +262,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just(Authority (Just (NU.UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) Nothing) Nothing Nothing)) @@ -260,7 +272,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just (NU.UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) (Just (Left rootDir))) Nothing Nothing)) @@ -270,7 +282,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "mongodb") (HierarchicalPart - (Just (Authority (Just (NU.UserInfo "sysop:moon")) [(Tuple (NameAddress "localhost") Nothing)])) + (Just (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) (Just (Right (rootDir file "records")))) Nothing Nothing)) @@ -310,7 +322,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "ftp") (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress "ftp.is.co.za") Nothing)])) + (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "ftp.is.co.za")) Nothing)])) (Just (Right ((rootDir dir "rfc") file "rfc1808.txt")))) Nothing Nothing)) @@ -319,7 +331,9 @@ main = runTest $ suite "Data.URI" do (Left (URI (Scheme "http") - (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "www.ietf.org") Nothing)])) (Just (Right ((rootDir dir "rfc") file "rfc2396.txt")))) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "www.ietf.org")) Nothing)])) + (Just (Right ((rootDir dir "rfc") file "rfc2396.txt")))) Nothing Nothing)) testIsoURIRef @@ -347,24 +361,26 @@ main = runTest $ suite "Data.URI" do (Left (URI (Scheme "foo") - (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "example.com")) (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) (Just (NQ.Query (singleton (Tuple "name" (Just "ferret"))))) - (Just (NF.Fragment "nose")))) + (Just (Fragment.unsafeFromString "nose")))) testIsoURIRef "foo://example.com:8042/over/there?name=ferret#" (Left (URI (Scheme "foo") - (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress "example.com") (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) + (HierarchicalPart + (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "example.com")) (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) (Just (NQ.Query (singleton (Tuple "name" (Just "ferret"))))) - (Just (NF.Fragment "")))) + (Just (Fragment.unsafeFromString "")))) testIsoURIRef "foo://info.example.com?fred" (Left (URI (Scheme "foo") (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress "info.example.com") Nothing)])) + (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "info.example.com")) Nothing)])) Nothing) (Just (NQ.Query (singleton $ Tuple "fred" Nothing))) Nothing)) @@ -376,7 +392,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority - (Just (NU.UserInfo "cnn.example.com&story=breaking_news")) + (Just (UserInfo.unsafeFromString "cnn.example.com&story=breaking_news")) [(Tuple (IPv4Address "10.0.0.1") Nothing)])) (Just (Right (rootDir file "top_story.htm")))) Nothing @@ -409,7 +425,7 @@ main = runTest $ suite "Data.URI" do (Just (Authority Nothing - [(Tuple (NameAddress "localhost") Nothing)])) + [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) (Just (Right (rootDir file "testBucket")))) (Just (NQ.Query (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)))) testIso @@ -422,7 +438,7 @@ main = runTest $ suite "Data.URI" do (Just (Authority Nothing - [(Tuple (NameAddress "localhost") (Just (Port 99999)))])) + [(Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 99999)))])) (Just (Right (rootDir file "testBucket")))) (Just (NQ.Query (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)))) testIsoURIRef @@ -431,7 +447,7 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "http") (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress "www.example.com") Nothing])) + (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "www.example.com")) Nothing])) ((Just (Right ((rootDir dir "some invented") file "url with spaces.html"))))) Nothing Nothing)) @@ -441,20 +457,20 @@ main = runTest $ suite "Data.URI" do (URI (Scheme "http") (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress "localhost") (Just (Port 53174))])) + (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 53174))])) ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) (Just mempty) Nothing)) - -- testIsoURIRef - -- "../top_story.htm" - -- (Right - -- (RelativeRef - -- (RelativePart - -- Nothing - -- (Just (Right (parentDir' currentDir file "top_story.htm")))) - -- Nothing - -- Nothing)) + testIsoURIRef + "../top_story.htm" + (Right + (RelativeRef + (RelativePart + Nothing + (Just (Right (parentDir' currentDir file "top_story.htm")))) + Nothing + Nothing)) -- Not an iso in this case as the printed path is normalised -- testRunParseURIRefParses @@ -463,10 +479,10 @@ main = runTest $ suite "Data.URI" do -- (URI -- (Scheme "http") -- (HierarchicalPart - -- (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) + -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "local.)slamdata.com") Nothing])) -- ((Just (Left rootDir)))) -- ((Just mempty)) - -- ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) + -- ((Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214"))))) -- testPrinter -- URIRef.print -- "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" @@ -474,10 +490,10 @@ main = runTest $ suite "Data.URI" do -- (URI -- (Scheme "http") -- (HierarchicalPart - -- (Just (Authority Nothing [Tuple (NameAddress "local.slamdata.com") Nothing])) + -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "local.)slamdata.com") Nothing])) -- ((Just (Left rootDir)))) -- ((Just mempty)) - -- ((Just (Fragment "?sort=asc&q=path:/&salt=1177214"))))) + -- ((Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214"))))) -- testIsoURIRef -- "news:comp.infosystems.www.servers.unix" From 97534e6f15c57bd355c9d964b960cb500809eee9 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Feb 2018 12:33:49 +0000 Subject: [PATCH 13/69] Introduce encoded-value type for Query --- src/Data/URI.purs | 2 + src/Data/URI/AbsoluteURI.purs | 6 +- .../{Query.purs => QueryPairs.purs} | 38 +++---- src/Data/URI/Query.purs | 61 +++++++++-- src/Data/URI/RelativeRef.purs | 7 +- src/Data/URI/URI.purs | 6 +- src/Data/URI/URIRef.purs | 6 +- test/Main.purs | 102 ++++++++---------- 8 files changed, 135 insertions(+), 93 deletions(-) rename src/Data/URI/NonStandard/{Query.purs => QueryPairs.purs} (59%) diff --git a/src/Data/URI.purs b/src/Data/URI.purs index d6b8753..cfa77fd 100755 --- a/src/Data/URI.purs +++ b/src/Data/URI.purs @@ -7,6 +7,7 @@ module Data.URI , module Data.URI.Port , module Data.URI.RelativePart , module Data.URI.RelativeRef + , module Data.URI.Query , module Data.URI.Scheme , module Data.URI.URI , module Data.URI.URIRef @@ -21,6 +22,7 @@ import Data.URI.Fragment (Fragment) import Data.URI.Port (Port(..)) import Data.URI.RelativePart (RelativePart(..)) import Data.URI.RelativeRef (RelativeRef(..)) +import Data.URI.Query (Query) import Data.URI.Scheme (Scheme(..)) import Data.URI.URI (URI(..)) import Data.URI.URIRef (URIRef) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 0cfedfd..74a8728 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -9,6 +9,7 @@ module Data.URI.AbsoluteURI , _hierPart , _query , module Data.URI.HierarchicalPart + , module Data.URI.Query , module Data.URI.Scheme ) where @@ -26,6 +27,7 @@ import Data.String as String import Data.Tuple (Tuple) import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart +import Data.URI.Query (Query) import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) import Data.URI.Scheme as Scheme @@ -51,7 +53,7 @@ type AbsoluteURIParseOptions userInfo hosts host port hierPath query r = , parseHost ∷ Host → Either ParseError host , parsePort ∷ Port → Either ParseError port , parseHierPath ∷ String → Either ParseError hierPath - , parseQuery ∷ String → Either ParseError query + , parseQuery ∷ Query → Either ParseError query | r ) @@ -61,7 +63,7 @@ type AbsoluteURIPrintOptions userInfo hosts host port hierPath query r = , printHost ∷ host → Host , printPort ∷ port → Port , printHierPath ∷ hierPath → String - , printQuery ∷ query → String + , printQuery ∷ query → Query | r ) diff --git a/src/Data/URI/NonStandard/Query.purs b/src/Data/URI/NonStandard/QueryPairs.purs similarity index 59% rename from src/Data/URI/NonStandard/Query.purs rename to src/Data/URI/NonStandard/QueryPairs.purs index 1db25a1..c42e7e2 100644 --- a/src/Data/URI/NonStandard/Query.purs +++ b/src/Data/URI/NonStandard/QueryPairs.purs @@ -1,5 +1,5 @@ -module Data.URI.NonStandard.Query - ( Query(..) +module Data.URI.NonStandard.QueryPairs + ( QueryPairs(..) , parse , print ) where @@ -19,25 +19,25 @@ import Data.String as String import Data.String.Regex as RX import Data.String.Regex.Flags as RXF import Data.Tuple (Tuple(..)) +import Data.URI.Query as Q import Global (decodeURIComponent, encodeURIComponent) import Partial.Unsafe (unsafePartial) import Text.Parsing.StringParser (ParseError, Parser, runParser) import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy) import Text.Parsing.StringParser.String (regex, string) --- | The query component of a URI. -newtype Query = Query (List (Tuple String (Maybe String))) +newtype QueryPairs = QueryPairs (List (Tuple String (Maybe String))) -derive newtype instance eqQuery ∷ Eq Query -derive newtype instance ordQuery ∷ Ord Query -derive instance genericQuery ∷ Generic Query _ -derive instance newtypeQuery ∷ Newtype Query _ -instance showQuery ∷ Show Query where show = genericShow -derive newtype instance semigroupQuery ∷ Semigroup Query -derive newtype instance monoidQuery ∷ Monoid Query +derive newtype instance eqQueryPairs ∷ Eq QueryPairs +derive newtype instance ordQueryPairs ∷ Ord QueryPairs +derive instance genericQueryPairs ∷ Generic QueryPairs _ +derive instance newtypeQueryPairs ∷ Newtype QueryPairs _ +instance showQueryPairs ∷ Show QueryPairs where show = genericShow +derive newtype instance semigroupQueryPairs ∷ Semigroup QueryPairs +derive newtype instance monoidQueryPairs ∷ Monoid QueryPairs -parse ∷ String → Either ParseError Query -parse = runParser (Query <$> parseParts) +parse ∷ Q.Query → Either ParseError QueryPairs +parse = runParser (QueryPairs <$> parseParts) <<< Q.unsafeToString parseParts ∷ Parser (List (Tuple String (Maybe String))) parseParts = sepBy parsePart (string ";" <|> string "&") @@ -48,17 +48,17 @@ parsePart = do value ← optionMaybe $ decodeURIComponent <$> (string "=" *> regex "[^;&]*") pure $ Tuple key value -print ∷ Query → String -print (Query m) = String.joinWith "&" $ Array.fromFoldable (printPart <$> m) +print ∷ QueryPairs → Q.Query +print (QueryPairs m) = Q.unsafeFromString $ String.joinWith "&" $ Array.fromFoldable (printPart <$> m) where printPart ∷ Tuple String (Maybe String) → String printPart (Tuple k Nothing) = - printQueryPart k + printQueryPairsPart k printPart (Tuple k (Just v)) = - printQueryPart k <> "=" <> printQueryPart v + printQueryPairsPart k <> "=" <> printQueryPairsPart v -printQueryPart ∷ String → String -printQueryPart = String.joinWith "" <<< map printChar <<< String.split (String.Pattern "") +printQueryPairsPart ∷ String → String +printQueryPairsPart = String.joinWith "" <<< map printChar <<< String.split (String.Pattern "") where -- Fragments & queries have a bunch of characters that don't need escaping printChar ∷ String → String diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index fd1b040..cde21cd 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -1,21 +1,62 @@ -module Data.URI.Query where +module Data.URI.Query + ( Query + , fromString + , toString + , unsafeFromString + , unsafeToString + , parser + , print + ) where import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either) +import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (decodePCT, parsePChar, wrapParser) +import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded, wrapParser) +import Global (decodeURIComponent) import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.String (string) +import Text.Parsing.StringParser.String (char, string) -parser ∷ ∀ q. (String → Either ParseError q) → Parser q -parser parseQ = string "?" *> (wrapParser parseQ query) +newtype Query = Query String + +derive newtype instance eqQuery ∷ Eq Query +derive newtype instance ordQuery ∷ Ord Query +derive newtype instance semigroupQuery ∷ Semigroup Query +derive newtype instance monoidQuery ∷ Monoid Query + +instance showQuery ∷ Show Query where + show (Query s) = "(Query.unsafeFromString " <> show s <> ")" + +fromString ∷ String → Query +fromString = Query <<< printEncoded queryChar + +toString ∷ Query → String +toString (Query s) = decodeURIComponent s + +unsafeFromString ∷ String → Query +unsafeFromString = Query + +unsafeToString ∷ Query → String +unsafeToString (Query s) = s + +parser ∷ ∀ q. (Query → Either ParseError q) → Parser q +parser parseQ = + string "?" *> + wrapParser parseQ (Query <<< String.joinWith "" <$> Array.many p) where - query = - String.joinWith "" - <$> Array.many (parsePChar decodePCT <|> string "/" <|> string "?") + p = String.singleton <$> queryChar <|> newParsePCTEncoded + +print ∷ ∀ q. (q → Query) → q → String +print printQ q = "?" <> unsafeToString (printQ q) -print ∷ ∀ q. (q → String) → q → String -print printQ q = "?" <> printQ q +queryChar ∷ Parser Char +queryChar + = parseUnreserved + <|> parseSubDelims + <|> char ':' + <|> char '@' + <|> char '/' + <|> char '?' diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 1050feb..c45ec67 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -8,6 +8,8 @@ module Data.URI.RelativeRef , _relPart , _query , _fragment + , module Data.URI.Fragment + , module Data.URI.Query , module Data.URI.RelativePart ) where @@ -25,6 +27,7 @@ import Data.String as String import Data.Tuple (Tuple) import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment +import Data.URI.Query (Query) import Data.URI.Query as Query import Data.URI.RelativePart (Authority(..), Host(..), Port(..), RelativePart(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.RelativePart as RPart @@ -50,7 +53,7 @@ type RelativeRefParseOptions userInfo hosts host port relPath query fragment r = , parseHost ∷ Host → Either ParseError host , parsePort ∷ Port → Either ParseError port , parseRelPath ∷ String → Either ParseError relPath - , parseQuery ∷ String → Either ParseError query + , parseQuery ∷ Query → Either ParseError query , parseFragment ∷ Fragment → Either ParseError fragment | r ) @@ -61,7 +64,7 @@ type RelativeRefPrintOptions userInfo hosts host port relPath query fragment r = , printHost ∷ host → Host , printPort ∷ port → Port , printRelPath ∷ relPath → String - , printQuery ∷ query → String + , printQuery ∷ query → Query , printFragment ∷ fragment → Fragment | r ) diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 2e72ae7..374a56c 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -10,6 +10,7 @@ module Data.URI.URI , _query , _fragment , module Data.URI.HierarchicalPart + , module Data.URI.Query , module Data.URI.Scheme ) where @@ -29,6 +30,7 @@ import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart +import Data.URI.Query (Query) import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) import Data.URI.Scheme as Scheme @@ -54,7 +56,7 @@ type URIParseOptions userInfo hosts host port hierPath query fragment r = , parseHost ∷ Host → Either ParseError host , parsePort ∷ Port → Either ParseError port , parseHierPath ∷ String → Either ParseError hierPath - , parseQuery ∷ String → Either ParseError query + , parseQuery ∷ Query → Either ParseError query , parseFragment ∷ Fragment → Either ParseError fragment | r ) @@ -65,7 +67,7 @@ type URIPrintOptions userInfo hosts host port hierPath query fragment r = , printHost ∷ host → Host , printPort ∷ port → Port , printHierPath ∷ hierPath → String - , printQuery ∷ query → String + , printQuery ∷ query → Query , printFragment ∷ fragment → Fragment | r ) diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index 82e7585..c873386 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -9,6 +9,7 @@ module Data.URI.URIRef , module Data.URI.Fragment , module Data.URI.Host , module Data.URI.Port + , module Data.URI.Query , module Data.URI.UserInfo , module Data.URI.RelativeRef , module Data.URI.URI @@ -22,6 +23,7 @@ import Data.URI.Authority (Authority(..)) import Data.URI.Fragment (Fragment) import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) import Data.URI.Port (Port(..)) +import Data.URI.Query (Query) import Data.URI.RelativeRef (RelativeRef(..), RelativePart(..)) import Data.URI.RelativeRef as RelativeRef import Data.URI.URI (URI(..), HierarchicalPart(..)) @@ -46,7 +48,7 @@ type URIRefParseOptions userInfo hosts host port hierPath relPath query fragment , parsePort ∷ Port → Either ParseError port , parseRelPath ∷ String → Either ParseError relPath , parseHierPath ∷ String → Either ParseError hierPath - , parseQuery ∷ String → Either ParseError query + , parseQuery ∷ Query → Either ParseError query , parseFragment ∷ Fragment → Either ParseError fragment | r ) @@ -58,7 +60,7 @@ type URIRefPrintOptions userInfo hosts host port hierPath relPath query fragment , printPort ∷ port → Port , printRelPath ∷ relPath → String , printHierPath ∷ hierPath → String - , printQuery ∷ query → String + , printQuery ∷ query → Query , printFragment ∷ fragment → Fragment | r ) diff --git a/test/Main.purs b/test/Main.purs index c69499c..7ecf6ac 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -16,7 +16,7 @@ import Data.Monoid (mempty) import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) import Data.String as String import Data.Tuple (Tuple(..)) -import Data.URI (AbsoluteURI(..), Authority(..), HierarchicalPart(..), Host(..), Fragment, Port(..), RelativePart(..), RelativeRef(..), Scheme(..), URI(..), UserInfo) +import Data.URI (AbsoluteURI(..), Authority(..), HierarchicalPart(..), Host(..), Fragment, Port(..), RelativePart(..), RelativeRef(..), Query, Scheme(..), URI(..), UserInfo) import Data.URI.AbsoluteURI as AbsoluteURI import Data.URI.Authority as Authority import Data.URI.Fragment as Fragment @@ -24,7 +24,7 @@ import Data.URI.Host as Host import Data.URI.Host.RegName as RegName import Data.URI.Host.Gen as Host.Gen import Data.URI.NonStandard.Path as NP -import Data.URI.NonStandard.Query as NQ +import Data.URI.NonStandard.QueryPairs as NQP import Data.URI.Port as Port import Data.URI.Query as Query import Data.URI.Scheme as Scheme @@ -42,7 +42,7 @@ import Text.Parsing.StringParser (Parser, runParser) import Text.Parsing.StringParser.Combinators (sepBy) as SP import Text.Parsing.StringParser.String (string) as SP -options ∷ Record (URIRef.URIRefOptions UserInfo Array Host Port NP.URIPathAbs NP.URIPathRel NQ.Query Fragment) +options ∷ Record (URIRef.URIRefOptions UserInfo Array Host Port NP.URIPathAbs NP.URIPathRel Query Fragment) options = { parseUserInfo: pure , printUserInfo: id @@ -56,8 +56,8 @@ options = , printHierPath: NP.printPath , parseRelPath: NP.parseURIPathRel , printRelPath: NP.printPath - , parseQuery: NQ.parse - , printQuery: NQ.print + , parseQuery: pure + , printQuery: id , parseFragment: pure , printFragment: id } @@ -79,10 +79,10 @@ testIso p f uri expected = do testRunParseSuccess p uri expected testPrinter f uri expected -testIsoURI :: forall a. String -> URI.URI UserInfo Array Host Port NP.URIPathAbs NQ.Query Fragment -> TestSuite a +testIsoURI :: forall a. String -> URI.URI UserInfo Array Host Port NP.URIPathAbs Query Fragment -> TestSuite a testIsoURI = testIso (URI.parser options) (URI.print options) -testIsoURIRef :: forall a. String -> URIRef.URIRef UserInfo Array Host Port NP.URIPathAbs NP.URIPathRel NQ.Query Fragment -> TestSuite a +testIsoURIRef :: forall a. String -> URIRef.URIRef UserInfo Array Host Port NP.URIPathAbs NP.URIPathRel Query Fragment -> TestSuite a testIsoURIRef = testIso (URIRef.parser options) (URIRef.print options) -- testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a @@ -94,18 +94,6 @@ testRunParseURIRefFails uri = ("fails to parse: " <> uri) (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParser (URIRef.parser options) $ uri) -testPrintQuerySerializes :: forall a. NQ.Query -> String -> TestSuite a -testPrintQuerySerializes query expected = - test - ("serializes: " <> show query) - (equal expected (Query.print NQ.print query)) - -testParseQueryParses :: forall a. String -> NQ.Query -> TestSuite a -testParseQueryParses uri query = - test - ("parses: \"" <> uri <> "\"") - (equal (Right query) (runParser (Query.parser NQ.parse) uri)) - main :: forall eff. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR, exception :: EXCEPTION, random :: RANDOM | eff) Unit main = runTest $ suite "Data.URI" do @@ -171,7 +159,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [])) (Just (Left rootDir))) - (Just (NQ.Query (Tuple "q" (Just "foo") : Tuple "var.bar" (Just "baz") : Nil))) + (Just (Query.unsafeFromString "q=foo&var.bar=baz")) Nothing)) testIsoURIRef "mongodb://localhost" @@ -215,9 +203,7 @@ main = runTest $ suite "Data.URI" do [ Tuple (NameAddress (RegName.fromString "db1.example.net")) Nothing , Tuple (NameAddress (RegName.fromString "db2.example.net")) (Just (Port 2500))])) (Just (Right (rootDir file "authdb")))) - (Just - (NQ.Query - (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) + (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) Nothing)) testIsoURIRef "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" @@ -231,7 +217,7 @@ main = runTest $ suite "Data.URI" do [ (Tuple (NameAddress (RegName.fromString "db1.example.net")) (Just (Port 6))) , (Tuple (NameAddress (RegName.fromString "db2.example.net")) (Just (Port 2500)))])) (Just (Right (rootDir file "authdb")))) - (Just (NQ.Query (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil))) + (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) Nothing)) testIsoURIRef "mongodb://192.168.0.1" @@ -344,7 +330,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::7") Nothing)])) (Just (Right (rootDir file "c=GB")))) - (Just (NQ.Query (singleton $ (Tuple "objectClass?one" Nothing)))) + (Just (Query.unsafeFromString "objectClass?one")) Nothing)) testIsoURIRef "telnet://192.0.2.16:80/" @@ -363,7 +349,7 @@ main = runTest $ suite "Data.URI" do (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "example.com")) (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) - (Just (NQ.Query (singleton (Tuple "name" (Just "ferret"))))) + (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "nose")))) testIsoURIRef "foo://example.com:8042/over/there?name=ferret#" @@ -372,7 +358,7 @@ main = runTest $ suite "Data.URI" do (Scheme "foo") (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "example.com")) (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) - (Just (NQ.Query (singleton (Tuple "name" (Just "ferret"))))) + (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "")))) testIsoURIRef "foo://info.example.com?fred" @@ -382,7 +368,7 @@ main = runTest $ suite "Data.URI" do (HierarchicalPart (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "info.example.com")) Nothing)])) Nothing) - (Just (NQ.Query (singleton $ Tuple "fred" Nothing))) + (Just (Query.unsafeFromString "fred")) Nothing)) testIsoURIRef "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" @@ -427,7 +413,7 @@ main = runTest $ suite "Data.URI" do Nothing [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) (Just (Right (rootDir file "testBucket")))) - (Just (NQ.Query (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)))) + (Just (Query.unsafeFromString "password=&docTypeKey="))) testIso (AbsoluteURI.parser options) (AbsoluteURI.print options) @@ -440,7 +426,7 @@ main = runTest $ suite "Data.URI" do Nothing [(Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 99999)))])) (Just (Right (rootDir file "testBucket")))) - (Just (NQ.Query (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)))) + (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) testIsoURIRef "http://www.example.com/some%20invented/url%20with%20spaces.html" (Left @@ -546,37 +532,41 @@ main = runTest $ suite "Data.URI" do -- Nothing -- Nothing)) - suite "Query.print" do - testPrintQuerySerializes - (NQ.Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + suite "QueryPairs printer/parser" do + let testQueryIso = testIso (Query.parser NQP.parse) (Query.print NQP.print) + testQueryIso "?key1=value1&key2=value2&key1=value3" - testPrintQuerySerializes - (NQ.Query (Tuple "k=ey" (Just "value=1") : Nil)) + (NQP.QueryPairs (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + testQueryIso "?k%3Dey=value%3D1" - testPrintQuerySerializes (NQ.Query Nil) "?" - testPrintQuerySerializes - (NQ.Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + (NQP.QueryPairs (Tuple "k=ey" (Just "value=1") : Nil)) + testQueryIso + "?" + (NQP.QueryPairs Nil) + testQueryIso "?key1=&key2=" - testPrintQuerySerializes - (NQ.Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + (NQP.QueryPairs (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + testQueryIso "?key1&key2" - testPrintQuerySerializes - (NQ.Query (Tuple "key1" (Just "foo;bar") : Nil)) - "?key1=foo%3Bbar" - - suite "Query.parser" do - testParseQueryParses - "?key1=value1&key2=value2&key1=value3" - (NQ.Query (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) - testParseQueryParses - "?key1&key2" - (NQ.Query (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) - testParseQueryParses - "?key1=&key2=" - (NQ.Query (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) - testParseQueryParses + (NQP.QueryPairs (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + testQueryIso "?key1=foo%3Bbar" - (NQ.Query (Tuple "key1" (Just "foo;bar") : Nil)) + (NQP.QueryPairs (Tuple "key1" (Just "foo;bar") : Nil)) + testQueryIso + "?replicaSet=test&connectTimeoutMS=300000" + (NQP.QueryPairs (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil)) + testQueryIso + "?fred" + (NQP.QueryPairs (pure (Tuple "fred" Nothing))) + testQueryIso + "?objectClass?one" + (NQP.QueryPairs (pure (Tuple "objectClass?one" Nothing))) + testQueryIso + "?password=&docTypeKey=" + (NQP.QueryPairs (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)) + testQueryIso + "?password=pass&docTypeKey=type&queryTimeoutSeconds=20" + (NQP.QueryPairs (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)) forAll :: forall eff prop. QC.Testable prop => QCG.Gen prop -> Test (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) forAll = quickCheck From 97304515c2857af37fec582cfb7824cc8d1b40b9 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sat, 3 Feb 2018 19:34:41 +0000 Subject: [PATCH 14/69] Split up tests, update path representation --- src/Data/URI.purs | 20 +- src/Data/URI/AbsoluteURI.purs | 54 +-- src/Data/URI/Common.purs | 30 +- src/Data/URI/HierarchicalPart.purs | 122 +++-- src/Data/URI/NonStandard/Path.purs | 55 --- src/Data/URI/Path.purs | 64 +-- src/Data/URI/Path/Absolute.purs | 41 ++ src/Data/URI/Path/NoScheme.purs | 33 ++ src/Data/URI/Path/Rootless.purs | 32 ++ src/Data/URI/Path/Segment.purs | 118 +++++ src/Data/URI/RelativePart.purs | 122 +++-- src/Data/URI/RelativeRef.purs | 54 +-- src/Data/URI/URI.purs | 58 +-- src/Data/URI/URIRef.purs | 54 ++- test/Main.purs | 640 +++------------------------ test/URI/Authority.purs | 76 ++++ test/URI/Fragment.purs | 15 + test/URI/Host.purs | 37 ++ test/URI/NonStandard/QueryPairs.purs | 70 +++ test/URI/Path.purs | 14 + test/URI/Port.purs | 15 + test/URI/Scheme.purs | 14 + test/URI/URIRef.purs | 539 ++++++++++++++++++++++ test/URI/UserInfo.purs | 16 + test/Util.purs | 47 ++ 25 files changed, 1436 insertions(+), 904 deletions(-) delete mode 100644 src/Data/URI/NonStandard/Path.purs create mode 100644 src/Data/URI/Path/Absolute.purs create mode 100644 src/Data/URI/Path/NoScheme.purs create mode 100644 src/Data/URI/Path/Rootless.purs create mode 100644 src/Data/URI/Path/Segment.purs create mode 100644 test/URI/Authority.purs create mode 100644 test/URI/Fragment.purs create mode 100644 test/URI/Host.purs create mode 100644 test/URI/NonStandard/QueryPairs.purs create mode 100644 test/URI/Path.purs create mode 100644 test/URI/Port.purs create mode 100644 test/URI/Scheme.purs create mode 100644 test/URI/URIRef.purs create mode 100644 test/URI/UserInfo.purs create mode 100644 test/Util.purs diff --git a/src/Data/URI.purs b/src/Data/URI.purs index cfa77fd..fbe11df 100755 --- a/src/Data/URI.purs +++ b/src/Data/URI.purs @@ -1,13 +1,17 @@ module Data.URI ( module Data.URI.AbsoluteURI , module Data.URI.Authority + , module Data.URI.Fragment , module Data.URI.HierarchicalPart , module Data.URI.Host - , module Data.URI.Fragment + , module Data.URI.Path + , module Data.URI.Path.Absolute + , module Data.URI.Path.NoScheme + , module Data.URI.Path.Rootless , module Data.URI.Port + , module Data.URI.Query , module Data.URI.RelativePart , module Data.URI.RelativeRef - , module Data.URI.Query , module Data.URI.Scheme , module Data.URI.URI , module Data.URI.URIRef @@ -16,13 +20,17 @@ module Data.URI import Data.URI.AbsoluteURI (AbsoluteURI(..)) import Data.URI.Authority (Authority(..)) -import Data.URI.HierarchicalPart (HierarchicalPart(..)) -import Data.URI.Host (Host(..), RegName) import Data.URI.Fragment (Fragment) +import Data.URI.HierarchicalPart (HierarchicalPart(..), HierPath) +import Data.URI.Host (Host(..), RegName) +import Data.URI.Path (Path(..)) +import Data.URI.Path.Absolute (PathAbsolute(..)) +import Data.URI.Path.NoScheme (PathNoScheme(..)) +import Data.URI.Path.Rootless (PathRootless(..)) import Data.URI.Port (Port(..)) -import Data.URI.RelativePart (RelativePart(..)) -import Data.URI.RelativeRef (RelativeRef(..)) import Data.URI.Query (Query) +import Data.URI.RelativePart (RelativePart(..), RelPath) +import Data.URI.RelativeRef (RelativeRef(..)) import Data.URI.Scheme (Scheme(..)) import Data.URI.URI (URI(..)) import Data.URI.URIRef (URIRef) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 74a8728..03d453d 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -25,7 +25,7 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), Path, PathAbsolute, PathRootless, Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query (Query) import Data.URI.Query as Query @@ -36,41 +36,43 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A generic AbsoluteURI -data AbsoluteURI userInfo hosts host port hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts host port hierPath) (Maybe query) +data AbsoluteURI userInfo hosts host port path hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts host port path hierPath) (Maybe query) -derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts host port hierPath query) -derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hosts host port hierPath query) -derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts host port hierPath query) _ -instance showAbsoluteURI ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts host port hierPath query) where show = genericShow +derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts host port path hierPath query) +derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hosts host port path hierPath query) +derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts host port path hierPath query) _ +instance showAbsoluteURI ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show path, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts host port path hierPath query) where show = genericShow -type AbsoluteURIOptions userInfo hosts host port hierPath query = - AbsoluteURIParseOptions userInfo hosts host port hierPath query - (AbsoluteURIPrintOptions userInfo hosts host port hierPath query ()) +type AbsoluteURIOptions userInfo hosts host port path hierPath query = + AbsoluteURIParseOptions userInfo hosts host port path hierPath query + (AbsoluteURIPrintOptions userInfo hosts host port path hierPath query ()) -type AbsoluteURIParseOptions userInfo hosts host port hierPath query r = +type AbsoluteURIParseOptions userInfo hosts host port path hierPath query r = ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) , parseHost ∷ Host → Either ParseError host , parsePort ∷ Port → Either ParseError port - , parseHierPath ∷ String → Either ParseError hierPath + , parsePath ∷ Path → Either ParseError path + , parseHierPath ∷ Either PathAbsolute PathRootless → Either ParseError hierPath , parseQuery ∷ Query → Either ParseError query | r ) -type AbsoluteURIPrintOptions userInfo hosts host port hierPath query r = +type AbsoluteURIPrintOptions userInfo hosts host port path hierPath query r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String , printHost ∷ host → Host , printPort ∷ port → Port - , printHierPath ∷ hierPath → String + , printPath ∷ path → Path + , printHierPath ∷ hierPath → Either PathAbsolute PathRootless , printQuery ∷ query → Query | r ) parser - ∷ ∀ userInfo hosts host port hierPath query r - . Record (AbsoluteURIParseOptions userInfo hosts host port hierPath query r) - → Parser (AbsoluteURI userInfo hosts host port hierPath query) + ∷ ∀ userInfo hosts host port path hierPath query r + . Record (AbsoluteURIParseOptions userInfo hosts host port path hierPath query r) + → Parser (AbsoluteURI userInfo hosts host port path hierPath query) parser opts = AbsoluteURI <$> Scheme.parser <*> HPart.parser opts @@ -78,10 +80,10 @@ parser opts = AbsoluteURI <* eof print - ∷ ∀ userInfo hosts host port hierPath query r + ∷ ∀ userInfo hosts host port path hierPath query r . Functor hosts - ⇒ Record (AbsoluteURIPrintOptions userInfo hosts host port hierPath query r) - → AbsoluteURI userInfo hosts host port hierPath query + ⇒ Record (AbsoluteURIPrintOptions userInfo hosts host port path hierPath query r) + → AbsoluteURI userInfo hosts host port path hierPath query → String print opts (AbsoluteURI s h q) = String.joinWith "" $ Array.catMaybes @@ -91,9 +93,9 @@ print opts (AbsoluteURI s h q) = ] _scheme - ∷ ∀ userInfo hosts host port hierPath query + ∷ ∀ userInfo hosts host port path hierPath query . Lens' - (AbsoluteURI userInfo hosts host port hierPath query) + (AbsoluteURI userInfo hosts host port path hierPath query) Scheme _scheme = lens @@ -101,19 +103,19 @@ _scheme = (\(AbsoluteURI _ h q) s → AbsoluteURI s h q) _hierPart - ∷ ∀ userInfo hosts host port hierPath query + ∷ ∀ userInfo hosts host port path hierPath query . Lens' - (AbsoluteURI userInfo hosts host port hierPath query) - (HierarchicalPart userInfo hosts host port hierPath) + (AbsoluteURI userInfo hosts host port path hierPath query) + (HierarchicalPart userInfo hosts host port path hierPath) _hierPart = lens (\(AbsoluteURI _ h _) → h) (\(AbsoluteURI s _ q) h → AbsoluteURI s h q) _query - ∷ ∀ userInfo hosts host port hierPath query + ∷ ∀ userInfo hosts host port path hierPath query . Lens' - (AbsoluteURI userInfo hosts host port hierPath query) + (AbsoluteURI userInfo hosts host port path hierPath query) (Maybe query) _query = lens diff --git a/src/Data/URI/Common.purs b/src/Data/URI/Common.purs index be96df5..92a61fc 100644 --- a/src/Data/URI/Common.purs +++ b/src/Data/URI/Common.purs @@ -1,10 +1,6 @@ module Data.URI.Common ( wrapParser - , parsePChar , parseUnreserved - , PCTEncoded - , decodePCT - , parsePCTEncoded , newParsePCTEncoded , parseSubDelims , printEncoded @@ -16,9 +12,9 @@ import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either(..), either) import Data.String as String -import Global (decodeURI, encodeURIComponent) +import Global (encodeURIComponent) import Text.Parsing.StringParser (ParseError, Parser(..), runParser, unParser) -import Text.Parsing.StringParser.String (alphaNum, anyChar, char, eof, oneOf, string) +import Text.Parsing.StringParser.String (alphaNum, anyChar, char, eof, oneOf) wrapParser ∷ ∀ a b. (a → Either ParseError b) → Parser a → Parser b wrapParser parseA p = Parser \ps → do @@ -27,14 +23,6 @@ wrapParser parseA p = Parser \ps → do Left error → Left { error, pos: ps.pos } Right result → Right { result, suffix: pr.suffix } -parsePChar ∷ (PCTEncoded → String) → Parser String -parsePChar f - = String.singleton <$> parseUnreserved - <|> parsePCTEncoded f - <|> String.singleton <$> parseSubDelims - <|> string ":" - <|> string "@" - parseUnreserved ∷ Parser Char parseUnreserved = alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~' @@ -50,20 +38,6 @@ parseSubDelims = -- TODO: resolve the `,` situation oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', {- ',', -} ';', '='] -newtype PCTEncoded = PCTEncoded String - -decodePCT ∷ PCTEncoded → String -decodePCT (PCTEncoded s) = decodeURI s - -parsePCTEncoded ∷ (PCTEncoded → String) → Parser String -parsePCTEncoded f = f <<< PCTEncoded <$> parseHex - where - parseHex = String.joinWith "" <$> Array.some do - d0 ← char '%' - d1 ← alphaNum - d2 ← alphaNum - pure $ String.fromCharArray [d0, d1, d2] - printEncoded ∷ Parser Char → String → String printEncoded p s = either (const s) id (runParser parse s) where diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index 8b00576..0a66b38 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -3,106 +3,132 @@ module Data.URI.HierarchicalPart , HierarchicalPartOptions , HierarchicalPartParseOptions , HierarchicalPartPrintOptions + , HierPath , parser , print , _authority , _path + , _hierPath , module Data.URI.Authority + , module Data.URI.Path + , module Data.URI.Path.Absolute + , module Data.URI.Path.Rootless ) where import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Either (Either) +import Data.Either (Either(..), either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) -import Data.Lens (Lens', lens) -import Data.Maybe (Maybe(..)) +import Data.Lens (Traversal', wander) +import Data.Maybe (Maybe(..), maybe) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) import Data.URI.Authority (Authority(..), Host(..), Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority +import Data.URI.Path (Path) import Data.URI.Path as Path +import Data.URI.Path.Absolute (PathAbsolute) +import Data.URI.Path.Absolute as PathAbs +import Data.URI.Path.Rootless (PathRootless) +import Data.URI.Path.Rootless as PathRootless import Text.Parsing.StringParser (ParseError, Parser) +import Text.Parsing.StringParser.Combinators (optionMaybe) -- | The "hierarchical part" of a generic or absolute URI. -data HierarchicalPart userInfo hosts host port hierPath = HierarchicalPart (Maybe (Authority userInfo hosts host port)) (Maybe hierPath) +data HierarchicalPart userInfo hosts host port path hierPath + = HierarchicalPartAuth (Authority userInfo hosts host port) (Maybe path) + | HierarchicalPartNoAuth (Maybe hierPath) -derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hosts host port hierPath) -derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hosts host port hierPath) -derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts host port hierPath) _ -instance showHierarchicalPart ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts host port hierPath) where show = genericShow +derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hosts host port path hierPath) +derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hosts host port path hierPath) +derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts host port path hierPath) _ +instance showHierarchicalPart ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show path, Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts host port path hierPath) where show = genericShow -type HierarchicalPartOptions userInfo hosts host port hierPath = - HierarchicalPartParseOptions userInfo hosts host port hierPath - (HierarchicalPartPrintOptions userInfo hosts host port hierPath ()) +type HierarchicalPartOptions userInfo hosts host port path hierPath = + HierarchicalPartParseOptions userInfo hosts host port path hierPath + (HierarchicalPartPrintOptions userInfo hosts host port path hierPath ()) -type HierarchicalPartParseOptions userInfo hosts host port hierPath r = +type HierarchicalPartParseOptions userInfo hosts host port path hierPath r = ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) , parseHost ∷ Host → Either ParseError host , parsePort ∷ Port → Either ParseError port - , parseHierPath ∷ String → Either ParseError hierPath + , parsePath ∷ Path → Either ParseError path + , parseHierPath ∷ HierPath → Either ParseError hierPath | r ) -type HierarchicalPartPrintOptions userInfo hosts host port hierPath r = +type HierarchicalPartPrintOptions userInfo hosts host port path hierPath r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String , printHost ∷ host → Host , printPort ∷ port → Port - , printHierPath ∷ hierPath → String + , printPath ∷ path → Path + , printHierPath ∷ hierPath → HierPath | r ) +type HierPath = Either PathAbsolute PathRootless + parser - ∷ ∀ userInfo hosts host port hierPath r - . Record (HierarchicalPartParseOptions userInfo hosts host port hierPath r) - → Parser (HierarchicalPart userInfo hosts host port hierPath) + ∷ ∀ userInfo hosts host port path hierPath r + . Record (HierarchicalPartParseOptions userInfo hosts host port path hierPath r) + → Parser (HierarchicalPart userInfo hosts host port path hierPath) parser opts = withAuth <|> withoutAuth where withAuth = - HierarchicalPart <<< Just + HierarchicalPartAuth <$> Authority.parser opts - <*> Path.parsePathAbEmpty opts.parseHierPath - - withoutAuth = HierarchicalPart Nothing <$> noAuthPath - + <*> optionMaybe (Path.parser opts.parsePath) + withoutAuth = + HierarchicalPartNoAuth <$> noAuthPath noAuthPath - = (Just <$> Path.parsePathAbsolute opts.parseHierPath) - <|> (Just <$> Path.parsePathRootless opts.parseHierPath) + = (Just <$> PathAbs.parse (opts.parseHierPath <<< Left)) + <|> (Just <$> PathRootless.parse (opts.parseHierPath <<< Right)) <|> pure Nothing print - ∷ ∀ userInfo hosts host port hierPath r + ∷ ∀ userInfo hosts host port path hierPath r . Functor hosts - ⇒ Record (HierarchicalPartPrintOptions userInfo hosts host port hierPath r) - → HierarchicalPart userInfo hosts host port hierPath → String -print opts (HierarchicalPart a p) = - String.joinWith "" $ Array.catMaybes - [ Authority.print opts <$> a - , opts.printHierPath <$> p - ] + ⇒ Record (HierarchicalPartPrintOptions userInfo hosts host port path hierPath r) + → HierarchicalPart userInfo hosts host port path hierPath → String +print opts = case _ of + HierarchicalPartAuth a p → + String.joinWith "" $ Array.catMaybes + [ pure $ Authority.print opts a + , Path.print <<< opts.printPath <$> p + ] + HierarchicalPartNoAuth p → + maybe "" (either PathAbs.print PathRootless.print <<< opts.printHierPath) p _authority - ∷ ∀ userInfo hosts host port hierPath - . Lens' - (HierarchicalPart userInfo hosts host port hierPath) - (Maybe (Authority userInfo hosts host port)) -_authority = - lens - (\(HierarchicalPart a _) → a) - (\(HierarchicalPart _ p) a → HierarchicalPart a p) + ∷ ∀ userInfo hosts host port path hierPath + . Traversal' + (HierarchicalPart userInfo hosts host port path hierPath) + (Authority userInfo hosts host port) +_authority = wander \f a → case a of + HierarchicalPartAuth a p → flip HierarchicalPartAuth p <$> f a + _ → pure a _path - ∷ ∀ userInfo hosts host port hierPath - . Lens' - (HierarchicalPart userInfo hosts host port hierPath) + ∷ ∀ userInfo hosts host port path hierPath + . Traversal' + (HierarchicalPart userInfo hosts host port path hierPath) + (Maybe path) +_path = wander \f a → case a of + HierarchicalPartAuth a p → HierarchicalPartAuth a <$> f p + _ → pure a + +_hierPath + ∷ ∀ userInfo hosts host port path hierPath + . Traversal' + (HierarchicalPart userInfo hosts host port path hierPath) (Maybe hierPath) -_path = - lens - (\(HierarchicalPart _ p) → p) - (\(HierarchicalPart a _) p → HierarchicalPart a p) +_hierPath = wander \f a → case a of + HierarchicalPartNoAuth p → HierarchicalPartNoAuth <$> f p + _ → pure a diff --git a/src/Data/URI/NonStandard/Path.purs b/src/Data/URI/NonStandard/Path.purs deleted file mode 100644 index 45ece1d..0000000 --- a/src/Data/URI/NonStandard/Path.purs +++ /dev/null @@ -1,55 +0,0 @@ -module Data.URI.NonStandard.Path - ( URIPath - , URIPathAbs - , URIPathRel - , parseURIPathAbs - , parseURIPathRel - , printPath - ) where - -import Prelude - -import Data.Either (Either(..), either) -import Data.Maybe (Maybe(..), fromMaybe) -import Data.Path.Pathy (Abs, Dir, Escaper(..), File, Path, Rel, Sandboxed, Unsandboxed, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile, rootDir, sandbox, unsafePrintPath', ()) -import Data.String as String -import Global (encodeURI) -import Text.Parsing.StringParser (ParseError(..)) - --- | A general URI path, can be used to represent relative or absolute paths --- | that are sandboxed or unsandboxed. -type URIPath a s = Either (Path a Dir s) (Path a File s) - --- | The path part for a generic or absolute URI. -type URIPathAbs = URIPath Abs Sandboxed - --- | The path part for a relative reference. -type URIPathRel = URIPath Rel Unsandboxed - -parseURIPathAbs ∷ String → Either ParseError URIPathAbs -parseURIPathAbs str = - case sandbox rootDir =<< parseAbsFile str of - Just file → Right $ Right (rootDir file) - Nothing → case sandbox rootDir =<< parseAbsDir str of - Just dir → Right $ Left (rootDir dir) - Nothing → Left (ParseError "Expected a valid path") - -parseURIPathRel ∷ String → Either ParseError URIPathRel -parseURIPathRel str = - case parseRelFile str of - Just file → Right (Right file) - Nothing → case parseRelDir str of - Just dir → Right (Left dir) - Nothing → Left (ParseError "Expected a valid path") - -printPath ∷ ∀ a s. URIPath a s → String -printPath = either printPath' printPath' - -printPath' ∷ ∀ a' b s'. Path a' b s' → String -printPath' path = - let printed = unsafePrintPath' escaper path - in fromMaybe printed $ String.stripPrefix (String.Pattern "./") printed - -escaper ∷ Escaper -escaper = Escaper $ - String.replaceAll (String.Pattern "#") (String.Replacement "%23") <<< encodeURI diff --git a/src/Data/URI/Path.purs b/src/Data/URI/Path.purs index 0a754cc..cbc3bdc 100644 --- a/src/Data/URI/Path.purs +++ b/src/Data/URI/Path.purs @@ -2,63 +2,25 @@ module Data.URI.Path where import Prelude -import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either) -import Data.Maybe (Maybe(..)) -import Data.Monoid (class Monoid) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) import Data.String as String -import Data.URI.Common (PCTEncoded, decodePCT, parsePCTEncoded, parsePChar, parseSubDelims, parseUnreserved, wrapParser) +import Data.URI.Common (wrapParser) +import Data.URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (string) -parsePath ∷ ∀ p. (String → Either ParseError p) → Parser (Maybe p) -parsePath p - = parsePathAbEmpty p - <|> (Just <$> parsePathAbsolute p) - <|> (Just <$> parsePathNoScheme p) - <|> (Just <$> parsePathRootless p) - <|> pure Nothing +newtype Path = Path (Array PathSegment) -parsePathAbEmpty ∷ ∀ p. (String → Either ParseError p) → Parser (Maybe p) -parsePathAbEmpty p = - optionMaybe $ wrapParser p do - parts ← Array.some (string "/" *> parseSegment) - pure ("/" <> String.joinWith "/" parts) +derive newtype instance eqPath ∷ Eq Path +derive newtype instance ordPath ∷ Ord Path +derive instance genericPath ∷ Generic Path _ +instance showPath ∷ Show Path where show = genericShow -parsePathAbsolute ∷ ∀ p. (String → Either ParseError p) → Parser p -parsePathAbsolute p = wrapParser p $ do - _ ← string "/" - start ← parseSegmentNonZero - rest ← String.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment) - pure $ "/" <> start <> rest +parser ∷ ∀ p. (Path → Either ParseError p) → Parser p +parser p = wrapParser p $ Path <$> Array.some (string "/" *> parseSegment) -parsePathNoScheme ∷ ∀ p. (String → Either ParseError p) → Parser p -parsePathNoScheme p = wrapParser p $ - append - <$> parseSegmentNonZeroNoColon - <*> (String.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment)) - -parsePathRootless ∷ ∀ p. (String → Either ParseError p) → Parser p -parsePathRootless p = wrapParser p $ - append - <$> parseSegmentNonZero - <*> (String.joinWith "" <$> Array.many (append <$> string "/" <*> parseSegment)) - -parseSegment ∷ Parser String -parseSegment = String.joinWith "" <$> Array.many (parsePChar decoder) - -parseSegmentNonZero ∷ Parser String -parseSegmentNonZero = String.joinWith "" <$> Array.some (parsePChar decoder) - -parseSegmentNonZeroNoColon ∷ Parser String -parseSegmentNonZeroNoColon = - String.joinWith "" <$> Array.some - (String.singleton <$> parseUnreserved <|> parsePCTEncoded decoder <|> String.singleton <$> parseSubDelims <|> string "@") - -decoder ∷ PCTEncoded → String -decoder = String.replaceAll (String.Pattern "%23") (String.Replacement "#") <<< decodePCT - -printPath ∷ ∀ p. (p → String) → p → String -printPath = id +print ∷ Path → String +print (Path segs) = "/" <> String.joinWith "/" (map unsafeSegmentToString segs) diff --git a/src/Data/URI/Path/Absolute.purs b/src/Data/URI/Path/Absolute.purs new file mode 100644 index 0000000..5acd4d2 --- /dev/null +++ b/src/Data/URI/Path/Absolute.purs @@ -0,0 +1,41 @@ +module Data.URI.Path.Absolute where + +import Prelude + +import Data.Array as Array +import Data.Either (Either) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Maybe (Maybe(..)) +import Data.String as String +import Data.Tuple (Tuple(..)) +import Data.URI.Common (wrapParser) +import Data.URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) +import Text.Parsing.StringParser (ParseError, Parser) +import Text.Parsing.StringParser.Combinators (optionMaybe) +import Text.Parsing.StringParser.String (string) + +newtype PathAbsolute = PathAbsolute (Maybe (Tuple PathSegmentNZ (Array PathSegment))) + +derive instance eqPathAbsolute ∷ Eq PathAbsolute +derive instance ordPathAbsolute ∷ Ord PathAbsolute +derive instance genericPathAbsolute ∷ Generic PathAbsolute _ +instance showPathAbsolute ∷ Show PathAbsolute where show = genericShow + +parse ∷ ∀ p. (PathAbsolute → Either ParseError p) → Parser p +parse p = wrapParser p do + _ ← string "/" + optionMaybe parseSegmentNonZero >>= case _ of + Just head → + PathAbsolute <<< Just <<< Tuple head <$> Array.many (string "/" *> parseSegment) + Nothing → + pure (PathAbsolute Nothing) + +print ∷ PathAbsolute → String +print = case _ of + PathAbsolute Nothing → + "/" + PathAbsolute (Just (Tuple head tail)) → + "/" + <> unsafeSegmentNZToString head + <> String.joinWith "/" (map unsafeSegmentToString tail) diff --git a/src/Data/URI/Path/NoScheme.purs b/src/Data/URI/Path/NoScheme.purs new file mode 100644 index 0000000..90d1584 --- /dev/null +++ b/src/Data/URI/Path/NoScheme.purs @@ -0,0 +1,33 @@ +module Data.URI.Path.NoScheme where + +import Prelude + +import Data.Array as Array +import Data.Either (Either) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.String as String +import Data.Tuple (Tuple(..)) +import Data.URI.Common (wrapParser) +import Data.URI.Path.Segment (PathSegment, PathSegmentNZNC, parseSegment, parseSegmentNonZeroNoColon, unsafeSegmentNZNCToString, unsafeSegmentToString) +import Text.Parsing.StringParser (ParseError, Parser) +import Text.Parsing.StringParser.String (char) + +newtype PathNoScheme = PathNoScheme (Tuple PathSegmentNZNC (Array PathSegment)) + +derive instance eqPathNoScheme ∷ Eq PathNoScheme +derive instance ordPathNoScheme ∷ Ord PathNoScheme +derive instance genericPathNoScheme ∷ Generic PathNoScheme _ +instance showPathNoScheme ∷ Show PathNoScheme where show = genericShow + +parse ∷ ∀ p. (PathNoScheme → Either ParseError p) → Parser p +parse p = wrapParser p do + head ← parseSegmentNonZeroNoColon + tail ← Array.many (char '/' *> parseSegment) + pure (PathNoScheme (Tuple head tail)) + +print ∷ PathNoScheme → String +print (PathNoScheme (Tuple head tail)) = + case tail of + [] → unsafeSegmentNZNCToString head + ps → unsafeSegmentNZNCToString head <> "/" <> String.joinWith "/" (map unsafeSegmentToString tail) diff --git a/src/Data/URI/Path/Rootless.purs b/src/Data/URI/Path/Rootless.purs new file mode 100644 index 0000000..2da94f4 --- /dev/null +++ b/src/Data/URI/Path/Rootless.purs @@ -0,0 +1,32 @@ +module Data.URI.Path.Rootless where + +import Prelude + +import Data.Array as Array +import Data.Either (Either) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.String as String +import Data.Tuple (Tuple(..)) +import Data.URI.Common (wrapParser) +import Data.URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) +import Text.Parsing.StringParser (ParseError, Parser) +import Text.Parsing.StringParser.String (char) + +newtype PathRootless = PathRootless (Tuple PathSegmentNZ (Array PathSegment)) + +derive instance eqPathRootless ∷ Eq PathRootless +derive instance ordPathRootless ∷ Ord PathRootless +derive instance genericPathRootless ∷ Generic PathRootless _ +instance showPathRootless ∷ Show PathRootless where show = genericShow + +parse ∷ ∀ p. (PathRootless → Either ParseError p) → Parser p +parse p = wrapParser p do + head ← parseSegmentNonZero + tail ← Array.many (char '/' *> parseSegment) + pure (PathRootless (Tuple head tail)) + +print ∷ PathRootless → String +print (PathRootless (Tuple head tail)) = + unsafeSegmentNZToString head + <> String.joinWith "/" (map unsafeSegmentToString tail) diff --git a/src/Data/URI/Path/Segment.purs b/src/Data/URI/Path/Segment.purs new file mode 100644 index 0000000..1aa55a8 --- /dev/null +++ b/src/Data/URI/Path/Segment.purs @@ -0,0 +1,118 @@ +module Data.URI.Path.Segment + ( PathSegment + , parseSegment + , segmentFromString + , segmentToString + , unsafeSegmentFromString + , unsafeSegmentToString + , PathSegmentNZ + , parseSegmentNonZero + , segmentNZFromString + , segmentNZToString + , unsafeSegmentNZFromString + , unsafeSegmentNZToString + , PathSegmentNZNC + , parseSegmentNonZeroNoColon + , segmentNZNCFromString + , segmentNZNCToString + , unsafeSegmentNZNCFromString + , unsafeSegmentNZNCToString + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Array as Array +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Maybe (Maybe(..)) +import Data.String as String +import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded) +import Global (decodeURIComponent) +import Text.Parsing.StringParser (Parser) +import Text.Parsing.StringParser.String (char) + +newtype PathSegment = PathSegment String + +derive newtype instance eqPathSegment ∷ Eq PathSegment +derive newtype instance ordPathSegment ∷ Ord PathSegment +derive instance genericPathSegment ∷ Generic PathSegment _ +instance showPathSegment ∷ Show PathSegment where show = genericShow + +parseSegment ∷ Parser PathSegment +parseSegment = + PathSegment + <<< String.joinWith "" + <$> Array.many (newParsePCTEncoded <|> String.singleton <$> segmentChar) + +segmentFromString ∷ String → PathSegment +segmentFromString = PathSegment <<< printEncoded segmentChar + +segmentToString ∷ PathSegment → String +segmentToString (PathSegment s) = decodeURIComponent s + +unsafeSegmentFromString ∷ String → PathSegment +unsafeSegmentFromString = PathSegment + +unsafeSegmentToString ∷ PathSegment → String +unsafeSegmentToString (PathSegment s) = s + +newtype PathSegmentNZ = PathSegmentNZ String + +derive newtype instance eqPathSegmentNZ ∷ Eq PathSegmentNZ +derive newtype instance ordPathSegmentNZ ∷ Ord PathSegmentNZ +derive instance genericPathSegmentNZ ∷ Generic PathSegmentNZ _ +instance showPathSegmentNZ ∷ Show PathSegmentNZ where show = genericShow + +parseSegmentNonZero ∷ Parser PathSegmentNZ +parseSegmentNonZero = + PathSegmentNZ + <<< String.joinWith "" + <$> Array.some (newParsePCTEncoded <|> String.singleton <$> segmentChar) + +segmentNZFromString ∷ String → Maybe PathSegmentNZ +segmentNZFromString = case _ of + "" → Nothing + s → Just $ PathSegmentNZ (printEncoded segmentChar s) + +segmentNZToString ∷ PathSegmentNZ → String +segmentNZToString (PathSegmentNZ s) = decodeURIComponent s + +unsafeSegmentNZFromString ∷ String → PathSegmentNZ +unsafeSegmentNZFromString = PathSegmentNZ + +unsafeSegmentNZToString ∷ PathSegmentNZ → String +unsafeSegmentNZToString (PathSegmentNZ s) = s + +newtype PathSegmentNZNC = PathSegmentNZNC String + +derive newtype instance eqPathSegmentNZNC ∷ Eq PathSegmentNZNC +derive newtype instance ordPathSegmentNZNC ∷ Ord PathSegmentNZNC +derive instance genericPathSegmentNZNC ∷ Generic PathSegmentNZNC _ +instance showPathSegmentNZNC ∷ Show PathSegmentNZNC where show = genericShow + +parseSegmentNonZeroNoColon ∷ Parser PathSegmentNZNC +parseSegmentNonZeroNoColon = + PathSegmentNZNC + <<< String.joinWith "" + <$> Array.some (newParsePCTEncoded <|> String.singleton <$> segmentNCChar) + +segmentNZNCToString ∷ PathSegmentNZNC → String +segmentNZNCToString (PathSegmentNZNC s) = decodeURIComponent s + +unsafeSegmentNZNCToString ∷ PathSegmentNZNC → String +unsafeSegmentNZNCToString (PathSegmentNZNC s) = s + +segmentNZNCFromString ∷ String → Maybe PathSegmentNZNC +segmentNZNCFromString = case _ of + "" → Nothing + s → Just $ PathSegmentNZNC (printEncoded segmentNCChar s) + +unsafeSegmentNZNCFromString ∷ String → PathSegmentNZNC +unsafeSegmentNZNCFromString = PathSegmentNZNC + +segmentChar ∷ Parser Char +segmentChar = segmentNCChar <|> char ':' + +segmentNCChar ∷ Parser Char +segmentNCChar = parseUnreserved <|> parseSubDelims <|> char '@' diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index 2eaf4c3..325a4c4 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -3,106 +3,132 @@ module Data.URI.RelativePart , RelativePartOptions , RelativePartParseOptions , RelativePartPrintOptions + , RelPath , parser , print , _authority , _path + , _relPath , module Data.URI.Authority + , module Data.URI.Path + , module Data.URI.Path.Absolute + , module Data.URI.Path.NoScheme ) where import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Either (Either) +import Data.Either (Either(..), either) import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) -import Data.Lens (Lens', lens) -import Data.Maybe (Maybe(..)) +import Data.Lens (Traversal', wander) +import Data.Maybe (Maybe(..), maybe) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) import Data.URI.Authority (Authority(..), Host(..), Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority +import Data.URI.Path (Path) import Data.URI.Path as Path +import Data.URI.Path.Absolute (PathAbsolute) +import Data.URI.Path.Absolute as PathAbs +import Data.URI.Path.NoScheme (PathNoScheme) +import Data.URI.Path.NoScheme as PathNoScheme import Text.Parsing.StringParser (ParseError, Parser) +import Text.Parsing.StringParser.Combinators (optionMaybe) -- | The "relative part" of a relative reference. -data RelativePart userInfo hosts host port relPath = RelativePart (Maybe (Authority userInfo hosts host port)) (Maybe relPath) +data RelativePart userInfo hosts host port path relPath + = RelativePartAuth (Authority userInfo hosts host port) (Maybe path) + | RelativePartNoAuth (Maybe relPath) -derive instance eqRelativePart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq relPath) ⇒ Eq (RelativePart userInfo hosts host port relPath) -derive instance ordRelativePart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord relPath) ⇒ Ord (RelativePart userInfo hosts host port relPath) -derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts host port relPath) _ -instance showRelativePart ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show port, Show relPath) ⇒ Show (RelativePart userInfo hosts host port relPath) where show = genericShow +derive instance eqRelativePart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq relPath) ⇒ Eq (RelativePart userInfo hosts host port path relPath) +derive instance ordRelativePart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord relPath) ⇒ Ord (RelativePart userInfo hosts host port path relPath) +derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts host port path relPath) _ +instance showRelativePart ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show port, Show path, Show relPath) ⇒ Show (RelativePart userInfo hosts host port path relPath) where show = genericShow -type RelativePartOptions userInfo hosts host port relPath = - RelativePartParseOptions userInfo hosts host port relPath - (RelativePartPrintOptions userInfo hosts host port relPath ()) +type RelativePartOptions userInfo hosts host port path relPath = + RelativePartParseOptions userInfo hosts host port path relPath + (RelativePartPrintOptions userInfo hosts host port path relPath ()) -type RelativePartParseOptions userInfo hosts host port relPath r = +type RelativePartParseOptions userInfo hosts host port path relPath r = ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) , parseHost ∷ Host → Either ParseError host , parsePort ∷ Port → Either ParseError port - , parseRelPath ∷ String → Either ParseError relPath + , parsePath ∷ Path → Either ParseError path + , parseRelPath ∷ RelPath → Either ParseError relPath | r ) -type RelativePartPrintOptions userInfo hosts host port relPath r = +type RelativePartPrintOptions userInfo hosts host port path relPath r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String , printHost ∷ host → Host , printPort ∷ port → Port - , printRelPath ∷ relPath → String + , printPath ∷ path → Path + , printRelPath ∷ relPath → RelPath | r ) +type RelPath = Either PathAbsolute PathNoScheme + parser - ∷ ∀ userInfo hosts host port relPath r - . Record (RelativePartParseOptions userInfo hosts host port relPath r) - → Parser (RelativePart userInfo hosts host port relPath) + ∷ ∀ userInfo hosts host port path relPath r + . Record (RelativePartParseOptions userInfo hosts host port path relPath r) + → Parser (RelativePart userInfo hosts host port path relPath) parser opts = withAuth <|> withoutAuth where withAuth = - RelativePart <<< Just + RelativePartAuth <$> Authority.parser opts - <*> Path.parsePathAbEmpty opts.parseRelPath - - withoutAuth = RelativePart Nothing <$> noAuthPath - + <*> optionMaybe (Path.parser opts.parsePath) + withoutAuth = + RelativePartNoAuth <$> noAuthPath noAuthPath - = (Just <$> Path.parsePathAbsolute opts.parseRelPath) - <|> (Just <$> Path.parsePathNoScheme opts.parseRelPath) + = (Just <$> PathAbs.parse (opts.parseRelPath <<< Left)) + <|> (Just <$> PathNoScheme.parse (opts.parseRelPath <<< Right)) <|> pure Nothing print - ∷ ∀ userInfo hosts host port relPath r + ∷ ∀ userInfo hosts host port path relPath r . Functor hosts - ⇒ Record (RelativePartPrintOptions userInfo hosts host port relPath r) - → RelativePart userInfo hosts host port relPath → String -print opts (RelativePart a p) = - String.joinWith "" $ Array.catMaybes - [ Authority.print opts <$> a - , opts.printRelPath <$> p - ] + ⇒ Record (RelativePartPrintOptions userInfo hosts host port path relPath r) + → RelativePart userInfo hosts host port path relPath → String +print opts = case _ of + RelativePartAuth a p → + String.joinWith "" $ Array.catMaybes + [ pure $ Authority.print opts a + , Path.print <<< opts.printPath <$> p + ] + RelativePartNoAuth p → + maybe "" (either PathAbs.print PathNoScheme.print <<< opts.printRelPath) p _authority - ∷ ∀ userInfo hosts host port relPath - . Lens' - (RelativePart userInfo hosts host port relPath) - (Maybe (Authority userInfo hosts host port)) -_authority = - lens - (\(RelativePart a _) → a) - (\(RelativePart _ p) a → RelativePart a p) + ∷ ∀ userInfo hosts host port path relPath + . Traversal' + (RelativePart userInfo hosts host port path relPath) + (Authority userInfo hosts host port) +_authority = wander \f a → case a of + RelativePartAuth a p → flip RelativePartAuth p <$> f a + _ → pure a _path - ∷ ∀ userInfo hosts host port relPath - . Lens' - (RelativePart userInfo hosts host port relPath) + ∷ ∀ userInfo hosts host port path relPath + . Traversal' + (RelativePart userInfo hosts host port path relPath) + (Maybe path) +_path = wander \f a → case a of + RelativePartAuth a p → RelativePartAuth a <$> f p + _ → pure a + +_relPath + ∷ ∀ userInfo hosts host port path relPath + . Traversal' + (RelativePart userInfo hosts host port path relPath) (Maybe relPath) -_path = - lens - (\(RelativePart _ p) → p) - (\(RelativePart a _) p → RelativePart a p) +_relPath = wander \f a → case a of + RelativePartNoAuth p → RelativePartNoAuth <$> f p + _ → pure a diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index c45ec67..1bf5144 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -29,50 +29,52 @@ import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment import Data.URI.Query (Query) import Data.URI.Query as Query -import Data.URI.RelativePart (Authority(..), Host(..), Port(..), RelativePart(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.RelativePart (Authority(..), Host(..), Path, PathAbsolute, PathNoScheme, Port(..), RelativePart(..), RelPath, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.RelativePart as RPart import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A relative reference for a URI. -data RelativeRef userInfo hosts host port relPath query fragment = RelativeRef (RelativePart userInfo hosts host port relPath) (Maybe query) (Maybe fragment) +data RelativeRef userInfo hosts host port path relPath query fragment = RelativeRef (RelativePart userInfo hosts host port path relPath) (Maybe query) (Maybe fragment) -derive instance eqRelativeRef ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo hosts host port relPath query fragment) -derive instance ordRelativeRef ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo hosts host port relPath query fragment) -derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts host port relPath query fragment) _ -instance showRelativeRef ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts host port relPath query fragment) where show = genericShow +derive instance eqRelativeRef ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo hosts host port path relPath query fragment) +derive instance ordRelativeRef ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo hosts host port path relPath query fragment) +derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts host port path relPath query fragment) _ +instance showRelativeRef ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show path, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts host port path relPath query fragment) where show = genericShow -type RelativeRefOptions userInfo hosts host port relPath query fragment = - RelativeRefParseOptions userInfo hosts host port relPath query fragment - (RelativeRefPrintOptions userInfo hosts host port relPath query fragment ()) +type RelativeRefOptions userInfo hosts host port path relPath query fragment = + RelativeRefParseOptions userInfo hosts host port path relPath query fragment + (RelativeRefPrintOptions userInfo hosts host port path relPath query fragment ()) -type RelativeRefParseOptions userInfo hosts host port relPath query fragment r = +type RelativeRefParseOptions userInfo hosts host port path relPath query fragment r = ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) , parseHost ∷ Host → Either ParseError host , parsePort ∷ Port → Either ParseError port - , parseRelPath ∷ String → Either ParseError relPath + , parsePath ∷ Path → Either ParseError path + , parseRelPath ∷ Either PathAbsolute PathNoScheme → Either ParseError relPath , parseQuery ∷ Query → Either ParseError query , parseFragment ∷ Fragment → Either ParseError fragment | r ) -type RelativeRefPrintOptions userInfo hosts host port relPath query fragment r = +type RelativeRefPrintOptions userInfo hosts host port path relPath query fragment r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String , printHost ∷ host → Host , printPort ∷ port → Port - , printRelPath ∷ relPath → String + , printPath ∷ path → Path + , printRelPath ∷ relPath → Either PathAbsolute PathNoScheme , printQuery ∷ query → Query , printFragment ∷ fragment → Fragment | r ) parser - ∷ ∀ userInfo hosts host port relPath query fragment r - . Record (RelativeRefParseOptions userInfo hosts host port relPath query fragment r) - → Parser (RelativeRef userInfo hosts host port relPath query fragment) + ∷ ∀ userInfo hosts host port path relPath query fragment r + . Record (RelativeRefParseOptions userInfo hosts host port path relPath query fragment r) + → Parser (RelativeRef userInfo hosts host port path relPath query fragment) parser opts = RelativeRef <$> RPart.parser opts @@ -81,10 +83,10 @@ parser opts = <* eof print - ∷ ∀ userInfo hosts host port relPath query fragment r + ∷ ∀ userInfo hosts host port path relPath query fragment r . Functor hosts - ⇒ Record (RelativeRefPrintOptions userInfo hosts host port relPath query fragment r) - → RelativeRef userInfo hosts host port relPath query fragment + ⇒ Record (RelativeRefPrintOptions userInfo hosts host port path relPath query fragment r) + → RelativeRef userInfo hosts host port path relPath query fragment → String print opts (RelativeRef h q f) = String.joinWith "" $ Array.catMaybes @@ -94,19 +96,19 @@ print opts (RelativeRef h q f) = ] _relPart - ∷ ∀ userInfo hosts host port relPath query fragment + ∷ ∀ userInfo hosts host port path relPath query fragment . Lens' - (RelativeRef userInfo hosts host port relPath query fragment) - (RelativePart userInfo hosts host port relPath) + (RelativeRef userInfo hosts host port path relPath query fragment) + (RelativePart userInfo hosts host port path relPath) _relPart = lens (\(RelativeRef r _ _) → r) (\(RelativeRef _ q f) r → RelativeRef r q f) _query - ∷ ∀ userInfo hosts host port relPath query fragment + ∷ ∀ userInfo hosts host port path relPath query fragment . Lens' - (RelativeRef userInfo hosts host port relPath query fragment) + (RelativeRef userInfo hosts host port path relPath query fragment) (Maybe query) _query = lens @@ -114,9 +116,9 @@ _query = (\(RelativeRef r _ f) q → RelativeRef r q f) _fragment - ∷ ∀ userInfo hosts host port relPath query fragment + ∷ ∀ userInfo hosts host port path relPath query fragment . Lens' - (RelativeRef userInfo hosts host port relPath query fragment) + (RelativeRef userInfo hosts host port path relPath query fragment) (Maybe fragment) _fragment = lens diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 374a56c..0f6029d 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -28,7 +28,7 @@ import Data.String as String import Data.Tuple (Tuple) import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), Host(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), Path, PathAbsolute, PathRootless, Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query (Query) import Data.URI.Query as Query @@ -39,43 +39,45 @@ import Text.Parsing.StringParser.Combinators (optionMaybe) import Text.Parsing.StringParser.String (eof) -- | A generic URI -data URI userInfo hosts host port hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts host port hierPath) (Maybe query) (Maybe fragment) +data URI userInfo hosts host port path hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts host port path hierPath) (Maybe query) (Maybe fragment) -derive instance eqURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hosts host port hierPath query fragment) -derive instance ordURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hosts host port hierPath query fragment) -derive instance genericURI ∷ Generic (URI userInfo hosts host port hierPath query fragment) _ -instance showURI ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts host port hierPath query fragment) where show = genericShow +derive instance eqURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hosts host port path hierPath query fragment) +derive instance ordURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hosts host port path hierPath query fragment) +derive instance genericURI ∷ Generic (URI userInfo hosts host port path hierPath query fragment) _ +instance showURI ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show path, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts host port path hierPath query fragment) where show = genericShow -type URIOptions userInfo hosts host port hierPath query fragment = - URIParseOptions userInfo hosts host port hierPath query fragment - (URIPrintOptions userInfo hosts host port hierPath query fragment ()) +type URIOptions userInfo hosts host port path hierPath query fragment = + URIParseOptions userInfo hosts host port path hierPath query fragment + (URIPrintOptions userInfo hosts host port path hierPath query fragment ()) -type URIParseOptions userInfo hosts host port hierPath query fragment r = +type URIParseOptions userInfo hosts host port path hierPath query fragment r = ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) , parseHost ∷ Host → Either ParseError host , parsePort ∷ Port → Either ParseError port - , parseHierPath ∷ String → Either ParseError hierPath + , parsePath ∷ Path → Either ParseError path + , parseHierPath ∷ Either PathAbsolute PathRootless → Either ParseError hierPath , parseQuery ∷ Query → Either ParseError query , parseFragment ∷ Fragment → Either ParseError fragment | r ) -type URIPrintOptions userInfo hosts host port hierPath query fragment r = +type URIPrintOptions userInfo hosts host port path hierPath query fragment r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String , printHost ∷ host → Host , printPort ∷ port → Port - , printHierPath ∷ hierPath → String + , printPath ∷ path → Path + , printHierPath ∷ hierPath → Either PathAbsolute PathRootless , printQuery ∷ query → Query , printFragment ∷ fragment → Fragment | r ) parser - ∷ ∀ userInfo hosts host port hierPath query fragment r - . Record (URIParseOptions userInfo hosts host port hierPath query fragment r) - → Parser (URI userInfo hosts host port hierPath query fragment) + ∷ ∀ userInfo hosts host port path hierPath query fragment r + . Record (URIParseOptions userInfo hosts host port path hierPath query fragment r) + → Parser (URI userInfo hosts host port path hierPath query fragment) parser opts = URI <$> Scheme.parser <*> HPart.parser opts @@ -84,10 +86,10 @@ parser opts = URI <* eof print - ∷ ∀ userInfo hosts host port hierPath query fragment r + ∷ ∀ userInfo hosts host port path hierPath query fragment r . Functor hosts - ⇒ Record (URIPrintOptions userInfo hosts host port hierPath query fragment r) - → URI userInfo hosts host port hierPath query fragment + ⇒ Record (URIPrintOptions userInfo hosts host port path hierPath query fragment r) + → URI userInfo hosts host port path hierPath query fragment → String print opts (URI s h q f) = String.joinWith "" $ Array.catMaybes @@ -98,9 +100,9 @@ print opts (URI s h q f) = ] _scheme - ∷ ∀ userInfo hosts host port hierPath query fragment + ∷ ∀ userInfo hosts host port path hierPath query fragment . Lens' - (URI userInfo hosts host port hierPath query fragment) + (URI userInfo hosts host port path hierPath query fragment) Scheme _scheme = lens @@ -108,19 +110,19 @@ _scheme = (\(URI _ h q f) s → URI s h q f) _hierPart - ∷ ∀ userInfo hosts host port hierPath query fragment + ∷ ∀ userInfo hosts host port path hierPath query fragment . Lens' - (URI userInfo hosts host port hierPath query fragment) - (HierarchicalPart userInfo hosts host port hierPath) + (URI userInfo hosts host port path hierPath query fragment) + (HierarchicalPart userInfo hosts host port path hierPath) _hierPart = lens (\(URI _ h _ _) → h) (\(URI s _ q f) h → URI s h q f) _query - ∷ ∀ userInfo hosts host port hierPath query fragment + ∷ ∀ userInfo hosts host port path hierPath query fragment . Lens' - (URI userInfo hosts host port hierPath query fragment) + (URI userInfo hosts host port path hierPath query fragment) (Maybe query) _query = lens @@ -128,9 +130,9 @@ _query = (\(URI s h _ f) q → URI s h q f) _fragment - ∷ ∀ userInfo hosts host port hierPath query fragment + ∷ ∀ userInfo hosts host port path hierPath query fragment . Lens' - (URI userInfo hosts host port hierPath query fragment) + (URI userInfo hosts host port path hierPath query fragment) (Maybe fragment) _fragment = lens diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index c873386..16c6c6f 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -8,11 +8,16 @@ module Data.URI.URIRef , module Data.URI.Authority , module Data.URI.Fragment , module Data.URI.Host + , module Data.URI.Path + , module Data.URI.Path.Absolute + , module Data.URI.Path.NoScheme + , module Data.URI.Path.Rootless , module Data.URI.Port , module Data.URI.Query - , module Data.URI.UserInfo , module Data.URI.RelativeRef + , module Data.URI.Scheme , module Data.URI.URI + , module Data.URI.UserInfo ) where import Prelude @@ -22,62 +27,69 @@ import Data.Either (Either(..), either) import Data.URI.Authority (Authority(..)) import Data.URI.Fragment (Fragment) import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) +import Data.URI.Path (Path(..)) +import Data.URI.Path.Absolute (PathAbsolute(..)) +import Data.URI.Path.NoScheme (PathNoScheme(..)) +import Data.URI.Path.Rootless (PathRootless(..)) import Data.URI.Port (Port(..)) import Data.URI.Query (Query) -import Data.URI.RelativeRef (RelativeRef(..), RelativePart(..)) +import Data.URI.RelativeRef (RelativeRef(..), RelativePart(..), RelPath) import Data.URI.RelativeRef as RelativeRef -import Data.URI.URI (URI(..), HierarchicalPart(..)) +import Data.URI.Scheme (Scheme(..)) +import Data.URI.URI (URI(..), HierarchicalPart(..), HierPath) import Data.URI.URI as URI import Data.URI.UserInfo (UserInfo) import Text.Parsing.StringParser (ParseError, Parser, try) -- | An alias for the most common use case of resource identifiers. -type URIRef userInfo hosts host port hierPath relPath query fragment = +type URIRef userInfo hosts host port path hierPath relPath query fragment = Either - (URI.URI userInfo hosts host port hierPath query fragment) - (RelativeRef.RelativeRef userInfo hosts host port relPath query fragment) + (URI.URI userInfo hosts host port path hierPath query fragment) + (RelativeRef.RelativeRef userInfo hosts host port path relPath query fragment) -type URIRefOptions userInfo hosts host port hierPath relPath query fragment = - URIRefParseOptions userInfo hosts host port hierPath relPath query fragment - (URIRefPrintOptions userInfo hosts host port hierPath relPath query fragment ()) +type URIRefOptions userInfo hosts host port path hierPath relPath query fragment = + URIRefParseOptions userInfo hosts host port path hierPath relPath query fragment + (URIRefPrintOptions userInfo hosts host port path hierPath relPath query fragment ()) -type URIRefParseOptions userInfo hosts host port hierPath relPath query fragment r = +type URIRefParseOptions userInfo hosts host port path hierPath relPath query fragment r = ( parseUserInfo ∷ UserInfo → Either ParseError userInfo , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) , parseHost ∷ Host → Either ParseError host , parsePort ∷ Port → Either ParseError port - , parseRelPath ∷ String → Either ParseError relPath - , parseHierPath ∷ String → Either ParseError hierPath + , parsePath ∷ Path → Either ParseError path + , parseHierPath ∷ Either PathAbsolute PathRootless → Either ParseError hierPath + , parseRelPath ∷ Either PathAbsolute PathNoScheme → Either ParseError relPath , parseQuery ∷ Query → Either ParseError query , parseFragment ∷ Fragment → Either ParseError fragment | r ) -type URIRefPrintOptions userInfo hosts host port hierPath relPath query fragment r = +type URIRefPrintOptions userInfo hosts host port path hierPath relPath query fragment r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts String → String , printHost ∷ host → Host , printPort ∷ port → Port - , printRelPath ∷ relPath → String - , printHierPath ∷ hierPath → String + , printPath ∷ path → Path + , printHierPath ∷ hierPath → Either PathAbsolute PathRootless + , printRelPath ∷ relPath → Either PathAbsolute PathNoScheme , printQuery ∷ query → Query , printFragment ∷ fragment → Fragment | r ) parser - ∷ ∀ userInfo hosts host port hierPath relPath query fragment r - . Record (URIRefParseOptions userInfo hosts host port hierPath relPath query fragment r) - → Parser (URIRef userInfo hosts host port hierPath relPath query fragment) + ∷ ∀ userInfo hosts host port path hierPath relPath query fragment r + . Record (URIRefParseOptions userInfo hosts host port path hierPath relPath query fragment r) + → Parser (URIRef userInfo hosts host port path hierPath relPath query fragment) parser opts = (Left <$> try (URI.parser opts)) <|> (Right <$> RelativeRef.parser opts) print - ∷ ∀ userInfo hosts host port hierPath relPath query fragment r + ∷ ∀ userInfo hosts host port path hierPath relPath query fragment r . Functor hosts - ⇒ Record (URIRefPrintOptions userInfo hosts host port hierPath relPath query fragment r) - → URIRef userInfo hosts host port hierPath relPath query fragment + ⇒ Record (URIRefPrintOptions userInfo hosts host port path hierPath relPath query fragment r) + → URIRef userInfo hosts host port path hierPath relPath query fragment → String print opts = either diff --git a/test/Main.purs b/test/Main.purs index 7ecf6ac..e7decb3 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -4,572 +4,78 @@ import Prelude import Control.Monad.Aff.AVar (AVAR) import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Class (liftEff) -import Control.Monad.Eff.Console (CONSOLE) -import Control.Monad.Eff.Exception (EXCEPTION) -import Control.Monad.Eff.Random (RANDOM) -import Data.Array as Array -import Data.Either (isLeft, Either(..)) -import Data.List (List(..), singleton, (:)) -import Data.Maybe (Maybe(Nothing, Just)) -import Data.Monoid (mempty) -import Data.Path.Pathy (currentDir, parentDir', file, dir, rootDir, ()) -import Data.String as String -import Data.Tuple (Tuple(..)) -import Data.URI (AbsoluteURI(..), Authority(..), HierarchicalPart(..), Host(..), Fragment, Port(..), RelativePart(..), RelativeRef(..), Query, Scheme(..), URI(..), UserInfo) -import Data.URI.AbsoluteURI as AbsoluteURI -import Data.URI.Authority as Authority -import Data.URI.Fragment as Fragment -import Data.URI.Host as Host -import Data.URI.Host.RegName as RegName -import Data.URI.Host.Gen as Host.Gen -import Data.URI.NonStandard.Path as NP -import Data.URI.NonStandard.QueryPairs as NQP -import Data.URI.Port as Port -import Data.URI.Query as Query -import Data.URI.Scheme as Scheme -import Data.URI.URI as URI -import Data.URI.URIRef as URIRef -import Data.URI.UserInfo as UserInfo -import Test.QuickCheck ((===)) -import Test.QuickCheck as QC -import Test.QuickCheck.Gen as QCG -import Test.Unit (Test, suite, test, TestSuite) -import Test.Unit.Assert (assert, equal) +import Test.URI.Authority as Authority +import Test.URI.Fragment as Fragment +import Test.URI.Host as Host +import Test.URI.NonStandard.QueryPairs as NonStandard.QueryPairs +import Test.URI.Path as Path +import Test.URI.Port as Port +import Test.URI.Scheme as Scheme +import Test.URI.UserInfo as UserInfo +import Test.URI.URIRef as URIRef +import Test.Unit (suite) import Test.Unit.Console (TESTOUTPUT) import Test.Unit.Main (runTest) -import Text.Parsing.StringParser (Parser, runParser) -import Text.Parsing.StringParser.Combinators (sepBy) as SP -import Text.Parsing.StringParser.String (string) as SP - -options ∷ Record (URIRef.URIRefOptions UserInfo Array Host Port NP.URIPathAbs NP.URIPathRel Query Fragment) -options = - { parseUserInfo: pure - , printUserInfo: id - , parseHosts: map Array.fromFoldable <<< flip SP.sepBy (SP.string ",") - , printHosts: String.joinWith "," - , parseHost: pure - , printHost: id - , parsePort: pure - , printPort: id - , parseHierPath: NP.parseURIPathAbs - , printHierPath: NP.printPath - , parseRelPath: NP.parseURIPathRel - , printRelPath: NP.printPath - , parseQuery: pure - , printQuery: id - , parseFragment: pure - , printFragment: id - } - -testPrinter :: forall a b. Show b => (b -> String) -> String -> b -> TestSuite a -testPrinter f expected uri = - test - ("prints: " <> expected) - (equal expected (f uri)) - -testRunParseSuccess :: forall a b. Eq b => Show b => Parser b -> String -> b -> TestSuite a -testRunParseSuccess p uri expected = - test - ("parses: " <> uri) - (equal (Right expected) (runParser p uri)) - -testIso :: forall a b. Eq b => Show b => Parser b -> (b -> String) -> String -> b -> TestSuite a -testIso p f uri expected = do - testRunParseSuccess p uri expected - testPrinter f uri expected - -testIsoURI :: forall a. String -> URI.URI UserInfo Array Host Port NP.URIPathAbs Query Fragment -> TestSuite a -testIsoURI = testIso (URI.parser options) (URI.print options) - -testIsoURIRef :: forall a. String -> URIRef.URIRef UserInfo Array Host Port NP.URIPathAbs NP.URIPathRel Query Fragment -> TestSuite a -testIsoURIRef = testIso (URIRef.parser options) (URIRef.print options) - --- testRunParseURIRefParses :: forall a. String -> Either URI RelativeRef -> TestSuite a --- testRunParseURIRefParses = testRunParseSuccess URIRef.parser - -testRunParseURIRefFails :: forall a. String -> TestSuite a -testRunParseURIRefFails uri = - test - ("fails to parse: " <> uri) - (assert ("parse should fail for: " <> uri) <<< isLeft <<< runParser (URIRef.parser options) $ uri) - -main :: forall eff. Eff (console :: CONSOLE, testOutput :: TESTOUTPUT, avar :: AVAR, exception :: EXCEPTION, random :: RANDOM | eff) Unit -main = runTest $ suite "Data.URI" do - - suite "parseIPv4Address" do - - test "parseIPv4Address / Host.print roundtrip" do - forAll do - ipv4 <- Host.Gen.genIPv4 - let printed = Host.print id ipv4 - let parsed = runParser (Host.parser pure) printed - pure $ pure ipv4 === parsed - - test "0-lead octets should not parse as an IP address" do - equal - (Right (NameAddress (RegName.unsafeFromString "192.168.001.1"))) - (runParser (Host.parser pure) "192.168.001.1") - - suite "Scheme parser" do - testRunParseSuccess Scheme.parser "http:" (Scheme "http") - testRunParseSuccess Scheme.parser "git+ssh:" (Scheme "git+ssh") - - suite "UserInfo parser" do - testRunParseSuccess (UserInfo.parser pure) "user" (UserInfo.fromString "user") - testRunParseSuccess (UserInfo.parser pure) "spaced%20user" (UserInfo.fromString "spaced user") - testRunParseSuccess (UserInfo.parser pure) "user:password" (UserInfo.fromString "user:password") - testRunParseSuccess (UserInfo.parser pure) "spaced%20user:password%25%C2%A3" (UserInfo.fromString "spaced user:password%£") - testRunParseSuccess (UserInfo.parser pure) "a:b:c" (UserInfo.fromString "a:b:c") - - suite "Host parser" do - testRunParseSuccess (Host.parser pure) "localhost" (NameAddress (RegName.fromString "localhost")) - testRunParseSuccess (Host.parser pure) "github.com" (NameAddress (RegName.fromString "github.com")) - testRunParseSuccess (Host.parser pure) "www.multipart.domain.example.com" (NameAddress (RegName.fromString "www.multipart.domain.example.com")) - testRunParseSuccess (Host.parser pure) "192.168.0.1" (IPv4Address "192.168.0.1") - testRunParseSuccess (Host.parser pure) "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") - - suite "Port parser" do - testRunParseSuccess (Port.parser pure) "0" (Port 0) - testRunParseSuccess (Port.parser pure) "1234" (Port 1234) - testRunParseSuccess (Port.parser pure) "63174" (Port 63174) - - suite "Fragment parser" do - testRunParseSuccess (Fragment.parser pure) "#" (Fragment.fromString "") - testRunParseSuccess (Fragment.parser pure) "#foo" (Fragment.fromString "foo") - testRunParseSuccess (Fragment.parser pure) "#foo%23bar" (Fragment.fromString "foo#bar") - testRunParseSuccess (Fragment.parser pure) "#foo%23bar" (Fragment.unsafeFromString "foo%23bar") - - suite "Authority parser" do - testRunParseSuccess - (Authority.parser options) - "//localhost" - (Authority Nothing [Tuple (NameAddress (RegName.fromString "localhost")) Nothing]) - testRunParseSuccess - (Authority.parser options) - "//localhost:3000" - (Authority Nothing [Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 3000))]) - - suite "URIRef.parse" do - testIsoURIRef - "sql2:///?q=foo&var.bar=baz" - (Left - (URI - (Scheme "sql2") - (HierarchicalPart - (Just (Authority Nothing [])) - (Just (Left rootDir))) - (Just (Query.unsafeFromString "q=foo&var.bar=baz")) - Nothing)) - testIsoURIRef - "mongodb://localhost" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) - Nothing) - Nothing - Nothing)) - testIsoURIRef - "https://1a.example.com" - (Left - (URI - (Scheme "https") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "1a.example.com")) Nothing)])) - Nothing) - Nothing - Nothing)) - testIsoURIRef - "http://en.wikipedia.org/wiki/URI_scheme" - (Left - (URI - (Scheme "http") - (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "en.wikipedia.org")) Nothing])) - ((Just (Right ((rootDir dir "wiki") file "URI_scheme"))))) - Nothing - Nothing)) - testIsoURIRef - "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPart - (Just - (Authority - (Just (UserInfo.unsafeFromString "foo:bar")) - [ Tuple (NameAddress (RegName.fromString "db1.example.net")) Nothing - , Tuple (NameAddress (RegName.fromString "db2.example.net")) (Just (Port 2500))])) - (Just (Right (rootDir file "authdb")))) - (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) - Nothing)) - testIsoURIRef - "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPart - (Just - (Authority - (Just (UserInfo.unsafeFromString "foo:bar")) - [ (Tuple (NameAddress (RegName.fromString "db1.example.net")) (Just (Port 6))) - , (Tuple (NameAddress (RegName.fromString "db2.example.net")) (Just (Port 2500)))])) - (Just (Right (rootDir file "authdb")))) - (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) - Nothing)) - testIsoURIRef - "mongodb://192.168.0.1" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPart (Just (Authority Nothing [(Tuple (IPv4Address "192.168.0.1") Nothing)])) Nothing) - Nothing - Nothing)) - testIsoURIRef - "mongodb://192.168.0.1,192.168.0.2" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPart - (Just - (Authority - Nothing - [ Tuple (IPv4Address "192.168.0.1") Nothing - , Tuple (IPv4Address "192.168.0.2") Nothing - ])) - Nothing) - Nothing - Nothing)) - testIsoURIRef - "mongodb://sysop:moon@localhost" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPart - (Just (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) - Nothing) - Nothing - Nothing)) - testIsoURIRef - "mongodb://sysop:moon@localhost/" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPart - (Just (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) - (Just (Left rootDir))) - Nothing - Nothing)) - testIsoURIRef - "mongodb://sysop:moon@localhost/records" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPart - (Just (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) - (Just (Right (rootDir file "records")))) - Nothing - Nothing)) - testIsoURIRef - "foo://[2001:cdba:0000:0000:0000:0000:3257:9652]" - (Left - (URI - (Scheme "foo") - (HierarchicalPart - (Just (Authority Nothing [Tuple (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") Nothing])) - Nothing) - Nothing - Nothing)) - testIsoURIRef - "foo://[FE80::0202:B3FF:FE1E:8329]" - (Left - (URI - (Scheme "foo") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (IPv6Address "FE80::0202:B3FF:FE1E:8329") Nothing)])) - Nothing) - Nothing - Nothing)) - testIsoURIRef - "foo://[2001:db8::1]:80" - (Left - (URI - (Scheme "foo") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::1") (Just (Port 80)))])) - Nothing) - Nothing - Nothing)) - testIsoURIRef - "ftp://ftp.is.co.za/rfc/rfc1808.txt" - (Left - (URI - (Scheme "ftp") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "ftp.is.co.za")) Nothing)])) - (Just (Right ((rootDir dir "rfc") file "rfc1808.txt")))) - Nothing - Nothing)) - testIsoURIRef - "http://www.ietf.org/rfc/rfc2396.txt" - (Left - (URI - (Scheme "http") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "www.ietf.org")) Nothing)])) - (Just (Right ((rootDir dir "rfc") file "rfc2396.txt")))) - Nothing - Nothing)) - testIsoURIRef - "ldap://[2001:db8::7]/c=GB?objectClass?one" - (Left - (URI - (Scheme "ldap") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (IPv6Address "2001:db8::7") Nothing)])) - (Just (Right (rootDir file "c=GB")))) - (Just (Query.unsafeFromString "objectClass?one")) - Nothing)) - testIsoURIRef - "telnet://192.0.2.16:80/" - (Left - (URI - (Scheme "telnet") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (IPv4Address "192.0.2.16") (Just (Port 80)))])) - (Just (Left rootDir))) - Nothing - Nothing)) - testIsoURIRef - "foo://example.com:8042/over/there?name=ferret#nose" - (Left - (URI - (Scheme "foo") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "example.com")) (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) - (Just (Query.unsafeFromString "name=ferret")) - (Just (Fragment.unsafeFromString "nose")))) - testIsoURIRef - "foo://example.com:8042/over/there?name=ferret#" - (Left - (URI - (Scheme "foo") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "example.com")) (Just (Port 8042)))])) (Just (Right ((rootDir dir "over") file "there")))) - (Just (Query.unsafeFromString "name=ferret")) - (Just (Fragment.unsafeFromString "")))) - testIsoURIRef - "foo://info.example.com?fred" - (Left - (URI - (Scheme "foo") - (HierarchicalPart - (Just (Authority Nothing [(Tuple (NameAddress (RegName.fromString "info.example.com")) Nothing)])) - Nothing) - (Just (Query.unsafeFromString "fred")) - Nothing)) - testIsoURIRef - "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" - (Left - (URI - (Scheme "ftp") - (HierarchicalPart - (Just - (Authority - (Just (UserInfo.unsafeFromString "cnn.example.com&story=breaking_news")) - [(Tuple (IPv4Address "10.0.0.1") Nothing)])) - (Just (Right (rootDir file "top_story.htm")))) - Nothing - Nothing)) - testIsoURIRef - "../top_story.htm" - (Right - (RelativeRef - (RelativePart - Nothing - (Just (Right ((parentDir' currentDir) file "top_story.htm")))) - Nothing - Nothing)) - testIsoURIRef - "top_story.htm" - (Right - (RelativeRef - (RelativePart - Nothing - (Just (Right (currentDir file "top_story.htm")))) - Nothing - Nothing)) - testIso - (AbsoluteURI.parser options) - (AbsoluteURI.print options) - "couchbase://localhost/testBucket?password=&docTypeKey=" - (AbsoluteURI - (Scheme "couchbase") - (HierarchicalPart - (Just - (Authority - Nothing - [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) - (Just (Right (rootDir file "testBucket")))) - (Just (Query.unsafeFromString "password=&docTypeKey="))) - testIso - (AbsoluteURI.parser options) - (AbsoluteURI.print options) - "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" - (AbsoluteURI - (Scheme "couchbase") - (HierarchicalPart - (Just - (Authority - Nothing - [(Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 99999)))])) - (Just (Right (rootDir file "testBucket")))) - (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) - testIsoURIRef - "http://www.example.com/some%20invented/url%20with%20spaces.html" - (Left - (URI - (Scheme "http") - (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "www.example.com")) Nothing])) - ((Just (Right ((rootDir dir "some invented") file "url with spaces.html"))))) - Nothing - Nothing)) - testIsoURIRef - "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" - (Left - (URI - (Scheme "http") - (HierarchicalPart - (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 53174))])) - ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) - (Just mempty) - Nothing)) - - testIsoURIRef - "../top_story.htm" - (Right - (RelativeRef - (RelativePart - Nothing - (Just (Right (parentDir' currentDir file "top_story.htm")))) - Nothing - Nothing)) - - -- Not an iso in this case as the printed path is normalised - -- testRunParseURIRefParses - -- "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" - -- (Left - -- (URI - -- (Scheme "http") - -- (HierarchicalPart - -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "local.)slamdata.com") Nothing])) - -- ((Just (Left rootDir)))) - -- ((Just mempty)) - -- ((Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214"))))) - -- testPrinter - -- URIRef.print - -- "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" - -- (Left - -- (URI - -- (Scheme "http") - -- (HierarchicalPart - -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "local.)slamdata.com") Nothing])) - -- ((Just (Left rootDir)))) - -- ((Just mempty)) - -- ((Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214"))))) - - -- testIsoURIRef - -- "news:comp.infosystems.www.servers.unix" - -- (Left - -- (URI - -- (Scheme "news") - -- (HierarchicalPart - -- Nothing - -- (Just "comp.infosystems.www.servers.unix")) - -- Nothing - -- Nothing)) - -- testIsoURIRef - -- "tel:+1-816-555-1212" - -- (Left - -- (URI - -- (Scheme "tel") - -- (HierarchicalPart - -- Nothing - -- (Just "+1-816-555-1212")) - -- Nothing - -- Nothing)) - -- testIsoURIRef - -- "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" - -- (Left - -- (URI - -- (Scheme "urn") - -- (HierarchicalPart - -- Nothing - -- (Just "oasis:names:specification:docbook:dtd:xml:4.1.2")) - -- Nothing - -- Nothing)) - -- testIsoURIRef - -- "mailto:John.Doe@example.com" - -- (Left - -- (URI - -- (Scheme "mailto") - -- (HierarchicalPart - -- Nothing - -- (Just "John.Doe@example.com")) - -- Nothing - -- Nothing)) - -- testIsoURIRef - -- "mailto:fred@example.com" - -- (Left - -- (URI - -- (Scheme "mailto") - -- (HierarchicalPart - -- Nothing - -- (Just "fred@example.com")) - -- Nothing - -- Nothing)) - - suite "QueryPairs printer/parser" do - let testQueryIso = testIso (Query.parser NQP.parse) (Query.print NQP.print) - testQueryIso - "?key1=value1&key2=value2&key1=value3" - (NQP.QueryPairs (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) - testQueryIso - "?k%3Dey=value%3D1" - (NQP.QueryPairs (Tuple "k=ey" (Just "value=1") : Nil)) - testQueryIso - "?" - (NQP.QueryPairs Nil) - testQueryIso - "?key1=&key2=" - (NQP.QueryPairs (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) - testQueryIso - "?key1&key2" - (NQP.QueryPairs (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) - testQueryIso - "?key1=foo%3Bbar" - (NQP.QueryPairs (Tuple "key1" (Just "foo;bar") : Nil)) - testQueryIso - "?replicaSet=test&connectTimeoutMS=300000" - (NQP.QueryPairs (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil)) - testQueryIso - "?fred" - (NQP.QueryPairs (pure (Tuple "fred" Nothing))) - testQueryIso - "?objectClass?one" - (NQP.QueryPairs (pure (Tuple "objectClass?one" Nothing))) - testQueryIso - "?password=&docTypeKey=" - (NQP.QueryPairs (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)) - testQueryIso - "?password=pass&docTypeKey=type&queryTimeoutSeconds=20" - (NQP.QueryPairs (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)) - -forAll :: forall eff prop. QC.Testable prop => QCG.Gen prop -> Test (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) -forAll = quickCheck - -quickCheck :: forall eff prop. QC.Testable prop => prop -> Test (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) -quickCheck = liftEff <<< QC.quickCheck' 100 +import Test.Util (TestEffects) + +main ∷ ∀ eff. Eff (TestEffects (avar ∷ AVAR, testOutput ∷ TESTOUTPUT)) Unit +main = runTest $ + suite "Data.URI" do + Scheme.spec + UserInfo.spec + Host.spec + Port.spec + Fragment.spec + Authority.spec + Path.spec + NonStandard.QueryPairs.spec + URIRef.spec +-- -- testIso +-- -- (AbsoluteURI.parser options) +-- -- (AbsoluteURI.print options) +-- -- "couchbase://localhost/testBucket?password=&docTypeKey=" +-- -- (AbsoluteURI +-- -- (Scheme "couchbase") +-- -- (HierarchicalPart +-- -- (Just +-- -- (Authority +-- -- Nothing +-- -- [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) +-- -- (Just (Right (rootDir file "testBucket")))) +-- -- (Just (Query.unsafeFromString "password=&docTypeKey="))) +-- -- testIso +-- -- (AbsoluteURI.parser options) +-- -- (AbsoluteURI.print options) +-- -- "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" +-- -- (AbsoluteURI +-- -- (Scheme "couchbase") +-- -- (HierarchicalPart +-- -- (Just +-- -- (Authority +-- -- Nothing +-- -- [(Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 99999)))])) +-- -- (Just (Right (rootDir file "testBucket")))) +-- -- (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) + +-- -- Not an iso in this case as the printed path is normalised +-- -- testRunParseURIRefParses +-- -- "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" +-- -- (Left +-- -- (URI +-- -- (Scheme "http") +-- -- (HierarchicalPart +-- -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "local.)slamdata.com") Nothing])) +-- -- ((Just (Left rootDir)))) +-- -- ((Just mempty)) +-- -- ((Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214"))))) +-- -- testPrinter +-- -- URIRef.print +-- -- "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" +-- -- (Left +-- -- (URI +-- -- (Scheme "http") +-- -- (HierarchicalPart +-- -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "local.)slamdata.com") Nothing])) +-- -- ((Just (Left rootDir)))) +-- -- ((Just mempty)) +-- -- ((Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214"))))) diff --git a/test/URI/Authority.purs b/test/URI/Authority.purs new file mode 100644 index 0000000..c32c17a --- /dev/null +++ b/test/URI/Authority.purs @@ -0,0 +1,76 @@ +module Test.URI.Authority where + +import Prelude + +import Data.Array as Array +import Data.Identity (Identity(..)) +import Data.Maybe (Maybe(..)) +import Data.Newtype (un) +import Data.Tuple (Tuple(..)) +import Data.String as String +import Data.URI.Authority (Authority(..), AuthorityOptions, Host(..), Port(..), UserInfo) +import Data.URI.Authority as Authority +import Data.URI.Host.RegName as RegName +import Data.URI.UserInfo as UserInfo +import Test.Unit (TestSuite, suite) +import Test.Util (testIso) +import Text.Parsing.StringParser.Combinators (sepBy) as SP +import Text.Parsing.StringParser.String (string) as SP + +spec ∷ ∀ eff. TestSuite eff +spec = + suite "Authority parser/printer" do + testIso + (Authority.parser optionsSingle) + (Authority.print optionsSingle) + "//localhost" + (Authority + Nothing + (Identity (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + testIso + (Authority.parser optionsSingle) + (Authority.print optionsSingle) + "//localhost:3000" + (Authority + Nothing + (Identity (Tuple (NameAddress (RegName.unsafeFromString "localhost")) (Just (Port 3000))))) + testIso + (Authority.parser optionsSingle) + (Authority.print optionsSingle) + "//user@localhost:3000" + (Authority + (Just (UserInfo.unsafeFromString "user")) + (Identity (Tuple (NameAddress (RegName.unsafeFromString "localhost")) (Just (Port 3000))))) + testIso + (Authority.parser optionsMany) + (Authority.print optionsMany) + "//mongo-1,mongo-2:3000" + (Authority + Nothing + [ Tuple (NameAddress (RegName.unsafeFromString "mongo-1")) Nothing + , Tuple (NameAddress (RegName.unsafeFromString "mongo-2")) (Just (Port 3000)) + ]) + +optionsSingle ∷ Record (AuthorityOptions UserInfo Identity Host Port) +optionsSingle = + { parseUserInfo: pure + , printUserInfo: id + , parseHosts: map Identity + , printHosts: un Identity + , parseHost: pure + , printHost: id + , parsePort: pure + , printPort: id + } + +optionsMany ∷ Record (AuthorityOptions UserInfo Array Host Port) +optionsMany = + { parseUserInfo: pure + , printUserInfo: id + , parseHosts: map Array.fromFoldable <<< flip SP.sepBy (SP.string ",") + , printHosts: String.joinWith "," + , parseHost: pure + , printHost: id + , parsePort: pure + , printPort: id + } diff --git a/test/URI/Fragment.purs b/test/URI/Fragment.purs new file mode 100644 index 0000000..9c6ab95 --- /dev/null +++ b/test/URI/Fragment.purs @@ -0,0 +1,15 @@ +module Test.URI.Fragment where + +import Prelude + +import Data.URI.Fragment as Fragment +import Test.Unit (TestSuite, suite) +import Test.Util (testIso) + +spec ∷ ∀ eff. TestSuite eff +spec = + suite "Fragment parser/printer" do + testIso (Fragment.parser pure) (Fragment.print id) "#" (Fragment.fromString "") + testIso (Fragment.parser pure) (Fragment.print id) "#foo" (Fragment.fromString "foo") + testIso (Fragment.parser pure) (Fragment.print id) "#foo%23bar" (Fragment.fromString "foo#bar") + testIso (Fragment.parser pure) (Fragment.print id) "#foo%23bar" (Fragment.unsafeFromString "foo%23bar") diff --git a/test/URI/Host.purs b/test/URI/Host.purs new file mode 100644 index 0000000..4e42a4e --- /dev/null +++ b/test/URI/Host.purs @@ -0,0 +1,37 @@ +module Test.URI.Host where + +import Prelude + +import Data.Either (Either(..)) +import Data.URI.Host (Host(..)) +import Data.URI.Host as Host +import Data.URI.Host.Gen as Host.Gen +import Data.URI.Host.RegName as RegName +import Test.QuickCheck ((===)) +import Test.Unit (TestSuite, suite, test) +import Test.Unit.Assert (equal) +import Test.Util (TestEffects, forAll, testIso) +import Text.Parsing.StringParser (runParser) + +spec ∷ ∀ eff. TestSuite (TestEffects eff) +spec = do + suite "parseIPv4Address" do + + test "parseIPv4Address / Host.print roundtrip" do + forAll do + ipv4 <- Host.Gen.genIPv4 + let printed = Host.print id ipv4 + let parsed = runParser (Host.parser pure) printed + pure $ pure ipv4 === parsed + + test "0-lead octets should not parse as an IP address" do + equal + (Right (NameAddress (RegName.unsafeFromString "192.168.001.1"))) + (runParser (Host.parser pure) "192.168.001.1") + + suite "Host parser/printer" do + testIso (Host.parser pure) (Host.print id) "localhost" (NameAddress (RegName.fromString "localhost")) + testIso (Host.parser pure) (Host.print id) "github.com" (NameAddress (RegName.fromString "github.com")) + testIso (Host.parser pure) (Host.print id) "www.multipart.domain.example.com" (NameAddress (RegName.fromString "www.multipart.domain.example.com")) + testIso (Host.parser pure) (Host.print id) "192.168.0.1" (IPv4Address "192.168.0.1") + testIso (Host.parser pure) (Host.print id) "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") diff --git a/test/URI/NonStandard/QueryPairs.purs b/test/URI/NonStandard/QueryPairs.purs new file mode 100644 index 0000000..9a1b898 --- /dev/null +++ b/test/URI/NonStandard/QueryPairs.purs @@ -0,0 +1,70 @@ +module Test.URI.NonStandard.QueryPairs where + +import Prelude + +import Data.List (List(..), (:)) +import Data.Maybe (Maybe(..)) +import Data.Tuple (Tuple(..)) +import Data.URI.NonStandard.QueryPairs as NQP +import Data.URI.Query as Query +import Test.Unit (TestSuite, suite) +import Test.Util (testIso) + +spec ∷ ∀ eff. TestSuite eff +spec = + suite "QueryPairs printer/parser" do + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?key1=value1&key2=value2&key1=value3" + (NQP.QueryPairs (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?k%3Dey=value%3D1" + (NQP.QueryPairs (Tuple "k=ey" (Just "value=1") : Nil)) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?" + (NQP.QueryPairs Nil) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?key1=&key2=" + (NQP.QueryPairs (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?key1&key2" + (NQP.QueryPairs (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?key1=foo%3Bbar" + (NQP.QueryPairs (Tuple "key1" (Just "foo;bar") : Nil)) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?replicaSet=test&connectTimeoutMS=300000" + (NQP.QueryPairs (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil)) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?fred" + (NQP.QueryPairs (pure (Tuple "fred" Nothing))) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?objectClass?one" + (NQP.QueryPairs (pure (Tuple "objectClass?one" Nothing))) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?password=&docTypeKey=" + (NQP.QueryPairs (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)) + testIso + (Query.parser NQP.parse) + (Query.print NQP.print) + "?password=pass&docTypeKey=type&queryTimeoutSeconds=20" + (NQP.QueryPairs (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)) diff --git a/test/URI/Path.purs b/test/URI/Path.purs new file mode 100644 index 0000000..c1e41b3 --- /dev/null +++ b/test/URI/Path.purs @@ -0,0 +1,14 @@ +module Test.URI.Path where + +import Prelude + +import Data.URI.Path (Path(..)) +import Data.URI.Path as Path +import Data.URI.Path.Segment as PathSegment +import Test.Unit (TestSuite, suite) +import Test.Util (testIso) + +spec ∷ ∀ eff. TestSuite eff +spec = + suite "Path parser/printer" do + testIso (Path.parser pure) Path.print "/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23" (Path [PathSegment.segmentFromString "Пациенты# #"]) diff --git a/test/URI/Port.purs b/test/URI/Port.purs new file mode 100644 index 0000000..b54ebde --- /dev/null +++ b/test/URI/Port.purs @@ -0,0 +1,15 @@ +module Test.URI.Port where + +import Prelude + +import Data.URI.Port (Port(..)) +import Data.URI.Port as Port +import Test.Unit (TestSuite, suite) +import Test.Util (testIso) + +spec ∷ ∀ eff. TestSuite eff +spec = + suite "Port parser/printer" do + testIso (Port.parser pure) (Port.print id) "0" (Port 0) + testIso (Port.parser pure) (Port.print id) "1234" (Port 1234) + testIso (Port.parser pure) (Port.print id) "63174" (Port 63174) diff --git a/test/URI/Scheme.purs b/test/URI/Scheme.purs new file mode 100644 index 0000000..c1e2dd3 --- /dev/null +++ b/test/URI/Scheme.purs @@ -0,0 +1,14 @@ +module Test.URI.Scheme where + +import Prelude + +import Data.URI.Scheme (Scheme(..)) +import Data.URI.Scheme as Scheme +import Test.Unit (TestSuite, suite) +import Test.Util (testIso) + +spec ∷ ∀ eff. TestSuite eff +spec = + suite "Scheme parser/printer" do + testIso Scheme.parser Scheme.print "http:" (Scheme "http") + testIso Scheme.parser Scheme.print "git+ssh:" (Scheme "git+ssh") diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs new file mode 100644 index 0000000..2cf8e86 --- /dev/null +++ b/test/URI/URIRef.purs @@ -0,0 +1,539 @@ +module Test.URI.URIRef where + +import Prelude + +import Data.Either (Either(..)) +import Data.Identity (Identity(..)) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Newtype (un) +import Data.Tuple (Tuple(..)) +import Data.URI.Fragment as Fragment +import Data.URI.Host.RegName as RegName +import Data.URI.Path.Segment as PathSegment +import Data.URI.Query as Query +import Data.URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), Port(..), Query, RelPath, RelativePart(..), RelativeRef(..), Scheme(..), URI(..), URIRefOptions, UserInfo) +import Data.URI.URIRef as URIRef +import Data.URI.UserInfo as UserInfo +import Test.Unit (TestSuite, suite) +import Test.Util (testIso) +import Text.Parsing.StringParser.Combinators (optionMaybe) + +spec ∷ ∀ eff. TestSuite eff +spec = + suite "URIRef parser/printer" do + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "sql2:///?q=foo&var.bar=baz" + (Left + (URI + (Scheme "sql2") + (HierarchicalPartAuth + (Authority Nothing Nothing) + (path [""])) + (Just (Query.unsafeFromString "q=foo&var.bar=baz")) + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "sql2://?q=foo&var.bar=baz" + (Left + (URI + (Scheme "sql2") + (HierarchicalPartAuth + (Authority Nothing Nothing) + Nothing) + (Just (Query.unsafeFromString "q=foo&var.bar=baz")) + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "sql2:/?q=foo&var.bar=baz" + (Left + (URI + (Scheme "sql2") + (HierarchicalPartNoAuth (Just (Left (PathAbsolute Nothing)))) + (Just (Query.unsafeFromString "q=foo&var.bar=baz")) + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "sql2:?q=foo&var.bar=baz" + (Left + (URI + (Scheme "sql2") + (HierarchicalPartNoAuth Nothing) + (Just (Query.unsafeFromString "q=foo&var.bar=baz")) + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "mongodb://localhost" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + Nothing) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "https://1a.example.com" + (Left + (URI + (Scheme "https") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.unsafeFromString "1a.example.com")) Nothing))) + Nothing) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "http://en.wikipedia.org/wiki/URI_scheme" + (Left + (URI + (Scheme "http") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.unsafeFromString "en.wikipedia.org")) Nothing))) + (path ["wiki", "URI_scheme"])) + Nothing + Nothing)) +-- -- testIsoURIRef +-- -- "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" +-- -- (Left +-- -- (URI +-- -- (Scheme "mongodb") +-- -- (HierarchicalPart +-- -- (Just +-- -- (Authority +-- -- (Just (UserInfo.unsafeFromString "foo:bar")) +-- -- [ Tuple (NameAddress (RegName.unsafeFromString "db1.example.net")) Nothing +-- -- , Tuple (NameAddress (RegName.unsafeFromString "db2.example.net")) (Just (Port 2500))])) +-- -- (Just (Right (rootDir file "authdb")))) +-- -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) +-- -- Nothing)) +-- -- testIsoURIRef +-- -- "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" +-- -- (Left +-- -- (URI +-- -- (Scheme "mongodb") +-- -- (HierarchicalPart +-- -- (Just +-- -- (Authority +-- -- (Just (UserInfo.unsafeFromString "foo:bar")) +-- -- [ (Tuple (NameAddress (RegName.unsafeFromString "db1.example.net")) (Just (Port 6))) +-- -- , (Tuple (NameAddress (RegName.unsafeFromString "db2.example.net")) (Just (Port 2500)))])) +-- -- (Just (Right (rootDir file "authdb")))) +-- -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) +-- -- Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "mongodb://192.168.0.1" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPartAuth + (Authority Nothing (Just (Tuple (IPv4Address "192.168.0.1") Nothing))) + Nothing) + Nothing + Nothing)) +-- -- testIsoURIRef +-- -- "mongodb://192.168.0.1,192.168.0.2" +-- -- (Left +-- -- (URI +-- -- (Scheme "mongodb") +-- -- (HierarchicalPart +-- -- (Just +-- -- (Authority +-- -- Nothing +-- -- [ Tuple (IPv4Address "192.168.0.1") Nothing +-- -- , Tuple (IPv4Address "192.168.0.2") Nothing +-- -- ])) +-- -- Nothing) +-- -- Nothing +-- -- Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "mongodb://sysop:moon@localhost" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPartAuth + (Authority + (Just (UserInfo.unsafeFromString "sysop:moon")) + (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + Nothing) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "mongodb://sysop:moon@localhost/" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPartAuth + (Authority + (Just (UserInfo.unsafeFromString "sysop:moon")) + (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + (path [""])) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "mongodb://sysop:moon@localhost/records" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPartAuth + (Authority + (Just (UserInfo.unsafeFromString "sysop:moon")) + (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + (path ["records"])) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "mongodb://sysop:moon@localhost/records/etc/" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPartAuth + (Authority + (Just (UserInfo.unsafeFromString "sysop:moon")) + (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + (path ["records", "etc", ""])) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "foo://[2001:cdba:0000:0000:0000:0000:3257:9652]" + (Left + (URI + (Scheme "foo") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") Nothing))) + Nothing) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "foo://[FE80::0202:B3FF:FE1E:8329]" + (Left + (URI + (Scheme "foo") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (IPv6Address "FE80::0202:B3FF:FE1E:8329") Nothing))) + Nothing) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "foo://[2001:db8::1]:80" + (Left + (URI + (Scheme "foo") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (IPv6Address "2001:db8::1") (Just (Port 80))))) + Nothing) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "ftp://ftp.is.co.za/rfc/rfc1808.txt" + (Left + (URI + (Scheme "ftp") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.unsafeFromString "ftp.is.co.za")) Nothing))) + (path ["rfc", "rfc1808.txt"])) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "http://www.ietf.org/rfc/rfc2396.txt" + (Left + (URI + (Scheme "http") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.unsafeFromString "www.ietf.org")) Nothing))) + (path ["rfc", "rfc2396.txt"])) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "ldap://[2001:db8::7]/c=GB?objectClass?one" + (Left + (URI + (Scheme "ldap") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (IPv6Address "2001:db8::7") Nothing))) + (path ["c=GB"])) + (Just (Query.unsafeFromString "objectClass?one")) + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "telnet://192.0.2.16:80/" + (Left + (URI + (Scheme "telnet") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (IPv4Address "192.0.2.16") (Just (Port 80))))) + (path [""])) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "foo://example.com:8042/over/there?name=ferret#nose" + (Left + (URI + (Scheme "foo") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.unsafeFromString "example.com")) (Just (Port 8042))))) + (path ["over", "there"])) + (Just (Query.unsafeFromString "name=ferret")) + (Just (Fragment.unsafeFromString "nose")))) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "foo://example.com:8042/over/there?name=ferret#" + (Left + (URI + (Scheme "foo") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.unsafeFromString "example.com")) (Just (Port 8042))))) + (path ["over", "there"])) + (Just (Query.unsafeFromString "name=ferret")) + (Just (Fragment.unsafeFromString "")))) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "foo://info.example.com?fred" + (Left + (URI + (Scheme "foo") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.unsafeFromString "info.example.com")) Nothing))) + Nothing) + (Just (Query.unsafeFromString "fred")) + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" + (Left + (URI + (Scheme "ftp") + (HierarchicalPartAuth + (Authority + (Just (UserInfo.unsafeFromString "cnn.example.com&story=breaking_news")) + (Just (Tuple (IPv4Address "10.0.0.1") Nothing))) + (path ["top_story.htm"])) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "top_story.htm" + (Right + (RelativeRef + (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString "top_story.htm") []))))) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "../top_story.htm" + (Right + (RelativeRef + (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString "..") [PathSegment.unsafeSegmentFromString "top_story.htm"]))))) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "/top_story.htm" + (Right + (RelativeRef + (RelativePartNoAuth (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString "top_story.htm") [])))))) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "/" + (Right + (RelativeRef + (RelativePartNoAuth (Just (Left (PathAbsolute Nothing)))) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "" + (Right + (RelativeRef + (RelativePartNoAuth Nothing) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "http://www.example.com/some%20invented/url%20with%20spaces.html" + (Left + (URI + (Scheme "http") + (HierarchicalPartAuth + (Authority Nothing (Just (Tuple (NameAddress (RegName.fromString "www.example.com")) Nothing))) + (path ["some%20invented", "url%20with%20spaces.html"])) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" + (Left + (URI + (Scheme "http") + (HierarchicalPartAuth + (Authority Nothing (Just (Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 53174))))) + (path ["metadata", "fs", "test", "%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23"])) + (Just (Query.unsafeFromString "")) + Nothing)) +-- -- testIsoURIRef +-- -- "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" +-- -- (Left +-- -- (URI +-- -- (Scheme "http") +-- -- (HierarchicalPart +-- -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 53174))])) +-- -- ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) +-- -- (Just mempty) +-- -- Nothing)) +-- -- +-- -- testIsoURIRef +-- -- "../top_story.htm" +-- -- (Right +-- -- (RelativeRef +-- -- (RelativePart +-- -- Nothing +-- -- (Just (Right (parentDir' currentDir file "top_story.htm")))) +-- -- Nothing +-- -- Nothing)) + +-- -- testIsoURIRef +-- -- "news:comp.infosystems.www.servers.unix" +-- -- (Left +-- -- (URI +-- -- (Scheme "news") +-- -- (HierarchicalPart +-- -- Nothing +-- -- (Just "comp.infosystems.www.servers.unix")) +-- -- Nothing +-- -- Nothing)) +-- -- testIsoURIRef +-- -- "tel:+1-816-555-1212" +-- -- (Left +-- -- (URI +-- -- (Scheme "tel") +-- -- (HierarchicalPart +-- -- Nothing +-- -- (Just "+1-816-555-1212")) +-- -- Nothing +-- -- Nothing)) +-- -- testIsoURIRef +-- -- "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" +-- -- (Left +-- -- (URI +-- -- (Scheme "urn") +-- -- (HierarchicalPart +-- -- Nothing +-- -- (Just "oasis:names:specification:docbook:dtd:xml:4.1.2")) +-- -- Nothing +-- -- Nothing)) +-- -- testIsoURIRef +-- -- "mailto:John.Doe@example.com" +-- -- (Left +-- -- (URI +-- -- (Scheme "mailto") +-- -- (HierarchicalPart +-- -- Nothing +-- -- (Just "John.Doe@example.com")) +-- -- Nothing +-- -- Nothing)) +-- -- testIsoURIRef +-- -- "mailto:fred@example.com" +-- -- (Left +-- -- (URI +-- -- (Scheme "mailto") +-- -- (HierarchicalPart +-- -- Nothing +-- -- (Just "fred@example.com")) +-- -- Nothing +-- -- Nothing)) + +path ∷ Array String → Maybe Path +path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString + +optionsSingle ∷ Record (URIRefOptions UserInfo Maybe Host Port Path HierPath RelPath Query Fragment) +optionsSingle = + { parseUserInfo: pure + , printUserInfo: id + , parseHosts: optionMaybe + , printHosts: fromMaybe "" + , parseHost: pure + , printHost: id + , parsePort: pure + , printPort: id + , parsePath: pure + , printPath: id + , parseHierPath: pure + , printHierPath: id + , parseRelPath: pure + , printRelPath: id + , parseQuery: pure + , printQuery: id + , parseFragment: pure + , printFragment: id + } diff --git a/test/URI/UserInfo.purs b/test/URI/UserInfo.purs new file mode 100644 index 0000000..fa6a7c0 --- /dev/null +++ b/test/URI/UserInfo.purs @@ -0,0 +1,16 @@ +module Test.URI.UserInfo where + +import Prelude + +import Data.URI.UserInfo as UserInfo +import Test.Unit (TestSuite, suite) +import Test.Util (testIso) + +spec ∷ ∀ eff. TestSuite eff +spec = + suite "UserInfo parser/printer" do + testIso (UserInfo.parser pure) (UserInfo.print id) "user" (UserInfo.fromString "user") + testIso (UserInfo.parser pure) (UserInfo.print id) "spaced%20user" (UserInfo.fromString "spaced user") + testIso (UserInfo.parser pure) (UserInfo.print id) "user:password" (UserInfo.fromString "user:password") + testIso (UserInfo.parser pure) (UserInfo.print id) "spaced%20user:password%25%C2%A3" (UserInfo.fromString "spaced user:password%£") + testIso (UserInfo.parser pure) (UserInfo.print id) "a:b:c" (UserInfo.fromString "a:b:c") diff --git a/test/Util.purs b/test/Util.purs new file mode 100644 index 0000000..efc531a --- /dev/null +++ b/test/Util.purs @@ -0,0 +1,47 @@ +module Test.Util where + +import Prelude + +import Control.Monad.Eff.Class (liftEff) +import Control.Monad.Eff.Console (CONSOLE) +import Control.Monad.Eff.Exception (EXCEPTION) +import Control.Monad.Eff.Random (RANDOM) +import Data.Either (Either(..)) +import Test.QuickCheck as QC +import Test.QuickCheck.Gen as QCG +import Test.Unit (Test, TestSuite, failure, success, test) +import Text.Parsing.StringParser (Parser, runParser) + +type TestEffects eff = (console ∷ CONSOLE, random ∷ RANDOM, exception ∷ EXCEPTION | eff) + +testPrinter ∷ ∀ a b. Show b ⇒ (b → String) → String → b → TestSuite a +testPrinter f expected uri = + test + ("prints: " <> expected) + (equal expected (f uri)) + +testParser ∷ ∀ a b. Eq b ⇒ Show b ⇒ Parser b → String → b → TestSuite a +testParser p uri expected = + test + ("parses: " <> uri) + (equal (Right expected) (runParser p uri)) + +equal :: forall a e. Eq a => Show a => a -> a -> Test e +equal expected actual = + if expected == actual + then success + else + failure $ + "\nexpected: " <> show expected <> + "\ngot: " <> show actual + +testIso ∷ ∀ a b. Eq b ⇒ Show b ⇒ Parser b → (b → String) → String → b → TestSuite a +testIso p f uri expected = do + testParser p uri expected + testPrinter f uri expected + +forAll ∷ ∀ eff prop. QC.Testable prop ⇒ QCG.Gen prop → Test (TestEffects eff) +forAll = quickCheck + +quickCheck ∷ ∀ eff prop. QC.Testable prop ⇒ prop → Test (TestEffects eff) +quickCheck = liftEff <<< QC.quickCheck' 100 From e5e7b111438a32363e7c929943a65a54c30695aa Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 5 Feb 2018 01:05:52 +0000 Subject: [PATCH 15/69] More tests, fix some re-exports --- src/Data/URI/AbsoluteURI.purs | 2 +- src/Data/URI/HierarchicalPart.purs | 6 +- src/Data/URI/Path/Absolute.purs | 3 + src/Data/URI/Path/Rootless.purs | 10 ++- test/Main.purs | 30 +------ test/URI/AbsoluteURI.purs | 82 +++++++++++++++++++ test/URI/URIRef.purs | 125 ++++++++++++----------------- 7 files changed, 150 insertions(+), 108 deletions(-) create mode 100644 test/URI/AbsoluteURI.purs diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 03d453d..8c097f8 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -25,7 +25,7 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), Path, PathAbsolute, PathRootless, Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query (Query) import Data.URI.Query as Query diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index 0a66b38..312dbbe 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -30,11 +30,11 @@ import Data.String as String import Data.Tuple (Tuple) import Data.URI.Authority (Authority(..), Host(..), Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority -import Data.URI.Path (Path) +import Data.URI.Path (Path(..)) import Data.URI.Path as Path -import Data.URI.Path.Absolute (PathAbsolute) +import Data.URI.Path.Absolute (PathAbsolute(..)) import Data.URI.Path.Absolute as PathAbs -import Data.URI.Path.Rootless (PathRootless) +import Data.URI.Path.Rootless (PathRootless(..)) import Data.URI.Path.Rootless as PathRootless import Text.Parsing.StringParser (ParseError, Parser) import Text.Parsing.StringParser.Combinators (optionMaybe) diff --git a/src/Data/URI/Path/Absolute.purs b/src/Data/URI/Path/Absolute.purs index 5acd4d2..da429f3 100644 --- a/src/Data/URI/Path/Absolute.purs +++ b/src/Data/URI/Path/Absolute.purs @@ -35,7 +35,10 @@ print ∷ PathAbsolute → String print = case _ of PathAbsolute Nothing → "/" + PathAbsolute (Just (Tuple head [])) → + "/" <> unsafeSegmentNZToString head PathAbsolute (Just (Tuple head tail)) → "/" <> unsafeSegmentNZToString head + <> "/" <> String.joinWith "/" (map unsafeSegmentToString tail) diff --git a/src/Data/URI/Path/Rootless.purs b/src/Data/URI/Path/Rootless.purs index 2da94f4..3452a41 100644 --- a/src/Data/URI/Path/Rootless.purs +++ b/src/Data/URI/Path/Rootless.purs @@ -27,6 +27,10 @@ parse p = wrapParser p do pure (PathRootless (Tuple head tail)) print ∷ PathRootless → String -print (PathRootless (Tuple head tail)) = - unsafeSegmentNZToString head - <> String.joinWith "/" (map unsafeSegmentToString tail) +print = case _ of + PathRootless (Tuple head []) → + unsafeSegmentNZToString head + PathRootless (Tuple head tail) → + unsafeSegmentNZToString head + <> "/" + <> String.joinWith "/" (map unsafeSegmentToString tail) diff --git a/test/Main.purs b/test/Main.purs index e7decb3..9b01bf7 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -4,6 +4,7 @@ import Prelude import Control.Monad.Aff.AVar (AVAR) import Control.Monad.Eff (Eff) +import Test.URI.AbsoluteURI as AbsoluteURI import Test.URI.Authority as Authority import Test.URI.Fragment as Fragment import Test.URI.Host as Host @@ -18,7 +19,7 @@ import Test.Unit.Console (TESTOUTPUT) import Test.Unit.Main (runTest) import Test.Util (TestEffects) -main ∷ ∀ eff. Eff (TestEffects (avar ∷ AVAR, testOutput ∷ TESTOUTPUT)) Unit +main ∷ Eff (TestEffects (avar ∷ AVAR, testOutput ∷ TESTOUTPUT)) Unit main = runTest $ suite "Data.URI" do Scheme.spec @@ -30,32 +31,7 @@ main = runTest $ Path.spec NonStandard.QueryPairs.spec URIRef.spec --- -- testIso --- -- (AbsoluteURI.parser options) --- -- (AbsoluteURI.print options) --- -- "couchbase://localhost/testBucket?password=&docTypeKey=" --- -- (AbsoluteURI --- -- (Scheme "couchbase") --- -- (HierarchicalPart --- -- (Just --- -- (Authority --- -- Nothing --- -- [(Tuple (NameAddress (RegName.fromString "localhost")) Nothing)])) --- -- (Just (Right (rootDir file "testBucket")))) --- -- (Just (Query.unsafeFromString "password=&docTypeKey="))) --- -- testIso --- -- (AbsoluteURI.parser options) --- -- (AbsoluteURI.print options) --- -- "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" --- -- (AbsoluteURI --- -- (Scheme "couchbase") --- -- (HierarchicalPart --- -- (Just --- -- (Authority --- -- Nothing --- -- [(Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 99999)))])) --- -- (Just (Right (rootDir file "testBucket")))) --- -- (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) + AbsoluteURI.spec -- -- Not an iso in this case as the printed path is normalised -- -- testRunParseURIRefParses diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs new file mode 100644 index 0000000..0a07e7a --- /dev/null +++ b/test/URI/AbsoluteURI.purs @@ -0,0 +1,82 @@ +module Test.URI.AbsoluteURI where + +import Prelude + +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Tuple (Tuple(..)) +import Data.URI.Host.RegName as RegName +import Data.URI.Path.Segment as PathSegment +import Data.URI.Query as Query +import Data.URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port(..), Query, Scheme(..), AbsoluteURI(..), AbsoluteURIOptions, UserInfo) +import Data.URI.AbsoluteURI as AbsoluteURI +import Test.Unit (TestSuite, suite) +import Test.Util (testIso) +import Text.Parsing.StringParser.Combinators (optionMaybe) + +spec ∷ ∀ eff. TestSuite eff +spec = + suite "AbsoluteURI parser/printer" do + testIso + (AbsoluteURI.parser options) + (AbsoluteURI.print options) + "couchbase://localhost/testBucket?password=&docTypeKey=" + (AbsoluteURI + (Scheme "couchbase") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.fromString "localhost")) Nothing))) + (path ["testBucket"])) + (Just (Query.unsafeFromString "password=&docTypeKey="))) + testIso + (AbsoluteURI.parser options) + (AbsoluteURI.print options) + "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" + (AbsoluteURI + (Scheme "couchbase") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 99999))))) + (path ["testBucket"])) + (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) + testIso + (AbsoluteURI.parser options) + (AbsoluteURI.print options) + "foo:/abc/def" + (AbsoluteURI + (Scheme "foo") + (HierarchicalPartNoAuth + (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString "abc") [PathSegment.unsafeSegmentFromString "def"])))))) + Nothing) + testIso + (AbsoluteURI.parser options) + (AbsoluteURI.print options) + "foo:abc/def" + (AbsoluteURI + (Scheme "foo") + (HierarchicalPartNoAuth + (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "abc") [PathSegment.unsafeSegmentFromString "def"]))))) + Nothing) + +path ∷ Array String → Maybe Path +path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString + +options ∷ Record (AbsoluteURIOptions UserInfo Maybe Host Port Path HierPath Query) +options = + { parseUserInfo: pure + , printUserInfo: id + , parseHosts: optionMaybe + , printHosts: fromMaybe "" + , parseHost: pure + , printHost: id + , parsePort: pure + , printPort: id + , parsePath: pure + , printPath: id + , parseHierPath: pure + , printHierPath: id + , parseQuery: pure + , printQuery: id + } diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index 2cf8e86..344f0e1 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -3,15 +3,13 @@ module Test.URI.URIRef where import Prelude import Data.Either (Either(..)) -import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..), fromMaybe) -import Data.Newtype (un) import Data.Tuple (Tuple(..)) import Data.URI.Fragment as Fragment import Data.URI.Host.RegName as RegName import Data.URI.Path.Segment as PathSegment import Data.URI.Query as Query -import Data.URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), Port(..), Query, RelPath, RelativePart(..), RelativeRef(..), Scheme(..), URI(..), URIRefOptions, UserInfo) +import Data.URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), PathRootless(..), Port(..), Query, RelPath, RelativePart(..), RelativeRef(..), Scheme(..), URI(..), URIRefOptions, UserInfo) import Data.URI.URIRef as URIRef import Data.URI.UserInfo as UserInfo import Test.Unit (TestSuite, suite) @@ -441,77 +439,56 @@ spec = (path ["metadata", "fs", "test", "%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23"])) (Just (Query.unsafeFromString "")) Nothing)) --- -- testIsoURIRef --- -- "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" --- -- (Left --- -- (URI --- -- (Scheme "http") --- -- (HierarchicalPart --- -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 53174))])) --- -- ((Just (Right (rootDir dir "metadata" dir "fs" dir "test" file "Пациенты# #"))))) --- -- (Just mempty) --- -- Nothing)) --- -- --- -- testIsoURIRef --- -- "../top_story.htm" --- -- (Right --- -- (RelativeRef --- -- (RelativePart --- -- Nothing --- -- (Just (Right (parentDir' currentDir file "top_story.htm")))) --- -- Nothing --- -- Nothing)) - --- -- testIsoURIRef --- -- "news:comp.infosystems.www.servers.unix" --- -- (Left --- -- (URI --- -- (Scheme "news") --- -- (HierarchicalPart --- -- Nothing --- -- (Just "comp.infosystems.www.servers.unix")) --- -- Nothing --- -- Nothing)) --- -- testIsoURIRef --- -- "tel:+1-816-555-1212" --- -- (Left --- -- (URI --- -- (Scheme "tel") --- -- (HierarchicalPart --- -- Nothing --- -- (Just "+1-816-555-1212")) --- -- Nothing --- -- Nothing)) --- -- testIsoURIRef --- -- "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" --- -- (Left --- -- (URI --- -- (Scheme "urn") --- -- (HierarchicalPart --- -- Nothing --- -- (Just "oasis:names:specification:docbook:dtd:xml:4.1.2")) --- -- Nothing --- -- Nothing)) --- -- testIsoURIRef --- -- "mailto:John.Doe@example.com" --- -- (Left --- -- (URI --- -- (Scheme "mailto") --- -- (HierarchicalPart --- -- Nothing --- -- (Just "John.Doe@example.com")) --- -- Nothing --- -- Nothing)) --- -- testIsoURIRef --- -- "mailto:fred@example.com" --- -- (Left --- -- (URI --- -- (Scheme "mailto") --- -- (HierarchicalPart --- -- Nothing --- -- (Just "fred@example.com")) --- -- Nothing --- -- Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "news:comp.infosystems.www.servers.unix" + (Left + (URI + (Scheme "news") + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "comp.infosystems.www.servers.unix") []))))) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "tel:+1-816-555-1212" + (Left + (URI + (Scheme "tel") + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "+1-816-555-1212") []))))) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" + (Left + (URI + (Scheme "urn") + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "oasis:names:specification:docbook:dtd:xml:4.1.2") []))))) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "mailto:John.Doe@example.com" + (Left + (URI + (Scheme "mailto") + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "John.Doe@example.com") []))))) + Nothing + Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "mailto:fred@example.com" + (Left + (URI + (Scheme "mailto") + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "fred@example.com") []))))) + Nothing + Nothing)) path ∷ Array String → Maybe Path path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString From c9172966b53721cb2749084a61e4f9f42fdb864e Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 5 Feb 2018 15:57:21 +0000 Subject: [PATCH 16/69] Update to use preferred test/parse libraries --- bower.json | 13 ++-- src/Data/URI/AbsoluteURI.purs | 23 +++---- src/Data/URI/Authority.purs | 21 +++--- src/Data/URI/Common.purs | 81 +++++++++++++++++------- src/Data/URI/Fragment.purs | 17 ++--- src/Data/URI/HierarchicalPart.purs | 31 ++++----- src/Data/URI/Host.purs | 49 +++++++------- src/Data/URI/Host/RegName.purs | 10 +-- src/Data/URI/NonStandard/QueryPairs.purs | 70 -------------------- src/Data/URI/Path.purs | 10 +-- src/Data/URI/Path/Absolute.purs | 14 ++-- src/Data/URI/Path/NoScheme.purs | 8 +-- src/Data/URI/Path/Rootless.purs | 8 +-- src/Data/URI/Path/Segment.purs | 22 +++---- src/Data/URI/Port.purs | 9 ++- src/Data/URI/Query.purs | 14 ++-- src/Data/URI/RelativePart.purs | 27 ++++---- src/Data/URI/RelativeRef.purs | 25 ++++---- src/Data/URI/Scheme.purs | 12 ++-- src/Data/URI/URI.purs | 25 ++++---- src/Data/URI/URIRef.purs | 24 +++---- src/Data/URI/UserInfo.purs | 14 ++-- test/Main.purs | 55 ++++------------ test/URI/AbsoluteURI.purs | 8 +-- test/URI/Authority.purs | 14 ++-- test/URI/Fragment.purs | 6 +- test/URI/Host.purs | 22 +++---- test/URI/NonStandard/QueryPairs.purs | 70 -------------------- test/URI/Path.purs | 6 +- test/URI/Port.purs | 6 +- test/URI/Scheme.purs | 6 +- test/URI/URIRef.purs | 36 +++++++++-- test/URI/UserInfo.purs | 6 +- test/Util.purs | 52 +++++++-------- 34 files changed, 360 insertions(+), 454 deletions(-) delete mode 100644 src/Data/URI/NonStandard/QueryPairs.purs delete mode 100644 test/URI/NonStandard/QueryPairs.purs diff --git a/bower.json b/bower.json index 5fe2447..2246a32 100755 --- a/bower.json +++ b/bower.json @@ -17,17 +17,16 @@ "package.json" ], "dependencies": { + "purescript-generics-rep": "^5.2.0", "purescript-globals": "^3.0.0", "purescript-integers": "^3.0.0", "purescript-maps": "^3.0.0", - "purescript-pathy": "^4.0.0", - "purescript-string-parsers": "^3.0.0", - "purescript-unfoldable": "^3.0.0", - "purescript-generics-rep": "^5.2.0", - "purescript-profunctor-lenses": "^3.7.0" + "purescript-parsing": "^4.3.1", + "purescript-profunctor-lenses": "^3.7.0", + "purescript-unfoldable": "^3.0.0" }, "devDependencies": { - "purescript-test-unit": "11.0.0", - "purescript-quickcheck": "^4.4.0" + "purescript-quickcheck": "^4.4.0", + "purescript-spec": "^2.0.0" } } diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 8c097f8..844e1a0 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -25,15 +25,16 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) +import Data.URI.Common (URIPartParseError) import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query (Query) import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) import Data.URI.Scheme as Scheme -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (optionMaybe) -import Text.Parsing.StringParser.String (eof) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (optionMaybe) +import Text.Parsing.Parser.String (eof) -- | A generic AbsoluteURI data AbsoluteURI userInfo hosts host port path hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts host port path hierPath) (Maybe query) @@ -48,13 +49,13 @@ type AbsoluteURIOptions userInfo hosts host port path hierPath query = (AbsoluteURIPrintOptions userInfo hosts host port path hierPath query ()) type AbsoluteURIParseOptions userInfo hosts host port path hierPath query r = - ( parseUserInfo ∷ UserInfo → Either ParseError userInfo - , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) - , parseHost ∷ Host → Either ParseError host - , parsePort ∷ Port → Either ParseError port - , parsePath ∷ Path → Either ParseError path - , parseHierPath ∷ Either PathAbsolute PathRootless → Either ParseError hierPath - , parseQuery ∷ Query → Either ParseError query + ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo + , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHost ∷ Host → Either URIPartParseError host + , parsePort ∷ Port → Either URIPartParseError port + , parsePath ∷ Path → Either URIPartParseError path + , parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError hierPath + , parseQuery ∷ Query → Either URIPartParseError query | r ) @@ -72,7 +73,7 @@ type AbsoluteURIPrintOptions userInfo hosts host port path hierPath query r = parser ∷ ∀ userInfo hosts host port path hierPath query r . Record (AbsoluteURIParseOptions userInfo hosts host port path hierPath query r) - → Parser (AbsoluteURI userInfo hosts host port path hierPath query) + → Parser String (AbsoluteURI userInfo hosts host port path hierPath query) parser opts = AbsoluteURI <$> Scheme.parser <*> HPart.parser opts diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index f0b93d2..2c107f5 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -22,15 +22,16 @@ import Data.Lens (Lens', lens) import Data.Maybe (Maybe, maybe) import Data.Ord (class Ord1, compare1) import Data.Tuple (Tuple(..)) +import Data.URI.Common (URIPartParseError) import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) import Data.URI.Host as Host import Data.URI.Port (Port(..)) import Data.URI.Port as Port import Data.URI.UserInfo (UserInfo) import Data.URI.UserInfo as UserInfo -import Text.Parsing.StringParser (ParseError, Parser, try) -import Text.Parsing.StringParser.Combinators (optionMaybe) -import Text.Parsing.StringParser.String (string) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (optionMaybe, try) +import Text.Parsing.Parser.String (char, string) -- | The authority part of a URI. For example: `purescript.org`, -- | `localhost:3000`, `user@example.net` @@ -54,10 +55,10 @@ type AuthorityOptions userInfo hosts host port = (AuthorityPrintOptions userInfo hosts host port ()) type AuthorityParseOptions userInfo hosts host port r = - ( parseUserInfo ∷ UserInfo → Either ParseError userInfo - , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) - , parseHost ∷ Host → Either ParseError host - , parsePort ∷ Port → Either ParseError port + ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo + , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHost ∷ Host → Either URIPartParseError host + , parsePort ∷ Port → Either URIPartParseError port | r ) @@ -72,14 +73,14 @@ type AuthorityPrintOptions userInfo hosts host port r = parser ∷ ∀ userInfo hosts host port r . Record (AuthorityParseOptions userInfo hosts host port r) - → Parser (Authority userInfo hosts host port) + → Parser String (Authority userInfo hosts host port) parser opts = do _ ← string "//" - ui ← optionMaybe $ try (UserInfo.parser opts.parseUserInfo <* string "@") + ui ← optionMaybe $ try (UserInfo.parser opts.parseUserInfo <* char '@') hosts ← opts.parseHosts $ Tuple <$> Host.parser opts.parseHost - <*> optionMaybe (string ":" *> Port.parser opts.parsePort) + <*> optionMaybe (char ':' *> Port.parser opts.parsePort) pure $ Authority ui hosts print diff --git a/src/Data/URI/Common.purs b/src/Data/URI/Common.purs index 92a61fc..3167692 100644 --- a/src/Data/URI/Common.purs +++ b/src/Data/URI/Common.purs @@ -1,7 +1,12 @@ module Data.URI.Common - ( wrapParser + ( URIPartParseError(..) + , wrapParser + , alpha + , digit + , alphaNum + , hexDigit , parseUnreserved - , newParsePCTEncoded + , pctEncoded , parseSubDelims , printEncoded ) where @@ -9,41 +14,71 @@ module Data.URI.Common import Prelude import Control.Alt ((<|>)) +import Control.Monad.Except (throwError) +import Control.Monad.State (get) import Data.Array as Array import Data.Either (Either(..), either) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Newtype (class Newtype, un) import Data.String as String import Global (encodeURIComponent) -import Text.Parsing.StringParser (ParseError, Parser(..), runParser, unParser) -import Text.Parsing.StringParser.String (alphaNum, anyChar, char, eof, oneOf) +import Text.Parsing.Parser (ParseError(..), ParseState(..), Parser, ParserT(..), runParser) +import Text.Parsing.Parser.String (anyChar, char, eof, oneOf, satisfy) -wrapParser ∷ ∀ a b. (a → Either ParseError b) → Parser a → Parser b -wrapParser parseA p = Parser \ps → do - pr ← unParser p ps - case parseA pr.result of - Left error → Left { error, pos: ps.pos } - Right result → Right { result, suffix: pr.suffix } +newtype URIPartParseError = URIPartParseError String -parseUnreserved ∷ Parser Char +derive newtype instance eqURIPartParseError :: Eq URIPartParseError +derive newtype instance ordURIPartParseError :: Ord URIPartParseError +derive instance newtypeURIPartParseError :: Newtype URIPartParseError _ +derive instance genericURIPartParseError :: Generic URIPartParseError _ +instance showURIPartParseError :: Show URIPartParseError where show = genericShow + +wrapParser + ∷ ∀ s m a b + . Monad m + ⇒ (a → Either URIPartParseError b) + → ParserT s m a + → ParserT s m b +wrapParser parseA p = ParserT do + ParseState _ pos _ ← get + a ← un ParserT p + case parseA a of + Left (URIPartParseError err) → throwError (ParseError err pos) + Right b → pure b + +alpha ∷ Parser String Char +alpha = satisfy \c → (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') + +digit ∷ Parser String Char +digit = satisfy \c → (c >= '0' && c <= '9') + +alphaNum ∷ Parser String Char +alphaNum = alpha <|> digit + +hexDigit ∷ Parser String Char +hexDigit = satisfy \c → (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F') + +parseUnreserved ∷ Parser String Char parseUnreserved = alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~' -newParsePCTEncoded ∷ Parser String -newParsePCTEncoded = do +pctEncoded ∷ Parser String String +pctEncoded = do d0 ← char '%' - d1 ← alphaNum - d2 ← alphaNum + d1 ← hexDigit + d2 ← hexDigit pure $ String.fromCharArray [d0, d1, d2] -parseSubDelims ∷ Parser Char +parseSubDelims ∷ Parser String Char parseSubDelims = - -- TODO: resolve the `,` situation - oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', {- ',', -} ';', '='] + oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '='] -- ','] -printEncoded ∷ Parser Char → String → String -printEncoded p s = either (const s) id (runParser parse s) +printEncoded ∷ Parser String Char → String → String +printEncoded p s = either (const s) id (runParser s parse) where - parse ∷ Parser String + parse ∷ Parser String String parse = (String.joinWith "" <$> Array.many (simpleChar <|> encodedChar)) <* eof - simpleChar ∷ Parser String + simpleChar ∷ Parser String String simpleChar = String.singleton <$> p - encodedChar ∷ Parser String + encodedChar ∷ Parser String String encodedChar = encodeURIComponent <<< String.singleton <$> anyChar diff --git a/src/Data/URI/Fragment.purs b/src/Data/URI/Fragment.purs index 685e3df..7c173f1 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/Data/URI/Fragment.purs @@ -15,10 +15,10 @@ import Data.Array as Array import Data.Either (Either) import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded, wrapParser) +import Data.URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) import Global (decodeURIComponent) -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.String (char, string) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.String (char) -- | The hash fragment of a URI. newtype Fragment = Fragment String @@ -43,16 +43,17 @@ unsafeFromString = Fragment unsafeToString ∷ Fragment → String unsafeToString (Fragment s) = s -parser ∷ ∀ f. (Fragment → Either ParseError f) → Parser f -parser parseF = string "#" *> - wrapParser parseF (Fragment <<< String.joinWith "" - <$> Array.many (newParsePCTEncoded <|> String.singleton <$> fragmentChar)) +parser ∷ ∀ f. (Fragment → Either URIPartParseError f) → Parser String f +parser parseF = + char '#' *> + wrapParser parseF (Fragment <<< String.joinWith "" + <$> Array.many (pctEncoded <|> String.singleton <$> fragmentChar)) print ∷ ∀ f. (f → Fragment) → f → String print printF f = "#" <> unsafeToString (printF f) -- | The supported fragment characters, excluding percent-encodings. -fragmentChar ∷ Parser Char +fragmentChar ∷ Parser String Char fragmentChar = parseUnreserved <|> parseSubDelims <|> char ':' <|> char '@' <|> char '/' <|> char '?' diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index 312dbbe..2c5e715 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -30,14 +30,15 @@ import Data.String as String import Data.Tuple (Tuple) import Data.URI.Authority (Authority(..), Host(..), Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority +import Data.URI.Common (URIPartParseError) import Data.URI.Path (Path(..)) import Data.URI.Path as Path import Data.URI.Path.Absolute (PathAbsolute(..)) import Data.URI.Path.Absolute as PathAbs import Data.URI.Path.Rootless (PathRootless(..)) import Data.URI.Path.Rootless as PathRootless -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (optionMaybe) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (optionMaybe) -- | The "hierarchical part" of a generic or absolute URI. data HierarchicalPart userInfo hosts host port path hierPath @@ -54,12 +55,12 @@ type HierarchicalPartOptions userInfo hosts host port path hierPath = (HierarchicalPartPrintOptions userInfo hosts host port path hierPath ()) type HierarchicalPartParseOptions userInfo hosts host port path hierPath r = - ( parseUserInfo ∷ UserInfo → Either ParseError userInfo - , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) - , parseHost ∷ Host → Either ParseError host - , parsePort ∷ Port → Either ParseError port - , parsePath ∷ Path → Either ParseError path - , parseHierPath ∷ HierPath → Either ParseError hierPath + ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo + , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHost ∷ Host → Either URIPartParseError host + , parsePort ∷ Port → Either URIPartParseError port + , parsePath ∷ Path → Either URIPartParseError path + , parseHierPath ∷ HierPath → Either URIPartParseError hierPath | r ) @@ -78,7 +79,7 @@ type HierPath = Either PathAbsolute PathRootless parser ∷ ∀ userInfo hosts host port path hierPath r . Record (HierarchicalPartParseOptions userInfo hosts host port path hierPath r) - → Parser (HierarchicalPart userInfo hosts host port path hierPath) + → Parser String (HierarchicalPart userInfo hosts host port path hierPath) parser opts = withAuth <|> withoutAuth where withAuth = @@ -111,24 +112,24 @@ _authority . Traversal' (HierarchicalPart userInfo hosts host port path hierPath) (Authority userInfo hosts host port) -_authority = wander \f a → case a of +_authority = wander \f → case _ of HierarchicalPartAuth a p → flip HierarchicalPartAuth p <$> f a - _ → pure a + a → pure a _path ∷ ∀ userInfo hosts host port path hierPath . Traversal' (HierarchicalPart userInfo hosts host port path hierPath) (Maybe path) -_path = wander \f a → case a of +_path = wander \f → case _ of HierarchicalPartAuth a p → HierarchicalPartAuth a <$> f p - _ → pure a + a → pure a _hierPath ∷ ∀ userInfo hosts host port path hierPath . Traversal' (HierarchicalPart userInfo hosts host port path hierPath) (Maybe hierPath) -_hierPath = wander \f a → case a of +_hierPath = wander \f → case _ of HierarchicalPartNoAuth p → HierarchicalPartNoAuth <$> f p - _ → pure a + a → pure a diff --git a/src/Data/URI/Host.purs b/src/Data/URI/Host.purs index 7cf1f83..22f7389 100644 --- a/src/Data/URI/Host.purs +++ b/src/Data/URI/Host.purs @@ -11,6 +11,7 @@ module Data.URI.Host import Prelude import Control.Alt ((<|>)) +import Data.Array as Array import Data.Either (Either(..)) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) @@ -18,12 +19,12 @@ import Data.Int as Int import Data.Lens (Prism', prism') import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (wrapParser) +import Data.URI.Common (URIPartParseError(..), digit, hexDigit, wrapParser) import Data.URI.Host.RegName (RegName) import Data.URI.Host.RegName as RegName -import Text.Parsing.StringParser (ParseError(..), Parser, try) -import Text.Parsing.StringParser.Combinators (()) -import Text.Parsing.StringParser.String (anyDigit, char, regex, satisfy, string) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (try, ()) +import Text.Parsing.Parser.String (char, satisfy) -- | A host address. data Host @@ -36,40 +37,40 @@ derive instance ordHost ∷ Ord Host derive instance genericHost ∷ Generic Host _ instance showHost ∷ Show Host where show = genericShow -parser ∷ ∀ h. (Host → Either ParseError h) → Parser h +parser ∷ ∀ h. (Host → Either URIPartParseError h) → Parser String h parser p = wrapParser p $ ipv6AddressParser <|> try ipv4AddressParser <|> (NameAddress <$> RegName.parser) --- TODO: this is much too forgiving right now -ipv6AddressParser ∷ Parser Host -ipv6AddressParser = IPv6Address <$> (string "[" *> regex "[a-fA-F0-9\\.:]+" <* string "]") "IPv6 address" +-- TODO: this is still much too forgiving +ipv6AddressParser ∷ Parser String Host +ipv6AddressParser = IPv6Address <$> (char '[' *> (String.fromCharArray <$> Array.some ipv6Char) <* char ']') "IPv6 address" + where + ipv6Char ∷ Parser String Char + ipv6Char = hexDigit <|> char ':' <|> char '.' -ipv4AddressParser ∷ Parser Host +ipv4AddressParser ∷ Parser String Host ipv4AddressParser = IPv4Address <$> addr "IPv4 address" where - addr ∷ Parser String + addr ∷ Parser String String addr = do - o1 <- octet - _ <- char '.' - o2 <- octet - _ <- char '.' - o3 <- octet - _ <- char '.' - o4 <- octet + o1 ← octet <* char '.' + o2 ← octet <* char '.' + o3 ← octet <* char '.' + o4 ← octet pure $ show o1 <> "." <> show o2 <> "." <> show o3 <> "." <> show o4 - octet ∷ Parser Int + octet ∷ Parser String Int octet = wrapParser toInt - $ try ((\x y z → String.fromCharArray [x, y, z]) <$> nzDigit <*> anyDigit <*> anyDigit) - <|> try ((\x y → String.fromCharArray [x, y]) <$> nzDigit <*> anyDigit) - <|> (String.singleton <$> anyDigit) - nzDigit ∷ Parser Char + $ try ((\x y z → String.fromCharArray [x, y, z]) <$> nzDigit <*> digit <*> digit) + <|> try ((\x y → String.fromCharArray [x, y]) <$> nzDigit <*> digit) + <|> (String.singleton <$> digit) + nzDigit ∷ Parser String Char nzDigit = satisfy (\c → c >= '1' && c <= '9') - toInt ∷ String → Either ParseError Int + toInt ∷ String → Either URIPartParseError Int toInt s = case Int.fromString s of Just n | n >= 0 && n <= 255 → Right n - _ → Left (ParseError "Invalid IPv4 address octet") + _ → Left (URIPartParseError "Invalid IPv4 address octet") print ∷ ∀ h. (h → Host) → h → String print f = f >>> case _ of diff --git a/src/Data/URI/Host/RegName.purs b/src/Data/URI/Host/RegName.purs index aea84bc..414be7d 100644 --- a/src/Data/URI/Host/RegName.purs +++ b/src/Data/URI/Host/RegName.purs @@ -13,9 +13,9 @@ import Control.Alt ((<|>)) import Data.Array as Array import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded) +import Data.URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) import Global (decodeURIComponent) -import Text.Parsing.StringParser (Parser) +import Text.Parsing.Parser (Parser) newtype RegName = RegName String @@ -52,10 +52,10 @@ unsafeFromString = RegName unsafeToString ∷ RegName → String unsafeToString (RegName s) = s -parser ∷ Parser RegName +parser ∷ Parser String RegName parser = RegName <<< String.joinWith "" <$> Array.some p where - p = newParsePCTEncoded <|> String.singleton <$> regNameChar + p = pctEncoded <|> String.singleton <$> regNameChar -regNameChar ∷ Parser Char +regNameChar ∷ Parser String Char regNameChar = parseUnreserved <|> parseSubDelims diff --git a/src/Data/URI/NonStandard/QueryPairs.purs b/src/Data/URI/NonStandard/QueryPairs.purs deleted file mode 100644 index c42e7e2..0000000 --- a/src/Data/URI/NonStandard/QueryPairs.purs +++ /dev/null @@ -1,70 +0,0 @@ -module Data.URI.NonStandard.QueryPairs - ( QueryPairs(..) - , parse - , print - ) where - -import Prelude - -import Control.Alt ((<|>)) -import Data.Array as Array -import Data.Either (Either, fromRight) -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.List (List) -import Data.Maybe (Maybe(..)) -import Data.Monoid (class Monoid) -import Data.Newtype (class Newtype) -import Data.String as String -import Data.String.Regex as RX -import Data.String.Regex.Flags as RXF -import Data.Tuple (Tuple(..)) -import Data.URI.Query as Q -import Global (decodeURIComponent, encodeURIComponent) -import Partial.Unsafe (unsafePartial) -import Text.Parsing.StringParser (ParseError, Parser, runParser) -import Text.Parsing.StringParser.Combinators (optionMaybe, sepBy) -import Text.Parsing.StringParser.String (regex, string) - -newtype QueryPairs = QueryPairs (List (Tuple String (Maybe String))) - -derive newtype instance eqQueryPairs ∷ Eq QueryPairs -derive newtype instance ordQueryPairs ∷ Ord QueryPairs -derive instance genericQueryPairs ∷ Generic QueryPairs _ -derive instance newtypeQueryPairs ∷ Newtype QueryPairs _ -instance showQueryPairs ∷ Show QueryPairs where show = genericShow -derive newtype instance semigroupQueryPairs ∷ Semigroup QueryPairs -derive newtype instance monoidQueryPairs ∷ Monoid QueryPairs - -parse ∷ Q.Query → Either ParseError QueryPairs -parse = runParser (QueryPairs <$> parseParts) <<< Q.unsafeToString - -parseParts ∷ Parser (List (Tuple String (Maybe String))) -parseParts = sepBy parsePart (string ";" <|> string "&") - -parsePart ∷ Parser (Tuple String (Maybe String)) -parsePart = do - key ← decodeURIComponent <$> regex "[^=;&]+" - value ← optionMaybe $ decodeURIComponent <$> (string "=" *> regex "[^;&]*") - pure $ Tuple key value - -print ∷ QueryPairs → Q.Query -print (QueryPairs m) = Q.unsafeFromString $ String.joinWith "&" $ Array.fromFoldable (printPart <$> m) - where - printPart ∷ Tuple String (Maybe String) → String - printPart (Tuple k Nothing) = - printQueryPairsPart k - printPart (Tuple k (Just v)) = - printQueryPairsPart k <> "=" <> printQueryPairsPart v - -printQueryPairsPart ∷ String → String -printQueryPairsPart = String.joinWith "" <<< map printChar <<< String.split (String.Pattern "") - where - -- Fragments & queries have a bunch of characters that don't need escaping - printChar ∷ String → String - printChar s - | RX.test rxPrintable s = s - | otherwise = encodeURIComponent s - -rxPrintable ∷ RX.Regex -rxPrintable = unsafePartial fromRight $ RX.regex "[$+/?:@]" RXF.global diff --git a/src/Data/URI/Path.purs b/src/Data/URI/Path.purs index cbc3bdc..8f35ee2 100644 --- a/src/Data/URI/Path.purs +++ b/src/Data/URI/Path.purs @@ -7,10 +7,10 @@ import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.String as String -import Data.URI.Common (wrapParser) +import Data.URI.Common (URIPartParseError, wrapParser) import Data.URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.String (string) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.String (char) newtype Path = Path (Array PathSegment) @@ -19,8 +19,8 @@ derive newtype instance ordPath ∷ Ord Path derive instance genericPath ∷ Generic Path _ instance showPath ∷ Show Path where show = genericShow -parser ∷ ∀ p. (Path → Either ParseError p) → Parser p -parser p = wrapParser p $ Path <$> Array.some (string "/" *> parseSegment) +parser ∷ ∀ p. (Path → Either URIPartParseError p) → Parser String p +parser p = wrapParser p $ Path <$> Array.some (char '/' *> parseSegment) print ∷ Path → String print (Path segs) = "/" <> String.joinWith "/" (map unsafeSegmentToString segs) diff --git a/src/Data/URI/Path/Absolute.purs b/src/Data/URI/Path/Absolute.purs index da429f3..afba2e0 100644 --- a/src/Data/URI/Path/Absolute.purs +++ b/src/Data/URI/Path/Absolute.purs @@ -9,11 +9,11 @@ import Data.Generic.Rep.Show (genericShow) import Data.Maybe (Maybe(..)) import Data.String as String import Data.Tuple (Tuple(..)) -import Data.URI.Common (wrapParser) +import Data.URI.Common (URIPartParseError, wrapParser) import Data.URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (optionMaybe) -import Text.Parsing.StringParser.String (string) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (optionMaybe) +import Text.Parsing.Parser.String (char) newtype PathAbsolute = PathAbsolute (Maybe (Tuple PathSegmentNZ (Array PathSegment))) @@ -22,12 +22,12 @@ derive instance ordPathAbsolute ∷ Ord PathAbsolute derive instance genericPathAbsolute ∷ Generic PathAbsolute _ instance showPathAbsolute ∷ Show PathAbsolute where show = genericShow -parse ∷ ∀ p. (PathAbsolute → Either ParseError p) → Parser p +parse ∷ ∀ p. (PathAbsolute → Either URIPartParseError p) → Parser String p parse p = wrapParser p do - _ ← string "/" + _ ← char '/' optionMaybe parseSegmentNonZero >>= case _ of Just head → - PathAbsolute <<< Just <<< Tuple head <$> Array.many (string "/" *> parseSegment) + PathAbsolute <<< Just <<< Tuple head <$> Array.many (char '/' *> parseSegment) Nothing → pure (PathAbsolute Nothing) diff --git a/src/Data/URI/Path/NoScheme.purs b/src/Data/URI/Path/NoScheme.purs index 90d1584..e9d853b 100644 --- a/src/Data/URI/Path/NoScheme.purs +++ b/src/Data/URI/Path/NoScheme.purs @@ -8,10 +8,10 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.String as String import Data.Tuple (Tuple(..)) -import Data.URI.Common (wrapParser) +import Data.URI.Common (URIPartParseError, wrapParser) import Data.URI.Path.Segment (PathSegment, PathSegmentNZNC, parseSegment, parseSegmentNonZeroNoColon, unsafeSegmentNZNCToString, unsafeSegmentToString) -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.String (char) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.String (char) newtype PathNoScheme = PathNoScheme (Tuple PathSegmentNZNC (Array PathSegment)) @@ -20,7 +20,7 @@ derive instance ordPathNoScheme ∷ Ord PathNoScheme derive instance genericPathNoScheme ∷ Generic PathNoScheme _ instance showPathNoScheme ∷ Show PathNoScheme where show = genericShow -parse ∷ ∀ p. (PathNoScheme → Either ParseError p) → Parser p +parse ∷ ∀ p. (PathNoScheme → Either URIPartParseError p) → Parser String p parse p = wrapParser p do head ← parseSegmentNonZeroNoColon tail ← Array.many (char '/' *> parseSegment) diff --git a/src/Data/URI/Path/Rootless.purs b/src/Data/URI/Path/Rootless.purs index 3452a41..05cdc42 100644 --- a/src/Data/URI/Path/Rootless.purs +++ b/src/Data/URI/Path/Rootless.purs @@ -8,10 +8,10 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.String as String import Data.Tuple (Tuple(..)) -import Data.URI.Common (wrapParser) +import Data.URI.Common (URIPartParseError, wrapParser) import Data.URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.String (char) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.String (char) newtype PathRootless = PathRootless (Tuple PathSegmentNZ (Array PathSegment)) @@ -20,7 +20,7 @@ derive instance ordPathRootless ∷ Ord PathRootless derive instance genericPathRootless ∷ Generic PathRootless _ instance showPathRootless ∷ Show PathRootless where show = genericShow -parse ∷ ∀ p. (PathRootless → Either ParseError p) → Parser p +parse ∷ ∀ p. (PathRootless → Either URIPartParseError p) → Parser String p parse p = wrapParser p do head ← parseSegmentNonZero tail ← Array.many (char '/' *> parseSegment) diff --git a/src/Data/URI/Path/Segment.purs b/src/Data/URI/Path/Segment.purs index 1aa55a8..f2a4494 100644 --- a/src/Data/URI/Path/Segment.purs +++ b/src/Data/URI/Path/Segment.purs @@ -27,10 +27,10 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded) +import Data.URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) import Global (decodeURIComponent) -import Text.Parsing.StringParser (Parser) -import Text.Parsing.StringParser.String (char) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.String (char) newtype PathSegment = PathSegment String @@ -39,11 +39,11 @@ derive newtype instance ordPathSegment ∷ Ord PathSegment derive instance genericPathSegment ∷ Generic PathSegment _ instance showPathSegment ∷ Show PathSegment where show = genericShow -parseSegment ∷ Parser PathSegment +parseSegment ∷ Parser String PathSegment parseSegment = PathSegment <<< String.joinWith "" - <$> Array.many (newParsePCTEncoded <|> String.singleton <$> segmentChar) + <$> Array.many (pctEncoded <|> String.singleton <$> segmentChar) segmentFromString ∷ String → PathSegment segmentFromString = PathSegment <<< printEncoded segmentChar @@ -64,11 +64,11 @@ derive newtype instance ordPathSegmentNZ ∷ Ord PathSegmentNZ derive instance genericPathSegmentNZ ∷ Generic PathSegmentNZ _ instance showPathSegmentNZ ∷ Show PathSegmentNZ where show = genericShow -parseSegmentNonZero ∷ Parser PathSegmentNZ +parseSegmentNonZero ∷ Parser String PathSegmentNZ parseSegmentNonZero = PathSegmentNZ <<< String.joinWith "" - <$> Array.some (newParsePCTEncoded <|> String.singleton <$> segmentChar) + <$> Array.some (pctEncoded <|> String.singleton <$> segmentChar) segmentNZFromString ∷ String → Maybe PathSegmentNZ segmentNZFromString = case _ of @@ -91,11 +91,11 @@ derive newtype instance ordPathSegmentNZNC ∷ Ord PathSegmentNZNC derive instance genericPathSegmentNZNC ∷ Generic PathSegmentNZNC _ instance showPathSegmentNZNC ∷ Show PathSegmentNZNC where show = genericShow -parseSegmentNonZeroNoColon ∷ Parser PathSegmentNZNC +parseSegmentNonZeroNoColon ∷ Parser String PathSegmentNZNC parseSegmentNonZeroNoColon = PathSegmentNZNC <<< String.joinWith "" - <$> Array.some (newParsePCTEncoded <|> String.singleton <$> segmentNCChar) + <$> Array.some (pctEncoded <|> String.singleton <$> segmentNCChar) segmentNZNCToString ∷ PathSegmentNZNC → String segmentNZNCToString (PathSegmentNZNC s) = decodeURIComponent s @@ -111,8 +111,8 @@ segmentNZNCFromString = case _ of unsafeSegmentNZNCFromString ∷ String → PathSegmentNZNC unsafeSegmentNZNCFromString = PathSegmentNZNC -segmentChar ∷ Parser Char +segmentChar ∷ Parser String Char segmentChar = segmentNCChar <|> char ':' -segmentNCChar ∷ Parser Char +segmentNCChar ∷ Parser String Char segmentNCChar = parseUnreserved <|> parseSubDelims <|> char '@' diff --git a/src/Data/URI/Port.purs b/src/Data/URI/Port.purs index dbb1ef9..90c6a69 100644 --- a/src/Data/URI/Port.purs +++ b/src/Data/URI/Port.purs @@ -14,10 +14,9 @@ import Data.Int (fromNumber) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) import Data.String as String -import Data.URI.Common (wrapParser) +import Data.URI.Common (URIPartParseError, digit, wrapParser) import Global (readInt) -import Text.Parsing.StringParser (ParseError, Parser, fail) -import Text.Parsing.StringParser.String (anyDigit) +import Text.Parsing.Parser (Parser, fail) -- | A port number. newtype Port = Port Int @@ -28,9 +27,9 @@ derive instance genericPort ∷ Generic Port _ derive instance newtypePort ∷ Newtype Port _ instance showPort ∷ Show Port where show = genericShow -parser ∷ ∀ p. (Port → Either ParseError p) → Parser p +parser ∷ ∀ p. (Port → Either URIPartParseError p) → Parser String p parser p = wrapParser p do - s ← String.fromCharArray <$> Array.some anyDigit + s ← String.fromCharArray <$> Array.some digit case fromNumber $ readInt 10 s of Just x → pure (Port x) _ → fail "Expected valid port number" diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index cde21cd..12d05e6 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -15,10 +15,10 @@ import Data.Array as Array import Data.Either (Either) import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded, wrapParser) +import Data.URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) import Global (decodeURIComponent) -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.String (char, string) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.String (char) newtype Query = Query String @@ -42,17 +42,17 @@ unsafeFromString = Query unsafeToString ∷ Query → String unsafeToString (Query s) = s -parser ∷ ∀ q. (Query → Either ParseError q) → Parser q +parser ∷ ∀ q. (Query → Either URIPartParseError q) → Parser String q parser parseQ = - string "?" *> + char '?' *> wrapParser parseQ (Query <<< String.joinWith "" <$> Array.many p) where - p = String.singleton <$> queryChar <|> newParsePCTEncoded + p = String.singleton <$> queryChar <|> pctEncoded print ∷ ∀ q. (q → Query) → q → String print printQ q = "?" <> unsafeToString (printQ q) -queryChar ∷ Parser Char +queryChar ∷ Parser String Char queryChar = parseUnreserved <|> parseSubDelims diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index 325a4c4..b419f9f 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -30,14 +30,15 @@ import Data.String as String import Data.Tuple (Tuple) import Data.URI.Authority (Authority(..), Host(..), Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority +import Data.URI.Common (URIPartParseError) import Data.URI.Path (Path) import Data.URI.Path as Path import Data.URI.Path.Absolute (PathAbsolute) import Data.URI.Path.Absolute as PathAbs import Data.URI.Path.NoScheme (PathNoScheme) import Data.URI.Path.NoScheme as PathNoScheme -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (optionMaybe) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (optionMaybe) -- | The "relative part" of a relative reference. data RelativePart userInfo hosts host port path relPath @@ -54,12 +55,12 @@ type RelativePartOptions userInfo hosts host port path relPath = (RelativePartPrintOptions userInfo hosts host port path relPath ()) type RelativePartParseOptions userInfo hosts host port path relPath r = - ( parseUserInfo ∷ UserInfo → Either ParseError userInfo - , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) - , parseHost ∷ Host → Either ParseError host - , parsePort ∷ Port → Either ParseError port - , parsePath ∷ Path → Either ParseError path - , parseRelPath ∷ RelPath → Either ParseError relPath + ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo + , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHost ∷ Host → Either URIPartParseError host + , parsePort ∷ Port → Either URIPartParseError port + , parsePath ∷ Path → Either URIPartParseError path + , parseRelPath ∷ RelPath → Either URIPartParseError relPath | r ) @@ -78,7 +79,7 @@ type RelPath = Either PathAbsolute PathNoScheme parser ∷ ∀ userInfo hosts host port path relPath r . Record (RelativePartParseOptions userInfo hosts host port path relPath r) - → Parser (RelativePart userInfo hosts host port path relPath) + → Parser String (RelativePart userInfo hosts host port path relPath) parser opts = withAuth <|> withoutAuth where withAuth = @@ -111,18 +112,18 @@ _authority . Traversal' (RelativePart userInfo hosts host port path relPath) (Authority userInfo hosts host port) -_authority = wander \f a → case a of +_authority = wander \f → case _ of RelativePartAuth a p → flip RelativePartAuth p <$> f a - _ → pure a + a → pure a _path ∷ ∀ userInfo hosts host port path relPath . Traversal' (RelativePart userInfo hosts host port path relPath) (Maybe path) -_path = wander \f a → case a of +_path = wander \f → case _ of RelativePartAuth a p → RelativePartAuth a <$> f p - _ → pure a + a → pure a _relPath ∷ ∀ userInfo hosts host port path relPath diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 1bf5144..49c55e6 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -25,15 +25,16 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) +import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment import Data.URI.Query (Query) import Data.URI.Query as Query import Data.URI.RelativePart (Authority(..), Host(..), Path, PathAbsolute, PathNoScheme, Port(..), RelativePart(..), RelPath, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.RelativePart as RPart -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (optionMaybe) -import Text.Parsing.StringParser.String (eof) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (optionMaybe) +import Text.Parsing.Parser.String (eof) -- | A relative reference for a URI. data RelativeRef userInfo hosts host port path relPath query fragment = RelativeRef (RelativePart userInfo hosts host port path relPath) (Maybe query) (Maybe fragment) @@ -48,14 +49,14 @@ type RelativeRefOptions userInfo hosts host port path relPath query fragment = (RelativeRefPrintOptions userInfo hosts host port path relPath query fragment ()) type RelativeRefParseOptions userInfo hosts host port path relPath query fragment r = - ( parseUserInfo ∷ UserInfo → Either ParseError userInfo - , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) - , parseHost ∷ Host → Either ParseError host - , parsePort ∷ Port → Either ParseError port - , parsePath ∷ Path → Either ParseError path - , parseRelPath ∷ Either PathAbsolute PathNoScheme → Either ParseError relPath - , parseQuery ∷ Query → Either ParseError query - , parseFragment ∷ Fragment → Either ParseError fragment + ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo + , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHost ∷ Host → Either URIPartParseError host + , parsePort ∷ Port → Either URIPartParseError port + , parsePath ∷ Path → Either URIPartParseError path + , parseRelPath ∷ Either PathAbsolute PathNoScheme → Either URIPartParseError relPath + , parseQuery ∷ Query → Either URIPartParseError query + , parseFragment ∷ Fragment → Either URIPartParseError fragment | r ) @@ -74,7 +75,7 @@ type RelativeRefPrintOptions userInfo hosts host port path relPath query fragmen parser ∷ ∀ userInfo hosts host port path relPath query fragment r . Record (RelativeRefParseOptions userInfo hosts host port path relPath query fragment r) - → Parser (RelativeRef userInfo hosts host port path relPath query fragment) + → Parser String (RelativeRef userInfo hosts host port path relPath query fragment) parser opts = RelativeRef <$> RPart.parser opts diff --git a/src/Data/URI/Scheme.purs b/src/Data/URI/Scheme.purs index 7d5475d..b1d3dc1 100644 --- a/src/Data/URI/Scheme.purs +++ b/src/Data/URI/Scheme.purs @@ -8,8 +8,9 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Newtype (class Newtype) import Data.String as String -import Text.Parsing.StringParser (Parser) -import Text.Parsing.StringParser.String (alphaNum, anyLetter, char, string) +import Data.URI.Common (alpha, alphaNum) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.String (char) -- | The scheme part of an absolute URI. For example: `http`, `ftp`, `git`. newtype Scheme = Scheme String @@ -20,12 +21,13 @@ derive instance genericScheme ∷ Generic Scheme _ derive instance newtypeScheme ∷ Newtype Scheme _ instance showScheme ∷ Show Scheme where show = genericShow -parser ∷ Parser Scheme -parser = Scheme <$> parseScheme <* string ":" +parser ∷ Parser String Scheme +parser = Scheme <$> parseScheme where parseScheme = do - init ← anyLetter + init ← alpha rest ← Array.many (alphaNum <|> char '+' <|> char '-' <|> char '.') + _ ← char ':' pure $ String.singleton init <> String.fromCharArray rest print ∷ Scheme → String diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 0f6029d..ddc8466 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -26,6 +26,7 @@ import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String import Data.Tuple (Tuple) +import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), Path, PathAbsolute, PathRootless, Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) @@ -34,9 +35,9 @@ import Data.URI.Query (Query) import Data.URI.Query as Query import Data.URI.Scheme (Scheme(..)) import Data.URI.Scheme as Scheme -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.Combinators (optionMaybe) -import Text.Parsing.StringParser.String (eof) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (optionMaybe) +import Text.Parsing.Parser.String (eof) -- | A generic URI data URI userInfo hosts host port path hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts host port path hierPath) (Maybe query) (Maybe fragment) @@ -51,14 +52,14 @@ type URIOptions userInfo hosts host port path hierPath query fragment = (URIPrintOptions userInfo hosts host port path hierPath query fragment ()) type URIParseOptions userInfo hosts host port path hierPath query fragment r = - ( parseUserInfo ∷ UserInfo → Either ParseError userInfo - , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) - , parseHost ∷ Host → Either ParseError host - , parsePort ∷ Port → Either ParseError port - , parsePath ∷ Path → Either ParseError path - , parseHierPath ∷ Either PathAbsolute PathRootless → Either ParseError hierPath - , parseQuery ∷ Query → Either ParseError query - , parseFragment ∷ Fragment → Either ParseError fragment + ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo + , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHost ∷ Host → Either URIPartParseError host + , parsePort ∷ Port → Either URIPartParseError port + , parsePath ∷ Path → Either URIPartParseError path + , parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError hierPath + , parseQuery ∷ Query → Either URIPartParseError query + , parseFragment ∷ Fragment → Either URIPartParseError fragment | r ) @@ -77,7 +78,7 @@ type URIPrintOptions userInfo hosts host port path hierPath query fragment r = parser ∷ ∀ userInfo hosts host port path hierPath query fragment r . Record (URIParseOptions userInfo hosts host port path hierPath query fragment r) - → Parser (URI userInfo hosts host port path hierPath query fragment) + → Parser String (URI userInfo hosts host port path hierPath query fragment) parser opts = URI <$> Scheme.parser <*> HPart.parser opts diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index 16c6c6f..8ad4426 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -25,6 +25,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Either (Either(..), either) import Data.URI.Authority (Authority(..)) +import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) import Data.URI.Path (Path(..)) @@ -39,7 +40,8 @@ import Data.URI.Scheme (Scheme(..)) import Data.URI.URI (URI(..), HierarchicalPart(..), HierPath) import Data.URI.URI as URI import Data.URI.UserInfo (UserInfo) -import Text.Parsing.StringParser (ParseError, Parser, try) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (try) -- | An alias for the most common use case of resource identifiers. type URIRef userInfo hosts host port path hierPath relPath query fragment = @@ -52,15 +54,15 @@ type URIRefOptions userInfo hosts host port path hierPath relPath query fragment (URIRefPrintOptions userInfo hosts host port path hierPath relPath query fragment ()) type URIRefParseOptions userInfo hosts host port path hierPath relPath query fragment r = - ( parseUserInfo ∷ UserInfo → Either ParseError userInfo - , parseHosts ∷ ∀ a. Parser a → Parser (hosts a) - , parseHost ∷ Host → Either ParseError host - , parsePort ∷ Port → Either ParseError port - , parsePath ∷ Path → Either ParseError path - , parseHierPath ∷ Either PathAbsolute PathRootless → Either ParseError hierPath - , parseRelPath ∷ Either PathAbsolute PathNoScheme → Either ParseError relPath - , parseQuery ∷ Query → Either ParseError query - , parseFragment ∷ Fragment → Either ParseError fragment + ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo + , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHost ∷ Host → Either URIPartParseError host + , parsePort ∷ Port → Either URIPartParseError port + , parsePath ∷ Path → Either URIPartParseError path + , parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError hierPath + , parseRelPath ∷ Either PathAbsolute PathNoScheme → Either URIPartParseError relPath + , parseQuery ∷ Query → Either URIPartParseError query + , parseFragment ∷ Fragment → Either URIPartParseError fragment | r ) @@ -80,7 +82,7 @@ type URIRefPrintOptions userInfo hosts host port path hierPath relPath query fra parser ∷ ∀ userInfo hosts host port path hierPath relPath query fragment r . Record (URIRefParseOptions userInfo hosts host port path hierPath relPath query fragment r) - → Parser (URIRef userInfo hosts host port path hierPath relPath query fragment) + → Parser String (URIRef userInfo hosts host port path hierPath relPath query fragment) parser opts = (Left <$> try (URI.parser opts)) <|> (Right <$> RelativeRef.parser opts) diff --git a/src/Data/URI/UserInfo.purs b/src/Data/URI/UserInfo.purs index 1da2a8c..c93f0aa 100644 --- a/src/Data/URI/UserInfo.purs +++ b/src/Data/URI/UserInfo.purs @@ -15,10 +15,10 @@ import Data.Array as Array import Data.Either (Either) import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (newParsePCTEncoded, parseSubDelims, parseUnreserved, printEncoded, wrapParser) +import Data.URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) import Global (decodeURIComponent) -import Text.Parsing.StringParser (ParseError, Parser) -import Text.Parsing.StringParser.String (char) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.String (char) -- | The user info part of an `Authority`. For example: `user`, `foo:bar`. newtype UserInfo = UserInfo String @@ -56,15 +56,15 @@ unsafeFromString = UserInfo unsafeToString ∷ UserInfo → String unsafeToString (UserInfo s) = s -parser ∷ ∀ ui. (UserInfo → Either ParseError ui) → Parser ui +parser ∷ ∀ ui. (UserInfo → Either URIPartParseError ui) → Parser String ui parser p = wrapParser p (UserInfo <<< String.joinWith "" <$> Array.some parse) where - parse ∷ Parser String - parse = String.singleton <$> userInfoChar <|> newParsePCTEncoded + parse ∷ Parser String String + parse = String.singleton <$> userInfoChar <|> pctEncoded print ∷ ∀ ui. (ui → UserInfo) → ui → String print = map unsafeToString -- | The supported user info characters, excluding percent-encodings. -userInfoChar ∷ Parser Char +userInfoChar ∷ Parser String Char userInfoChar = parseUnreserved <|> parseSubDelims <|> char ':' diff --git a/test/Main.purs b/test/Main.purs index 9b01bf7..71097a6 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -4,54 +4,27 @@ import Prelude import Control.Monad.Aff.AVar (AVAR) import Control.Monad.Eff (Eff) +import Test.Spec.Reporter (consoleReporter) +import Test.Spec.Runner (PROCESS, run) import Test.URI.AbsoluteURI as AbsoluteURI import Test.URI.Authority as Authority import Test.URI.Fragment as Fragment import Test.URI.Host as Host -import Test.URI.NonStandard.QueryPairs as NonStandard.QueryPairs import Test.URI.Path as Path import Test.URI.Port as Port import Test.URI.Scheme as Scheme -import Test.URI.UserInfo as UserInfo import Test.URI.URIRef as URIRef -import Test.Unit (suite) -import Test.Unit.Console (TESTOUTPUT) -import Test.Unit.Main (runTest) +import Test.URI.UserInfo as UserInfo import Test.Util (TestEffects) -main ∷ Eff (TestEffects (avar ∷ AVAR, testOutput ∷ TESTOUTPUT)) Unit -main = runTest $ - suite "Data.URI" do - Scheme.spec - UserInfo.spec - Host.spec - Port.spec - Fragment.spec - Authority.spec - Path.spec - NonStandard.QueryPairs.spec - URIRef.spec - AbsoluteURI.spec - --- -- Not an iso in this case as the printed path is normalised --- -- testRunParseURIRefParses --- -- "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" --- -- (Left --- -- (URI --- -- (Scheme "http") --- -- (HierarchicalPart --- -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "local.)slamdata.com") Nothing])) --- -- ((Just (Left rootDir)))) --- -- ((Just mempty)) --- -- ((Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214"))))) --- -- testPrinter --- -- URIRef.print --- -- "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" --- -- (Left --- -- (URI --- -- (Scheme "http") --- -- (HierarchicalPart --- -- (Just (Authority Nothing [Tuple (NameAddress (RegName.fromString "local.)slamdata.com") Nothing])) --- -- ((Just (Left rootDir)))) --- -- ((Just mempty)) --- -- ((Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214"))))) +main ∷ Eff (TestEffects (avar ∷ AVAR, process ∷ PROCESS)) Unit +main = run [consoleReporter] do + Scheme.spec + UserInfo.spec + Host.spec + Port.spec + Fragment.spec + Authority.spec + Path.spec + URIRef.spec + AbsoluteURI.spec diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs index 0a07e7a..066130b 100644 --- a/test/URI/AbsoluteURI.purs +++ b/test/URI/AbsoluteURI.purs @@ -10,13 +10,13 @@ import Data.URI.Path.Segment as PathSegment import Data.URI.Query as Query import Data.URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port(..), Query, Scheme(..), AbsoluteURI(..), AbsoluteURIOptions, UserInfo) import Data.URI.AbsoluteURI as AbsoluteURI -import Test.Unit (TestSuite, suite) +import Test.Spec (Spec, describe) import Test.Util (testIso) -import Text.Parsing.StringParser.Combinators (optionMaybe) +import Text.Parsing.Parser.Combinators (optionMaybe) -spec ∷ ∀ eff. TestSuite eff +spec ∷ ∀ eff. Spec eff Unit spec = - suite "AbsoluteURI parser/printer" do + describe "AbsoluteURI parser/printer" do testIso (AbsoluteURI.parser options) (AbsoluteURI.print options) diff --git a/test/URI/Authority.purs b/test/URI/Authority.purs index c32c17a..b0564c7 100644 --- a/test/URI/Authority.purs +++ b/test/URI/Authority.purs @@ -6,20 +6,20 @@ import Data.Array as Array import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..)) import Data.Newtype (un) -import Data.Tuple (Tuple(..)) import Data.String as String +import Data.Tuple (Tuple(..)) import Data.URI.Authority (Authority(..), AuthorityOptions, Host(..), Port(..), UserInfo) import Data.URI.Authority as Authority import Data.URI.Host.RegName as RegName import Data.URI.UserInfo as UserInfo -import Test.Unit (TestSuite, suite) +import Test.Spec (Spec, describe) import Test.Util (testIso) -import Text.Parsing.StringParser.Combinators (sepBy) as SP -import Text.Parsing.StringParser.String (string) as SP +import Text.Parsing.Parser.Combinators (sepBy) as SP +import Text.Parsing.Parser.String (char) as SP -spec ∷ ∀ eff. TestSuite eff +spec ∷ ∀ eff. Spec eff Unit spec = - suite "Authority parser/printer" do + describe "Authority parser/printer" do testIso (Authority.parser optionsSingle) (Authority.print optionsSingle) @@ -67,7 +67,7 @@ optionsMany ∷ Record (AuthorityOptions UserInfo Array Host Port) optionsMany = { parseUserInfo: pure , printUserInfo: id - , parseHosts: map Array.fromFoldable <<< flip SP.sepBy (SP.string ",") + , parseHosts: map Array.fromFoldable <<< flip SP.sepBy (SP.char ',') , printHosts: String.joinWith "," , parseHost: pure , printHost: id diff --git a/test/URI/Fragment.purs b/test/URI/Fragment.purs index 9c6ab95..5fa97b5 100644 --- a/test/URI/Fragment.purs +++ b/test/URI/Fragment.purs @@ -3,12 +3,12 @@ module Test.URI.Fragment where import Prelude import Data.URI.Fragment as Fragment -import Test.Unit (TestSuite, suite) +import Test.Spec (Spec, describe) import Test.Util (testIso) -spec ∷ ∀ eff. TestSuite eff +spec ∷ ∀ eff. Spec eff Unit spec = - suite "Fragment parser/printer" do + describe "Fragment parser/printer" do testIso (Fragment.parser pure) (Fragment.print id) "#" (Fragment.fromString "") testIso (Fragment.parser pure) (Fragment.print id) "#foo" (Fragment.fromString "foo") testIso (Fragment.parser pure) (Fragment.print id) "#foo%23bar" (Fragment.fromString "foo#bar") diff --git a/test/URI/Host.purs b/test/URI/Host.purs index 4e42a4e..d25d0f9 100644 --- a/test/URI/Host.purs +++ b/test/URI/Host.purs @@ -8,28 +8,28 @@ import Data.URI.Host as Host import Data.URI.Host.Gen as Host.Gen import Data.URI.Host.RegName as RegName import Test.QuickCheck ((===)) -import Test.Unit (TestSuite, suite, test) -import Test.Unit.Assert (equal) +import Test.Spec (Spec, describe, it) +import Test.Spec.Assertions (shouldEqual) import Test.Util (TestEffects, forAll, testIso) -import Text.Parsing.StringParser (runParser) +import Text.Parsing.Parser (runParser) -spec ∷ ∀ eff. TestSuite (TestEffects eff) +spec ∷ ∀ eff. Spec (TestEffects eff) Unit spec = do - suite "parseIPv4Address" do + describe "parseIPv4Address" do - test "parseIPv4Address / Host.print roundtrip" do + it "Should successfully roundtrip values sent through parseIPv4Address / Host.print" do forAll do ipv4 <- Host.Gen.genIPv4 let printed = Host.print id ipv4 - let parsed = runParser (Host.parser pure) printed + let parsed = runParser printed (Host.parser pure) pure $ pure ipv4 === parsed - test "0-lead octets should not parse as an IP address" do - equal + it "should not parse 0-lead octets as an IP address" do + shouldEqual (Right (NameAddress (RegName.unsafeFromString "192.168.001.1"))) - (runParser (Host.parser pure) "192.168.001.1") + (runParser "192.168.001.1" (Host.parser pure)) - suite "Host parser/printer" do + describe "Host parser/printer" do testIso (Host.parser pure) (Host.print id) "localhost" (NameAddress (RegName.fromString "localhost")) testIso (Host.parser pure) (Host.print id) "github.com" (NameAddress (RegName.fromString "github.com")) testIso (Host.parser pure) (Host.print id) "www.multipart.domain.example.com" (NameAddress (RegName.fromString "www.multipart.domain.example.com")) diff --git a/test/URI/NonStandard/QueryPairs.purs b/test/URI/NonStandard/QueryPairs.purs deleted file mode 100644 index 9a1b898..0000000 --- a/test/URI/NonStandard/QueryPairs.purs +++ /dev/null @@ -1,70 +0,0 @@ -module Test.URI.NonStandard.QueryPairs where - -import Prelude - -import Data.List (List(..), (:)) -import Data.Maybe (Maybe(..)) -import Data.Tuple (Tuple(..)) -import Data.URI.NonStandard.QueryPairs as NQP -import Data.URI.Query as Query -import Test.Unit (TestSuite, suite) -import Test.Util (testIso) - -spec ∷ ∀ eff. TestSuite eff -spec = - suite "QueryPairs printer/parser" do - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?key1=value1&key2=value2&key1=value3" - (NQP.QueryPairs (Tuple "key1" (Just "value1") : Tuple "key2" (Just "value2") : Tuple "key1" (Just "value3") : Nil)) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?k%3Dey=value%3D1" - (NQP.QueryPairs (Tuple "k=ey" (Just "value=1") : Nil)) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?" - (NQP.QueryPairs Nil) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?key1=&key2=" - (NQP.QueryPairs (Tuple "key1" (Just "") : Tuple "key2" (Just "") : Nil)) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?key1&key2" - (NQP.QueryPairs (Tuple "key1" Nothing : Tuple "key2" Nothing : Nil)) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?key1=foo%3Bbar" - (NQP.QueryPairs (Tuple "key1" (Just "foo;bar") : Nil)) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?replicaSet=test&connectTimeoutMS=300000" - (NQP.QueryPairs (Tuple "replicaSet" (Just "test") : Tuple "connectTimeoutMS" (Just "300000") : Nil)) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?fred" - (NQP.QueryPairs (pure (Tuple "fred" Nothing))) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?objectClass?one" - (NQP.QueryPairs (pure (Tuple "objectClass?one" Nothing))) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?password=&docTypeKey=" - (NQP.QueryPairs (Tuple "password" (Just "") : Tuple "docTypeKey" (Just "") : Nil)) - testIso - (Query.parser NQP.parse) - (Query.print NQP.print) - "?password=pass&docTypeKey=type&queryTimeoutSeconds=20" - (NQP.QueryPairs (Tuple "password" (Just "pass") : Tuple "docTypeKey" (Just "type") : Tuple "queryTimeoutSeconds" (Just "20") : Nil)) diff --git a/test/URI/Path.purs b/test/URI/Path.purs index c1e41b3..a48b10c 100644 --- a/test/URI/Path.purs +++ b/test/URI/Path.purs @@ -5,10 +5,10 @@ import Prelude import Data.URI.Path (Path(..)) import Data.URI.Path as Path import Data.URI.Path.Segment as PathSegment -import Test.Unit (TestSuite, suite) +import Test.Spec (Spec, describe) import Test.Util (testIso) -spec ∷ ∀ eff. TestSuite eff +spec ∷ ∀ eff. Spec eff Unit spec = - suite "Path parser/printer" do + describe "Path parser/printer" do testIso (Path.parser pure) Path.print "/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23" (Path [PathSegment.segmentFromString "Пациенты# #"]) diff --git a/test/URI/Port.purs b/test/URI/Port.purs index b54ebde..753556f 100644 --- a/test/URI/Port.purs +++ b/test/URI/Port.purs @@ -4,12 +4,12 @@ import Prelude import Data.URI.Port (Port(..)) import Data.URI.Port as Port -import Test.Unit (TestSuite, suite) +import Test.Spec (Spec, describe) import Test.Util (testIso) -spec ∷ ∀ eff. TestSuite eff +spec ∷ ∀ eff. Spec eff Unit spec = - suite "Port parser/printer" do + describe "Port parser/printer" do testIso (Port.parser pure) (Port.print id) "0" (Port 0) testIso (Port.parser pure) (Port.print id) "1234" (Port 1234) testIso (Port.parser pure) (Port.print id) "63174" (Port 63174) diff --git a/test/URI/Scheme.purs b/test/URI/Scheme.purs index c1e2dd3..453f091 100644 --- a/test/URI/Scheme.purs +++ b/test/URI/Scheme.purs @@ -4,11 +4,11 @@ import Prelude import Data.URI.Scheme (Scheme(..)) import Data.URI.Scheme as Scheme -import Test.Unit (TestSuite, suite) +import Test.Spec (Spec, describe) import Test.Util (testIso) -spec ∷ ∀ eff. TestSuite eff +spec ∷ ∀ eff. Spec eff Unit spec = - suite "Scheme parser/printer" do + describe "Scheme parser/printer" do testIso Scheme.parser Scheme.print "http:" (Scheme "http") testIso Scheme.parser Scheme.print "git+ssh:" (Scheme "git+ssh") diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index 344f0e1..3bbe51d 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -12,13 +12,13 @@ import Data.URI.Query as Query import Data.URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), PathRootless(..), Port(..), Query, RelPath, RelativePart(..), RelativeRef(..), Scheme(..), URI(..), URIRefOptions, UserInfo) import Data.URI.URIRef as URIRef import Data.URI.UserInfo as UserInfo -import Test.Unit (TestSuite, suite) +import Test.Spec (Spec, describe) import Test.Util (testIso) -import Text.Parsing.StringParser.Combinators (optionMaybe) +import Text.Parsing.Parser.Combinators (optionMaybe) -spec ∷ ∀ eff. TestSuite eff +spec ∷ ∀ eff. Spec eff Unit spec = - suite "URIRef parser/printer" do + describe "URIRef parser/printer" do testIso (URIRef.parser optionsSingle) (URIRef.print optionsSingle) @@ -489,6 +489,34 @@ spec = (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "fred@example.com") []))))) Nothing Nothing)) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" + (Left + (URI + (Scheme "http") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.fromString "local.slamdata.com")) Nothing))) + (path [""])) + (Just (Query.unsafeFromString "")) + (Just (Fragment.unsafeFromString "?sort=asc&q=path%3A%2F&salt=1177214")))) + testIso + (URIRef.parser optionsSingle) + (URIRef.print optionsSingle) + "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" + (Left + (URI + (Scheme "http") + (HierarchicalPartAuth + (Authority + Nothing + (Just (Tuple (NameAddress (RegName.fromString "local.slamdata.com")) Nothing))) + (path [""])) + (Just (Query.unsafeFromString "")) + (Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214")))) path ∷ Array String → Maybe Path path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString diff --git a/test/URI/UserInfo.purs b/test/URI/UserInfo.purs index fa6a7c0..6870bc6 100644 --- a/test/URI/UserInfo.purs +++ b/test/URI/UserInfo.purs @@ -3,12 +3,12 @@ module Test.URI.UserInfo where import Prelude import Data.URI.UserInfo as UserInfo -import Test.Unit (TestSuite, suite) +import Test.Spec (Spec, describe) import Test.Util (testIso) -spec ∷ ∀ eff. TestSuite eff +spec ∷ ∀ eff. Spec eff Unit spec = - suite "UserInfo parser/printer" do + describe "UserInfo parser/printer" do testIso (UserInfo.parser pure) (UserInfo.print id) "user" (UserInfo.fromString "user") testIso (UserInfo.parser pure) (UserInfo.print id) "spaced%20user" (UserInfo.fromString "spaced user") testIso (UserInfo.parser pure) (UserInfo.print id) "user:password" (UserInfo.fromString "user:password") diff --git a/test/Util.purs b/test/Util.purs index efc531a..2ea8399 100644 --- a/test/Util.purs +++ b/test/Util.purs @@ -2,6 +2,7 @@ module Test.Util where import Prelude +import Control.Monad.Aff (Aff) import Control.Monad.Eff.Class (liftEff) import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) @@ -9,39 +10,38 @@ import Control.Monad.Eff.Random (RANDOM) import Data.Either (Either(..)) import Test.QuickCheck as QC import Test.QuickCheck.Gen as QCG -import Test.Unit (Test, TestSuite, failure, success, test) -import Text.Parsing.StringParser (Parser, runParser) +import Test.Spec (Spec, it) +import Test.Spec.Assertions (fail) +import Text.Parsing.Parser (Parser, runParser) type TestEffects eff = (console ∷ CONSOLE, random ∷ RANDOM, exception ∷ EXCEPTION | eff) -testPrinter ∷ ∀ a b. Show b ⇒ (b → String) → String → b → TestSuite a -testPrinter f expected uri = - test +testPrinter ∷ ∀ a eff. Show a ⇒ (a → String) → String → a → Spec eff Unit +testPrinter f expected value = + it ("prints: " <> expected) - (equal expected (f uri)) + (equal expected (f value)) -testParser ∷ ∀ a b. Eq b ⇒ Show b ⇒ Parser b → String → b → TestSuite a -testParser p uri expected = - test - ("parses: " <> uri) - (equal (Right expected) (runParser p uri)) +testParser ∷ ∀ a eff. Eq a ⇒ Show a ⇒ Parser String a → String → a → Spec eff Unit +testParser p value expected = + it + ("parses: " <> value) + (equal (Right expected) (runParser value p)) -equal :: forall a e. Eq a => Show a => a -> a -> Test e +equal :: forall a eff. Eq a => Show a => a -> a -> Aff eff Unit equal expected actual = - if expected == actual - then success - else - failure $ - "\nexpected: " <> show expected <> - "\ngot: " <> show actual - -testIso ∷ ∀ a b. Eq b ⇒ Show b ⇒ Parser b → (b → String) → String → b → TestSuite a -testIso p f uri expected = do - testParser p uri expected - testPrinter f uri expected - -forAll ∷ ∀ eff prop. QC.Testable prop ⇒ QCG.Gen prop → Test (TestEffects eff) + when (expected /= actual) do + fail $ + "\nexpected: " <> show expected <> + "\ngot: " <> show actual + +testIso ∷ ∀ a b eff. Eq b ⇒ Show b ⇒ Parser String b → (b → String) → String → b → Spec eff Unit +testIso p f value expected = do + testParser p value expected + testPrinter f value expected + +forAll ∷ ∀ eff prop. QC.Testable prop ⇒ QCG.Gen prop → Aff (TestEffects eff) Unit forAll = quickCheck -quickCheck ∷ ∀ eff prop. QC.Testable prop ⇒ prop → Test (TestEffects eff) +quickCheck ∷ ∀ eff prop. QC.Testable prop ⇒ prop → Aff (TestEffects eff) Unit quickCheck = liftEff <<< QC.quickCheck' 100 From 2fed7b5ae764012cb767a857b43f70a0fe77367f Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 6 Feb 2018 11:15:21 +0000 Subject: [PATCH 17/69] Some progress on valid handling of `,` & multi-host support --- bower.json | 3 +- src/Data/URI/AbsoluteURI.purs | 8 +- src/Data/URI/Authority.purs | 51 ++++++--- src/Data/URI/Common.purs | 14 +-- src/Data/URI/HierarchicalPart.purs | 7 +- src/Data/URI/Host/RegName.purs | 7 +- src/Data/URI/RelativePart.purs | 8 +- src/Data/URI/RelativeRef.purs | 7 +- src/Data/URI/URI.purs | 7 +- src/Data/URI/URIRef.purs | 4 +- test/URI/AbsoluteURI.purs | 12 +-- test/URI/Authority.purs | 69 +++++++++--- test/URI/Host.purs | 6 +- test/URI/URIRef.purs | 166 +++++++++++++++++------------ 14 files changed, 234 insertions(+), 135 deletions(-) diff --git a/bower.json b/bower.json index 2246a32..475dae5 100755 --- a/bower.json +++ b/bower.json @@ -23,7 +23,8 @@ "purescript-maps": "^3.0.0", "purescript-parsing": "^4.3.1", "purescript-profunctor-lenses": "^3.7.0", - "purescript-unfoldable": "^3.0.0" + "purescript-unfoldable": "^3.0.0", + "purescript-these": "^3.0.0" }, "devDependencies": { "purescript-quickcheck": "^4.4.0", diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 844e1a0..827be0e 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -24,9 +24,9 @@ import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String -import Data.Tuple (Tuple) +import Data.These (These) import Data.URI.Common (URIPartParseError) -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), HostsParseOptions, Path(..), PathAbsolute(..), PathRootless(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query (Query) import Data.URI.Query as Query @@ -42,7 +42,7 @@ data AbsoluteURI userInfo hosts host port path hierPath query = AbsoluteURI Sche derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts host port path hierPath query) derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hosts host port path hierPath query) derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts host port path hierPath query) _ -instance showAbsoluteURI ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show path, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts host port path hierPath query) where show = genericShow +instance showAbsoluteURI ∷ (Show userInfo, Show (hosts (These host port)), Show host, Show port, Show path, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts host port path hierPath query) where show = genericShow type AbsoluteURIOptions userInfo hosts host port path hierPath query = AbsoluteURIParseOptions userInfo hosts host port path hierPath query @@ -50,7 +50,7 @@ type AbsoluteURIOptions userInfo hosts host port path hierPath query = type AbsoluteURIParseOptions userInfo hosts host port path hierPath query r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHosts ∷ HostsParseOptions hosts , parseHost ∷ Host → Either URIPartParseError host , parsePort ∷ Port → Either URIPartParseError port , parsePath ∷ Path → Either URIPartParseError path diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index 2c107f5..c8cedba 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -3,6 +3,7 @@ module Data.URI.Authority , AuthorityOptions , AuthorityParseOptions , AuthorityPrintOptions + , HostsParseOptions , parser , print , _userInfo @@ -14,14 +15,15 @@ module Data.URI.Authority import Prelude -import Data.Either (Either) +import Data.Either (Either(..)) import Data.Eq (class Eq1, eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) -import Data.Maybe (Maybe, maybe) +import Data.List (List) +import Data.Maybe (Maybe(..), maybe) import Data.Ord (class Ord1, compare1) -import Data.Tuple (Tuple(..)) +import Data.These (These(..)) import Data.URI.Common (URIPartParseError) import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) import Data.URI.Host as Host @@ -30,12 +32,12 @@ import Data.URI.Port as Port import Data.URI.UserInfo (UserInfo) import Data.URI.UserInfo as UserInfo import Text.Parsing.Parser (Parser) -import Text.Parsing.Parser.Combinators (optionMaybe, try) +import Text.Parsing.Parser.Combinators (optionMaybe, sepBy1, try) import Text.Parsing.Parser.String (char, string) -- | The authority part of a URI. For example: `purescript.org`, -- | `localhost:3000`, `user@example.net` -data Authority userInfo hosts host port = Authority (Maybe userInfo) (hosts (Tuple host (Maybe port))) +data Authority userInfo hosts host port = Authority (Maybe userInfo) (hosts (These host port)) instance eqAuthority ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port) ⇒ Eq (Authority userInfo hosts host port) where eq (Authority ui1 hs1) (Authority ui2 hs2) = eq ui1 ui2 && eq1 hs1 hs2 @@ -48,7 +50,7 @@ instance ordAuthority ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port) ⇒ Ord derive instance genericAuthority ∷ Generic (Authority userInfo hosts host port) _ -instance showAuthority ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show port) ⇒ Show (Authority userInfo hosts host port) where show = genericShow +instance showAuthority ∷ (Show userInfo, Show (hosts (These host port)), Show port) ⇒ Show (Authority userInfo hosts host port) where show = genericShow type AuthorityOptions userInfo hosts host port = AuthorityParseOptions userInfo hosts host port @@ -56,7 +58,7 @@ type AuthorityOptions userInfo hosts host port = type AuthorityParseOptions userInfo hosts host port r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHosts ∷ HostsParseOptions hosts , parseHost ∷ Host → Either URIPartParseError host , parsePort ∷ Port → Either URIPartParseError port | r @@ -70,6 +72,12 @@ type AuthorityPrintOptions userInfo hosts host port r = | r ) +type HostsParseOptions hosts + = ∀ a + . Either + (Maybe a → hosts a) + { split ∷ Parser String Unit, build ∷ List a → hosts a } + parser ∷ ∀ userInfo hosts host port r . Record (AuthorityParseOptions userInfo hosts host port r) @@ -77,10 +85,22 @@ parser parser opts = do _ ← string "//" ui ← optionMaybe $ try (UserInfo.parser opts.parseUserInfo <* char '@') - hosts ← opts.parseHosts $ - Tuple - <$> Host.parser opts.parseHost - <*> optionMaybe (char ':' *> Port.parser opts.parsePort) + hosts ← case opts.parseHosts of + Left build → do + host ← optionMaybe (Host.parser opts.parseHost) + port ← optionMaybe (char ':' *> Port.parser opts.parsePort) + pure $ build case host, port of + Just h, Nothing → Just (This h) + Nothing, Just p → Just (That p) + Just h, Just p → Just (Both h p) + Nothing, Nothing → Nothing + Right { split, build } → do + hosts ← + flip sepBy1 split $ + Both + <$> Host.parser opts.parseHost + <*> (char ':' *> Port.parser opts.parsePort) + pure $ build hosts pure $ Authority ui hosts print @@ -94,9 +114,12 @@ print opts (Authority ui hs) = where printUserInfo = maybe "" (\u → UserInfo.print opts.printUserInfo u <> "@") - printHostAndPort (Tuple h p) = + printHostAndPort (This h) = Host.print opts.printHost h - <> maybe "" (\n → ":" <> Port.print opts.printPort n) p + printHostAndPort (That p) = + ":" <> Port.print opts.printPort p + printHostAndPort (Both h p) = + Host.print opts.printHost h <> ":" <> Port.print opts.printPort p _userInfo ∷ ∀ userInfo hosts host port @@ -112,7 +135,7 @@ _hosts ∷ ∀ userInfo hosts host port . Lens' (Authority userInfo hosts host port) - (hosts (Tuple host (Maybe port))) + (hosts (These host port)) _hosts = lens (\(Authority _ hs) → hs) diff --git a/src/Data/URI/Common.purs b/src/Data/URI/Common.purs index 3167692..1fa639d 100644 --- a/src/Data/URI/Common.purs +++ b/src/Data/URI/Common.purs @@ -71,14 +71,14 @@ pctEncoded = do parseSubDelims ∷ Parser String Char parseSubDelims = - oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '='] -- ','] + oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '=', ','] printEncoded ∷ Parser String Char → String → String printEncoded p s = either (const s) id (runParser s parse) where - parse ∷ Parser String String - parse = (String.joinWith "" <$> Array.many (simpleChar <|> encodedChar)) <* eof - simpleChar ∷ Parser String String - simpleChar = String.singleton <$> p - encodedChar ∷ Parser String String - encodedChar = encodeURIComponent <<< String.singleton <$> anyChar + parse ∷ Parser String String + parse = (String.joinWith "" <$> Array.many (simpleChar <|> encodedChar)) <* eof + simpleChar ∷ Parser String String + simpleChar = String.singleton <$> p + encodedChar ∷ Parser String String + encodedChar = encodeURIComponent <<< String.singleton <$> anyChar diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index 2c5e715..e3c527f 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -27,8 +27,9 @@ import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) import Data.Ord (class Ord1) import Data.String as String +import Data.These (These) import Data.Tuple (Tuple) -import Data.URI.Authority (Authority(..), Host(..), Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.URI.Authority (Authority(..), Host(..), HostsParseOptions, Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Common (URIPartParseError) import Data.URI.Path (Path(..)) @@ -48,7 +49,7 @@ data HierarchicalPart userInfo hosts host port path hierPath derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hosts host port path hierPath) derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hosts host port path hierPath) derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts host port path hierPath) _ -instance showHierarchicalPart ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show path, Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts host port path hierPath) where show = genericShow +instance showHierarchicalPart ∷ (Show userInfo, Show (hosts (These host port)), Show host, Show port, Show path, Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts host port path hierPath) where show = genericShow type HierarchicalPartOptions userInfo hosts host port path hierPath = HierarchicalPartParseOptions userInfo hosts host port path hierPath @@ -56,7 +57,7 @@ type HierarchicalPartOptions userInfo hosts host port path hierPath = type HierarchicalPartParseOptions userInfo hosts host port path hierPath r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHosts ∷ HostsParseOptions hosts , parseHost ∷ Host → Either URIPartParseError host , parsePort ∷ Port → Either URIPartParseError port , parsePath ∷ Path → Either URIPartParseError path diff --git a/src/Data/URI/Host/RegName.purs b/src/Data/URI/Host/RegName.purs index 414be7d..0007de4 100644 --- a/src/Data/URI/Host/RegName.purs +++ b/src/Data/URI/Host/RegName.purs @@ -11,6 +11,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array +import Data.Maybe (Maybe(..)) import Data.Monoid (class Monoid) import Data.String as String import Data.URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) @@ -30,8 +31,10 @@ instance showRegName ∷ Show RegName where -- | Constructs a `RegName` part safely: percent-encoding will be -- | applied to any character that requires it for the user-info component of a -- | URI. -fromString ∷ String → RegName -fromString = RegName <<< printEncoded regNameChar +fromString ∷ String → Maybe RegName +fromString = case _ of + "" → Nothing + s → Just $ RegName (printEncoded regNameChar s) -- | Prints `RegName` as a string, decoding any percent-encoded -- | characters contained within. diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index b419f9f..7115c7d 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -27,8 +27,8 @@ import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) import Data.Ord (class Ord1) import Data.String as String -import Data.Tuple (Tuple) -import Data.URI.Authority (Authority(..), Host(..), Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.These (These) +import Data.URI.Authority (Authority(..), Host(..), HostsParseOptions, Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Common (URIPartParseError) import Data.URI.Path (Path) @@ -48,7 +48,7 @@ data RelativePart userInfo hosts host port path relPath derive instance eqRelativePart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq relPath) ⇒ Eq (RelativePart userInfo hosts host port path relPath) derive instance ordRelativePart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord relPath) ⇒ Ord (RelativePart userInfo hosts host port path relPath) derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts host port path relPath) _ -instance showRelativePart ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show port, Show path, Show relPath) ⇒ Show (RelativePart userInfo hosts host port path relPath) where show = genericShow +instance showRelativePart ∷ (Show userInfo, Show (hosts (These host port)), Show port, Show path, Show relPath) ⇒ Show (RelativePart userInfo hosts host port path relPath) where show = genericShow type RelativePartOptions userInfo hosts host port path relPath = RelativePartParseOptions userInfo hosts host port path relPath @@ -56,7 +56,7 @@ type RelativePartOptions userInfo hosts host port path relPath = type RelativePartParseOptions userInfo hosts host port path relPath r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHosts ∷ HostsParseOptions hosts , parseHost ∷ Host → Either URIPartParseError host , parsePort ∷ Port → Either URIPartParseError port , parsePath ∷ Path → Either URIPartParseError path diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index 49c55e6..d0e76bc 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -24,13 +24,14 @@ import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String +import Data.These (These) import Data.Tuple (Tuple) import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment import Data.URI.Query (Query) import Data.URI.Query as Query -import Data.URI.RelativePart (Authority(..), Host(..), Path, PathAbsolute, PathNoScheme, Port(..), RelativePart(..), RelPath, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.RelativePart (Authority(..), Host(..), HostsParseOptions, Path, PathAbsolute, PathNoScheme, Port(..), RelativePart(..), RelPath, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.RelativePart as RPart import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) @@ -42,7 +43,7 @@ data RelativeRef userInfo hosts host port path relPath query fragment = Relative derive instance eqRelativeRef ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo hosts host port path relPath query fragment) derive instance ordRelativeRef ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo hosts host port path relPath query fragment) derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts host port path relPath query fragment) _ -instance showRelativeRef ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show path, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts host port path relPath query fragment) where show = genericShow +instance showRelativeRef ∷ (Show userInfo, Show (hosts (These host port)), Show host, Show port, Show path, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts host port path relPath query fragment) where show = genericShow type RelativeRefOptions userInfo hosts host port path relPath query fragment = RelativeRefParseOptions userInfo hosts host port path relPath query fragment @@ -50,7 +51,7 @@ type RelativeRefOptions userInfo hosts host port path relPath query fragment = type RelativeRefParseOptions userInfo hosts host port path relPath query fragment r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHosts ∷ HostsParseOptions hosts , parseHost ∷ Host → Either URIPartParseError host , parsePort ∷ Port → Either URIPartParseError port , parsePath ∷ Path → Either URIPartParseError path diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index ddc8466..8e35368 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -25,11 +25,12 @@ import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.Ord (class Ord1) import Data.String as String +import Data.These (These) import Data.Tuple (Tuple) import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), Path, PathAbsolute, PathRootless, Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), HostsParseOptions, Path, PathAbsolute, PathRootless, Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query (Query) import Data.URI.Query as Query @@ -45,7 +46,7 @@ data URI userInfo hosts host port path hierPath query fragment = URI Scheme (Hie derive instance eqURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hosts host port path hierPath query fragment) derive instance ordURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hosts host port path hierPath query fragment) derive instance genericURI ∷ Generic (URI userInfo hosts host port path hierPath query fragment) _ -instance showURI ∷ (Show userInfo, Show (hosts (Tuple host (Maybe port))), Show host, Show port, Show path, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts host port path hierPath query fragment) where show = genericShow +instance showURI ∷ (Show userInfo, Show (hosts (These host port)), Show host, Show port, Show path, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts host port path hierPath query fragment) where show = genericShow type URIOptions userInfo hosts host port path hierPath query fragment = URIParseOptions userInfo hosts host port path hierPath query fragment @@ -53,7 +54,7 @@ type URIOptions userInfo hosts host port path hierPath query fragment = type URIParseOptions userInfo hosts host port path hierPath query fragment r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHosts ∷ HostsParseOptions hosts , parseHost ∷ Host → Either URIPartParseError host , parsePort ∷ Port → Either URIPartParseError port , parsePath ∷ Path → Either URIPartParseError path diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index 8ad4426..5d20afe 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -24,7 +24,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Either (Either(..), either) -import Data.URI.Authority (Authority(..)) +import Data.URI.Authority (Authority(..), HostsParseOptions) import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) @@ -55,7 +55,7 @@ type URIRefOptions userInfo hosts host port path hierPath relPath query fragment type URIRefParseOptions userInfo hosts host port path hierPath relPath query fragment r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ ∀ a. Parser String a → Parser String (hosts a) + , parseHosts ∷ HostsParseOptions hosts , parseHost ∷ Host → Either URIPartParseError host , parsePort ∷ Port → Either URIPartParseError port , parsePath ∷ Path → Either URIPartParseError path diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs index 066130b..e5421d9 100644 --- a/test/URI/AbsoluteURI.purs +++ b/test/URI/AbsoluteURI.purs @@ -4,15 +4,15 @@ import Prelude import Data.Either (Either(..)) import Data.Maybe (Maybe(..), fromMaybe) +import Data.These (These(..)) import Data.Tuple (Tuple(..)) +import Data.URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port(..), Query, Scheme(..), AbsoluteURI(..), AbsoluteURIOptions, UserInfo) +import Data.URI.AbsoluteURI as AbsoluteURI import Data.URI.Host.RegName as RegName import Data.URI.Path.Segment as PathSegment import Data.URI.Query as Query -import Data.URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port(..), Query, Scheme(..), AbsoluteURI(..), AbsoluteURIOptions, UserInfo) -import Data.URI.AbsoluteURI as AbsoluteURI import Test.Spec (Spec, describe) import Test.Util (testIso) -import Text.Parsing.Parser.Combinators (optionMaybe) spec ∷ ∀ eff. Spec eff Unit spec = @@ -26,7 +26,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.fromString "localhost")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) (path ["testBucket"])) (Just (Query.unsafeFromString "password=&docTypeKey="))) testIso @@ -38,7 +38,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 99999))))) + (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port 99999)))) (path ["testBucket"])) (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) testIso @@ -67,7 +67,7 @@ options ∷ Record (AbsoluteURIOptions UserInfo Maybe Host Port Path HierPath Qu options = { parseUserInfo: pure , printUserInfo: id - , parseHosts: optionMaybe + , parseHosts: Left id , printHosts: fromMaybe "" , parseHost: pure , printHost: id diff --git a/test/URI/Authority.purs b/test/URI/Authority.purs index b0564c7..e61e2c9 100644 --- a/test/URI/Authority.purs +++ b/test/URI/Authority.purs @@ -3,19 +3,17 @@ module Test.URI.Authority where import Prelude import Data.Array as Array -import Data.Identity (Identity(..)) -import Data.Maybe (Maybe(..)) -import Data.Newtype (un) +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..), fromMaybe) import Data.String as String -import Data.Tuple (Tuple(..)) +import Data.These (These(..)) import Data.URI.Authority (Authority(..), AuthorityOptions, Host(..), Port(..), UserInfo) import Data.URI.Authority as Authority import Data.URI.Host.RegName as RegName import Data.URI.UserInfo as UserInfo import Test.Spec (Spec, describe) import Test.Util (testIso) -import Text.Parsing.Parser.Combinators (sepBy) as SP -import Text.Parsing.Parser.String (char) as SP +import Text.Parsing.Parser.String as PS spec ∷ ∀ eff. Spec eff Unit spec = @@ -26,37 +24,78 @@ spec = "//localhost" (Authority Nothing - (Identity (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) testIso (Authority.parser optionsSingle) (Authority.print optionsSingle) "//localhost:3000" (Authority Nothing - (Identity (Tuple (NameAddress (RegName.unsafeFromString "localhost")) (Just (Port 3000))))) + (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port 3000)))) testIso (Authority.parser optionsSingle) (Authority.print optionsSingle) "//user@localhost:3000" (Authority (Just (UserInfo.unsafeFromString "user")) - (Identity (Tuple (NameAddress (RegName.unsafeFromString "localhost")) (Just (Port 3000))))) + (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port 3000)))) + testIso + (Authority.parser optionsMany) + (Authority.print optionsMany) + "//mongo-1,mongo-2" + (Authority + Nothing + [ This (NameAddress (RegName.unsafeFromString "mongo-1")) + , This (NameAddress (RegName.unsafeFromString "mongo-2")) + ]) + testIso + (Authority.parser optionsMany) + (Authority.print optionsMany) + "//mongo-1:2000,mongo-2:3000" + (Authority + Nothing + [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port 2000) + , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port 3000) + ]) + testIso + (Authority.parser optionsMany) + (Authority.print optionsMany) + "//mongo-1:2000,mongo-2" + (Authority + Nothing + [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port 2000) + , This (NameAddress (RegName.unsafeFromString "mongo-2")) + ]) testIso (Authority.parser optionsMany) (Authority.print optionsMany) "//mongo-1,mongo-2:3000" (Authority Nothing - [ Tuple (NameAddress (RegName.unsafeFromString "mongo-1")) Nothing - , Tuple (NameAddress (RegName.unsafeFromString "mongo-2")) (Just (Port 3000)) + [ This (NameAddress (RegName.unsafeFromString "mongo-1")) + , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port 3000) + ]) + testIso + (Authority.parser optionsSingle) + (Authority.print optionsSingle) + "//:8000" + (Authority Nothing (Just (That (Port 8000)))) + testIso + (Authority.parser optionsMany) + (Authority.print optionsMany) + "//:2000,:3000" + (Authority + Nothing + [ That (Port 2000) + , That (Port 3000) ]) -optionsSingle ∷ Record (AuthorityOptions UserInfo Identity Host Port) +optionsSingle ∷ Record (AuthorityOptions UserInfo Maybe Host Port) optionsSingle = { parseUserInfo: pure , printUserInfo: id - , parseHosts: map Identity - , printHosts: un Identity + , parseHosts: Left id + , printHosts: fromMaybe "" , parseHost: pure , printHost: id , parsePort: pure @@ -67,7 +106,7 @@ optionsMany ∷ Record (AuthorityOptions UserInfo Array Host Port) optionsMany = { parseUserInfo: pure , printUserInfo: id - , parseHosts: map Array.fromFoldable <<< flip SP.sepBy (SP.char ',') + , parseHosts: Right { split: void (PS.char ','), build: Array.fromFoldable } , printHosts: String.joinWith "," , parseHost: pure , printHost: id diff --git a/test/URI/Host.purs b/test/URI/Host.purs index d25d0f9..deeec10 100644 --- a/test/URI/Host.purs +++ b/test/URI/Host.purs @@ -30,8 +30,8 @@ spec = do (runParser "192.168.001.1" (Host.parser pure)) describe "Host parser/printer" do - testIso (Host.parser pure) (Host.print id) "localhost" (NameAddress (RegName.fromString "localhost")) - testIso (Host.parser pure) (Host.print id) "github.com" (NameAddress (RegName.fromString "github.com")) - testIso (Host.parser pure) (Host.print id) "www.multipart.domain.example.com" (NameAddress (RegName.fromString "www.multipart.domain.example.com")) + testIso (Host.parser pure) (Host.print id) "localhost" (NameAddress (RegName.unsafeFromString "localhost")) + testIso (Host.parser pure) (Host.print id) "github.com" (NameAddress (RegName.unsafeFromString "github.com")) + testIso (Host.parser pure) (Host.print id) "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString "www.multipart.domain.example.com")) testIso (Host.parser pure) (Host.print id) "192.168.0.1" (IPv4Address "192.168.0.1") testIso (Host.parser pure) (Host.print id) "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index 3bbe51d..7520e85 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -2,8 +2,11 @@ module Test.URI.URIRef where import Prelude +import Data.Array as Array import Data.Either (Either(..)) import Data.Maybe (Maybe(..), fromMaybe) +import Data.String as String +import Data.These (These(..)) import Data.Tuple (Tuple(..)) import Data.URI.Fragment as Fragment import Data.URI.Host.RegName as RegName @@ -14,7 +17,7 @@ import Data.URI.URIRef as URIRef import Data.URI.UserInfo as UserInfo import Test.Spec (Spec, describe) import Test.Util (testIso) -import Text.Parsing.Parser.Combinators (optionMaybe) +import Text.Parsing.Parser.String as PS spec ∷ ∀ eff. Spec eff Unit spec = @@ -73,7 +76,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) Nothing) Nothing Nothing)) @@ -87,7 +90,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.unsafeFromString "1a.example.com")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "1a.example.com"))))) Nothing) Nothing Nothing)) @@ -101,38 +104,42 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.unsafeFromString "en.wikipedia.org")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "en.wikipedia.org"))))) (path ["wiki", "URI_scheme"])) Nothing Nothing)) --- -- testIsoURIRef --- -- "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" --- -- (Left --- -- (URI --- -- (Scheme "mongodb") --- -- (HierarchicalPart --- -- (Just --- -- (Authority --- -- (Just (UserInfo.unsafeFromString "foo:bar")) --- -- [ Tuple (NameAddress (RegName.unsafeFromString "db1.example.net")) Nothing --- -- , Tuple (NameAddress (RegName.unsafeFromString "db2.example.net")) (Just (Port 2500))])) --- -- (Just (Right (rootDir file "authdb")))) --- -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) --- -- Nothing)) --- -- testIsoURIRef --- -- "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" --- -- (Left --- -- (URI --- -- (Scheme "mongodb") --- -- (HierarchicalPart --- -- (Just --- -- (Authority --- -- (Just (UserInfo.unsafeFromString "foo:bar")) --- -- [ (Tuple (NameAddress (RegName.unsafeFromString "db1.example.net")) (Just (Port 6))) --- -- , (Tuple (NameAddress (RegName.unsafeFromString "db2.example.net")) (Just (Port 2500)))])) --- -- (Just (Right (rootDir file "authdb")))) --- -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) --- -- Nothing)) + testIso + (URIRef.parser optionsMany) + (URIRef.print optionsMany) + "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPartAuth + (Authority + (Just (UserInfo.unsafeFromString "foo:bar")) + [ This (NameAddress (RegName.unsafeFromString "db1.example.net")) + , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port 2500) + ]) + (path ["authdb"])) + (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) + Nothing)) + testIso + (URIRef.parser optionsMany) + (URIRef.print optionsMany) + "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPartAuth + (Authority + (Just (UserInfo.unsafeFromString "foo:bar")) + [ Both (NameAddress (RegName.unsafeFromString "db1.example.net")) (Port 6) + , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port 2500) + ]) + (path ["authdb"])) + (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) + Nothing)) testIso (URIRef.parser optionsSingle) (URIRef.print optionsSingle) @@ -141,25 +148,26 @@ spec = (URI (Scheme "mongodb") (HierarchicalPartAuth - (Authority Nothing (Just (Tuple (IPv4Address "192.168.0.1") Nothing))) + (Authority Nothing (Just (This (IPv4Address "192.168.0.1")))) + Nothing) + Nothing + Nothing)) + testIso + (URIRef.parser optionsMany) + (URIRef.print optionsMany) + "mongodb://192.168.0.1,192.168.0.2" + (Left + (URI + (Scheme "mongodb") + (HierarchicalPartAuth + (Authority + Nothing + [ This (IPv4Address "192.168.0.1") + , This (IPv4Address "192.168.0.2") + ]) Nothing) Nothing Nothing)) --- -- testIsoURIRef --- -- "mongodb://192.168.0.1,192.168.0.2" --- -- (Left --- -- (URI --- -- (Scheme "mongodb") --- -- (HierarchicalPart --- -- (Just --- -- (Authority --- -- Nothing --- -- [ Tuple (IPv4Address "192.168.0.1") Nothing --- -- , Tuple (IPv4Address "192.168.0.2") Nothing --- -- ])) --- -- Nothing) --- -- Nothing --- -- Nothing)) testIso (URIRef.parser optionsSingle) (URIRef.print optionsSingle) @@ -170,7 +178,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) - (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) Nothing) Nothing Nothing)) @@ -184,7 +192,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) - (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) (path [""])) Nothing Nothing)) @@ -198,7 +206,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) - (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) (path ["records"])) Nothing Nothing)) @@ -212,7 +220,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) - (Just (Tuple (NameAddress (RegName.unsafeFromString "localhost")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) (path ["records", "etc", ""])) Nothing Nothing)) @@ -226,7 +234,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") Nothing))) + (Just (This (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652")))) Nothing) Nothing Nothing)) @@ -240,7 +248,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (IPv6Address "FE80::0202:B3FF:FE1E:8329") Nothing))) + (Just (This (IPv6Address "FE80::0202:B3FF:FE1E:8329")))) Nothing) Nothing Nothing)) @@ -254,7 +262,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (IPv6Address "2001:db8::1") (Just (Port 80))))) + (Just (Both (IPv6Address "2001:db8::1") (Port 80)))) Nothing) Nothing Nothing)) @@ -268,7 +276,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.unsafeFromString "ftp.is.co.za")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "ftp.is.co.za"))))) (path ["rfc", "rfc1808.txt"])) Nothing Nothing)) @@ -282,7 +290,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.unsafeFromString "www.ietf.org")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "www.ietf.org"))))) (path ["rfc", "rfc2396.txt"])) Nothing Nothing)) @@ -296,7 +304,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (IPv6Address "2001:db8::7") Nothing))) + (Just (This (IPv6Address "2001:db8::7")))) (path ["c=GB"])) (Just (Query.unsafeFromString "objectClass?one")) Nothing)) @@ -310,7 +318,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (IPv4Address "192.0.2.16") (Just (Port 80))))) + (Just (Both (IPv4Address "192.0.2.16") (Port 80)))) (path [""])) Nothing Nothing)) @@ -324,7 +332,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.unsafeFromString "example.com")) (Just (Port 8042))))) + (Just (Both (NameAddress (RegName.unsafeFromString "example.com")) (Port 8042)))) (path ["over", "there"])) (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "nose")))) @@ -338,7 +346,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.unsafeFromString "example.com")) (Just (Port 8042))))) + (Just (Both (NameAddress (RegName.unsafeFromString "example.com")) (Port 8042)))) (path ["over", "there"])) (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "")))) @@ -352,7 +360,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.unsafeFromString "info.example.com")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "info.example.com"))))) Nothing) (Just (Query.unsafeFromString "fred")) Nothing)) @@ -366,7 +374,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "cnn.example.com&story=breaking_news")) - (Just (Tuple (IPv4Address "10.0.0.1") Nothing))) + (Just (This (IPv4Address "10.0.0.1")))) (path ["top_story.htm"])) Nothing Nothing)) @@ -423,7 +431,7 @@ spec = (URI (Scheme "http") (HierarchicalPartAuth - (Authority Nothing (Just (Tuple (NameAddress (RegName.fromString "www.example.com")) Nothing))) + (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString "www.example.com"))))) (path ["some%20invented", "url%20with%20spaces.html"])) Nothing Nothing)) @@ -435,7 +443,7 @@ spec = (URI (Scheme "http") (HierarchicalPartAuth - (Authority Nothing (Just (Tuple (NameAddress (RegName.fromString "localhost")) (Just (Port 53174))))) + (Authority Nothing (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port 53174)))) (path ["metadata", "fs", "test", "%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23"])) (Just (Query.unsafeFromString "")) Nothing)) @@ -499,7 +507,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.fromString "local.slamdata.com")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "local.slamdata.com"))))) (path [""])) (Just (Query.unsafeFromString "")) (Just (Fragment.unsafeFromString "?sort=asc&q=path%3A%2F&salt=1177214")))) @@ -513,7 +521,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Tuple (NameAddress (RegName.fromString "local.slamdata.com")) Nothing))) + (Just (This (NameAddress (RegName.unsafeFromString "local.slamdata.com"))))) (path [""])) (Just (Query.unsafeFromString "")) (Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214")))) @@ -525,7 +533,7 @@ optionsSingle ∷ Record (URIRefOptions UserInfo Maybe Host Port Path HierPath R optionsSingle = { parseUserInfo: pure , printUserInfo: id - , parseHosts: optionMaybe + , parseHosts: Left id , printHosts: fromMaybe "" , parseHost: pure , printHost: id @@ -542,3 +550,25 @@ optionsSingle = , parseFragment: pure , printFragment: id } + +optionsMany ∷ Record (URIRefOptions UserInfo Array Host Port Path HierPath RelPath Query Fragment) +optionsMany = + { parseUserInfo: pure + , printUserInfo: id + , parseHosts: Right { split: void (PS.char ','), build: Array.fromFoldable } + , printHosts: String.joinWith "," + , parseHost: pure + , printHost: id + , parsePort: pure + , printPort: id + , parsePath: pure + , printPath: id + , parseHierPath: pure + , printHierPath: id + , parseRelPath: pure + , printRelPath: id + , parseQuery: pure + , printQuery: id + , parseFragment: pure + , printFragment: id + } From 0386d26ef70cbdda10ba0cccb764c84b5abf8e5b Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 6 Feb 2018 13:08:13 +0000 Subject: [PATCH 18/69] Fix warning --- test/Util.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Util.purs b/test/Util.purs index 2ea8399..662ced3 100644 --- a/test/Util.purs +++ b/test/Util.purs @@ -35,7 +35,7 @@ equal expected actual = "\nexpected: " <> show expected <> "\ngot: " <> show actual -testIso ∷ ∀ a b eff. Eq b ⇒ Show b ⇒ Parser String b → (b → String) → String → b → Spec eff Unit +testIso ∷ ∀ a eff. Eq a ⇒ Show a ⇒ Parser String a → (a → String) → String → a → Spec eff Unit testIso p f value expected = do testParser p value expected testPrinter f value expected From 3da1466bdc3f6a9fa6fdea8d7affa808ca9bb07a Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 6 Feb 2018 13:10:07 +0000 Subject: [PATCH 19/69] Fully parameterise host/port parsing I don't think there's an elegant way to support mongo-style multi-host (but non-spec-conformant) URIs without just handing control over entirely. Plus it reduces the number of type vars a bit, which is nice. --- src/Data/URI/AbsoluteURI.purs | 58 +++++------ src/Data/URI/Authority.purs | 101 ++++++------------- src/Data/URI/HierarchicalPart.purs | 61 +++++------- src/Data/URI/HostPortPair.purs | 46 +++++++++ src/Data/URI/Port.purs | 5 +- src/Data/URI/RelativePart.purs | 60 +++++------ src/Data/URI/RelativeRef.purs | 59 +++++------ src/Data/URI/URI.purs | 63 +++++------- src/Data/URI/URIRef.purs | 37 +++---- test/URI/AbsoluteURI.purs | 14 ++- test/URI/Authority.purs | 130 ++++++++++++------------ test/URI/URIRef.purs | 155 ++++++++++++++--------------- 12 files changed, 367 insertions(+), 422 deletions(-) create mode 100644 src/Data/URI/HostPortPair.purs diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 827be0e..2e0df52 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -17,14 +17,11 @@ import Prelude import Data.Array as Array import Data.Either (Either) -import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) -import Data.Ord (class Ord1) import Data.String as String -import Data.These (These) import Data.URI.Common (URIPartParseError) import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), HostsParseOptions, Path(..), PathAbsolute(..), PathRootless(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart @@ -37,33 +34,29 @@ import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) -- | A generic AbsoluteURI -data AbsoluteURI userInfo hosts host port path hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts host port path hierPath) (Maybe query) +data AbsoluteURI userInfo hosts path hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts path hierPath) (Maybe query) -derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts host port path hierPath query) -derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hosts host port path hierPath query) -derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts host port path hierPath query) _ -instance showAbsoluteURI ∷ (Show userInfo, Show (hosts (These host port)), Show host, Show port, Show path, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts host port path hierPath query) where show = genericShow +derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq hosts, Eq path, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts path hierPath query) +derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord hosts, Ord path, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hosts path hierPath query) +derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts path hierPath query) _ +instance showAbsoluteURI ∷ (Show userInfo, Show hosts, Show path, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts path hierPath query) where show = genericShow -type AbsoluteURIOptions userInfo hosts host port path hierPath query = - AbsoluteURIParseOptions userInfo hosts host port path hierPath query - (AbsoluteURIPrintOptions userInfo hosts host port path hierPath query ()) +type AbsoluteURIOptions userInfo hosts path hierPath query = + AbsoluteURIParseOptions userInfo hosts path hierPath query + (AbsoluteURIPrintOptions userInfo hosts path hierPath query ()) -type AbsoluteURIParseOptions userInfo hosts host port path hierPath query r = +type AbsoluteURIParseOptions userInfo hosts path hierPath query r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ HostsParseOptions hosts - , parseHost ∷ Host → Either URIPartParseError host - , parsePort ∷ Port → Either URIPartParseError port + , parseHosts ∷ Parser String hosts , parsePath ∷ Path → Either URIPartParseError path , parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError hierPath , parseQuery ∷ Query → Either URIPartParseError query | r ) -type AbsoluteURIPrintOptions userInfo hosts host port path hierPath query r = +type AbsoluteURIPrintOptions userInfo hosts path hierPath query r = ( printUserInfo ∷ userInfo → UserInfo - , printHosts ∷ hosts String → String - , printHost ∷ host → Host - , printPort ∷ port → Port + , printHosts ∷ hosts → String , printPath ∷ path → Path , printHierPath ∷ hierPath → Either PathAbsolute PathRootless , printQuery ∷ query → Query @@ -71,9 +64,9 @@ type AbsoluteURIPrintOptions userInfo hosts host port path hierPath query r = ) parser - ∷ ∀ userInfo hosts host port path hierPath query r - . Record (AbsoluteURIParseOptions userInfo hosts host port path hierPath query r) - → Parser String (AbsoluteURI userInfo hosts host port path hierPath query) + ∷ ∀ userInfo hosts path hierPath query r + . Record (AbsoluteURIParseOptions userInfo hosts path hierPath query r) + → Parser String (AbsoluteURI userInfo hosts path hierPath query) parser opts = AbsoluteURI <$> Scheme.parser <*> HPart.parser opts @@ -81,10 +74,9 @@ parser opts = AbsoluteURI <* eof print - ∷ ∀ userInfo hosts host port path hierPath query r - . Functor hosts - ⇒ Record (AbsoluteURIPrintOptions userInfo hosts host port path hierPath query r) - → AbsoluteURI userInfo hosts host port path hierPath query + ∷ ∀ userInfo hosts path hierPath query r + . Record (AbsoluteURIPrintOptions userInfo hosts path hierPath query r) + → AbsoluteURI userInfo hosts path hierPath query → String print opts (AbsoluteURI s h q) = String.joinWith "" $ Array.catMaybes @@ -94,9 +86,9 @@ print opts (AbsoluteURI s h q) = ] _scheme - ∷ ∀ userInfo hosts host port path hierPath query + ∷ ∀ userInfo hosts path hierPath query . Lens' - (AbsoluteURI userInfo hosts host port path hierPath query) + (AbsoluteURI userInfo hosts path hierPath query) Scheme _scheme = lens @@ -104,19 +96,19 @@ _scheme = (\(AbsoluteURI _ h q) s → AbsoluteURI s h q) _hierPart - ∷ ∀ userInfo hosts host port path hierPath query + ∷ ∀ userInfo hosts path hierPath query . Lens' - (AbsoluteURI userInfo hosts host port path hierPath query) - (HierarchicalPart userInfo hosts host port path hierPath) + (AbsoluteURI userInfo hosts path hierPath query) + (HierarchicalPart userInfo hosts path hierPath) _hierPart = lens (\(AbsoluteURI _ h _) → h) (\(AbsoluteURI s _ q) h → AbsoluteURI s h q) _query - ∷ ∀ userInfo hosts host port path hierPath query + ∷ ∀ userInfo hosts path hierPath query . Lens' - (AbsoluteURI userInfo hosts host port path hierPath query) + (AbsoluteURI userInfo hosts path hierPath query) (Maybe query) _query = lens diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index c8cedba..80fbac2 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -15,60 +15,43 @@ module Data.URI.Authority import Prelude -import Data.Either (Either(..)) -import Data.Eq (class Eq1, eq1) +import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.List (List) -import Data.Maybe (Maybe(..), maybe) -import Data.Ord (class Ord1, compare1) -import Data.These (These(..)) +import Data.Maybe (Maybe(..)) import Data.URI.Common (URIPartParseError) import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) -import Data.URI.Host as Host import Data.URI.Port (Port(..)) -import Data.URI.Port as Port import Data.URI.UserInfo (UserInfo) import Data.URI.UserInfo as UserInfo import Text.Parsing.Parser (Parser) -import Text.Parsing.Parser.Combinators (optionMaybe, sepBy1, try) +import Text.Parsing.Parser.Combinators (optionMaybe, try) import Text.Parsing.Parser.String (char, string) -- | The authority part of a URI. For example: `purescript.org`, -- | `localhost:3000`, `user@example.net` -data Authority userInfo hosts host port = Authority (Maybe userInfo) (hosts (These host port)) +data Authority userInfo hosts = Authority (Maybe userInfo) hosts -instance eqAuthority ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port) ⇒ Eq (Authority userInfo hosts host port) where - eq (Authority ui1 hs1) (Authority ui2 hs2) = eq ui1 ui2 && eq1 hs1 hs2 +derive instance eqAuthority ∷ (Eq userInfo, Eq hosts) ⇒ Eq (Authority userInfo hosts) +derive instance ordAuthority ∷ (Ord userInfo, Ord hosts) ⇒ Ord (Authority userInfo hosts) +derive instance genericAuthority ∷ Generic (Authority userInfo hosts) _ +instance showAuthority ∷ (Show userInfo, Show hosts) ⇒ Show (Authority userInfo hosts) where show = genericShow -instance ordAuthority ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port) ⇒ Ord (Authority userInfo hosts host port) where - compare (Authority ui1 hs1) (Authority ui2 hs2) = - case compare ui1 ui2 of - EQ → compare1 hs1 hs2 - o → o +type AuthorityOptions userInfo hosts = + AuthorityParseOptions userInfo hosts + (AuthorityPrintOptions userInfo hosts ()) -derive instance genericAuthority ∷ Generic (Authority userInfo hosts host port) _ - -instance showAuthority ∷ (Show userInfo, Show (hosts (These host port)), Show port) ⇒ Show (Authority userInfo hosts host port) where show = genericShow - -type AuthorityOptions userInfo hosts host port = - AuthorityParseOptions userInfo hosts host port - (AuthorityPrintOptions userInfo hosts host port ()) - -type AuthorityParseOptions userInfo hosts host port r = +type AuthorityParseOptions userInfo hosts r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ HostsParseOptions hosts - , parseHost ∷ Host → Either URIPartParseError host - , parsePort ∷ Port → Either URIPartParseError port + , parseHosts ∷ Parser String hosts | r ) -type AuthorityPrintOptions userInfo hosts host port r = +type AuthorityPrintOptions userInfo hosts r = ( printUserInfo ∷ userInfo → UserInfo - , printHosts ∷ hosts String → String - , printHost ∷ host → Host - , printPort ∷ port → Port + , printHosts ∷ hosts → String | r ) @@ -79,52 +62,28 @@ type HostsParseOptions hosts { split ∷ Parser String Unit, build ∷ List a → hosts a } parser - ∷ ∀ userInfo hosts host port r - . Record (AuthorityParseOptions userInfo hosts host port r) - → Parser String (Authority userInfo hosts host port) + ∷ ∀ userInfo hosts r + . Record (AuthorityParseOptions userInfo hosts r) + → Parser String (Authority userInfo hosts) parser opts = do _ ← string "//" ui ← optionMaybe $ try (UserInfo.parser opts.parseUserInfo <* char '@') - hosts ← case opts.parseHosts of - Left build → do - host ← optionMaybe (Host.parser opts.parseHost) - port ← optionMaybe (char ':' *> Port.parser opts.parsePort) - pure $ build case host, port of - Just h, Nothing → Just (This h) - Nothing, Just p → Just (That p) - Just h, Just p → Just (Both h p) - Nothing, Nothing → Nothing - Right { split, build } → do - hosts ← - flip sepBy1 split $ - Both - <$> Host.parser opts.parseHost - <*> (char ':' *> Port.parser opts.parsePort) - pure $ build hosts + hosts ← opts.parseHosts pure $ Authority ui hosts print - ∷ ∀ userInfo hosts host port r - . Functor hosts - ⇒ Record (AuthorityPrintOptions userInfo hosts host port r) - → Authority userInfo hosts host port + ∷ ∀ userInfo hosts r + . Record (AuthorityPrintOptions userInfo hosts r) + → Authority userInfo hosts → String -print opts (Authority ui hs) = - "//" <> printUserInfo ui <> opts.printHosts (printHostAndPort <$> hs) - where - printUserInfo = - maybe "" (\u → UserInfo.print opts.printUserInfo u <> "@") - printHostAndPort (This h) = - Host.print opts.printHost h - printHostAndPort (That p) = - ":" <> Port.print opts.printPort p - printHostAndPort (Both h p) = - Host.print opts.printHost h <> ":" <> Port.print opts.printPort p +print opts (Authority mui hs) = case mui of + Just ui → "//" <> UserInfo.print opts.printUserInfo ui <> "@" <> opts.printHosts hs + Nothing → "//" <> opts.printHosts hs _userInfo - ∷ ∀ userInfo hosts host port + ∷ ∀ userInfo hosts . Lens' - (Authority userInfo hosts host port) + (Authority userInfo hosts) (Maybe userInfo) _userInfo = lens @@ -132,10 +91,10 @@ _userInfo = (\(Authority _ hs) ui → Authority ui hs) _hosts - ∷ ∀ userInfo hosts host port + ∷ ∀ userInfo hosts . Lens' - (Authority userInfo hosts host port) - (hosts (These host port)) + (Authority userInfo hosts) + hosts _hosts = lens (\(Authority _ hs) → hs) diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index e3c527f..663a8a9 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -20,15 +20,11 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either(..), either) -import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) -import Data.Ord (class Ord1) import Data.String as String -import Data.These (These) -import Data.Tuple (Tuple) import Data.URI.Authority (Authority(..), Host(..), HostsParseOptions, Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Common (URIPartParseError) @@ -42,34 +38,30 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) -- | The "hierarchical part" of a generic or absolute URI. -data HierarchicalPart userInfo hosts host port path hierPath - = HierarchicalPartAuth (Authority userInfo hosts host port) (Maybe path) +data HierarchicalPart userInfo hosts path hierPath + = HierarchicalPartAuth (Authority userInfo hosts) (Maybe path) | HierarchicalPartNoAuth (Maybe hierPath) -derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hosts host port path hierPath) -derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hosts host port path hierPath) -derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts host port path hierPath) _ -instance showHierarchicalPart ∷ (Show userInfo, Show (hosts (These host port)), Show host, Show port, Show path, Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts host port path hierPath) where show = genericShow +derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq hosts, Eq path, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hosts path hierPath) +derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord hosts, Ord path, Ord hierPath) ⇒ Ord (HierarchicalPart userInfo hosts path hierPath) +derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts path hierPath) _ +instance showHierarchicalPart ∷ (Show userInfo, Show hosts, Show path, Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts path hierPath) where show = genericShow -type HierarchicalPartOptions userInfo hosts host port path hierPath = - HierarchicalPartParseOptions userInfo hosts host port path hierPath - (HierarchicalPartPrintOptions userInfo hosts host port path hierPath ()) +type HierarchicalPartOptions userInfo hosts path hierPath = + HierarchicalPartParseOptions userInfo hosts path hierPath + (HierarchicalPartPrintOptions userInfo hosts path hierPath ()) -type HierarchicalPartParseOptions userInfo hosts host port path hierPath r = +type HierarchicalPartParseOptions userInfo hosts path hierPath r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ HostsParseOptions hosts - , parseHost ∷ Host → Either URIPartParseError host - , parsePort ∷ Port → Either URIPartParseError port + , parseHosts ∷ Parser String hosts , parsePath ∷ Path → Either URIPartParseError path , parseHierPath ∷ HierPath → Either URIPartParseError hierPath | r ) -type HierarchicalPartPrintOptions userInfo hosts host port path hierPath r = +type HierarchicalPartPrintOptions userInfo hosts path hierPath r = ( printUserInfo ∷ userInfo → UserInfo - , printHosts ∷ hosts String → String - , printHost ∷ host → Host - , printPort ∷ port → Port + , printHosts ∷ hosts → String , printPath ∷ path → Path , printHierPath ∷ hierPath → HierPath | r @@ -78,9 +70,9 @@ type HierarchicalPartPrintOptions userInfo hosts host port path hierPath r = type HierPath = Either PathAbsolute PathRootless parser - ∷ ∀ userInfo hosts host port path hierPath r - . Record (HierarchicalPartParseOptions userInfo hosts host port path hierPath r) - → Parser String (HierarchicalPart userInfo hosts host port path hierPath) + ∷ ∀ userInfo hosts path hierPath r + . Record (HierarchicalPartParseOptions userInfo hosts path hierPath r) + → Parser String (HierarchicalPart userInfo hosts path hierPath) parser opts = withAuth <|> withoutAuth where withAuth = @@ -95,10 +87,9 @@ parser opts = withAuth <|> withoutAuth <|> pure Nothing print - ∷ ∀ userInfo hosts host port path hierPath r - . Functor hosts - ⇒ Record (HierarchicalPartPrintOptions userInfo hosts host port path hierPath r) - → HierarchicalPart userInfo hosts host port path hierPath → String + ∷ ∀ userInfo hosts path hierPath r + . Record (HierarchicalPartPrintOptions userInfo hosts path hierPath r) + → HierarchicalPart userInfo hosts path hierPath → String print opts = case _ of HierarchicalPartAuth a p → String.joinWith "" $ Array.catMaybes @@ -109,27 +100,27 @@ print opts = case _ of maybe "" (either PathAbs.print PathRootless.print <<< opts.printHierPath) p _authority - ∷ ∀ userInfo hosts host port path hierPath + ∷ ∀ userInfo hosts path hierPath . Traversal' - (HierarchicalPart userInfo hosts host port path hierPath) - (Authority userInfo hosts host port) + (HierarchicalPart userInfo hosts path hierPath) + (Authority userInfo hosts) _authority = wander \f → case _ of HierarchicalPartAuth a p → flip HierarchicalPartAuth p <$> f a a → pure a _path - ∷ ∀ userInfo hosts host port path hierPath + ∷ ∀ userInfo hosts path hierPath . Traversal' - (HierarchicalPart userInfo hosts host port path hierPath) + (HierarchicalPart userInfo hosts path hierPath) (Maybe path) _path = wander \f → case _ of HierarchicalPartAuth a p → HierarchicalPartAuth a <$> f p a → pure a _hierPath - ∷ ∀ userInfo hosts host port path hierPath + ∷ ∀ userInfo hosts path hierPath . Traversal' - (HierarchicalPart userInfo hosts host port path hierPath) + (HierarchicalPart userInfo hosts path hierPath) (Maybe hierPath) _hierPath = wander \f → case _ of HierarchicalPartNoAuth p → HierarchicalPartNoAuth <$> f p diff --git a/src/Data/URI/HostPortPair.purs b/src/Data/URI/HostPortPair.purs new file mode 100644 index 0000000..c57524e --- /dev/null +++ b/src/Data/URI/HostPortPair.purs @@ -0,0 +1,46 @@ +module Data.URI.HostPortPair where + +import Prelude + +import Data.Either (Either) +import Data.Maybe (Maybe(..)) +import Data.These (These(..)) +import Data.URI.Common (URIPartParseError) +import Data.URI.Host (Host) +import Data.URI.Host as Host +import Data.URI.Port (Port) +import Data.URI.Port as Port +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (optionMaybe) + +type HostPortPair host port = Maybe (These host port) + +parser + ∷ ∀ host port + . (Host → Either URIPartParseError host) + → (Port → Either URIPartParseError port) + → Parser String (HostPortPair host port) +parser parseHost parsePort = do + mh ← optionMaybe (Host.parser parseHost) + mp ← optionMaybe (Port.parser parsePort) + pure case mh, mp of + Just h, Nothing → Just (This h) + Nothing, Just p → Just (That p) + Just h, Just p → Just (Both h p) + Nothing, Nothing → Nothing + +print + ∷ ∀ host port + . (host → Host) + → (port → Port) + → HostPortPair host port + → String +print printHost printPort = case _ of + Nothing → + "" + Just (This host) → + Host.print printHost host + Just (That port) → + Port.print printPort port + Just (Both host port) → + Host.print printHost host <> Port.print printPort port diff --git a/src/Data/URI/Port.purs b/src/Data/URI/Port.purs index 90c6a69..7d9a28f 100644 --- a/src/Data/URI/Port.purs +++ b/src/Data/URI/Port.purs @@ -17,6 +17,7 @@ import Data.String as String import Data.URI.Common (URIPartParseError, digit, wrapParser) import Global (readInt) import Text.Parsing.Parser (Parser, fail) +import Text.Parsing.Parser.String (char) -- | A port number. newtype Port = Port Int @@ -29,10 +30,10 @@ instance showPort ∷ Show Port where show = genericShow parser ∷ ∀ p. (Port → Either URIPartParseError p) → Parser String p parser p = wrapParser p do - s ← String.fromCharArray <$> Array.some digit + s ← String.fromCharArray <$> (char ':' *> Array.some digit) case fromNumber $ readInt 10 s of Just x → pure (Port x) _ → fail "Expected valid port number" print ∷ ∀ p. (p → Port) → p → String -print = map (\(Port x) → show x) +print = map (\(Port x) → ":" <> show x) diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index 7115c7d..ff1a010 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -20,14 +20,11 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (Either(..), either) -import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) -import Data.Ord (class Ord1) import Data.String as String -import Data.These (These) import Data.URI.Authority (Authority(..), Host(..), HostsParseOptions, Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Common (URIPartParseError) @@ -41,34 +38,30 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) -- | The "relative part" of a relative reference. -data RelativePart userInfo hosts host port path relPath - = RelativePartAuth (Authority userInfo hosts host port) (Maybe path) +data RelativePart userInfo hosts path relPath + = RelativePartAuth (Authority userInfo hosts) (Maybe path) | RelativePartNoAuth (Maybe relPath) -derive instance eqRelativePart ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq relPath) ⇒ Eq (RelativePart userInfo hosts host port path relPath) -derive instance ordRelativePart ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord relPath) ⇒ Ord (RelativePart userInfo hosts host port path relPath) -derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts host port path relPath) _ -instance showRelativePart ∷ (Show userInfo, Show (hosts (These host port)), Show port, Show path, Show relPath) ⇒ Show (RelativePart userInfo hosts host port path relPath) where show = genericShow +derive instance eqRelativePart ∷ (Eq userInfo, Eq hosts, Eq path, Eq relPath) ⇒ Eq (RelativePart userInfo hosts path relPath) +derive instance ordRelativePart ∷ (Ord userInfo, Ord hosts, Ord path, Ord relPath) ⇒ Ord (RelativePart userInfo hosts path relPath) +derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts path relPath) _ +instance showRelativePart ∷ (Show userInfo, Show hosts, Show path, Show relPath) ⇒ Show (RelativePart userInfo hosts path relPath) where show = genericShow -type RelativePartOptions userInfo hosts host port path relPath = - RelativePartParseOptions userInfo hosts host port path relPath - (RelativePartPrintOptions userInfo hosts host port path relPath ()) +type RelativePartOptions userInfo hosts path relPath = + RelativePartParseOptions userInfo hosts path relPath + (RelativePartPrintOptions userInfo hosts path relPath ()) -type RelativePartParseOptions userInfo hosts host port path relPath r = +type RelativePartParseOptions userInfo hosts path relPath r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ HostsParseOptions hosts - , parseHost ∷ Host → Either URIPartParseError host - , parsePort ∷ Port → Either URIPartParseError port + , parseHosts ∷ Parser String hosts , parsePath ∷ Path → Either URIPartParseError path , parseRelPath ∷ RelPath → Either URIPartParseError relPath | r ) -type RelativePartPrintOptions userInfo hosts host port path relPath r = +type RelativePartPrintOptions userInfo hosts path relPath r = ( printUserInfo ∷ userInfo → UserInfo - , printHosts ∷ hosts String → String - , printHost ∷ host → Host - , printPort ∷ port → Port + , printHosts ∷ hosts → String , printPath ∷ path → Path , printRelPath ∷ relPath → RelPath | r @@ -77,9 +70,9 @@ type RelativePartPrintOptions userInfo hosts host port path relPath r = type RelPath = Either PathAbsolute PathNoScheme parser - ∷ ∀ userInfo hosts host port path relPath r - . Record (RelativePartParseOptions userInfo hosts host port path relPath r) - → Parser String (RelativePart userInfo hosts host port path relPath) + ∷ ∀ userInfo hosts path relPath r + . Record (RelativePartParseOptions userInfo hosts path relPath r) + → Parser String (RelativePart userInfo hosts path relPath) parser opts = withAuth <|> withoutAuth where withAuth = @@ -94,10 +87,9 @@ parser opts = withAuth <|> withoutAuth <|> pure Nothing print - ∷ ∀ userInfo hosts host port path relPath r - . Functor hosts - ⇒ Record (RelativePartPrintOptions userInfo hosts host port path relPath r) - → RelativePart userInfo hosts host port path relPath → String + ∷ ∀ userInfo hosts path relPath r + . Record (RelativePartPrintOptions userInfo hosts path relPath r) + → RelativePart userInfo hosts path relPath → String print opts = case _ of RelativePartAuth a p → String.joinWith "" $ Array.catMaybes @@ -108,27 +100,27 @@ print opts = case _ of maybe "" (either PathAbs.print PathNoScheme.print <<< opts.printRelPath) p _authority - ∷ ∀ userInfo hosts host port path relPath + ∷ ∀ userInfo hosts path relPath . Traversal' - (RelativePart userInfo hosts host port path relPath) - (Authority userInfo hosts host port) + (RelativePart userInfo hosts path relPath) + (Authority userInfo hosts) _authority = wander \f → case _ of RelativePartAuth a p → flip RelativePartAuth p <$> f a a → pure a _path - ∷ ∀ userInfo hosts host port path relPath + ∷ ∀ userInfo hosts path relPath . Traversal' - (RelativePart userInfo hosts host port path relPath) + (RelativePart userInfo hosts path relPath) (Maybe path) _path = wander \f → case _ of RelativePartAuth a p → RelativePartAuth a <$> f p a → pure a _relPath - ∷ ∀ userInfo hosts host port path relPath + ∷ ∀ userInfo hosts path relPath . Traversal' - (RelativePart userInfo hosts host port path relPath) + (RelativePart userInfo hosts path relPath) (Maybe relPath) _relPath = wander \f a → case a of RelativePartNoAuth p → RelativePartNoAuth <$> f p diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index d0e76bc..b0a71bd 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -17,15 +17,11 @@ import Prelude import Data.Array as Array import Data.Either (Either) -import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) -import Data.Ord (class Ord1) import Data.String as String -import Data.These (These) -import Data.Tuple (Tuple) import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment @@ -38,22 +34,20 @@ import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) -- | A relative reference for a URI. -data RelativeRef userInfo hosts host port path relPath query fragment = RelativeRef (RelativePart userInfo hosts host port path relPath) (Maybe query) (Maybe fragment) +data RelativeRef userInfo hosts path relPath query fragment = RelativeRef (RelativePart userInfo hosts path relPath) (Maybe query) (Maybe fragment) -derive instance eqRelativeRef ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo hosts host port path relPath query fragment) -derive instance ordRelativeRef ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo hosts host port path relPath query fragment) -derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts host port path relPath query fragment) _ -instance showRelativeRef ∷ (Show userInfo, Show (hosts (These host port)), Show host, Show port, Show path, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts host port path relPath query fragment) where show = genericShow +derive instance eqRelativeRef ∷ (Eq userInfo, Eq hosts, Eq path, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo hosts path relPath query fragment) +derive instance ordRelativeRef ∷ (Ord userInfo, Ord hosts, Ord path, Ord relPath, Ord query, Ord fragment) ⇒ Ord (RelativeRef userInfo hosts path relPath query fragment) +derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts path relPath query fragment) _ +instance showRelativeRef ∷ (Show userInfo, Show hosts, Show path, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts path relPath query fragment) where show = genericShow -type RelativeRefOptions userInfo hosts host port path relPath query fragment = - RelativeRefParseOptions userInfo hosts host port path relPath query fragment - (RelativeRefPrintOptions userInfo hosts host port path relPath query fragment ()) +type RelativeRefOptions userInfo hosts path relPath query fragment = + RelativeRefParseOptions userInfo hosts path relPath query fragment + (RelativeRefPrintOptions userInfo hosts path relPath query fragment ()) -type RelativeRefParseOptions userInfo hosts host port path relPath query fragment r = +type RelativeRefParseOptions userInfo hosts path relPath query fragment r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ HostsParseOptions hosts - , parseHost ∷ Host → Either URIPartParseError host - , parsePort ∷ Port → Either URIPartParseError port + , parseHosts ∷ Parser String hosts , parsePath ∷ Path → Either URIPartParseError path , parseRelPath ∷ Either PathAbsolute PathNoScheme → Either URIPartParseError relPath , parseQuery ∷ Query → Either URIPartParseError query @@ -61,11 +55,9 @@ type RelativeRefParseOptions userInfo hosts host port path relPath query fragmen | r ) -type RelativeRefPrintOptions userInfo hosts host port path relPath query fragment r = +type RelativeRefPrintOptions userInfo hosts path relPath query fragment r = ( printUserInfo ∷ userInfo → UserInfo - , printHosts ∷ hosts String → String - , printHost ∷ host → Host - , printPort ∷ port → Port + , printHosts ∷ hosts → String , printPath ∷ path → Path , printRelPath ∷ relPath → Either PathAbsolute PathNoScheme , printQuery ∷ query → Query @@ -74,9 +66,9 @@ type RelativeRefPrintOptions userInfo hosts host port path relPath query fragmen ) parser - ∷ ∀ userInfo hosts host port path relPath query fragment r - . Record (RelativeRefParseOptions userInfo hosts host port path relPath query fragment r) - → Parser String (RelativeRef userInfo hosts host port path relPath query fragment) + ∷ ∀ userInfo hosts path relPath query fragment r + . Record (RelativeRefParseOptions userInfo hosts path relPath query fragment r) + → Parser String (RelativeRef userInfo hosts path relPath query fragment) parser opts = RelativeRef <$> RPart.parser opts @@ -85,10 +77,9 @@ parser opts = <* eof print - ∷ ∀ userInfo hosts host port path relPath query fragment r - . Functor hosts - ⇒ Record (RelativeRefPrintOptions userInfo hosts host port path relPath query fragment r) - → RelativeRef userInfo hosts host port path relPath query fragment + ∷ ∀ userInfo hosts path relPath query fragment r + . Record (RelativeRefPrintOptions userInfo hosts path relPath query fragment r) + → RelativeRef userInfo hosts path relPath query fragment → String print opts (RelativeRef h q f) = String.joinWith "" $ Array.catMaybes @@ -98,19 +89,19 @@ print opts (RelativeRef h q f) = ] _relPart - ∷ ∀ userInfo hosts host port path relPath query fragment + ∷ ∀ userInfo hosts path relPath query fragment . Lens' - (RelativeRef userInfo hosts host port path relPath query fragment) - (RelativePart userInfo hosts host port path relPath) + (RelativeRef userInfo hosts path relPath query fragment) + (RelativePart userInfo hosts path relPath) _relPart = lens (\(RelativeRef r _ _) → r) (\(RelativeRef _ q f) r → RelativeRef r q f) _query - ∷ ∀ userInfo hosts host port path relPath query fragment + ∷ ∀ userInfo hosts path relPath query fragment . Lens' - (RelativeRef userInfo hosts host port path relPath query fragment) + (RelativeRef userInfo hosts path relPath query fragment) (Maybe query) _query = lens @@ -118,9 +109,9 @@ _query = (\(RelativeRef r _ f) q → RelativeRef r q f) _fragment - ∷ ∀ userInfo hosts host port path relPath query fragment + ∷ ∀ userInfo hosts path relPath query fragment . Lens' - (RelativeRef userInfo hosts host port path relPath query fragment) + (RelativeRef userInfo hosts path relPath query fragment) (Maybe fragment) _fragment = lens diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index 8e35368..a17499e 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -18,15 +18,11 @@ import Prelude import Data.Array as Array import Data.Either (Either) -import Data.Eq (class Eq1) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) -import Data.Ord (class Ord1) import Data.String as String -import Data.These (These) -import Data.Tuple (Tuple) import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment @@ -41,22 +37,20 @@ import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) -- | A generic URI -data URI userInfo hosts host port path hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts host port path hierPath) (Maybe query) (Maybe fragment) +data URI userInfo hosts path hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts path hierPath) (Maybe query) (Maybe fragment) -derive instance eqURI ∷ (Eq userInfo, Eq1 hosts, Eq host, Eq port, Eq path, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hosts host port path hierPath query fragment) -derive instance ordURI ∷ (Ord userInfo, Ord1 hosts, Ord host, Ord port, Ord path, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hosts host port path hierPath query fragment) -derive instance genericURI ∷ Generic (URI userInfo hosts host port path hierPath query fragment) _ -instance showURI ∷ (Show userInfo, Show (hosts (These host port)), Show host, Show port, Show path, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts host port path hierPath query fragment) where show = genericShow +derive instance eqURI ∷ (Eq userInfo, Eq hosts, Eq path, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hosts path hierPath query fragment) +derive instance ordURI ∷ (Ord userInfo, Ord hosts, Ord path, Ord hierPath, Ord query, Ord fragment) ⇒ Ord (URI userInfo hosts path hierPath query fragment) +derive instance genericURI ∷ Generic (URI userInfo hosts path hierPath query fragment) _ +instance showURI ∷ (Show userInfo, Show hosts, Show path, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts path hierPath query fragment) where show = genericShow -type URIOptions userInfo hosts host port path hierPath query fragment = - URIParseOptions userInfo hosts host port path hierPath query fragment - (URIPrintOptions userInfo hosts host port path hierPath query fragment ()) +type URIOptions userInfo hosts path hierPath query fragment = + URIParseOptions userInfo hosts path hierPath query fragment + (URIPrintOptions userInfo hosts path hierPath query fragment ()) -type URIParseOptions userInfo hosts host port path hierPath query fragment r = +type URIParseOptions userInfo hosts path hierPath query fragment r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ HostsParseOptions hosts - , parseHost ∷ Host → Either URIPartParseError host - , parsePort ∷ Port → Either URIPartParseError port + , parseHosts ∷ Parser String hosts , parsePath ∷ Path → Either URIPartParseError path , parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError hierPath , parseQuery ∷ Query → Either URIPartParseError query @@ -64,11 +58,9 @@ type URIParseOptions userInfo hosts host port path hierPath query fragment r = | r ) -type URIPrintOptions userInfo hosts host port path hierPath query fragment r = +type URIPrintOptions userInfo hosts path hierPath query fragment r = ( printUserInfo ∷ userInfo → UserInfo - , printHosts ∷ hosts String → String - , printHost ∷ host → Host - , printPort ∷ port → Port + , printHosts ∷ hosts → String , printPath ∷ path → Path , printHierPath ∷ hierPath → Either PathAbsolute PathRootless , printQuery ∷ query → Query @@ -77,9 +69,9 @@ type URIPrintOptions userInfo hosts host port path hierPath query fragment r = ) parser - ∷ ∀ userInfo hosts host port path hierPath query fragment r - . Record (URIParseOptions userInfo hosts host port path hierPath query fragment r) - → Parser String (URI userInfo hosts host port path hierPath query fragment) + ∷ ∀ userInfo hosts path hierPath query fragment r + . Record (URIParseOptions userInfo hosts path hierPath query fragment r) + → Parser String (URI userInfo hosts path hierPath query fragment) parser opts = URI <$> Scheme.parser <*> HPart.parser opts @@ -88,10 +80,9 @@ parser opts = URI <* eof print - ∷ ∀ userInfo hosts host port path hierPath query fragment r - . Functor hosts - ⇒ Record (URIPrintOptions userInfo hosts host port path hierPath query fragment r) - → URI userInfo hosts host port path hierPath query fragment + ∷ ∀ userInfo hosts path hierPath query fragment r + . Record (URIPrintOptions userInfo hosts path hierPath query fragment r) + → URI userInfo hosts path hierPath query fragment → String print opts (URI s h q f) = String.joinWith "" $ Array.catMaybes @@ -102,9 +93,9 @@ print opts (URI s h q f) = ] _scheme - ∷ ∀ userInfo hosts host port path hierPath query fragment + ∷ ∀ userInfo hosts path hierPath query fragment . Lens' - (URI userInfo hosts host port path hierPath query fragment) + (URI userInfo hosts path hierPath query fragment) Scheme _scheme = lens @@ -112,19 +103,19 @@ _scheme = (\(URI _ h q f) s → URI s h q f) _hierPart - ∷ ∀ userInfo hosts host port path hierPath query fragment + ∷ ∀ userInfo hosts path hierPath query fragment . Lens' - (URI userInfo hosts host port path hierPath query fragment) - (HierarchicalPart userInfo hosts host port path hierPath) + (URI userInfo hosts path hierPath query fragment) + (HierarchicalPart userInfo hosts path hierPath) _hierPart = lens (\(URI _ h _ _) → h) (\(URI s _ q f) h → URI s h q f) _query - ∷ ∀ userInfo hosts host port path hierPath query fragment + ∷ ∀ userInfo hosts path hierPath query fragment . Lens' - (URI userInfo hosts host port path hierPath query fragment) + (URI userInfo hosts path hierPath query fragment) (Maybe query) _query = lens @@ -132,9 +123,9 @@ _query = (\(URI s h _ f) q → URI s h q f) _fragment - ∷ ∀ userInfo hosts host port path hierPath query fragment + ∷ ∀ userInfo hosts path hierPath query fragment . Lens' - (URI userInfo hosts host port path hierPath query fragment) + (URI userInfo hosts path hierPath query fragment) (Maybe fragment) _fragment = lens diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index 5d20afe..cd6597a 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -44,20 +44,18 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) -- | An alias for the most common use case of resource identifiers. -type URIRef userInfo hosts host port path hierPath relPath query fragment = +type URIRef userInfo hosts path hierPath relPath query fragment = Either - (URI.URI userInfo hosts host port path hierPath query fragment) - (RelativeRef.RelativeRef userInfo hosts host port path relPath query fragment) + (URI.URI userInfo hosts path hierPath query fragment) + (RelativeRef.RelativeRef userInfo hosts path relPath query fragment) -type URIRefOptions userInfo hosts host port path hierPath relPath query fragment = - URIRefParseOptions userInfo hosts host port path hierPath relPath query fragment - (URIRefPrintOptions userInfo hosts host port path hierPath relPath query fragment ()) +type URIRefOptions userInfo hosts path hierPath relPath query fragment = + URIRefParseOptions userInfo hosts path hierPath relPath query fragment + (URIRefPrintOptions userInfo hosts path hierPath relPath query fragment ()) -type URIRefParseOptions userInfo hosts host port path hierPath relPath query fragment r = +type URIRefParseOptions userInfo hosts path hierPath relPath query fragment r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo - , parseHosts ∷ HostsParseOptions hosts - , parseHost ∷ Host → Either URIPartParseError host - , parsePort ∷ Port → Either URIPartParseError port + , parseHosts ∷ Parser String hosts , parsePath ∷ Path → Either URIPartParseError path , parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError hierPath , parseRelPath ∷ Either PathAbsolute PathNoScheme → Either URIPartParseError relPath @@ -66,11 +64,9 @@ type URIRefParseOptions userInfo hosts host port path hierPath relPath query fra | r ) -type URIRefPrintOptions userInfo hosts host port path hierPath relPath query fragment r = +type URIRefPrintOptions userInfo hosts path hierPath relPath query fragment r = ( printUserInfo ∷ userInfo → UserInfo - , printHosts ∷ hosts String → String - , printHost ∷ host → Host - , printPort ∷ port → Port + , printHosts ∷ hosts → String , printPath ∷ path → Path , printHierPath ∷ hierPath → Either PathAbsolute PathRootless , printRelPath ∷ relPath → Either PathAbsolute PathNoScheme @@ -80,18 +76,17 @@ type URIRefPrintOptions userInfo hosts host port path hierPath relPath query fra ) parser - ∷ ∀ userInfo hosts host port path hierPath relPath query fragment r - . Record (URIRefParseOptions userInfo hosts host port path hierPath relPath query fragment r) - → Parser String (URIRef userInfo hosts host port path hierPath relPath query fragment) + ∷ ∀ userInfo hosts path hierPath relPath query fragment r + . Record (URIRefParseOptions userInfo hosts path hierPath relPath query fragment r) + → Parser String (URIRef userInfo hosts path hierPath relPath query fragment) parser opts = (Left <$> try (URI.parser opts)) <|> (Right <$> RelativeRef.parser opts) print - ∷ ∀ userInfo hosts host port path hierPath relPath query fragment r - . Functor hosts - ⇒ Record (URIRefPrintOptions userInfo hosts host port path hierPath relPath query fragment r) - → URIRef userInfo hosts host port path hierPath relPath query fragment + ∷ ∀ userInfo hosts path hierPath relPath query fragment r + . Record (URIRefPrintOptions userInfo hosts path hierPath relPath query fragment r) + → URIRef userInfo hosts path hierPath relPath query fragment → String print opts = either diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs index e5421d9..545ee9f 100644 --- a/test/URI/AbsoluteURI.purs +++ b/test/URI/AbsoluteURI.purs @@ -3,12 +3,14 @@ module Test.URI.AbsoluteURI where import Prelude import Data.Either (Either(..)) -import Data.Maybe (Maybe(..), fromMaybe) +import Data.Maybe (Maybe(..)) import Data.These (These(..)) import Data.Tuple (Tuple(..)) import Data.URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port(..), Query, Scheme(..), AbsoluteURI(..), AbsoluteURIOptions, UserInfo) import Data.URI.AbsoluteURI as AbsoluteURI import Data.URI.Host.RegName as RegName +import Data.URI.HostPortPair (HostPortPair) +import Data.URI.HostPortPair as HostPortPair import Data.URI.Path.Segment as PathSegment import Data.URI.Query as Query import Test.Spec (Spec, describe) @@ -63,16 +65,12 @@ spec = path ∷ Array String → Maybe Path path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString -options ∷ Record (AbsoluteURIOptions UserInfo Maybe Host Port Path HierPath Query) +options ∷ Record (AbsoluteURIOptions UserInfo (HostPortPair Host Port) Path HierPath Query) options = { parseUserInfo: pure , printUserInfo: id - , parseHosts: Left id - , printHosts: fromMaybe "" - , parseHost: pure - , printHost: id - , parsePort: pure - , printPort: id + , parseHosts: HostPortPair.parser pure pure + , printHosts: HostPortPair.print id id , parsePath: pure , printPath: id , parseHierPath: pure diff --git a/test/URI/Authority.purs b/test/URI/Authority.purs index e61e2c9..060e507 100644 --- a/test/URI/Authority.purs +++ b/test/URI/Authority.purs @@ -2,18 +2,16 @@ module Test.URI.Authority where import Prelude -import Data.Array as Array -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..), fromMaybe) -import Data.String as String +import Data.Maybe (Maybe(..)) import Data.These (These(..)) import Data.URI.Authority (Authority(..), AuthorityOptions, Host(..), Port(..), UserInfo) import Data.URI.Authority as Authority import Data.URI.Host.RegName as RegName +import Data.URI.HostPortPair (HostPortPair) +import Data.URI.HostPortPair as HostPortPair import Data.URI.UserInfo as UserInfo import Test.Spec (Spec, describe) import Test.Util (testIso) -import Text.Parsing.Parser.String as PS spec ∷ ∀ eff. Spec eff Unit spec = @@ -39,77 +37,73 @@ spec = (Authority (Just (UserInfo.unsafeFromString "user")) (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port 3000)))) - testIso - (Authority.parser optionsMany) - (Authority.print optionsMany) - "//mongo-1,mongo-2" - (Authority - Nothing - [ This (NameAddress (RegName.unsafeFromString "mongo-1")) - , This (NameAddress (RegName.unsafeFromString "mongo-2")) - ]) - testIso - (Authority.parser optionsMany) - (Authority.print optionsMany) - "//mongo-1:2000,mongo-2:3000" - (Authority - Nothing - [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port 2000) - , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port 3000) - ]) - testIso - (Authority.parser optionsMany) - (Authority.print optionsMany) - "//mongo-1:2000,mongo-2" - (Authority - Nothing - [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port 2000) - , This (NameAddress (RegName.unsafeFromString "mongo-2")) - ]) - testIso - (Authority.parser optionsMany) - (Authority.print optionsMany) - "//mongo-1,mongo-2:3000" - (Authority - Nothing - [ This (NameAddress (RegName.unsafeFromString "mongo-1")) - , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port 3000) - ]) + -- testIso + -- (Authority.parser optionsMany) + -- (Authority.print optionsMany) + -- "//mongo-1,mongo-2" + -- (Authority + -- Nothing + -- [ This (NameAddress (RegName.unsafeFromString "mongo-1")) + -- , This (NameAddress (RegName.unsafeFromString "mongo-2")) + -- ]) + -- testIso + -- (Authority.parser optionsMany) + -- (Authority.print optionsMany) + -- "//mongo-1:2000,mongo-2:3000" + -- (Authority + -- Nothing + -- [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port 2000) + -- , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port 3000) + -- ]) + -- testIso + -- (Authority.parser optionsMany) + -- (Authority.print optionsMany) + -- "//mongo-1:2000,mongo-2" + -- (Authority + -- Nothing + -- [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port 2000) + -- , This (NameAddress (RegName.unsafeFromString "mongo-2")) + -- ]) + -- testIso + -- (Authority.parser optionsMany) + -- (Authority.print optionsMany) + -- "//mongo-1,mongo-2:3000" + -- (Authority + -- Nothing + -- [ This (NameAddress (RegName.unsafeFromString "mongo-1")) + -- , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port 3000) + -- ]) testIso (Authority.parser optionsSingle) (Authority.print optionsSingle) "//:8000" (Authority Nothing (Just (That (Port 8000)))) - testIso - (Authority.parser optionsMany) - (Authority.print optionsMany) - "//:2000,:3000" - (Authority - Nothing - [ That (Port 2000) - , That (Port 3000) - ]) + -- testIso + -- (Authority.parser optionsMany) + -- (Authority.print optionsMany) + -- "//:2000,:3000" + -- (Authority + -- Nothing + -- [ That (Port 2000) + -- , That (Port 3000) + -- ]) -optionsSingle ∷ Record (AuthorityOptions UserInfo Maybe Host Port) +optionsSingle ∷ Record (AuthorityOptions UserInfo (HostPortPair Host Port)) optionsSingle = { parseUserInfo: pure , printUserInfo: id - , parseHosts: Left id - , printHosts: fromMaybe "" - , parseHost: pure - , printHost: id - , parsePort: pure - , printPort: id + , parseHosts: HostPortPair.parser pure pure + , printHosts: HostPortPair.print id id } -optionsMany ∷ Record (AuthorityOptions UserInfo Array Host Port) -optionsMany = - { parseUserInfo: pure - , printUserInfo: id - , parseHosts: Right { split: void (PS.char ','), build: Array.fromFoldable } - , printHosts: String.joinWith "," - , parseHost: pure - , printHost: id - , parsePort: pure - , printPort: id - } +-- optionsMany ∷ Record (AuthorityOptions UserInfo (HostPortPair Host Port)) +-- optionsMany = +-- { parseUserInfo: pure +-- , printUserInfo: id +-- , parseHosts: Right { split: void (PS.char ','), build: Array.fromFoldable } +-- , printHosts: String.joinWith "," +-- , parseHost: pure +-- , printHost: id +-- , parsePort: pure +-- , printPort: id +-- } diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index 7520e85..d9b3ab6 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -2,14 +2,14 @@ module Test.URI.URIRef where import Prelude -import Data.Array as Array import Data.Either (Either(..)) -import Data.Maybe (Maybe(..), fromMaybe) -import Data.String as String +import Data.Maybe (Maybe(..)) import Data.These (These(..)) import Data.Tuple (Tuple(..)) import Data.URI.Fragment as Fragment import Data.URI.Host.RegName as RegName +import Data.URI.HostPortPair (HostPortPair) +import Data.URI.HostPortPair as HostPortPair import Data.URI.Path.Segment as PathSegment import Data.URI.Query as Query import Data.URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), PathRootless(..), Port(..), Query, RelPath, RelativePart(..), RelativeRef(..), Scheme(..), URI(..), URIRefOptions, UserInfo) @@ -17,7 +17,6 @@ import Data.URI.URIRef as URIRef import Data.URI.UserInfo as UserInfo import Test.Spec (Spec, describe) import Test.Util (testIso) -import Text.Parsing.Parser.String as PS spec ∷ ∀ eff. Spec eff Unit spec = @@ -108,38 +107,38 @@ spec = (path ["wiki", "URI_scheme"])) Nothing Nothing)) - testIso - (URIRef.parser optionsMany) - (URIRef.print optionsMany) - "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPartAuth - (Authority - (Just (UserInfo.unsafeFromString "foo:bar")) - [ This (NameAddress (RegName.unsafeFromString "db1.example.net")) - , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port 2500) - ]) - (path ["authdb"])) - (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) - Nothing)) - testIso - (URIRef.parser optionsMany) - (URIRef.print optionsMany) - "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPartAuth - (Authority - (Just (UserInfo.unsafeFromString "foo:bar")) - [ Both (NameAddress (RegName.unsafeFromString "db1.example.net")) (Port 6) - , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port 2500) - ]) - (path ["authdb"])) - (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) - Nothing)) + -- testIso + -- (URIRef.parser optionsMany) + -- (URIRef.print optionsMany) + -- "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" + -- (Left + -- (URI + -- (Scheme "mongodb") + -- (HierarchicalPartAuth + -- (Authority + -- (Just (UserInfo.unsafeFromString "foo:bar")) + -- [ This (NameAddress (RegName.unsafeFromString "db1.example.net")) + -- , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port 2500) + -- ]) + -- (path ["authdb"])) + -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) + -- Nothing)) + -- testIso + -- (URIRef.parser optionsMany) + -- (URIRef.print optionsMany) + -- "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" + -- (Left + -- (URI + -- (Scheme "mongodb") + -- (HierarchicalPartAuth + -- (Authority + -- (Just (UserInfo.unsafeFromString "foo:bar")) + -- [ Both (NameAddress (RegName.unsafeFromString "db1.example.net")) (Port 6) + -- , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port 2500) + -- ]) + -- (path ["authdb"])) + -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) + -- Nothing)) testIso (URIRef.parser optionsSingle) (URIRef.print optionsSingle) @@ -152,22 +151,22 @@ spec = Nothing) Nothing Nothing)) - testIso - (URIRef.parser optionsMany) - (URIRef.print optionsMany) - "mongodb://192.168.0.1,192.168.0.2" - (Left - (URI - (Scheme "mongodb") - (HierarchicalPartAuth - (Authority - Nothing - [ This (IPv4Address "192.168.0.1") - , This (IPv4Address "192.168.0.2") - ]) - Nothing) - Nothing - Nothing)) + -- testIso + -- (URIRef.parser optionsMany) + -- (URIRef.print optionsMany) + -- "mongodb://192.168.0.1,192.168.0.2" + -- (Left + -- (URI + -- (Scheme "mongodb") + -- (HierarchicalPartAuth + -- (Authority + -- Nothing + -- [ This (IPv4Address "192.168.0.1") + -- , This (IPv4Address "192.168.0.2") + -- ]) + -- Nothing) + -- Nothing + -- Nothing)) testIso (URIRef.parser optionsSingle) (URIRef.print optionsSingle) @@ -529,16 +528,12 @@ spec = path ∷ Array String → Maybe Path path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString -optionsSingle ∷ Record (URIRefOptions UserInfo Maybe Host Port Path HierPath RelPath Query Fragment) +optionsSingle ∷ Record (URIRefOptions UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) optionsSingle = { parseUserInfo: pure , printUserInfo: id - , parseHosts: Left id - , printHosts: fromMaybe "" - , parseHost: pure - , printHost: id - , parsePort: pure - , printPort: id + , parseHosts: HostPortPair.parser pure pure + , printHosts: HostPortPair.print id id , parsePath: pure , printPath: id , parseHierPath: pure @@ -551,24 +546,24 @@ optionsSingle = , printFragment: id } -optionsMany ∷ Record (URIRefOptions UserInfo Array Host Port Path HierPath RelPath Query Fragment) -optionsMany = - { parseUserInfo: pure - , printUserInfo: id - , parseHosts: Right { split: void (PS.char ','), build: Array.fromFoldable } - , printHosts: String.joinWith "," - , parseHost: pure - , printHost: id - , parsePort: pure - , printPort: id - , parsePath: pure - , printPath: id - , parseHierPath: pure - , printHierPath: id - , parseRelPath: pure - , printRelPath: id - , parseQuery: pure - , printQuery: id - , parseFragment: pure - , printFragment: id - } +-- optionsMany ∷ Record (URIRefOptions UserInfo Array Host Port Path HierPath RelPath Query Fragment) +-- optionsMany = +-- { parseUserInfo: pure +-- , printUserInfo: id +-- , parseHosts: Right { split: void (PS.char ','), build: Array.fromFoldable } +-- , printHosts: String.joinWith "," +-- , parseHost: pure +-- , printHost: id +-- , parsePort: pure +-- , printPort: id +-- , parsePath: pure +-- , printPath: id +-- , parseHierPath: pure +-- , printHierPath: id +-- , parseRelPath: pure +-- , printRelPath: id +-- , parseQuery: pure +-- , printQuery: id +-- , parseFragment: pure +-- , printFragment: id +-- } From 49d316896947cbedb95ea3514c92fa29752b3b1c Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 6 Feb 2018 14:22:16 +0000 Subject: [PATCH 20/69] Safe construction for a few more values --- src/Data/URI.purs | 6 +- src/Data/URI/AbsoluteURI.purs | 6 +- src/Data/URI/Authority.purs | 4 +- src/Data/URI/Fragment.purs | 4 +- src/Data/URI/HierarchicalPart.purs | 2 +- src/Data/URI/Host.purs | 65 ++++++------------ src/Data/URI/Host/Gen.purs | 16 ++--- src/Data/URI/Host/IPv4Address.purs | 69 +++++++++++++++++++ src/Data/URI/Host/IPv6Address.purs | 38 +++++++++++ src/Data/URI/HostPortPair.purs | 6 +- src/Data/URI/Path/Segment.purs | 17 ++--- src/Data/URI/Port.purs | 23 +++++-- src/Data/URI/Query.purs | 4 +- src/Data/URI/RelativePart.purs | 2 +- src/Data/URI/RelativeRef.purs | 6 +- src/Data/URI/Scheme.purs | 41 +++++++----- src/Data/URI/URI.purs | 8 +-- src/Data/URI/URIRef.purs | 6 +- test/URI/AbsoluteURI.purs | 14 ++-- test/URI/Authority.purs | 21 +++--- test/URI/Fragment.purs | 8 +-- test/URI/Host.purs | 16 +++-- test/URI/Port.purs | 7 +- test/URI/Scheme.purs | 5 +- test/URI/URIRef.purs | 102 +++++++++++++++-------------- 25 files changed, 303 insertions(+), 193 deletions(-) create mode 100644 src/Data/URI/Host/IPv4Address.purs create mode 100644 src/Data/URI/Host/IPv6Address.purs diff --git a/src/Data/URI.purs b/src/Data/URI.purs index fbe11df..cdc7e88 100755 --- a/src/Data/URI.purs +++ b/src/Data/URI.purs @@ -22,16 +22,16 @@ import Data.URI.AbsoluteURI (AbsoluteURI(..)) import Data.URI.Authority (Authority(..)) import Data.URI.Fragment (Fragment) import Data.URI.HierarchicalPart (HierarchicalPart(..), HierPath) -import Data.URI.Host (Host(..), RegName) +import Data.URI.Host (Host(..), RegName, IPv4Address, IPv6Address) import Data.URI.Path (Path(..)) import Data.URI.Path.Absolute (PathAbsolute(..)) import Data.URI.Path.NoScheme (PathNoScheme(..)) import Data.URI.Path.Rootless (PathRootless(..)) -import Data.URI.Port (Port(..)) +import Data.URI.Port (Port) import Data.URI.Query (Query) import Data.URI.RelativePart (RelativePart(..), RelPath) import Data.URI.RelativeRef (RelativeRef(..)) -import Data.URI.Scheme (Scheme(..)) +import Data.URI.Scheme (Scheme) import Data.URI.URI (URI(..)) import Data.URI.URIRef (URIRef) import Data.URI.UserInfo (UserInfo) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/Data/URI/AbsoluteURI.purs index 2e0df52..030f678 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/Data/URI/AbsoluteURI.purs @@ -23,11 +23,11 @@ import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as String import Data.URI.Common (URIPartParseError) -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), HostsParseOptions, Path(..), PathAbsolute(..), PathRootless(..), Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query (Query) import Data.URI.Query as Query -import Data.URI.Scheme (Scheme(..)) +import Data.URI.Scheme (Scheme) import Data.URI.Scheme as Scheme import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) @@ -82,7 +82,7 @@ print opts (AbsoluteURI s h q) = String.joinWith "" $ Array.catMaybes [ Just (Scheme.print s) , Just (HPart.print opts h) - , Query.print opts.printQuery <$> q + , Query.print <<< opts.printQuery <$> q ] _scheme diff --git a/src/Data/URI/Authority.purs b/src/Data/URI/Authority.purs index 80fbac2..5fa1272 100644 --- a/src/Data/URI/Authority.purs +++ b/src/Data/URI/Authority.purs @@ -22,8 +22,8 @@ import Data.Lens (Lens', lens) import Data.List (List) import Data.Maybe (Maybe(..)) import Data.URI.Common (URIPartParseError) -import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) -import Data.URI.Port (Port(..)) +import Data.URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) +import Data.URI.Port (Port) import Data.URI.UserInfo (UserInfo) import Data.URI.UserInfo as UserInfo import Text.Parsing.Parser (Parser) diff --git a/src/Data/URI/Fragment.purs b/src/Data/URI/Fragment.purs index 7c173f1..5a64622 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/Data/URI/Fragment.purs @@ -49,8 +49,8 @@ parser parseF = wrapParser parseF (Fragment <<< String.joinWith "" <$> Array.many (pctEncoded <|> String.singleton <$> fragmentChar)) -print ∷ ∀ f. (f → Fragment) → f → String -print printF f = "#" <> unsafeToString (printF f) +print ∷ Fragment → String +print (Fragment f) = "#" <> f -- | The supported fragment characters, excluding percent-encodings. fragmentChar ∷ Parser String Char diff --git a/src/Data/URI/HierarchicalPart.purs b/src/Data/URI/HierarchicalPart.purs index 663a8a9..f23c870 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/Data/URI/HierarchicalPart.purs @@ -25,7 +25,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) import Data.String as String -import Data.URI.Authority (Authority(..), Host(..), HostsParseOptions, Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Common (URIPartParseError) import Data.URI.Path (Path(..)) diff --git a/src/Data/URI/Host.purs b/src/Data/URI/Host.purs index 22f7389..ee36d3e 100644 --- a/src/Data/URI/Host.purs +++ b/src/Data/URI/Host.purs @@ -5,31 +5,33 @@ module Data.URI.Host , _IPv6Address , _IPv4Address , _NameAddress + , module Data.URI.Host.IPv4Address + , module Data.URI.Host.IPv6Address , module Data.URI.Host.RegName ) where import Prelude import Control.Alt ((<|>)) -import Data.Array as Array -import Data.Either (Either(..)) +import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) -import Data.Int as Int import Data.Lens (Prism', prism') import Data.Maybe (Maybe(..)) -import Data.String as String -import Data.URI.Common (URIPartParseError(..), digit, hexDigit, wrapParser) +import Data.URI.Common (URIPartParseError, wrapParser) +import Data.URI.Host.IPv4Address (IPv4Address) +import Data.URI.Host.IPv4Address as IPv4Address +import Data.URI.Host.IPv6Address (IPv6Address) +import Data.URI.Host.IPv6Address as IPv6Address import Data.URI.Host.RegName (RegName) import Data.URI.Host.RegName as RegName import Text.Parsing.Parser (Parser) -import Text.Parsing.Parser.Combinators (try, ()) -import Text.Parsing.Parser.String (char, satisfy) +import Text.Parsing.Parser.Combinators (try) -- | A host address. data Host - = IPv6Address String - | IPv4Address String + = IPv6Address IPv6Address + | IPv4Address IPv4Address | NameAddress RegName derive instance eqHost ∷ Eq Host @@ -39,51 +41,22 @@ instance showHost ∷ Show Host where show = genericShow parser ∷ ∀ h. (Host → Either URIPartParseError h) → Parser String h parser p = wrapParser p - $ ipv6AddressParser - <|> try ipv4AddressParser + $ (IPv6Address <$> IPv6Address.parser) + <|> try (IPv4Address <$> IPv4Address.parser) <|> (NameAddress <$> RegName.parser) --- TODO: this is still much too forgiving -ipv6AddressParser ∷ Parser String Host -ipv6AddressParser = IPv6Address <$> (char '[' *> (String.fromCharArray <$> Array.some ipv6Char) <* char ']') "IPv6 address" - where - ipv6Char ∷ Parser String Char - ipv6Char = hexDigit <|> char ':' <|> char '.' - -ipv4AddressParser ∷ Parser String Host -ipv4AddressParser = IPv4Address <$> addr "IPv4 address" - where - addr ∷ Parser String String - addr = do - o1 ← octet <* char '.' - o2 ← octet <* char '.' - o3 ← octet <* char '.' - o4 ← octet - pure $ show o1 <> "." <> show o2 <> "." <> show o3 <> "." <> show o4 - octet ∷ Parser String Int - octet = wrapParser toInt - $ try ((\x y z → String.fromCharArray [x, y, z]) <$> nzDigit <*> digit <*> digit) - <|> try ((\x y → String.fromCharArray [x, y]) <$> nzDigit <*> digit) - <|> (String.singleton <$> digit) - nzDigit ∷ Parser String Char - nzDigit = satisfy (\c → c >= '1' && c <= '9') - toInt ∷ String → Either URIPartParseError Int - toInt s = case Int.fromString s of - Just n | n >= 0 && n <= 255 → Right n - _ → Left (URIPartParseError "Invalid IPv4 address octet") - -print ∷ ∀ h. (h → Host) → h → String -print f = f >>> case _ of - IPv6Address addr → "[" <> addr <> "]" - IPv4Address addr → addr +print ∷ Host → String +print = case _ of + IPv6Address addr → IPv6Address.unsafeToString addr + IPv4Address addr → IPv4Address.print addr NameAddress addr → RegName.unsafeToString addr -_IPv6Address ∷ Prism' Host String +_IPv6Address ∷ Prism' Host IPv6Address _IPv6Address = prism' IPv6Address case _ of IPv6Address addr → Just addr _ → Nothing -_IPv4Address ∷ Prism' Host String +_IPv4Address ∷ Prism' Host IPv4Address _IPv4Address = prism' IPv4Address case _ of IPv4Address addr → Just addr _ → Nothing diff --git a/src/Data/URI/Host/Gen.purs b/src/Data/URI/Host/Gen.purs index 7d91888..51ff536 100644 --- a/src/Data/URI/Host/Gen.purs +++ b/src/Data/URI/Host/Gen.purs @@ -3,13 +3,13 @@ module Data.URI.Host.Gen where import Prelude import Control.Monad.Gen as Gen -import Data.String as String -import Data.URI.Host (Host(..)) +import Data.URI.Host (IPv4Address) +import Data.URI.Host.IPv4Address as IPv4Address -genIPv4 :: forall m. Gen.MonadGen m => m Host +genIPv4 ∷ ∀ m. Gen.MonadGen m ⇒ m IPv4Address genIPv4 = do - a <- Gen.chooseInt 0 255 - b <- Gen.chooseInt 0 255 - c <- Gen.chooseInt 0 255 - d <- Gen.chooseInt 0 255 - pure $ IPv4Address $ String.joinWith "." $ show <$> [a, b, c, d] + a ← Gen.chooseInt 0 255 + b ← Gen.chooseInt 0 255 + c ← Gen.chooseInt 0 255 + d ← Gen.chooseInt 0 255 + pure $ IPv4Address.unsafeFromOctets a b c d diff --git a/src/Data/URI/Host/IPv4Address.purs b/src/Data/URI/Host/IPv4Address.purs new file mode 100644 index 0000000..12d33da --- /dev/null +++ b/src/Data/URI/Host/IPv4Address.purs @@ -0,0 +1,69 @@ +module Data.URI.Host.IPv4Address + ( IPv4Address + , fromOctets + , unsafeFromOctets + , parser + , print + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Either (Either(..)) +import Data.Int as Int +import Data.Maybe (Maybe(..)) +import Data.String as String +import Data.URI.Common (URIPartParseError(..), digit, wrapParser) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (try) +import Text.Parsing.Parser.String (char, satisfy) + +data IPv4Address = IPv4Address Int Int Int Int + +derive instance eqIPv4Address ∷ Eq IPv4Address +derive instance ordIPv4Address ∷ Ord IPv4Address + +instance showIPv4Address ∷ Show IPv4Address where + show (IPv4Address o1 o2 o3 o4) = "(IPv4Address.unsafeFromOctets " <> show o1 <> " " <> show o2 <> " " <> show o3 <> " " <> show o4 <> ")" + +-- | Constructs a `IPv4Address` part safely: bounds-checks each octet to ensure +-- | it occurs within the range 0-255 (inclusive). +fromOctets ∷ Int → Int → Int → Int → Maybe IPv4Address +fromOctets o1 o2 o3 o4 = + IPv4Address <$> check o1 <*> check o2 <*> check o3 <*> check o4 + where + check ∷ Int → Maybe Int + check i + | i >= 0 && i <= 255 = Just i + | otherwise = Nothing + +-- | Constructs a `IPv4Address` part unsafely: no bounds-checking will be used +-- | on the passed integers, potentially allowing for invalid IP addresses. +unsafeFromOctets ∷ Int → Int → Int → Int → IPv4Address +unsafeFromOctets = IPv4Address + +parser ∷ Parser String IPv4Address +parser = do + o1 ← octet <* char '.' + o2 ← octet <* char '.' + o3 ← octet <* char '.' + o4 ← octet + pure $ IPv4Address o1 o2 o3 o4 + +print ∷ IPv4Address → String +print (IPv4Address o1 o2 o3 o4) = + show o1 <> "." <> show o2 <> "." <> show o3 <> "." <> show o4 + +octet ∷ Parser String Int +octet = wrapParser toInt + $ try ((\x y z → String.fromCharArray [x, y, z]) <$> nzDigit <*> digit <*> digit) + <|> try ((\x y → String.fromCharArray [x, y]) <$> nzDigit <*> digit) + <|> (String.singleton <$> digit) + +nzDigit ∷ Parser String Char +nzDigit = satisfy (\c → c >= '1' && c <= '9') + +toInt ∷ String → Either URIPartParseError Int +toInt s = case Int.fromString s of + Just n | n >= 0 && n <= 255 → Right n + _ → Left (URIPartParseError "Invalid IPv4 address octet") diff --git a/src/Data/URI/Host/IPv6Address.purs b/src/Data/URI/Host/IPv6Address.purs new file mode 100644 index 0000000..8fb1b83 --- /dev/null +++ b/src/Data/URI/Host/IPv6Address.purs @@ -0,0 +1,38 @@ +module Data.URI.Host.IPv6Address + ( IPv6Address + , unsafeFromString + , unsafeToString + , parser + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Array as Array +import Data.String as String +import Data.URI.Common (hexDigit) +import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (()) +import Text.Parsing.Parser.String (char) + +-- | This type and parser are much too forgiving currently, allowing almost +-- | anything through that looks vaguely IPv6ish. +newtype IPv6Address = IPv6Address String + +derive newtype instance eqIPv6Address ∷ Eq IPv6Address +derive newtype instance ordIPv6Address ∷ Ord IPv6Address + +instance showIPv6Address ∷ Show IPv6Address where + show (IPv6Address s) = "(IPv6Address.unsafeFromString " <> show s <> ")" + +unsafeFromString ∷ String → IPv6Address +unsafeFromString = IPv6Address + +unsafeToString ∷ IPv6Address → String +unsafeToString (IPv6Address s) = "[" <> s <> "]" + +parser ∷ Parser String IPv6Address +parser = IPv6Address <$> (char '[' *> (String.fromCharArray <$> Array.some ipv6Char) <* char ']') "IPv6 address" + where + ipv6Char ∷ Parser String Char + ipv6Char = hexDigit <|> char ':' <|> char '.' diff --git a/src/Data/URI/HostPortPair.purs b/src/Data/URI/HostPortPair.purs index c57524e..124f26f 100644 --- a/src/Data/URI/HostPortPair.purs +++ b/src/Data/URI/HostPortPair.purs @@ -39,8 +39,8 @@ print printHost printPort = case _ of Nothing → "" Just (This host) → - Host.print printHost host + Host.print (printHost host) Just (That port) → - Port.print printPort port + Port.print (printPort port) Just (Both host port) → - Host.print printHost host <> Port.print printPort port + Host.print (printHost host) <> Port.print (printPort port) diff --git a/src/Data/URI/Path/Segment.purs b/src/Data/URI/Path/Segment.purs index f2a4494..2e1266c 100644 --- a/src/Data/URI/Path/Segment.purs +++ b/src/Data/URI/Path/Segment.purs @@ -23,8 +23,6 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) import Data.Maybe (Maybe(..)) import Data.String as String import Data.URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) @@ -36,8 +34,9 @@ newtype PathSegment = PathSegment String derive newtype instance eqPathSegment ∷ Eq PathSegment derive newtype instance ordPathSegment ∷ Ord PathSegment -derive instance genericPathSegment ∷ Generic PathSegment _ -instance showPathSegment ∷ Show PathSegment where show = genericShow + +instance showPathSegment ∷ Show PathSegment where + show (PathSegment s) = "(PathSegment.unsafeFromString " <> show s <> ")" parseSegment ∷ Parser String PathSegment parseSegment = @@ -61,8 +60,9 @@ newtype PathSegmentNZ = PathSegmentNZ String derive newtype instance eqPathSegmentNZ ∷ Eq PathSegmentNZ derive newtype instance ordPathSegmentNZ ∷ Ord PathSegmentNZ -derive instance genericPathSegmentNZ ∷ Generic PathSegmentNZ _ -instance showPathSegmentNZ ∷ Show PathSegmentNZ where show = genericShow + +instance showPathSegmentNZ ∷ Show PathSegmentNZ where + show (PathSegmentNZ s) = "(PathSegmentNZ.unsafeFromString " <> show s <> ")" parseSegmentNonZero ∷ Parser String PathSegmentNZ parseSegmentNonZero = @@ -88,8 +88,9 @@ newtype PathSegmentNZNC = PathSegmentNZNC String derive newtype instance eqPathSegmentNZNC ∷ Eq PathSegmentNZNC derive newtype instance ordPathSegmentNZNC ∷ Ord PathSegmentNZNC -derive instance genericPathSegmentNZNC ∷ Generic PathSegmentNZNC _ -instance showPathSegmentNZNC ∷ Show PathSegmentNZNC where show = genericShow + +instance showPathSegmentNZNC ∷ Show PathSegmentNZNC where + show (PathSegmentNZNC s) = "(PathSegmentNZNC.unsafeFromString " <> show s <> ")" parseSegmentNonZeroNoColon ∷ Parser String PathSegmentNZNC parseSegmentNonZeroNoColon = diff --git a/src/Data/URI/Port.purs b/src/Data/URI/Port.purs index 7d9a28f..788bbbe 100644 --- a/src/Data/URI/Port.purs +++ b/src/Data/URI/Port.purs @@ -1,5 +1,8 @@ module Data.URI.Port - ( Port(..) + ( Port + , toInt + , fromInt + , unsafeFromInt , parser , print ) where @@ -12,22 +15,30 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Int (fromNumber) import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype) import Data.String as String import Data.URI.Common (URIPartParseError, digit, wrapParser) import Global (readInt) import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.String (char) --- | A port number. newtype Port = Port Int derive newtype instance eqPort ∷ Eq Port derive newtype instance ordPort ∷ Ord Port derive instance genericPort ∷ Generic Port _ -derive instance newtypePort ∷ Newtype Port _ instance showPort ∷ Show Port where show = genericShow +toInt ∷ Port → Int +toInt (Port i) = i + +fromInt ∷ Int → Maybe Port +fromInt n + | n >= 0 && n <= 65535 = Just (Port n) + | otherwise = Nothing + +unsafeFromInt ∷ Int → Port +unsafeFromInt = Port + parser ∷ ∀ p. (Port → Either URIPartParseError p) → Parser String p parser p = wrapParser p do s ← String.fromCharArray <$> (char ':' *> Array.some digit) @@ -35,5 +46,5 @@ parser p = wrapParser p do Just x → pure (Port x) _ → fail "Expected valid port number" -print ∷ ∀ p. (p → Port) → p → String -print = map (\(Port x) → ":" <> show x) +print ∷ Port → String +print (Port x) = ":" <> show x diff --git a/src/Data/URI/Query.purs b/src/Data/URI/Query.purs index 12d05e6..2063780 100644 --- a/src/Data/URI/Query.purs +++ b/src/Data/URI/Query.purs @@ -49,8 +49,8 @@ parser parseQ = where p = String.singleton <$> queryChar <|> pctEncoded -print ∷ ∀ q. (q → Query) → q → String -print printQ q = "?" <> unsafeToString (printQ q) +print ∷ Query → String +print (Query s) = "?" <> s queryChar ∷ Parser String Char queryChar diff --git a/src/Data/URI/RelativePart.purs b/src/Data/URI/RelativePart.purs index ff1a010..840a049 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/Data/URI/RelativePart.purs @@ -25,7 +25,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) import Data.String as String -import Data.URI.Authority (Authority(..), Host(..), HostsParseOptions, Port(..), RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import Data.URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import Data.URI.Authority as Authority import Data.URI.Common (URIPartParseError) import Data.URI.Path (Path) diff --git a/src/Data/URI/RelativeRef.purs b/src/Data/URI/RelativeRef.purs index b0a71bd..af88fe1 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/Data/URI/RelativeRef.purs @@ -27,7 +27,7 @@ import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment import Data.URI.Query (Query) import Data.URI.Query as Query -import Data.URI.RelativePart (Authority(..), Host(..), HostsParseOptions, Path, PathAbsolute, PathNoScheme, Port(..), RelativePart(..), RelPath, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.RelativePart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path, PathAbsolute, PathNoScheme, Port, RegName, RelPath, RelativePart(..), RelativePartOptions, RelativePartParseOptions, RelativePartPrintOptions, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _relPath, _userInfo) import Data.URI.RelativePart as RPart import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) @@ -84,8 +84,8 @@ print print opts (RelativeRef h q f) = String.joinWith "" $ Array.catMaybes [ Just (RPart.print opts h) - , Query.print opts.printQuery <$> q - , Fragment.print opts.printFragment <$> f + , Query.print <<< opts.printQuery <$> q + , Fragment.print <<< opts.printFragment <$> f ] _relPart diff --git a/src/Data/URI/Scheme.purs b/src/Data/URI/Scheme.purs index b1d3dc1..5e02e94 100644 --- a/src/Data/URI/Scheme.purs +++ b/src/Data/URI/Scheme.purs @@ -1,15 +1,20 @@ -module Data.URI.Scheme where +module Data.URI.Scheme + ( Scheme + , fromString + , unsafeFromString + , parser + , print + ) where import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.Newtype (class Newtype) +import Data.Either (hush) +import Data.Maybe (Maybe) import Data.String as String import Data.URI.Common (alpha, alphaNum) -import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser (Parser, runParser) import Text.Parsing.Parser.String (char) -- | The scheme part of an absolute URI. For example: `http`, `ftp`, `git`. @@ -17,18 +22,24 @@ newtype Scheme = Scheme String derive newtype instance eqScheme ∷ Eq Scheme derive newtype instance ordScheme ∷ Ord Scheme -derive instance genericScheme ∷ Generic Scheme _ -derive instance newtypeScheme ∷ Newtype Scheme _ -instance showScheme ∷ Show Scheme where show = genericShow + +instance showScheme ∷ Show Scheme where + show (Scheme s) = "(Scheme.unsafeFromString " <> show s <> ")" + +fromString ∷ String → Maybe Scheme +fromString = map Scheme <<< hush <<< flip runParser parseScheme + +unsafeFromString ∷ String → Scheme +unsafeFromString = Scheme parser ∷ Parser String Scheme -parser = Scheme <$> parseScheme - where - parseScheme = do - init ← alpha - rest ← Array.many (alphaNum <|> char '+' <|> char '-' <|> char '.') - _ ← char ':' - pure $ String.singleton init <> String.fromCharArray rest +parser = Scheme <$> parseScheme <* char ':' + +parseScheme ∷ Parser String String +parseScheme = do + init ← alpha + rest ← Array.many (alphaNum <|> char '+' <|> char '-' <|> char '.') + pure $ String.singleton init <> String.fromCharArray rest print ∷ Scheme → String print (Scheme s) = s <> ":" diff --git a/src/Data/URI/URI.purs b/src/Data/URI/URI.purs index a17499e..15bcb70 100644 --- a/src/Data/URI/URI.purs +++ b/src/Data/URI/URI.purs @@ -26,11 +26,11 @@ import Data.String as String import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) import Data.URI.Fragment as Fragment -import Data.URI.HierarchicalPart (Authority(..), HierarchicalPart(..), HierPath, Host(..), HostsParseOptions, Path, PathAbsolute, PathRootless, Port(..), UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _userInfo) +import Data.URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) import Data.URI.HierarchicalPart as HPart import Data.URI.Query (Query) import Data.URI.Query as Query -import Data.URI.Scheme (Scheme(..)) +import Data.URI.Scheme (Scheme) import Data.URI.Scheme as Scheme import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) @@ -88,8 +88,8 @@ print opts (URI s h q f) = String.joinWith "" $ Array.catMaybes [ Just (Scheme.print s) , Just (HPart.print opts h) - , Query.print opts.printQuery <$> q - , Fragment.print opts.printFragment <$> f + , Query.print <<< opts.printQuery <$> q + , Fragment.print <<< opts.printFragment <$> f ] _scheme diff --git a/src/Data/URI/URIRef.purs b/src/Data/URI/URIRef.purs index cd6597a..11c4446 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/Data/URI/URIRef.purs @@ -27,16 +27,16 @@ import Data.Either (Either(..), either) import Data.URI.Authority (Authority(..), HostsParseOptions) import Data.URI.Common (URIPartParseError) import Data.URI.Fragment (Fragment) -import Data.URI.Host (Host(..), RegName, _IPv4Address, _IPv6Address, _NameAddress) +import Data.URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) import Data.URI.Path (Path(..)) import Data.URI.Path.Absolute (PathAbsolute(..)) import Data.URI.Path.NoScheme (PathNoScheme(..)) import Data.URI.Path.Rootless (PathRootless(..)) -import Data.URI.Port (Port(..)) +import Data.URI.Port (Port) import Data.URI.Query (Query) import Data.URI.RelativeRef (RelativeRef(..), RelativePart(..), RelPath) import Data.URI.RelativeRef as RelativeRef -import Data.URI.Scheme (Scheme(..)) +import Data.URI.Scheme (Scheme) import Data.URI.URI (URI(..), HierarchicalPart(..), HierPath) import Data.URI.URI as URI import Data.URI.UserInfo (UserInfo) diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs index 545ee9f..d4ad7c9 100644 --- a/test/URI/AbsoluteURI.purs +++ b/test/URI/AbsoluteURI.purs @@ -6,13 +6,15 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.These (These(..)) import Data.Tuple (Tuple(..)) -import Data.URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port(..), Query, Scheme(..), AbsoluteURI(..), AbsoluteURIOptions, UserInfo) +import Data.URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port, Query, AbsoluteURI(..), AbsoluteURIOptions, UserInfo) import Data.URI.AbsoluteURI as AbsoluteURI import Data.URI.Host.RegName as RegName import Data.URI.HostPortPair (HostPortPair) import Data.URI.HostPortPair as HostPortPair import Data.URI.Path.Segment as PathSegment +import Data.URI.Port as Port import Data.URI.Query as Query +import Data.URI.Scheme as Scheme import Test.Spec (Spec, describe) import Test.Util (testIso) @@ -24,7 +26,7 @@ spec = (AbsoluteURI.print options) "couchbase://localhost/testBucket?password=&docTypeKey=" (AbsoluteURI - (Scheme "couchbase") + (Scheme.unsafeFromString "couchbase") (HierarchicalPartAuth (Authority Nothing @@ -36,11 +38,11 @@ spec = (AbsoluteURI.print options) "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (AbsoluteURI - (Scheme "couchbase") + (Scheme.unsafeFromString "couchbase") (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port 99999)))) + (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 99999)))) (path ["testBucket"])) (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) testIso @@ -48,7 +50,7 @@ spec = (AbsoluteURI.print options) "foo:/abc/def" (AbsoluteURI - (Scheme "foo") + (Scheme.unsafeFromString "foo") (HierarchicalPartNoAuth (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString "abc") [PathSegment.unsafeSegmentFromString "def"])))))) Nothing) @@ -57,7 +59,7 @@ spec = (AbsoluteURI.print options) "foo:abc/def" (AbsoluteURI - (Scheme "foo") + (Scheme.unsafeFromString "foo") (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "abc") [PathSegment.unsafeSegmentFromString "def"]))))) Nothing) diff --git a/test/URI/Authority.purs b/test/URI/Authority.purs index 060e507..8b69d2b 100644 --- a/test/URI/Authority.purs +++ b/test/URI/Authority.purs @@ -4,11 +4,12 @@ import Prelude import Data.Maybe (Maybe(..)) import Data.These (These(..)) -import Data.URI.Authority (Authority(..), AuthorityOptions, Host(..), Port(..), UserInfo) +import Data.URI.Authority (Authority(..), AuthorityOptions, Host(..), Port, UserInfo) import Data.URI.Authority as Authority import Data.URI.Host.RegName as RegName import Data.URI.HostPortPair (HostPortPair) import Data.URI.HostPortPair as HostPortPair +import Data.URI.Port as Port import Data.URI.UserInfo as UserInfo import Test.Spec (Spec, describe) import Test.Util (testIso) @@ -29,14 +30,14 @@ spec = "//localhost:3000" (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port 3000)))) + (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) testIso (Authority.parser optionsSingle) (Authority.print optionsSingle) "//user@localhost:3000" (Authority (Just (UserInfo.unsafeFromString "user")) - (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port 3000)))) + (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) -- testIso -- (Authority.parser optionsMany) -- (Authority.print optionsMany) @@ -52,8 +53,8 @@ spec = -- "//mongo-1:2000,mongo-2:3000" -- (Authority -- Nothing - -- [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port 2000) - -- , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port 3000) + -- [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) + -- , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) -- ]) -- testIso -- (Authority.parser optionsMany) @@ -61,7 +62,7 @@ spec = -- "//mongo-1:2000,mongo-2" -- (Authority -- Nothing - -- [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port 2000) + -- [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) -- , This (NameAddress (RegName.unsafeFromString "mongo-2")) -- ]) -- testIso @@ -71,21 +72,21 @@ spec = -- (Authority -- Nothing -- [ This (NameAddress (RegName.unsafeFromString "mongo-1")) - -- , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port 3000) + -- , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) -- ]) testIso (Authority.parser optionsSingle) (Authority.print optionsSingle) "//:8000" - (Authority Nothing (Just (That (Port 8000)))) + (Authority Nothing (Just (That (Port.unsafeFromInt 8000)))) -- testIso -- (Authority.parser optionsMany) -- (Authority.print optionsMany) -- "//:2000,:3000" -- (Authority -- Nothing - -- [ That (Port 2000) - -- , That (Port 3000) + -- [ That (Port.unsafeFromInt 2000) + -- , That (Port.unsafeFromInt 3000) -- ]) optionsSingle ∷ Record (AuthorityOptions UserInfo (HostPortPair Host Port)) diff --git a/test/URI/Fragment.purs b/test/URI/Fragment.purs index 5fa97b5..bc12918 100644 --- a/test/URI/Fragment.purs +++ b/test/URI/Fragment.purs @@ -9,7 +9,7 @@ import Test.Util (testIso) spec ∷ ∀ eff. Spec eff Unit spec = describe "Fragment parser/printer" do - testIso (Fragment.parser pure) (Fragment.print id) "#" (Fragment.fromString "") - testIso (Fragment.parser pure) (Fragment.print id) "#foo" (Fragment.fromString "foo") - testIso (Fragment.parser pure) (Fragment.print id) "#foo%23bar" (Fragment.fromString "foo#bar") - testIso (Fragment.parser pure) (Fragment.print id) "#foo%23bar" (Fragment.unsafeFromString "foo%23bar") + testIso (Fragment.parser pure) Fragment.print "#" (Fragment.fromString "") + testIso (Fragment.parser pure) Fragment.print "#foo" (Fragment.fromString "foo") + testIso (Fragment.parser pure) Fragment.print "#foo%23bar" (Fragment.fromString "foo#bar") + testIso (Fragment.parser pure) Fragment.print "#foo%23bar" (Fragment.unsafeFromString "foo%23bar") diff --git a/test/URI/Host.purs b/test/URI/Host.purs index deeec10..1471c53 100644 --- a/test/URI/Host.purs +++ b/test/URI/Host.purs @@ -6,6 +6,8 @@ import Data.Either (Either(..)) import Data.URI.Host (Host(..)) import Data.URI.Host as Host import Data.URI.Host.Gen as Host.Gen +import Data.URI.Host.IPv4Address as IPv4Address +import Data.URI.Host.IPv6Address as IPv6Address import Data.URI.Host.RegName as RegName import Test.QuickCheck ((===)) import Test.Spec (Spec, describe, it) @@ -20,9 +22,9 @@ spec = do it "Should successfully roundtrip values sent through parseIPv4Address / Host.print" do forAll do ipv4 <- Host.Gen.genIPv4 - let printed = Host.print id ipv4 + let printed = IPv4Address.print ipv4 let parsed = runParser printed (Host.parser pure) - pure $ pure ipv4 === parsed + pure $ pure (IPv4Address ipv4) === parsed it "should not parse 0-lead octets as an IP address" do shouldEqual @@ -30,8 +32,8 @@ spec = do (runParser "192.168.001.1" (Host.parser pure)) describe "Host parser/printer" do - testIso (Host.parser pure) (Host.print id) "localhost" (NameAddress (RegName.unsafeFromString "localhost")) - testIso (Host.parser pure) (Host.print id) "github.com" (NameAddress (RegName.unsafeFromString "github.com")) - testIso (Host.parser pure) (Host.print id) "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString "www.multipart.domain.example.com")) - testIso (Host.parser pure) (Host.print id) "192.168.0.1" (IPv4Address "192.168.0.1") - testIso (Host.parser pure) (Host.print id) "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652") + testIso (Host.parser pure) Host.print "localhost" (NameAddress (RegName.unsafeFromString "localhost")) + testIso (Host.parser pure) Host.print "github.com" (NameAddress (RegName.unsafeFromString "github.com")) + testIso (Host.parser pure) Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString "www.multipart.domain.example.com")) + testIso (Host.parser pure) Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromOctets 192 168 0 1)) + testIso (Host.parser pure) Host.print "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")) diff --git a/test/URI/Port.purs b/test/URI/Port.purs index 753556f..251dc52 100644 --- a/test/URI/Port.purs +++ b/test/URI/Port.purs @@ -2,7 +2,6 @@ module Test.URI.Port where import Prelude -import Data.URI.Port (Port(..)) import Data.URI.Port as Port import Test.Spec (Spec, describe) import Test.Util (testIso) @@ -10,6 +9,6 @@ import Test.Util (testIso) spec ∷ ∀ eff. Spec eff Unit spec = describe "Port parser/printer" do - testIso (Port.parser pure) (Port.print id) "0" (Port 0) - testIso (Port.parser pure) (Port.print id) "1234" (Port 1234) - testIso (Port.parser pure) (Port.print id) "63174" (Port 63174) + testIso (Port.parser pure) Port.print ":0" (Port.unsafeFromInt 0) + testIso (Port.parser pure) Port.print ":1234" (Port.unsafeFromInt 1234) + testIso (Port.parser pure) Port.print ":63174" (Port.unsafeFromInt 63174) diff --git a/test/URI/Scheme.purs b/test/URI/Scheme.purs index 453f091..2ddb6ce 100644 --- a/test/URI/Scheme.purs +++ b/test/URI/Scheme.purs @@ -2,7 +2,6 @@ module Test.URI.Scheme where import Prelude -import Data.URI.Scheme (Scheme(..)) import Data.URI.Scheme as Scheme import Test.Spec (Spec, describe) import Test.Util (testIso) @@ -10,5 +9,5 @@ import Test.Util (testIso) spec ∷ ∀ eff. Spec eff Unit spec = describe "Scheme parser/printer" do - testIso Scheme.parser Scheme.print "http:" (Scheme "http") - testIso Scheme.parser Scheme.print "git+ssh:" (Scheme "git+ssh") + testIso Scheme.parser Scheme.print "http:" (Scheme.unsafeFromString "http") + testIso Scheme.parser Scheme.print "git+ssh:" (Scheme.unsafeFromString "git+ssh") diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index d9b3ab6..2bfdf7e 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -7,12 +7,16 @@ import Data.Maybe (Maybe(..)) import Data.These (These(..)) import Data.Tuple (Tuple(..)) import Data.URI.Fragment as Fragment +import Data.URI.Host.IPv4Address as IPv4Address +import Data.URI.Host.IPv6Address as IPv6Address import Data.URI.Host.RegName as RegName import Data.URI.HostPortPair (HostPortPair) import Data.URI.HostPortPair as HostPortPair import Data.URI.Path.Segment as PathSegment +import Data.URI.Port as Port import Data.URI.Query as Query -import Data.URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), PathRootless(..), Port(..), Query, RelPath, RelativePart(..), RelativeRef(..), Scheme(..), URI(..), URIRefOptions, UserInfo) +import Data.URI.Scheme as Scheme +import Data.URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), PathRootless(..), Port, Query, RelPath, RelativePart(..), RelativeRef(..), URI(..), URIRefOptions, UserInfo) import Data.URI.URIRef as URIRef import Data.URI.UserInfo as UserInfo import Test.Spec (Spec, describe) @@ -27,7 +31,7 @@ spec = "sql2:///?q=foo&var.bar=baz" (Left (URI - (Scheme "sql2") + (Scheme.unsafeFromString "sql2") (HierarchicalPartAuth (Authority Nothing Nothing) (path [""])) @@ -39,7 +43,7 @@ spec = "sql2://?q=foo&var.bar=baz" (Left (URI - (Scheme "sql2") + (Scheme.unsafeFromString "sql2") (HierarchicalPartAuth (Authority Nothing Nothing) Nothing) @@ -51,7 +55,7 @@ spec = "sql2:/?q=foo&var.bar=baz" (Left (URI - (Scheme "sql2") + (Scheme.unsafeFromString "sql2") (HierarchicalPartNoAuth (Just (Left (PathAbsolute Nothing)))) (Just (Query.unsafeFromString "q=foo&var.bar=baz")) Nothing)) @@ -61,7 +65,7 @@ spec = "sql2:?q=foo&var.bar=baz" (Left (URI - (Scheme "sql2") + (Scheme.unsafeFromString "sql2") (HierarchicalPartNoAuth Nothing) (Just (Query.unsafeFromString "q=foo&var.bar=baz")) Nothing)) @@ -71,7 +75,7 @@ spec = "mongodb://localhost" (Left (URI - (Scheme "mongodb") + (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority Nothing @@ -85,7 +89,7 @@ spec = "https://1a.example.com" (Left (URI - (Scheme "https") + (Scheme.unsafeFromString "https") (HierarchicalPartAuth (Authority Nothing @@ -99,7 +103,7 @@ spec = "http://en.wikipedia.org/wiki/URI_scheme" (Left (URI - (Scheme "http") + (Scheme.unsafeFromString "http") (HierarchicalPartAuth (Authority Nothing @@ -113,12 +117,12 @@ spec = -- "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" -- (Left -- (URI - -- (Scheme "mongodb") + -- (Scheme.unsafeFromString "mongodb") -- (HierarchicalPartAuth -- (Authority -- (Just (UserInfo.unsafeFromString "foo:bar")) -- [ This (NameAddress (RegName.unsafeFromString "db1.example.net")) - -- , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port 2500) + -- , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) -- ]) -- (path ["authdb"])) -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) @@ -129,12 +133,12 @@ spec = -- "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" -- (Left -- (URI - -- (Scheme "mongodb") + -- (Scheme.unsafeFromString "mongodb") -- (HierarchicalPartAuth -- (Authority -- (Just (UserInfo.unsafeFromString "foo:bar")) - -- [ Both (NameAddress (RegName.unsafeFromString "db1.example.net")) (Port 6) - -- , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port 2500) + -- [ Both (NameAddress (RegName.unsafeFromString "db1.example.net")) (Port.unsafeFromInt 6) + -- , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) -- ]) -- (path ["authdb"])) -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) @@ -145,9 +149,9 @@ spec = "mongodb://192.168.0.1" (Left (URI - (Scheme "mongodb") + (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth - (Authority Nothing (Just (This (IPv4Address "192.168.0.1")))) + (Authority Nothing (Just (This (IPv4Address (IPv4Address.unsafeFromOctets 192 168 0 1))))) Nothing) Nothing Nothing)) @@ -157,7 +161,7 @@ spec = -- "mongodb://192.168.0.1,192.168.0.2" -- (Left -- (URI - -- (Scheme "mongodb") + -- (Scheme.unsafeFromString "mongodb") -- (HierarchicalPartAuth -- (Authority -- Nothing @@ -173,7 +177,7 @@ spec = "mongodb://sysop:moon@localhost" (Left (URI - (Scheme "mongodb") + (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) @@ -187,7 +191,7 @@ spec = "mongodb://sysop:moon@localhost/" (Left (URI - (Scheme "mongodb") + (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) @@ -201,7 +205,7 @@ spec = "mongodb://sysop:moon@localhost/records" (Left (URI - (Scheme "mongodb") + (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) @@ -215,7 +219,7 @@ spec = "mongodb://sysop:moon@localhost/records/etc/" (Left (URI - (Scheme "mongodb") + (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) @@ -229,11 +233,11 @@ spec = "foo://[2001:cdba:0000:0000:0000:0000:3257:9652]" (Left (URI - (Scheme "foo") + (Scheme.unsafeFromString "foo") (HierarchicalPartAuth (Authority Nothing - (Just (This (IPv6Address "2001:cdba:0000:0000:0000:0000:3257:9652")))) + (Just (This (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652"))))) Nothing) Nothing Nothing)) @@ -243,11 +247,11 @@ spec = "foo://[FE80::0202:B3FF:FE1E:8329]" (Left (URI - (Scheme "foo") + (Scheme.unsafeFromString "foo") (HierarchicalPartAuth (Authority Nothing - (Just (This (IPv6Address "FE80::0202:B3FF:FE1E:8329")))) + (Just (This (IPv6Address (IPv6Address.unsafeFromString "FE80::0202:B3FF:FE1E:8329"))))) Nothing) Nothing Nothing)) @@ -257,11 +261,11 @@ spec = "foo://[2001:db8::1]:80" (Left (URI - (Scheme "foo") + (Scheme.unsafeFromString "foo") (HierarchicalPartAuth (Authority Nothing - (Just (Both (IPv6Address "2001:db8::1") (Port 80)))) + (Just (Both (IPv6Address (IPv6Address.unsafeFromString "2001:db8::1")) (Port.unsafeFromInt 80)))) Nothing) Nothing Nothing)) @@ -271,7 +275,7 @@ spec = "ftp://ftp.is.co.za/rfc/rfc1808.txt" (Left (URI - (Scheme "ftp") + (Scheme.unsafeFromString "ftp") (HierarchicalPartAuth (Authority Nothing @@ -285,7 +289,7 @@ spec = "http://www.ietf.org/rfc/rfc2396.txt" (Left (URI - (Scheme "http") + (Scheme.unsafeFromString "http") (HierarchicalPartAuth (Authority Nothing @@ -299,11 +303,11 @@ spec = "ldap://[2001:db8::7]/c=GB?objectClass?one" (Left (URI - (Scheme "ldap") + (Scheme.unsafeFromString "ldap") (HierarchicalPartAuth (Authority Nothing - (Just (This (IPv6Address "2001:db8::7")))) + (Just (This (IPv6Address (IPv6Address.unsafeFromString "2001:db8::7"))))) (path ["c=GB"])) (Just (Query.unsafeFromString "objectClass?one")) Nothing)) @@ -313,11 +317,11 @@ spec = "telnet://192.0.2.16:80/" (Left (URI - (Scheme "telnet") + (Scheme.unsafeFromString "telnet") (HierarchicalPartAuth (Authority Nothing - (Just (Both (IPv4Address "192.0.2.16") (Port 80)))) + (Just (Both (IPv4Address (IPv4Address.unsafeFromOctets 192 0 2 16)) (Port.unsafeFromInt 80)))) (path [""])) Nothing Nothing)) @@ -327,11 +331,11 @@ spec = "foo://example.com:8042/over/there?name=ferret#nose" (Left (URI - (Scheme "foo") + (Scheme.unsafeFromString "foo") (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString "example.com")) (Port 8042)))) + (Just (Both (NameAddress (RegName.unsafeFromString "example.com")) (Port.unsafeFromInt 8042)))) (path ["over", "there"])) (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "nose")))) @@ -341,11 +345,11 @@ spec = "foo://example.com:8042/over/there?name=ferret#" (Left (URI - (Scheme "foo") + (Scheme.unsafeFromString "foo") (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString "example.com")) (Port 8042)))) + (Just (Both (NameAddress (RegName.unsafeFromString "example.com")) (Port.unsafeFromInt 8042)))) (path ["over", "there"])) (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "")))) @@ -355,7 +359,7 @@ spec = "foo://info.example.com?fred" (Left (URI - (Scheme "foo") + (Scheme.unsafeFromString "foo") (HierarchicalPartAuth (Authority Nothing @@ -369,11 +373,11 @@ spec = "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" (Left (URI - (Scheme "ftp") + (Scheme.unsafeFromString "ftp") (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "cnn.example.com&story=breaking_news")) - (Just (This (IPv4Address "10.0.0.1")))) + (Just (This (IPv4Address (IPv4Address.unsafeFromOctets 10 0 0 1))))) (path ["top_story.htm"])) Nothing Nothing)) @@ -428,7 +432,7 @@ spec = "http://www.example.com/some%20invented/url%20with%20spaces.html" (Left (URI - (Scheme "http") + (Scheme.unsafeFromString "http") (HierarchicalPartAuth (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString "www.example.com"))))) (path ["some%20invented", "url%20with%20spaces.html"])) @@ -440,9 +444,9 @@ spec = "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" (Left (URI - (Scheme "http") + (Scheme.unsafeFromString "http") (HierarchicalPartAuth - (Authority Nothing (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port 53174)))) + (Authority Nothing (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 53174)))) (path ["metadata", "fs", "test", "%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23"])) (Just (Query.unsafeFromString "")) Nothing)) @@ -452,7 +456,7 @@ spec = "news:comp.infosystems.www.servers.unix" (Left (URI - (Scheme "news") + (Scheme.unsafeFromString "news") (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "comp.infosystems.www.servers.unix") []))))) Nothing Nothing)) @@ -462,7 +466,7 @@ spec = "tel:+1-816-555-1212" (Left (URI - (Scheme "tel") + (Scheme.unsafeFromString "tel") (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "+1-816-555-1212") []))))) Nothing Nothing)) @@ -472,7 +476,7 @@ spec = "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" (Left (URI - (Scheme "urn") + (Scheme.unsafeFromString "urn") (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "oasis:names:specification:docbook:dtd:xml:4.1.2") []))))) Nothing Nothing)) @@ -482,7 +486,7 @@ spec = "mailto:John.Doe@example.com" (Left (URI - (Scheme "mailto") + (Scheme.unsafeFromString "mailto") (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "John.Doe@example.com") []))))) Nothing Nothing)) @@ -492,7 +496,7 @@ spec = "mailto:fred@example.com" (Left (URI - (Scheme "mailto") + (Scheme.unsafeFromString "mailto") (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "fred@example.com") []))))) Nothing Nothing)) @@ -502,7 +506,7 @@ spec = "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" (Left (URI - (Scheme "http") + (Scheme.unsafeFromString "http") (HierarchicalPartAuth (Authority Nothing @@ -516,7 +520,7 @@ spec = "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" (Left (URI - (Scheme "http") + (Scheme.unsafeFromString "http") (HierarchicalPartAuth (Authority Nothing From 9a15157e9b6658ae4cc14544bb1b89397bffd09a Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 6 Feb 2018 16:01:37 +0000 Subject: [PATCH 21/69] Restore `QueryPairs` extra structure --- src/Data/URI/Extra/QueryPairs.purs | 140 +++++++++++++++++++++++++++++ test/Main.purs | 2 + test/URI/Extra/QueryPairs.purs | 79 ++++++++++++++++ 3 files changed, 221 insertions(+) create mode 100644 src/Data/URI/Extra/QueryPairs.purs create mode 100644 test/URI/Extra/QueryPairs.purs diff --git a/src/Data/URI/Extra/QueryPairs.purs b/src/Data/URI/Extra/QueryPairs.purs new file mode 100644 index 0000000..ebda11e --- /dev/null +++ b/src/Data/URI/Extra/QueryPairs.purs @@ -0,0 +1,140 @@ +module Data.URI.Extra.QueryPairs + ( Key + , keyFromString + , keyToString + , unsafeKeyFromString + , unsafeKeyToString + , Value + , valueFromString + , valueToString + , unsafeValueFromString + , unsafeValueToString + , QueryPairs(..) + , parse + , print + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Array as Array +import Data.Bifunctor (bimap) +import Data.Either (Either) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Maybe (Maybe(..)) +import Data.Monoid (class Monoid) +import Data.String as String +import Data.Traversable (traverse) +import Data.Tuple (Tuple(..)) +import Data.URI.Common (URIPartParseError(..), parseUnreserved, pctEncoded, printEncoded, wrapParser) +import Data.URI.Query as Q +import Global (decodeURIComponent) +import Text.Parsing.Parser (ParseError(..), Parser, runParser) +import Text.Parsing.Parser.Combinators (optionMaybe, sepBy) +import Text.Parsing.Parser.String (char, oneOf) + +newtype Key = Key String + +derive newtype instance eqKey ∷ Eq Key +derive newtype instance ordKey ∷ Ord Key +derive newtype instance semigroupKey ∷ Semigroup Key +derive newtype instance monoidKey ∷ Monoid Key + +instance showKey ∷ Show Key where + show (Key s) = "(QueryPairs.unsafeKeyFromString " <> show s <> ")" + +keyFromString ∷ String → Key +keyFromString = Key <<< printEncoded keyPartChar + +keyToString ∷ Key → String +keyToString (Key s) = decodeURIComponent s + +unsafeKeyFromString ∷ String → Key +unsafeKeyFromString = Key + +unsafeKeyToString ∷ Key → String +unsafeKeyToString (Key s) = s + +newtype Value = Value String + +derive newtype instance eqValue ∷ Eq Value +derive newtype instance ordValue ∷ Ord Value +derive newtype instance semigroupValue ∷ Semigroup Value +derive newtype instance monoidValue ∷ Monoid Value + +instance showValue ∷ Show Value where + show (Value s) = "(QueryPairs.unsafeValueFromString " <> show s <> ")" + +valueFromString ∷ String → Value +valueFromString = + -- `keyPartChar` is used intentionally here. It only differs from + -- `valuePartChar` by excluding `=`, and `=` should be encoded as `%3D`, but + -- can be unambiguously decoded so we want to accept it when reading but do + -- the right thing when printing + Value <<< printEncoded keyPartChar + +valueToString ∷ Value → String +valueToString (Value s) = decodeURIComponent s + +unsafeValueFromString ∷ String → Value +unsafeValueFromString = Value + +unsafeValueToString ∷ Value → String +unsafeValueToString (Value s) = s + +newtype QueryPairs k v = QueryPairs (Array (Tuple k (Maybe v))) + +derive newtype instance eqQueryPairs ∷ (Eq k, Eq v) ⇒ Eq (QueryPairs k v) +derive newtype instance ordQueryPairs ∷ (Ord k, Ord v) ⇒ Ord (QueryPairs k v) +derive instance genericQueryPairs ∷ Generic (QueryPairs k v) _ +instance showQueryPairs ∷ (Show k, Show v) ⇒ Show (QueryPairs k v) where show = genericShow +derive newtype instance semigroupQueryPairs ∷ Semigroup (QueryPairs k v) +derive newtype instance monoidQueryPairs ∷ Monoid (QueryPairs k v) + +parse + ∷ ∀ k v + . (Key → Either URIPartParseError k) + → (Value → Either URIPartParseError v) + → Q.Query + → Either URIPartParseError (QueryPairs k v) +parse parseK parseV = + bimap (\(ParseError err _) → URIPartParseError err) QueryPairs + <<< flip runParser (Array.fromFoldable <$> sepBy (parsePart parseK parseV) (char '&')) + <<< Q.unsafeToString + +parsePart + ∷ ∀ k v + . (Key → Either URIPartParseError k) + → (Value → Either URIPartParseError v) + → Parser String (Tuple k (Maybe v)) +parsePart parseK parseV = do + key ← wrapParser (parseK <<< Key) $ + String.joinWith "" <$> Array.some (String.singleton <$> keyPartChar <|> pctEncoded) + value ← wrapParser (traverse (parseV <<< Value)) $ optionMaybe do + _ ← char '=' + String.joinWith "" <$> Array.many (String.singleton <$> valuePartChar <|> pctEncoded) + pure $ Tuple key value + + +keyPartChar ∷ Parser String Char +keyPartChar + = parseUnreserved + <|> oneOf ['!', '$', '\'', '(', ')', '*', '+', ';', ',', ':', '@', '/', '?'] + +valuePartChar ∷ Parser String Char +valuePartChar = keyPartChar <|> char '=' + +print + ∷ ∀ k v + . (k → Key) + → (v → Value) + → QueryPairs k v + → Q.Query +print printK printV (QueryPairs m) = Q.unsafeFromString $ String.joinWith "&" $ Array.fromFoldable (printPart <$> m) + where + printPart ∷ Tuple k (Maybe v) → String + printPart (Tuple k Nothing) = + unsafeKeyToString (printK k) + printPart (Tuple k (Just v)) = + unsafeKeyToString (printK k) <> "=" <> unsafeValueToString (printV v) diff --git a/test/Main.purs b/test/Main.purs index 71097a6..5f8869a 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -10,6 +10,7 @@ import Test.URI.AbsoluteURI as AbsoluteURI import Test.URI.Authority as Authority import Test.URI.Fragment as Fragment import Test.URI.Host as Host +import Test.URI.Extra.QueryPairs as Extra.QueryPairs import Test.URI.Path as Path import Test.URI.Port as Port import Test.URI.Scheme as Scheme @@ -28,3 +29,4 @@ main = run [consoleReporter] do Path.spec URIRef.spec AbsoluteURI.spec + Extra.QueryPairs.spec diff --git a/test/URI/Extra/QueryPairs.purs b/test/URI/Extra/QueryPairs.purs new file mode 100644 index 0000000..4ea678a --- /dev/null +++ b/test/URI/Extra/QueryPairs.purs @@ -0,0 +1,79 @@ +module Test.URI.Extra.QueryPairs where + +import Prelude + +import Data.Maybe (Maybe(..)) +import Data.Tuple (Tuple(..)) +import Data.URI.Extra.QueryPairs as NQP +import Data.URI.Query as Query +import Test.Spec (Spec, describe) +import Test.Util (testIso) + +spec ∷ ∀ eff. Spec eff Unit +spec = + describe "QueryPairs printer/parser" do + let parser = Query.parser (NQP.parse pure pure) + let printer = Query.print <<< NQP.print id id + testIso parser printer + "?key1=value1&key2=value2&key1=value3" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "key1") (Just (NQP.unsafeValueFromString "value1")) + , Tuple (NQP.unsafeKeyFromString "key2") (Just (NQP.unsafeValueFromString "value2")) + , Tuple (NQP.unsafeKeyFromString "key1") (Just (NQP.unsafeValueFromString "value3")) + ]) + testIso parser printer + "?k%3Dey=value%3D1" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "k%3Dey") (Just (NQP.unsafeValueFromString "value%3D1")) ]) + testIso parser printer + "?k%3Dey=value%3D1" + (NQP.QueryPairs + [ Tuple (NQP.keyFromString "k=ey") (Just (NQP.valueFromString "value=1")) ]) + testIso parser printer + "?" + (NQP.QueryPairs []) + testIso parser printer + "?key1=&key2=" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "key1") (Just (NQP.unsafeValueFromString "")) + , Tuple (NQP.unsafeKeyFromString "key2") (Just (NQP.unsafeValueFromString "")) + ]) + testIso parser printer + "?key1&key2" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "key1") Nothing + , Tuple (NQP.unsafeKeyFromString "key2") Nothing + ]) + testIso parser printer + "?key1=foo%3Bbar" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "key1") (Just (NQP.unsafeValueFromString "foo%3Bbar")) + ]) + testIso parser printer + "?replicaSet=test&connectTimeoutMS=300000" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "replicaSet") (Just (NQP.unsafeValueFromString "test")) + , Tuple (NQP.unsafeKeyFromString "connectTimeoutMS") (Just (NQP.unsafeValueFromString "300000")) + ]) + testIso parser printer + "?fred" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "fred") Nothing ]) + testIso parser printer + "?objectClass?one" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "objectClass?one") Nothing + ]) + testIso parser printer + "?password=&docTypeKey=" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "password") (Just (NQP.unsafeValueFromString "")) + , Tuple (NQP.unsafeKeyFromString "docTypeKey") (Just (NQP.unsafeValueFromString "")) + ]) + testIso parser printer + "?password=pass&docTypeKey=type&queryTimeoutSeconds=20" + (NQP.QueryPairs + [ Tuple (NQP.unsafeKeyFromString "password") (Just (NQP.unsafeValueFromString "pass")) + , Tuple (NQP.unsafeKeyFromString "docTypeKey") (Just (NQP.unsafeValueFromString "type")) + , Tuple (NQP.unsafeKeyFromString "queryTimeoutSeconds") (Just (NQP.unsafeValueFromString "20")) + ]) From d5a5f334384ec753e907289330d1674669f494e0 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 6 Feb 2018 16:40:21 +0000 Subject: [PATCH 22/69] Introduce `MultiHostPortPair` --- src/Data/URI/Extra/MultiHostPortPair.purs | 74 +++++++ src/Data/URI/Host/Gen.purs | 2 +- src/Data/URI/Host/IPv4Address.purs | 14 +- test/Main.purs | 2 + test/URI/Authority.purs | 77 +------ test/URI/Extra/MultiHostPortPair.purs | 150 ++++++++++++++ test/URI/Host.purs | 2 +- test/URI/URIRef.purs | 232 ++++++++-------------- 8 files changed, 326 insertions(+), 227 deletions(-) create mode 100644 src/Data/URI/Extra/MultiHostPortPair.purs create mode 100644 test/URI/Extra/MultiHostPortPair.purs diff --git a/src/Data/URI/Extra/MultiHostPortPair.purs b/src/Data/URI/Extra/MultiHostPortPair.purs new file mode 100644 index 0000000..a513904 --- /dev/null +++ b/src/Data/URI/Extra/MultiHostPortPair.purs @@ -0,0 +1,74 @@ +module Data.URI.Extra.MultiHostPortPair + ( MultiHostPortPair + , parser + , print + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Array as Array +import Data.Either (Either) +import Data.Maybe (Maybe(..)) +import Data.String as String +import Data.These (These(..)) +import Data.URI.Common (URIPartParseError, parseUnreserved, pctEncoded, wrapParser) +import Data.URI.Host (Host(..), RegName) +import Data.URI.Host.IPv4Address as IPv4Address +import Data.URI.Host.IPv6Address as IPv6Address +import Data.URI.Host.RegName as RegName +import Data.URI.HostPortPair as HostPortPair +import Data.URI.Port (Port) +import Data.URI.Port as Port +import Text.Parsing.Parser (Parser, fail) +import Text.Parsing.Parser.Combinators (optionMaybe, sepBy, try) +import Text.Parsing.Parser.String (char, oneOf) + +-- | Multi-host/port pairs, where host & port combinations can be separated by +-- | `,`, as used by some connection URI schemes. This is not strictly +-- | compatible with RFC 3986, as in that spec `RegName`s can contain `,`, and +-- | only one port can be specified in the authority. +type MultiHostPortPair host port = Array (These host port) + +parser + ∷ ∀ host port + . (Host → Either URIPartParseError host) + → (Port → Either URIPartParseError port) + → Parser String (MultiHostPortPair host port) +parser parseHost parsePort = + Array.fromFoldable <$> sepBy (parsePair parseHost parsePort) (char ',') + +parsePair + ∷ ∀ host port + . (Host → Either URIPartParseError host) + → (Port → Either URIPartParseError port) + → Parser String (These host port) +parsePair parseHost parsePort = do + mh ← optionMaybe (parseHost' parseHost) + mp ← optionMaybe (Port.parser parsePort) + case mh, mp of + Just h, Nothing → pure (This h) + Nothing, Just p → pure (That p) + Just h, Just p → pure (Both h p) + Nothing, Nothing → fail "Neither host nor port present" + +parseHost' ∷ ∀ h. (Host → Either URIPartParseError h) → Parser String h +parseHost' p = wrapParser p + $ (IPv6Address <$> IPv6Address.parser) + <|> try (IPv4Address <$> IPv4Address.parser) + <|> (NameAddress <$> parseRegName') + +parseRegName' ∷ Parser String RegName +parseRegName' = RegName.unsafeFromString <<< String.joinWith "" <$> Array.some p + where + p = pctEncoded <|> String.singleton <$> c + c = parseUnreserved <|> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '='] + +print + ∷ ∀ host port + . (host → Host) + → (port → Port) + → MultiHostPortPair host port + → String +print printHost printPort = + String.joinWith "," <<< map (HostPortPair.print printHost printPort <<< Just) diff --git a/src/Data/URI/Host/Gen.purs b/src/Data/URI/Host/Gen.purs index 51ff536..c67adef 100644 --- a/src/Data/URI/Host/Gen.purs +++ b/src/Data/URI/Host/Gen.purs @@ -12,4 +12,4 @@ genIPv4 = do b ← Gen.chooseInt 0 255 c ← Gen.chooseInt 0 255 d ← Gen.chooseInt 0 255 - pure $ IPv4Address.unsafeFromOctets a b c d + pure $ IPv4Address.unsafeFromInts a b c d diff --git a/src/Data/URI/Host/IPv4Address.purs b/src/Data/URI/Host/IPv4Address.purs index 12d33da..e8af674 100644 --- a/src/Data/URI/Host/IPv4Address.purs +++ b/src/Data/URI/Host/IPv4Address.purs @@ -1,7 +1,7 @@ module Data.URI.Host.IPv4Address ( IPv4Address - , fromOctets - , unsafeFromOctets + , fromInts + , unsafeFromInts , parser , print ) where @@ -24,12 +24,12 @@ derive instance eqIPv4Address ∷ Eq IPv4Address derive instance ordIPv4Address ∷ Ord IPv4Address instance showIPv4Address ∷ Show IPv4Address where - show (IPv4Address o1 o2 o3 o4) = "(IPv4Address.unsafeFromOctets " <> show o1 <> " " <> show o2 <> " " <> show o3 <> " " <> show o4 <> ")" + show (IPv4Address o1 o2 o3 o4) = "(IPv4Address.unsafeFromInts " <> show o1 <> " " <> show o2 <> " " <> show o3 <> " " <> show o4 <> ")" -- | Constructs a `IPv4Address` part safely: bounds-checks each octet to ensure -- | it occurs within the range 0-255 (inclusive). -fromOctets ∷ Int → Int → Int → Int → Maybe IPv4Address -fromOctets o1 o2 o3 o4 = +fromInts ∷ Int → Int → Int → Int → Maybe IPv4Address +fromInts o1 o2 o3 o4 = IPv4Address <$> check o1 <*> check o2 <*> check o3 <*> check o4 where check ∷ Int → Maybe Int @@ -39,8 +39,8 @@ fromOctets o1 o2 o3 o4 = -- | Constructs a `IPv4Address` part unsafely: no bounds-checking will be used -- | on the passed integers, potentially allowing for invalid IP addresses. -unsafeFromOctets ∷ Int → Int → Int → Int → IPv4Address -unsafeFromOctets = IPv4Address +unsafeFromInts ∷ Int → Int → Int → Int → IPv4Address +unsafeFromInts = IPv4Address parser ∷ Parser String IPv4Address parser = do diff --git a/test/Main.purs b/test/Main.purs index 5f8869a..873afa4 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -11,6 +11,7 @@ import Test.URI.Authority as Authority import Test.URI.Fragment as Fragment import Test.URI.Host as Host import Test.URI.Extra.QueryPairs as Extra.QueryPairs +import Test.URI.Extra.MultiHostPortPair as Extra.MultiHostPortPair import Test.URI.Path as Path import Test.URI.Port as Port import Test.URI.Scheme as Scheme @@ -30,3 +31,4 @@ main = run [consoleReporter] do URIRef.spec AbsoluteURI.spec Extra.QueryPairs.spec + Extra.MultiHostPortPair.spec diff --git a/test/URI/Authority.purs b/test/URI/Authority.purs index 8b69d2b..43a6972 100644 --- a/test/URI/Authority.purs +++ b/test/URI/Authority.purs @@ -18,93 +18,36 @@ spec ∷ ∀ eff. Spec eff Unit spec = describe "Authority parser/printer" do testIso - (Authority.parser optionsSingle) - (Authority.print optionsSingle) + (Authority.parser options) + (Authority.print options) "//localhost" (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) testIso - (Authority.parser optionsSingle) - (Authority.print optionsSingle) + (Authority.parser options) + (Authority.print options) "//localhost:3000" (Authority Nothing (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) testIso - (Authority.parser optionsSingle) - (Authority.print optionsSingle) + (Authority.parser options) + (Authority.print options) "//user@localhost:3000" (Authority (Just (UserInfo.unsafeFromString "user")) (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) - -- testIso - -- (Authority.parser optionsMany) - -- (Authority.print optionsMany) - -- "//mongo-1,mongo-2" - -- (Authority - -- Nothing - -- [ This (NameAddress (RegName.unsafeFromString "mongo-1")) - -- , This (NameAddress (RegName.unsafeFromString "mongo-2")) - -- ]) - -- testIso - -- (Authority.parser optionsMany) - -- (Authority.print optionsMany) - -- "//mongo-1:2000,mongo-2:3000" - -- (Authority - -- Nothing - -- [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) - -- , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) - -- ]) - -- testIso - -- (Authority.parser optionsMany) - -- (Authority.print optionsMany) - -- "//mongo-1:2000,mongo-2" - -- (Authority - -- Nothing - -- [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) - -- , This (NameAddress (RegName.unsafeFromString "mongo-2")) - -- ]) - -- testIso - -- (Authority.parser optionsMany) - -- (Authority.print optionsMany) - -- "//mongo-1,mongo-2:3000" - -- (Authority - -- Nothing - -- [ This (NameAddress (RegName.unsafeFromString "mongo-1")) - -- , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) - -- ]) testIso - (Authority.parser optionsSingle) - (Authority.print optionsSingle) + (Authority.parser options) + (Authority.print options) "//:8000" (Authority Nothing (Just (That (Port.unsafeFromInt 8000)))) - -- testIso - -- (Authority.parser optionsMany) - -- (Authority.print optionsMany) - -- "//:2000,:3000" - -- (Authority - -- Nothing - -- [ That (Port.unsafeFromInt 2000) - -- , That (Port.unsafeFromInt 3000) - -- ]) -optionsSingle ∷ Record (AuthorityOptions UserInfo (HostPortPair Host Port)) -optionsSingle = +options ∷ Record (AuthorityOptions UserInfo (HostPortPair Host Port)) +options = { parseUserInfo: pure , printUserInfo: id , parseHosts: HostPortPair.parser pure pure , printHosts: HostPortPair.print id id } - --- optionsMany ∷ Record (AuthorityOptions UserInfo (HostPortPair Host Port)) --- optionsMany = --- { parseUserInfo: pure --- , printUserInfo: id --- , parseHosts: Right { split: void (PS.char ','), build: Array.fromFoldable } --- , printHosts: String.joinWith "," --- , parseHost: pure --- , printHost: id --- , parsePort: pure --- , printPort: id --- } diff --git a/test/URI/Extra/MultiHostPortPair.purs b/test/URI/Extra/MultiHostPortPair.purs new file mode 100644 index 0000000..18a1374 --- /dev/null +++ b/test/URI/Extra/MultiHostPortPair.purs @@ -0,0 +1,150 @@ +module Test.URI.Extra.MultiHostPortPair where + +import Prelude + +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Data.These (These(..)) +import Data.URI.Authority (Authority(..), Host(..), Port, UserInfo) +import Data.URI.Authority as Authority +import Data.URI.Extra.MultiHostPortPair (MultiHostPortPair) +import Data.URI.Extra.MultiHostPortPair as MultiHostPortPair +import Data.URI.Host.RegName as RegName +import Data.URI.Host.IPv4Address as IPv4Address +import Data.URI.Path.Segment as PathSegment +import Data.URI.Port as Port +import Data.URI.Query as Query +import Data.URI.Scheme as Scheme +import Data.URI.URIRef (Fragment, HierPath, HierarchicalPart(..), Path(..), Query, RelPath, URI(..), URIRefOptions) +import Data.URI.URIRef as URIRef +import Data.URI.UserInfo as UserInfo +import Test.Spec (Spec, describe) +import Test.Util (testIso) + +spec ∷ ∀ eff. Spec eff Unit +spec = do + describe "Authority+MultiHostPortPair parser/printer" do + testIso + (Authority.parser options) + (Authority.print options) + "//mongo-1,mongo-2" + (Authority + Nothing + [ This (NameAddress (RegName.unsafeFromString "mongo-1")) + , This (NameAddress (RegName.unsafeFromString "mongo-2")) + ]) + testIso + (Authority.parser options) + (Authority.print options) + "//mongo-1:2000,mongo-2:3000" + (Authority + Nothing + [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) + , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) + ]) + testIso + (Authority.parser options) + (Authority.print options) + "//mongo-1:2000,mongo-2" + (Authority + Nothing + [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) + , This (NameAddress (RegName.unsafeFromString "mongo-2")) + ]) + testIso + (Authority.parser options) + (Authority.print options) + "//mongo-1,mongo-2:3000" + (Authority + Nothing + [ This (NameAddress (RegName.unsafeFromString "mongo-1")) + , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) + ]) + testIso + (Authority.parser options) + (Authority.print options) + "//:2000,:3000" + (Authority + Nothing + [ That (Port.unsafeFromInt 2000) + , That (Port.unsafeFromInt 3000) + ]) + testIso + (Authority.parser options) + (Authority.print options) + "//user@mongo-1,mongo-2" + (Authority + (Just (UserInfo.unsafeFromString "user")) + [ This (NameAddress (RegName.unsafeFromString "mongo-1")) + , This (NameAddress (RegName.unsafeFromString "mongo-2")) + ]) + describe "URIRef+MultiHostPortPair parser/printer" do + testIso + (URIRef.parser options) + (URIRef.print options) + "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" + (Left + (URI + (Scheme.unsafeFromString "mongodb") + (HierarchicalPartAuth + (Authority + (Just (UserInfo.unsafeFromString "foo:bar")) + [ This (NameAddress (RegName.unsafeFromString "db1.example.net")) + , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) + ]) + (path ["authdb"])) + (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) + Nothing)) + testIso + (URIRef.parser options) + (URIRef.print options) + "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" + (Left + (URI + (Scheme.unsafeFromString "mongodb") + (HierarchicalPartAuth + (Authority + (Just (UserInfo.unsafeFromString "foo:bar")) + [ Both (NameAddress (RegName.unsafeFromString "db1.example.net")) (Port.unsafeFromInt 6) + , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) + ]) + (path ["authdb"])) + (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) + Nothing)) + testIso + (URIRef.parser options) + (URIRef.print options) + "mongodb://192.168.0.1,192.168.0.2" + (Left + (URI + (Scheme.unsafeFromString "mongodb") + (HierarchicalPartAuth + (Authority + Nothing + [ This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) + , This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 2)) + ]) + Nothing) + Nothing + Nothing)) + +path ∷ Array String → Maybe Path +path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString + +options ∷ Record (URIRefOptions UserInfo (MultiHostPortPair Host Port) Path HierPath RelPath Query Fragment) +options = + { parseUserInfo: pure + , printUserInfo: id + , parseHosts: MultiHostPortPair.parser pure pure + , printHosts: MultiHostPortPair.print id id + , parsePath: pure + , printPath: id + , parseHierPath: pure + , printHierPath: id + , parseRelPath: pure + , printRelPath: id + , parseQuery: pure + , printQuery: id + , parseFragment: pure + , printFragment: id + } diff --git a/test/URI/Host.purs b/test/URI/Host.purs index 1471c53..cdbc02c 100644 --- a/test/URI/Host.purs +++ b/test/URI/Host.purs @@ -35,5 +35,5 @@ spec = do testIso (Host.parser pure) Host.print "localhost" (NameAddress (RegName.unsafeFromString "localhost")) testIso (Host.parser pure) Host.print "github.com" (NameAddress (RegName.unsafeFromString "github.com")) testIso (Host.parser pure) Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString "www.multipart.domain.example.com")) - testIso (Host.parser pure) Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromOctets 192 168 0 1)) + testIso (Host.parser pure) Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) testIso (Host.parser pure) Host.print "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")) diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index 2bfdf7e..6ff6232 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -26,8 +26,8 @@ spec ∷ ∀ eff. Spec eff Unit spec = describe "URIRef parser/printer" do testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "sql2:///?q=foo&var.bar=baz" (Left (URI @@ -38,8 +38,8 @@ spec = (Just (Query.unsafeFromString "q=foo&var.bar=baz")) Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "sql2://?q=foo&var.bar=baz" (Left (URI @@ -50,8 +50,8 @@ spec = (Just (Query.unsafeFromString "q=foo&var.bar=baz")) Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "sql2:/?q=foo&var.bar=baz" (Left (URI @@ -60,8 +60,8 @@ spec = (Just (Query.unsafeFromString "q=foo&var.bar=baz")) Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "sql2:?q=foo&var.bar=baz" (Left (URI @@ -70,8 +70,8 @@ spec = (Just (Query.unsafeFromString "q=foo&var.bar=baz")) Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "mongodb://localhost" (Left (URI @@ -84,8 +84,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "https://1a.example.com" (Left (URI @@ -98,8 +98,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "http://en.wikipedia.org/wiki/URI_scheme" (Left (URI @@ -111,69 +111,21 @@ spec = (path ["wiki", "URI_scheme"])) Nothing Nothing)) - -- testIso - -- (URIRef.parser optionsMany) - -- (URIRef.print optionsMany) - -- "mongodb://foo:bar@db1.example.net,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" - -- (Left - -- (URI - -- (Scheme.unsafeFromString "mongodb") - -- (HierarchicalPartAuth - -- (Authority - -- (Just (UserInfo.unsafeFromString "foo:bar")) - -- [ This (NameAddress (RegName.unsafeFromString "db1.example.net")) - -- , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) - -- ]) - -- (path ["authdb"])) - -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) - -- Nothing)) - -- testIso - -- (URIRef.parser optionsMany) - -- (URIRef.print optionsMany) - -- "mongodb://foo:bar@db1.example.net:6,db2.example.net:2500/authdb?replicaSet=test&connectTimeoutMS=300000" - -- (Left - -- (URI - -- (Scheme.unsafeFromString "mongodb") - -- (HierarchicalPartAuth - -- (Authority - -- (Just (UserInfo.unsafeFromString "foo:bar")) - -- [ Both (NameAddress (RegName.unsafeFromString "db1.example.net")) (Port.unsafeFromInt 6) - -- , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) - -- ]) - -- (path ["authdb"])) - -- (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) - -- Nothing)) - testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + testIso + (URIRef.parser options) + (URIRef.print options) "mongodb://192.168.0.1" (Left (URI (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth - (Authority Nothing (Just (This (IPv4Address (IPv4Address.unsafeFromOctets 192 168 0 1))))) + (Authority Nothing (Just (This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1))))) Nothing) Nothing Nothing)) - -- testIso - -- (URIRef.parser optionsMany) - -- (URIRef.print optionsMany) - -- "mongodb://192.168.0.1,192.168.0.2" - -- (Left - -- (URI - -- (Scheme.unsafeFromString "mongodb") - -- (HierarchicalPartAuth - -- (Authority - -- Nothing - -- [ This (IPv4Address "192.168.0.1") - -- , This (IPv4Address "192.168.0.2") - -- ]) - -- Nothing) - -- Nothing - -- Nothing)) - testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + testIso + (URIRef.parser options) + (URIRef.print options) "mongodb://sysop:moon@localhost" (Left (URI @@ -186,8 +138,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "mongodb://sysop:moon@localhost/" (Left (URI @@ -200,8 +152,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "mongodb://sysop:moon@localhost/records" (Left (URI @@ -214,8 +166,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "mongodb://sysop:moon@localhost/records/etc/" (Left (URI @@ -228,8 +180,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "foo://[2001:cdba:0000:0000:0000:0000:3257:9652]" (Left (URI @@ -242,8 +194,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "foo://[FE80::0202:B3FF:FE1E:8329]" (Left (URI @@ -256,8 +208,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "foo://[2001:db8::1]:80" (Left (URI @@ -270,8 +222,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "ftp://ftp.is.co.za/rfc/rfc1808.txt" (Left (URI @@ -284,8 +236,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "http://www.ietf.org/rfc/rfc2396.txt" (Left (URI @@ -298,8 +250,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "ldap://[2001:db8::7]/c=GB?objectClass?one" (Left (URI @@ -312,8 +264,8 @@ spec = (Just (Query.unsafeFromString "objectClass?one")) Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "telnet://192.0.2.16:80/" (Left (URI @@ -321,13 +273,13 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Both (IPv4Address (IPv4Address.unsafeFromOctets 192 0 2 16)) (Port.unsafeFromInt 80)))) + (Just (Both (IPv4Address (IPv4Address.unsafeFromInts 192 0 2 16)) (Port.unsafeFromInt 80)))) (path [""])) Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "foo://example.com:8042/over/there?name=ferret#nose" (Left (URI @@ -340,8 +292,8 @@ spec = (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "nose")))) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "foo://example.com:8042/over/there?name=ferret#" (Left (URI @@ -354,8 +306,8 @@ spec = (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "")))) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "foo://info.example.com?fred" (Left (URI @@ -368,8 +320,8 @@ spec = (Just (Query.unsafeFromString "fred")) Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm" (Left (URI @@ -377,13 +329,13 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "cnn.example.com&story=breaking_news")) - (Just (This (IPv4Address (IPv4Address.unsafeFromOctets 10 0 0 1))))) + (Just (This (IPv4Address (IPv4Address.unsafeFromInts 10 0 0 1))))) (path ["top_story.htm"])) Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "top_story.htm" (Right (RelativeRef @@ -391,8 +343,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "../top_story.htm" (Right (RelativeRef @@ -400,8 +352,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "/top_story.htm" (Right (RelativeRef @@ -409,8 +361,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "/" (Right (RelativeRef @@ -418,8 +370,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "" (Right (RelativeRef @@ -427,8 +379,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "http://www.example.com/some%20invented/url%20with%20spaces.html" (Left (URI @@ -439,8 +391,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "http://localhost:53174/metadata/fs/test/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23?" (Left (URI @@ -451,8 +403,8 @@ spec = (Just (Query.unsafeFromString "")) Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "news:comp.infosystems.www.servers.unix" (Left (URI @@ -461,8 +413,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "tel:+1-816-555-1212" (Left (URI @@ -471,8 +423,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "urn:oasis:names:specification:docbook:dtd:xml:4.1.2" (Left (URI @@ -481,8 +433,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "mailto:John.Doe@example.com" (Left (URI @@ -491,8 +443,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "mailto:fred@example.com" (Left (URI @@ -501,8 +453,8 @@ spec = Nothing Nothing)) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "http://local.slamdata.com/?#?sort=asc&q=path%3A%2F&salt=1177214" (Left (URI @@ -515,8 +467,8 @@ spec = (Just (Query.unsafeFromString "")) (Just (Fragment.unsafeFromString "?sort=asc&q=path%3A%2F&salt=1177214")))) testIso - (URIRef.parser optionsSingle) - (URIRef.print optionsSingle) + (URIRef.parser options) + (URIRef.print options) "http://local.slamdata.com/?#?sort=asc&q=path:/&salt=1177214" (Left (URI @@ -532,8 +484,8 @@ spec = path ∷ Array String → Maybe Path path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString -optionsSingle ∷ Record (URIRefOptions UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) -optionsSingle = +options ∷ Record (URIRefOptions UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) +options = { parseUserInfo: pure , printUserInfo: id , parseHosts: HostPortPair.parser pure pure @@ -549,25 +501,3 @@ optionsSingle = , parseFragment: pure , printFragment: id } - --- optionsMany ∷ Record (URIRefOptions UserInfo Array Host Port Path HierPath RelPath Query Fragment) --- optionsMany = --- { parseUserInfo: pure --- , printUserInfo: id --- , parseHosts: Right { split: void (PS.char ','), build: Array.fromFoldable } --- , printHosts: String.joinWith "," --- , parseHost: pure --- , printHost: id --- , parsePort: pure --- , printPort: id --- , parsePath: pure --- , printPath: id --- , parseHierPath: pure --- , printHierPath: id --- , parseRelPath: pure --- , printRelPath: id --- , parseQuery: pure --- , printQuery: id --- , parseFragment: pure --- , printFragment: id --- } From 281a512074cfe78345ede543a49c8a61239d944f Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 7 Feb 2018 02:48:17 +0000 Subject: [PATCH 23/69] Add extra for `user:password` handling in `UserInfo` --- src/Data/URI/Extra/UserPassInfo.purs | 53 ++++++++++++++++++ test/Main.purs | 2 + test/URI/Extra/UserPassInfo.purs | 80 ++++++++++++++++++++++++++++ 3 files changed, 135 insertions(+) create mode 100644 src/Data/URI/Extra/UserPassInfo.purs create mode 100644 test/URI/Extra/UserPassInfo.purs diff --git a/src/Data/URI/Extra/UserPassInfo.purs b/src/Data/URI/Extra/UserPassInfo.purs new file mode 100644 index 0000000..595f714 --- /dev/null +++ b/src/Data/URI/Extra/UserPassInfo.purs @@ -0,0 +1,53 @@ +module Data.URI.Extra.UserPassInfo + ( UserPassInfo(..) + , parse + , print + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Data.Either (Either) +import Data.Maybe (Maybe(..)) +import Data.String as String +import Data.URI.Common (parseSubDelims, parseUnreserved, printEncoded) +import Data.URI.UserInfo (UserInfo) +import Data.URI.UserInfo as UserInfo +import Global (decodeURIComponent) +import Text.Parsing.Parser (Parser) + +newtype UserPassInfo = UserPassInfo { user ∷ String, password ∷ Maybe String } + +derive instance eqUserPassInfo ∷ Eq UserPassInfo +derive instance ordUserPassInfo ∷ Ord UserPassInfo + +instance showUserPassInfo ∷ Show UserPassInfo where + show (UserPassInfo { user, password }) = + "(UserPassInfo { user: " <> show user <> ", password: " <> show password <> "})" + +parse ∷ ∀ e. UserInfo → Either e UserPassInfo +parse ui = + let + s = UserInfo.unsafeToString ui + in + pure $ UserPassInfo + case flip String.splitAt s =<< String.indexOf (String.Pattern ":") s of + Just { before, after } → + { user: decodeURIComponent before + , password: Just (decodeURIComponent (String.drop 1 after)) + } + Nothing → + { user: decodeURIComponent s, password: Nothing } + +print ∷ UserPassInfo → UserInfo +print (UserPassInfo { user, password }) = + case password of + Nothing → + UserInfo.unsafeFromString (printEncoded userPassInfoChar user) + Just p → + UserInfo.unsafeFromString (printEncoded userPassInfoChar user) + <> UserInfo.unsafeFromString ":" + <> UserInfo.unsafeFromString (printEncoded userPassInfoChar p) + +userPassInfoChar ∷ Parser String Char +userPassInfoChar = parseUnreserved <|> parseSubDelims diff --git a/test/Main.purs b/test/Main.purs index 873afa4..209792c 100755 --- a/test/Main.purs +++ b/test/Main.purs @@ -12,6 +12,7 @@ import Test.URI.Fragment as Fragment import Test.URI.Host as Host import Test.URI.Extra.QueryPairs as Extra.QueryPairs import Test.URI.Extra.MultiHostPortPair as Extra.MultiHostPortPair +import Test.URI.Extra.UserPassInfo as Extra.UserPassInfo import Test.URI.Path as Path import Test.URI.Port as Port import Test.URI.Scheme as Scheme @@ -32,3 +33,4 @@ main = run [consoleReporter] do AbsoluteURI.spec Extra.QueryPairs.spec Extra.MultiHostPortPair.spec + Extra.UserPassInfo.spec diff --git a/test/URI/Extra/UserPassInfo.purs b/test/URI/Extra/UserPassInfo.purs new file mode 100644 index 0000000..ea783ff --- /dev/null +++ b/test/URI/Extra/UserPassInfo.purs @@ -0,0 +1,80 @@ +module Test.URI.Extra.UserPassInfo where + +import Prelude + +import Data.Maybe (Maybe(..)) +import Data.These (These(..)) +import Data.URI.Authority (Authority(..), Host(..), Port) +import Data.URI.Authority as Authority +import Data.URI.HostPortPair (HostPortPair) +import Data.URI.HostPortPair as HostPortPair +import Data.URI.Extra.UserPassInfo (UserPassInfo(..)) +import Data.URI.Extra.UserPassInfo as UserPassInfo +import Data.URI.Host.RegName as RegName +import Data.URI.URIRef (Fragment, HierPath, Path, Query, RelPath, URIRefOptions) +import Test.Spec (Spec, describe) +import Test.Util (testIso) + +spec ∷ ∀ eff. Spec eff Unit +spec = do + describe "Authority+UserPassInfo parser/printer" do + testIso + (Authority.parser options) + (Authority.print options) + "//user@host" + (Authority + (Just (UserPassInfo { user: "user", password: Nothing })) + (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + testIso + (Authority.parser options) + (Authority.print options) + "//user:pass@host" + (Authority + (Just (UserPassInfo { user: "user", password: Just "pass" })) + (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + testIso + (Authority.parser options) + (Authority.print options) + "//user:pa%3Ass@host" + (Authority + (Just (UserPassInfo { user: "user", password: Just "pa:ss" })) + (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + testIso + (Authority.parser options) + (Authority.print options) + "//us%3Aer:pa%3Ass@host" + (Authority + (Just (UserPassInfo { user: "us:er", password: Just "pa:ss" })) + (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + testIso + (Authority.parser options) + (Authority.print options) + "//us%3Aer:pa%3Ass@host" + (Authority + (Just (UserPassInfo { user: "us:er", password: Just "pa:ss" })) + (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + testIso + (Authority.parser options) + (Authority.print options) + "//user:p%40ss@host" + (Authority + (Just (UserPassInfo { user: "user", password: Just "p@ss" })) + (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + +options ∷ Record (URIRefOptions UserPassInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) +options = + { parseUserInfo: UserPassInfo.parse + , printUserInfo: UserPassInfo.print + , parseHosts: HostPortPair.parser pure pure + , printHosts: HostPortPair.print id id + , parsePath: pure + , printPath: id + , parseHierPath: pure + , printHierPath: id + , parseRelPath: pure + , printRelPath: id + , parseQuery: pure + , printQuery: id + , parseFragment: pure + , printFragment: id + } From 33468dd11def2c0a7e745adb37c8bff9ab5abe30 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 19:18:10 +0400 Subject: [PATCH 24/69] use NonEmptyString for RegName and PathSegmentNZ --- src/Data/URI/Host/RegName.purs | 9 ++++----- src/Data/URI/Path/Segment.purs | 8 ++++---- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src/Data/URI/Host/RegName.purs b/src/Data/URI/Host/RegName.purs index 0007de4..40481bd 100644 --- a/src/Data/URI/Host/RegName.purs +++ b/src/Data/URI/Host/RegName.purs @@ -11,9 +11,10 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Maybe (Maybe(..)) import Data.Monoid (class Monoid) import Data.String as String +import Data.String.NonEmpty (NonEmptyString) +import Data.String.NonEmpty as NES import Data.URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) @@ -31,10 +32,8 @@ instance showRegName ∷ Show RegName where -- | Constructs a `RegName` part safely: percent-encoding will be -- | applied to any character that requires it for the user-info component of a -- | URI. -fromString ∷ String → Maybe RegName -fromString = case _ of - "" → Nothing - s → Just $ RegName (printEncoded regNameChar s) +fromString ∷ NonEmptyString → RegName +fromString s = RegName (printEncoded regNameChar $ NES.toString s) -- | Prints `RegName` as a string, decoding any percent-encoded -- | characters contained within. diff --git a/src/Data/URI/Path/Segment.purs b/src/Data/URI/Path/Segment.purs index 2e1266c..c561f90 100644 --- a/src/Data/URI/Path/Segment.purs +++ b/src/Data/URI/Path/Segment.purs @@ -25,6 +25,8 @@ import Control.Alt ((<|>)) import Data.Array as Array import Data.Maybe (Maybe(..)) import Data.String as String +import Data.String.NonEmpty (NonEmptyString) +import Data.String.NonEmpty as NES import Data.URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) @@ -70,10 +72,8 @@ parseSegmentNonZero = <<< String.joinWith "" <$> Array.some (pctEncoded <|> String.singleton <$> segmentChar) -segmentNZFromString ∷ String → Maybe PathSegmentNZ -segmentNZFromString = case _ of - "" → Nothing - s → Just $ PathSegmentNZ (printEncoded segmentChar s) +segmentNZFromString ∷ NonEmptyString → PathSegmentNZ +segmentNZFromString s = PathSegmentNZ (printEncoded segmentChar $ NES.toString s) segmentNZToString ∷ PathSegmentNZ → String segmentNZToString (PathSegmentNZ s) = decodeURIComponent s From 2c177fd5506d6c22183d08b8cf463b7d5b60e0f8 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 19:18:30 +0400 Subject: [PATCH 25/69] use crashWith for Scheme --- src/Data/URI/Scheme.purs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Data/URI/Scheme.purs b/src/Data/URI/Scheme.purs index 5e02e94..9839f85 100644 --- a/src/Data/URI/Scheme.purs +++ b/src/Data/URI/Scheme.purs @@ -11,9 +11,10 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.Either (hush) -import Data.Maybe (Maybe) +import Data.Maybe (Maybe(..)) import Data.String as String import Data.URI.Common (alpha, alphaNum) +import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, runParser) import Text.Parsing.Parser.String (char) @@ -30,7 +31,9 @@ fromString ∷ String → Maybe Scheme fromString = map Scheme <<< hush <<< flip runParser parseScheme unsafeFromString ∷ String → Scheme -unsafeFromString = Scheme +unsafeFromString s = case fromString s of + Nothing → unsafeCrashWith $ "Got invalid scheme in unsafeFromString : `" <> show s <> "`" + Just s' → s' parser ∷ Parser String Scheme parser = Scheme <$> parseScheme <* char ':' From 17c14082f1f1c50fd6659c797d9faa0e2724fcbc Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 19:21:23 +0400 Subject: [PATCH 26/69] add Semigroup and Monoid for Path --- src/Data/URI/Path.purs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Data/URI/Path.purs b/src/Data/URI/Path.purs index 8f35ee2..f7ee47f 100644 --- a/src/Data/URI/Path.purs +++ b/src/Data/URI/Path.purs @@ -6,6 +6,7 @@ import Data.Array as Array import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) +import Data.Monoid (class Monoid) import Data.String as String import Data.URI.Common (URIPartParseError, wrapParser) import Data.URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) @@ -16,6 +17,8 @@ newtype Path = Path (Array PathSegment) derive newtype instance eqPath ∷ Eq Path derive newtype instance ordPath ∷ Ord Path +derive newtype instance semigroupPath ∷ Semigroup Path +derive newtype instance monoidPath ∷ Monoid Path derive instance genericPath ∷ Generic Path _ instance showPath ∷ Show Path where show = genericShow From 3fba380df7a9a908924744be5731b49ad4ed8c18 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 19:25:02 +0400 Subject: [PATCH 27/69] use NonEmptyString for unsafeFromString --- src/Data/URI/Host/RegName.purs | 4 ++-- src/Data/URI/Path/Segment.purs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Data/URI/Host/RegName.purs b/src/Data/URI/Host/RegName.purs index 40481bd..6d9c9d4 100644 --- a/src/Data/URI/Host/RegName.purs +++ b/src/Data/URI/Host/RegName.purs @@ -43,8 +43,8 @@ toString (RegName s) = decodeURIComponent s -- | Constructs a `RegName` part unsafely: no encoding will be applied -- | to the value. If an incorrect value is provided, the URI will be invalid -- | when printed back. -unsafeFromString ∷ String → RegName -unsafeFromString = RegName +unsafeFromString ∷ NonEmptyString → RegName +unsafeFromString = NES.toString >>> RegName -- | Prints `RegName` as a string without performing any decoding of -- | percent-encoded octets. Only "unsafe" in the sense that values this diff --git a/src/Data/URI/Path/Segment.purs b/src/Data/URI/Path/Segment.purs index c561f90..4a01dd2 100644 --- a/src/Data/URI/Path/Segment.purs +++ b/src/Data/URI/Path/Segment.purs @@ -78,8 +78,8 @@ segmentNZFromString s = PathSegmentNZ (printEncoded segmentChar $ NES.toString s segmentNZToString ∷ PathSegmentNZ → String segmentNZToString (PathSegmentNZ s) = decodeURIComponent s -unsafeSegmentNZFromString ∷ String → PathSegmentNZ -unsafeSegmentNZFromString = PathSegmentNZ +unsafeSegmentNZFromString ∷ NonEmptyString → PathSegmentNZ +unsafeSegmentNZFromString = NES.toString >>> PathSegmentNZ unsafeSegmentNZToString ∷ PathSegmentNZ → String unsafeSegmentNZToString (PathSegmentNZ s) = s From dcafee8e01f725c59b67f595fa7d9c4732189883 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 20:06:08 +0400 Subject: [PATCH 28/69] use NonEmptyString for PathSegmentNZNC --- src/Data/URI/Path/Segment.purs | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/Data/URI/Path/Segment.purs b/src/Data/URI/Path/Segment.purs index 4a01dd2..b59fca9 100644 --- a/src/Data/URI/Path/Segment.purs +++ b/src/Data/URI/Path/Segment.purs @@ -23,7 +23,6 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Maybe (Maybe(..)) import Data.String as String import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES @@ -104,13 +103,11 @@ segmentNZNCToString (PathSegmentNZNC s) = decodeURIComponent s unsafeSegmentNZNCToString ∷ PathSegmentNZNC → String unsafeSegmentNZNCToString (PathSegmentNZNC s) = s -segmentNZNCFromString ∷ String → Maybe PathSegmentNZNC -segmentNZNCFromString = case _ of - "" → Nothing - s → Just $ PathSegmentNZNC (printEncoded segmentNCChar s) +segmentNZNCFromString ∷ NonEmptyString → PathSegmentNZNC +segmentNZNCFromString s = PathSegmentNZNC (printEncoded segmentNCChar $ NES.toString s) -unsafeSegmentNZNCFromString ∷ String → PathSegmentNZNC -unsafeSegmentNZNCFromString = PathSegmentNZNC +unsafeSegmentNZNCFromString ∷ NonEmptyString → PathSegmentNZNC +unsafeSegmentNZNCFromString = NES.toString >>> PathSegmentNZNC segmentChar ∷ Parser String Char segmentChar = segmentNCChar <|> char ':' From 36c51c0ab93642f8b8fffe84dceaa2430e0e0a4e Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 20:08:28 +0400 Subject: [PATCH 29/69] update unsafe usages --- src/Data/URI/Extra/MultiHostPortPair.purs | 8 +++- test/URI/AbsoluteURI.purs | 10 +++-- test/URI/Authority.purs | 8 ++-- test/URI/Extra/MultiHostPortPair.purs | 32 ++++++++------- test/URI/Extra/UserPassInfo.purs | 18 ++++---- test/URI/Host.purs | 10 +++-- test/URI/URIRef.purs | 50 ++++++++++++----------- 7 files changed, 77 insertions(+), 59 deletions(-) diff --git a/src/Data/URI/Extra/MultiHostPortPair.purs b/src/Data/URI/Extra/MultiHostPortPair.purs index a513904..663f171 100644 --- a/src/Data/URI/Extra/MultiHostPortPair.purs +++ b/src/Data/URI/Extra/MultiHostPortPair.purs @@ -11,6 +11,7 @@ import Data.Array as Array import Data.Either (Either) import Data.Maybe (Maybe(..)) import Data.String as String +import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.URI.Common (URIPartParseError, parseUnreserved, pctEncoded, wrapParser) import Data.URI.Host (Host(..), RegName) @@ -20,6 +21,7 @@ import Data.URI.Host.RegName as RegName import Data.URI.HostPortPair as HostPortPair import Data.URI.Port (Port) import Data.URI.Port as Port +import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.Combinators (optionMaybe, sepBy, try) import Text.Parsing.Parser.String (char, oneOf) @@ -59,7 +61,11 @@ parseHost' p = wrapParser p <|> (NameAddress <$> parseRegName') parseRegName' ∷ Parser String RegName -parseRegName' = RegName.unsafeFromString <<< String.joinWith "" <$> Array.some p +parseRegName' = do + n ← Array.some p + case NES.fromString $ String.joinWith "" n of + Just x → pure $ RegName.unsafeFromString x + Nothing → unsafeCrashWith "This must be unPathSegment.unsafeSegmentNZFromStringreachable as we shuold parse at least one char in `pctEncoded`" where p = pctEncoded <|> String.singleton <$> c c = parseUnreserved <|> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '='] diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs index d4ad7c9..df8cf87 100644 --- a/test/URI/AbsoluteURI.purs +++ b/test/URI/AbsoluteURI.purs @@ -4,6 +4,7 @@ import Prelude import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) +import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.Tuple (Tuple(..)) import Data.URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port, Query, AbsoluteURI(..), AbsoluteURIOptions, UserInfo) @@ -15,6 +16,7 @@ import Data.URI.Path.Segment as PathSegment import Data.URI.Port as Port import Data.URI.Query as Query import Data.URI.Scheme as Scheme +import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) @@ -30,7 +32,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) (path ["testBucket"])) (Just (Query.unsafeFromString "password=&docTypeKey="))) testIso @@ -42,7 +44,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 99999)))) + (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 99999)))) (path ["testBucket"])) (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) testIso @@ -52,7 +54,7 @@ spec = (AbsoluteURI (Scheme.unsafeFromString "foo") (HierarchicalPartNoAuth - (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString "abc") [PathSegment.unsafeSegmentFromString "def"])))))) + (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "abc") [PathSegment.unsafeSegmentFromString "def"])))))) Nothing) testIso (AbsoluteURI.parser options) @@ -61,7 +63,7 @@ spec = (AbsoluteURI (Scheme.unsafeFromString "foo") (HierarchicalPartNoAuth - (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "abc") [PathSegment.unsafeSegmentFromString "def"]))))) + (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "abc") [PathSegment.unsafeSegmentFromString "def"]))))) Nothing) path ∷ Array String → Maybe Path diff --git a/test/URI/Authority.purs b/test/URI/Authority.purs index 43a6972..7053dbd 100644 --- a/test/URI/Authority.purs +++ b/test/URI/Authority.purs @@ -3,6 +3,7 @@ module Test.URI.Authority where import Prelude import Data.Maybe (Maybe(..)) +import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.URI.Authority (Authority(..), AuthorityOptions, Host(..), Port, UserInfo) import Data.URI.Authority as Authority @@ -11,6 +12,7 @@ import Data.URI.HostPortPair (HostPortPair) import Data.URI.HostPortPair as HostPortPair import Data.URI.Port as Port import Data.URI.UserInfo as UserInfo +import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) @@ -23,21 +25,21 @@ spec = "//localhost" (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) testIso (Authority.parser options) (Authority.print options) "//localhost:3000" (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) + (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) testIso (Authority.parser options) (Authority.print options) "//user@localhost:3000" (Authority (Just (UserInfo.unsafeFromString "user")) - (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) + (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) testIso (Authority.parser options) (Authority.print options) diff --git a/test/URI/Extra/MultiHostPortPair.purs b/test/URI/Extra/MultiHostPortPair.purs index 18a1374..baa1808 100644 --- a/test/URI/Extra/MultiHostPortPair.purs +++ b/test/URI/Extra/MultiHostPortPair.purs @@ -4,13 +4,14 @@ import Prelude import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) +import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.URI.Authority (Authority(..), Host(..), Port, UserInfo) import Data.URI.Authority as Authority import Data.URI.Extra.MultiHostPortPair (MultiHostPortPair) import Data.URI.Extra.MultiHostPortPair as MultiHostPortPair -import Data.URI.Host.RegName as RegName import Data.URI.Host.IPv4Address as IPv4Address +import Data.URI.Host.RegName as RegName import Data.URI.Path.Segment as PathSegment import Data.URI.Port as Port import Data.URI.Query as Query @@ -18,6 +19,7 @@ import Data.URI.Scheme as Scheme import Data.URI.URIRef (Fragment, HierPath, HierarchicalPart(..), Path(..), Query, RelPath, URI(..), URIRefOptions) import Data.URI.URIRef as URIRef import Data.URI.UserInfo as UserInfo +import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) @@ -30,8 +32,8 @@ spec = do "//mongo-1,mongo-2" (Authority Nothing - [ This (NameAddress (RegName.unsafeFromString "mongo-1")) - , This (NameAddress (RegName.unsafeFromString "mongo-2")) + [ This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) + , This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) ]) testIso (Authority.parser options) @@ -39,8 +41,8 @@ spec = do "//mongo-1:2000,mongo-2:3000" (Authority Nothing - [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) - , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) + [ Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) + , Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) ]) testIso (Authority.parser options) @@ -48,8 +50,8 @@ spec = do "//mongo-1:2000,mongo-2" (Authority Nothing - [ Both (NameAddress (RegName.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) - , This (NameAddress (RegName.unsafeFromString "mongo-2")) + [ Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) + , This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) ]) testIso (Authority.parser options) @@ -57,8 +59,8 @@ spec = do "//mongo-1,mongo-2:3000" (Authority Nothing - [ This (NameAddress (RegName.unsafeFromString "mongo-1")) - , Both (NameAddress (RegName.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) + [ This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) + , Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) ]) testIso (Authority.parser options) @@ -75,8 +77,8 @@ spec = do "//user@mongo-1,mongo-2" (Authority (Just (UserInfo.unsafeFromString "user")) - [ This (NameAddress (RegName.unsafeFromString "mongo-1")) - , This (NameAddress (RegName.unsafeFromString "mongo-2")) + [ This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) + , This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) ]) describe "URIRef+MultiHostPortPair parser/printer" do testIso @@ -89,8 +91,8 @@ spec = do (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "foo:bar")) - [ This (NameAddress (RegName.unsafeFromString "db1.example.net")) - , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) + [ This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "db1.example.net")) + , Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) ]) (path ["authdb"])) (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) @@ -105,8 +107,8 @@ spec = do (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "foo:bar")) - [ Both (NameAddress (RegName.unsafeFromString "db1.example.net")) (Port.unsafeFromInt 6) - , Both (NameAddress (RegName.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) + [ Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "db1.example.net")) (Port.unsafeFromInt 6) + , Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) ]) (path ["authdb"])) (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) diff --git a/test/URI/Extra/UserPassInfo.purs b/test/URI/Extra/UserPassInfo.purs index ea783ff..2cfeba5 100644 --- a/test/URI/Extra/UserPassInfo.purs +++ b/test/URI/Extra/UserPassInfo.purs @@ -3,15 +3,17 @@ module Test.URI.Extra.UserPassInfo where import Prelude import Data.Maybe (Maybe(..)) +import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.URI.Authority (Authority(..), Host(..), Port) import Data.URI.Authority as Authority -import Data.URI.HostPortPair (HostPortPair) -import Data.URI.HostPortPair as HostPortPair import Data.URI.Extra.UserPassInfo (UserPassInfo(..)) import Data.URI.Extra.UserPassInfo as UserPassInfo import Data.URI.Host.RegName as RegName +import Data.URI.HostPortPair (HostPortPair) +import Data.URI.HostPortPair as HostPortPair import Data.URI.URIRef (Fragment, HierPath, Path, Query, RelPath, URIRefOptions) +import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) @@ -24,42 +26,42 @@ spec = do "//user@host" (Authority (Just (UserPassInfo { user: "user", password: Nothing })) - (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//user:pass@host" (Authority (Just (UserPassInfo { user: "user", password: Just "pass" })) - (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//user:pa%3Ass@host" (Authority (Just (UserPassInfo { user: "user", password: Just "pa:ss" })) - (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//us%3Aer:pa%3Ass@host" (Authority (Just (UserPassInfo { user: "us:er", password: Just "pa:ss" })) - (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//us%3Aer:pa%3Ass@host" (Authority (Just (UserPassInfo { user: "us:er", password: Just "pa:ss" })) - (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//user:p%40ss@host" (Authority (Just (UserPassInfo { user: "user", password: Just "p@ss" })) - (Just (This (NameAddress (RegName.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) options ∷ Record (URIRefOptions UserPassInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) options = diff --git a/test/URI/Host.purs b/test/URI/Host.purs index cdbc02c..e02f7e9 100644 --- a/test/URI/Host.purs +++ b/test/URI/Host.purs @@ -3,12 +3,14 @@ module Test.URI.Host where import Prelude import Data.Either (Either(..)) +import Data.String.NonEmpty as NES import Data.URI.Host (Host(..)) import Data.URI.Host as Host import Data.URI.Host.Gen as Host.Gen import Data.URI.Host.IPv4Address as IPv4Address import Data.URI.Host.IPv6Address as IPv6Address import Data.URI.Host.RegName as RegName +import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((===)) import Test.Spec (Spec, describe, it) import Test.Spec.Assertions (shouldEqual) @@ -28,12 +30,12 @@ spec = do it "should not parse 0-lead octets as an IP address" do shouldEqual - (Right (NameAddress (RegName.unsafeFromString "192.168.001.1"))) + (Right (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "192.168.001.1"))) (runParser "192.168.001.1" (Host.parser pure)) describe "Host parser/printer" do - testIso (Host.parser pure) Host.print "localhost" (NameAddress (RegName.unsafeFromString "localhost")) - testIso (Host.parser pure) Host.print "github.com" (NameAddress (RegName.unsafeFromString "github.com")) - testIso (Host.parser pure) Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString "www.multipart.domain.example.com")) + testIso (Host.parser pure) Host.print "localhost" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) + testIso (Host.parser pure) Host.print "github.com" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "github.com")) + testIso (Host.parser pure) Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "www.multipart.domain.example.com")) testIso (Host.parser pure) Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) testIso (Host.parser pure) Host.print "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")) diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index 6ff6232..936cd4d 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -4,6 +4,7 @@ import Prelude import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) +import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.Tuple (Tuple(..)) import Data.URI.Fragment as Fragment @@ -19,6 +20,7 @@ import Data.URI.Scheme as Scheme import Data.URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), PathRootless(..), Port, Query, RelPath, RelativePart(..), RelativeRef(..), URI(..), URIRefOptions, UserInfo) import Data.URI.URIRef as URIRef import Data.URI.UserInfo as UserInfo +import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) @@ -79,7 +81,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) Nothing) Nothing Nothing)) @@ -93,7 +95,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "1a.example.com"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "1a.example.com"))))) Nothing) Nothing Nothing)) @@ -107,7 +109,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "en.wikipedia.org"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "en.wikipedia.org"))))) (path ["wiki", "URI_scheme"])) Nothing Nothing)) @@ -133,7 +135,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) - (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) Nothing) Nothing Nothing)) @@ -147,7 +149,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) - (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) (path [""])) Nothing Nothing)) @@ -161,7 +163,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) - (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) (path ["records"])) Nothing Nothing)) @@ -175,7 +177,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString "sysop:moon")) - (Just (This (NameAddress (RegName.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) (path ["records", "etc", ""])) Nothing Nothing)) @@ -231,7 +233,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "ftp.is.co.za"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "ftp.is.co.za"))))) (path ["rfc", "rfc1808.txt"])) Nothing Nothing)) @@ -245,7 +247,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "www.ietf.org"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "www.ietf.org"))))) (path ["rfc", "rfc2396.txt"])) Nothing Nothing)) @@ -287,7 +289,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString "example.com")) (Port.unsafeFromInt 8042)))) + (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "example.com")) (Port.unsafeFromInt 8042)))) (path ["over", "there"])) (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "nose")))) @@ -301,7 +303,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString "example.com")) (Port.unsafeFromInt 8042)))) + (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "example.com")) (Port.unsafeFromInt 8042)))) (path ["over", "there"])) (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "")))) @@ -315,7 +317,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "info.example.com"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "info.example.com"))))) Nothing) (Just (Query.unsafeFromString "fred")) Nothing)) @@ -339,7 +341,7 @@ spec = "top_story.htm" (Right (RelativeRef - (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString "top_story.htm") []))))) + (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString $ unsafePartial $ NES.unsafeFromString "top_story.htm") []))))) Nothing Nothing)) testIso @@ -348,7 +350,7 @@ spec = "../top_story.htm" (Right (RelativeRef - (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString "..") [PathSegment.unsafeSegmentFromString "top_story.htm"]))))) + (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString $ unsafePartial $ NES.unsafeFromString "..") [PathSegment.unsafeSegmentFromString "top_story.htm"]))))) Nothing Nothing)) testIso @@ -357,7 +359,7 @@ spec = "/top_story.htm" (Right (RelativeRef - (RelativePartNoAuth (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString "top_story.htm") [])))))) + (RelativePartNoAuth (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "top_story.htm") [])))))) Nothing Nothing)) testIso @@ -386,7 +388,7 @@ spec = (URI (Scheme.unsafeFromString "http") (HierarchicalPartAuth - (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString "www.example.com"))))) + (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "www.example.com"))))) (path ["some%20invented", "url%20with%20spaces.html"])) Nothing Nothing)) @@ -398,7 +400,7 @@ spec = (URI (Scheme.unsafeFromString "http") (HierarchicalPartAuth - (Authority Nothing (Just (Both (NameAddress (RegName.unsafeFromString "localhost")) (Port.unsafeFromInt 53174)))) + (Authority Nothing (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 53174)))) (path ["metadata", "fs", "test", "%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23"])) (Just (Query.unsafeFromString "")) Nothing)) @@ -409,7 +411,7 @@ spec = (Left (URI (Scheme.unsafeFromString "news") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "comp.infosystems.www.servers.unix") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "comp.infosystems.www.servers.unix") []))))) Nothing Nothing)) testIso @@ -419,7 +421,7 @@ spec = (Left (URI (Scheme.unsafeFromString "tel") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "+1-816-555-1212") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "+1-816-555-1212") []))))) Nothing Nothing)) testIso @@ -429,7 +431,7 @@ spec = (Left (URI (Scheme.unsafeFromString "urn") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "oasis:names:specification:docbook:dtd:xml:4.1.2") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "oasis:names:specification:docbook:dtd:xml:4.1.2") []))))) Nothing Nothing)) testIso @@ -439,7 +441,7 @@ spec = (Left (URI (Scheme.unsafeFromString "mailto") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "John.Doe@example.com") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "John.Doe@example.com") []))))) Nothing Nothing)) testIso @@ -449,7 +451,7 @@ spec = (Left (URI (Scheme.unsafeFromString "mailto") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString "fred@example.com") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "fred@example.com") []))))) Nothing Nothing)) testIso @@ -462,7 +464,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "local.slamdata.com"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "local.slamdata.com"))))) (path [""])) (Just (Query.unsafeFromString "")) (Just (Fragment.unsafeFromString "?sort=asc&q=path%3A%2F&salt=1177214")))) @@ -476,7 +478,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString "local.slamdata.com"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "local.slamdata.com"))))) (path [""])) (Just (Query.unsafeFromString "")) (Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214")))) From 802dd783322b4fe82682d7a94a1cf8a0f9803a5b Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 28 Feb 2018 14:40:03 +0000 Subject: [PATCH 30/69] Add crashes for illegal unsafe port/ipv4 address constructions --- src/Data/URI/Host/IPv4Address.purs | 14 +++++++++++--- src/Data/URI/Port.purs | 13 ++++++++++++- 2 files changed, 23 insertions(+), 4 deletions(-) diff --git a/src/Data/URI/Host/IPv4Address.purs b/src/Data/URI/Host/IPv4Address.purs index e8af674..58acfb6 100644 --- a/src/Data/URI/Host/IPv4Address.purs +++ b/src/Data/URI/Host/IPv4Address.purs @@ -14,6 +14,7 @@ import Data.Int as Int import Data.Maybe (Maybe(..)) import Data.String as String import Data.URI.Common (URIPartParseError(..), digit, wrapParser) +import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) import Text.Parsing.Parser.String (char, satisfy) @@ -37,10 +38,17 @@ fromInts o1 o2 o3 o4 = | i >= 0 && i <= 255 = Just i | otherwise = Nothing --- | Constructs a `IPv4Address` part unsafely: no bounds-checking will be used --- | on the passed integers, potentially allowing for invalid IP addresses. +-- | Constructs a `IPv4Address` part unsafely: if any of the arguments are +-- | outside the allowable bounds, a runtime error will be thrown. +-- | +-- | This is intended as a convenience when describing `IPv4Address`es +-- | statically in PureScript code, in all other cases `fromInts` should be +-- | preferred. unsafeFromInts ∷ Int → Int → Int → Int → IPv4Address -unsafeFromInts = IPv4Address +unsafeFromInts o1 o2 o3 o4 = + case fromInts o1 o2 o3 o4 of + Just addr → addr + Nothing → unsafeCrashWith "IPv4Address octet was out of range" parser ∷ Parser String IPv4Address parser = do diff --git a/src/Data/URI/Port.purs b/src/Data/URI/Port.purs index 788bbbe..5181b17 100644 --- a/src/Data/URI/Port.purs +++ b/src/Data/URI/Port.purs @@ -18,6 +18,7 @@ import Data.Maybe (Maybe(..)) import Data.String as String import Data.URI.Common (URIPartParseError, digit, wrapParser) import Global (readInt) +import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.String (char) @@ -31,13 +32,23 @@ instance showPort ∷ Show Port where show = genericShow toInt ∷ Port → Int toInt (Port i) = i +-- | Constructs a `Port` safely: bounds-checks the value to ensure it occurs +-- | within the range 0-65535 (inclusive). fromInt ∷ Int → Maybe Port fromInt n | n >= 0 && n <= 65535 = Just (Port n) | otherwise = Nothing +-- | Constructs a `Port` unsafely: if the value is outside the allowable range, +-- | a runtime error will be thrown. +-- | +-- | This is intended as a convenience when describing `Port`s statically in +-- | PureScript code, in all other cases `fromInt` should be preferred. unsafeFromInt ∷ Int → Port -unsafeFromInt = Port +unsafeFromInt n = + case fromInt n of + Just addr → addr + Nothing → unsafeCrashWith "Port was out of range" parser ∷ ∀ p. (Port → Either URIPartParseError p) → Parser String p parser p = wrapParser p do From 46145579dc350fc614638d619853e4ea74050b0e Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 28 Feb 2018 15:44:48 +0000 Subject: [PATCH 31/69] Fix illegal port in tests --- test/URI/AbsoluteURI.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs index df8cf87..e1f1cd6 100644 --- a/test/URI/AbsoluteURI.purs +++ b/test/URI/AbsoluteURI.purs @@ -38,13 +38,13 @@ spec = testIso (AbsoluteURI.parser options) (AbsoluteURI.print options) - "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" + "couchbase://localhost:9999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (AbsoluteURI (Scheme.unsafeFromString "couchbase") (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 99999)))) + (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 9999)))) (path ["testBucket"])) (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) testIso From 619ed07f49b3d97330d135381fc05ae8902902b7 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 28 Feb 2018 15:56:07 +0000 Subject: [PATCH 32/69] Move namespace to just URI --- src/Data/URI.purs | 37 ------------ src/URI.purs | 37 ++++++++++++ src/{Data => }/URI/AbsoluteURI.purs | 22 +++---- src/{Data => }/URI/Authority.purs | 18 +++--- src/{Data => }/URI/Common.purs | 2 +- .../URI/Extra/MultiHostPortPair.purs | 18 +++--- src/{Data => }/URI/Extra/QueryPairs.purs | 6 +- src/{Data => }/URI/Extra/UserPassInfo.purs | 8 +-- src/{Data => }/URI/Fragment.purs | 4 +- src/{Data => }/URI/HierarchicalPart.purs | 28 ++++----- src/{Data => }/URI/Host.purs | 22 +++---- src/{Data => }/URI/Host/Gen.purs | 6 +- src/{Data => }/URI/Host/IPv4Address.purs | 4 +- src/{Data => }/URI/Host/IPv6Address.purs | 4 +- src/{Data => }/URI/Host/RegName.purs | 4 +- src/{Data => }/URI/HostPortPair.purs | 12 ++-- src/{Data => }/URI/Path.purs | 6 +- src/{Data => }/URI/Path/Absolute.purs | 6 +- src/{Data => }/URI/Path/NoScheme.purs | 6 +- src/{Data => }/URI/Path/Rootless.purs | 6 +- src/{Data => }/URI/Path/Segment.purs | 4 +- src/{Data => }/URI/Port.purs | 4 +- src/{Data => }/URI/Query.purs | 4 +- src/{Data => }/URI/RelativePart.purs | 28 ++++----- src/{Data => }/URI/RelativeRef.purs | 22 +++---- src/{Data => }/URI/Scheme.purs | 4 +- src/{Data => }/URI/URI.purs | 26 ++++---- src/{Data => }/URI/URIRef.purs | 60 +++++++++---------- src/{Data => }/URI/UserInfo.purs | 4 +- test/URI/AbsoluteURI.purs | 18 +++--- test/URI/Authority.purs | 14 ++--- test/URI/Extra/MultiHostPortPair.purs | 26 ++++---- test/URI/Extra/QueryPairs.purs | 4 +- test/URI/Extra/UserPassInfo.purs | 16 ++--- test/URI/Fragment.purs | 2 +- test/URI/Host.purs | 12 ++-- test/URI/Path.purs | 6 +- test/URI/Port.purs | 2 +- test/URI/Scheme.purs | 2 +- test/URI/URIRef.purs | 26 ++++---- test/URI/UserInfo.purs | 2 +- 41 files changed, 271 insertions(+), 271 deletions(-) delete mode 100755 src/Data/URI.purs create mode 100644 src/URI.purs rename src/{Data => }/URI/AbsoluteURI.purs (82%) rename src/{Data => }/URI/Authority.purs (88%) rename src/{Data => }/URI/Common.purs (99%) rename src/{Data => }/URI/Extra/MultiHostPortPair.purs (86%) rename src/{Data => }/URI/Extra/QueryPairs.purs (96%) rename src/{Data => }/URI/Extra/UserPassInfo.purs (89%) rename src/{Data => }/URI/Fragment.purs (92%) rename src/{Data => }/URI/HierarchicalPart.purs (84%) rename src/{Data => }/URI/Host.purs (76%) rename src/{Data => }/URI/Host/Gen.purs (70%) rename src/{Data => }/URI/Host/IPv4Address.purs (96%) rename src/{Data => }/URI/Host/IPv6Address.purs (94%) rename src/{Data => }/URI/Host/RegName.purs (94%) rename src/{Data => }/URI/HostPortPair.purs (84%) rename src/{Data => }/URI/Path.purs (84%) rename src/{Data => }/URI/Path/Absolute.purs (85%) rename src/{Data => }/URI/Path/NoScheme.purs (81%) rename src/{Data => }/URI/Path/Rootless.purs (82%) rename src/{Data => }/URI/Path/Segment.purs (97%) rename src/{Data => }/URI/Port.purs (95%) rename src/{Data => }/URI/Query.purs (91%) rename src/{Data => }/URI/RelativePart.purs (84%) rename src/{Data => }/URI/RelativeRef.purs (84%) rename src/{Data => }/URI/Scheme.purs (95%) rename src/{Data => }/URI/URI.purs (82%) rename src/{Data => }/URI/URIRef.purs (67%) rename src/{Data => }/URI/UserInfo.purs (94%) diff --git a/src/Data/URI.purs b/src/Data/URI.purs deleted file mode 100755 index cdc7e88..0000000 --- a/src/Data/URI.purs +++ /dev/null @@ -1,37 +0,0 @@ -module Data.URI - ( module Data.URI.AbsoluteURI - , module Data.URI.Authority - , module Data.URI.Fragment - , module Data.URI.HierarchicalPart - , module Data.URI.Host - , module Data.URI.Path - , module Data.URI.Path.Absolute - , module Data.URI.Path.NoScheme - , module Data.URI.Path.Rootless - , module Data.URI.Port - , module Data.URI.Query - , module Data.URI.RelativePart - , module Data.URI.RelativeRef - , module Data.URI.Scheme - , module Data.URI.URI - , module Data.URI.URIRef - , module Data.URI.UserInfo - ) where - -import Data.URI.AbsoluteURI (AbsoluteURI(..)) -import Data.URI.Authority (Authority(..)) -import Data.URI.Fragment (Fragment) -import Data.URI.HierarchicalPart (HierarchicalPart(..), HierPath) -import Data.URI.Host (Host(..), RegName, IPv4Address, IPv6Address) -import Data.URI.Path (Path(..)) -import Data.URI.Path.Absolute (PathAbsolute(..)) -import Data.URI.Path.NoScheme (PathNoScheme(..)) -import Data.URI.Path.Rootless (PathRootless(..)) -import Data.URI.Port (Port) -import Data.URI.Query (Query) -import Data.URI.RelativePart (RelativePart(..), RelPath) -import Data.URI.RelativeRef (RelativeRef(..)) -import Data.URI.Scheme (Scheme) -import Data.URI.URI (URI(..)) -import Data.URI.URIRef (URIRef) -import Data.URI.UserInfo (UserInfo) diff --git a/src/URI.purs b/src/URI.purs new file mode 100644 index 0000000..cae449c --- /dev/null +++ b/src/URI.purs @@ -0,0 +1,37 @@ +module URI + ( module URI.AbsoluteURI + , module URI.Authority + , module URI.Fragment + , module URI.HierarchicalPart + , module URI.Host + , module URI.Path + , module URI.Path.Absolute + , module URI.Path.NoScheme + , module URI.Path.Rootless + , module URI.Port + , module URI.Query + , module URI.RelativePart + , module URI.RelativeRef + , module URI.Scheme + , module URI.URI + , module URI.URIRef + , module URI.UserInfo + ) where + +import URI.AbsoluteURI (AbsoluteURI(..)) +import URI.Authority (Authority(..)) +import URI.Fragment (Fragment) +import URI.HierarchicalPart (HierarchicalPart(..), HierPath) +import URI.Host (Host(..), RegName, IPv4Address, IPv6Address) +import URI.Path (Path(..)) +import URI.Path.Absolute (PathAbsolute(..)) +import URI.Path.NoScheme (PathNoScheme(..)) +import URI.Path.Rootless (PathRootless(..)) +import URI.Port (Port) +import URI.Query (Query) +import URI.RelativePart (RelativePart(..), RelPath) +import URI.RelativeRef (RelativeRef(..)) +import URI.Scheme (Scheme) +import URI.URI (URI(..)) +import URI.URIRef (URIRef) +import URI.UserInfo (UserInfo) diff --git a/src/Data/URI/AbsoluteURI.purs b/src/URI/AbsoluteURI.purs similarity index 82% rename from src/Data/URI/AbsoluteURI.purs rename to src/URI/AbsoluteURI.purs index 030f678..e9e4c71 100644 --- a/src/Data/URI/AbsoluteURI.purs +++ b/src/URI/AbsoluteURI.purs @@ -1,4 +1,4 @@ -module Data.URI.AbsoluteURI +module URI.AbsoluteURI ( AbsoluteURI(..) , AbsoluteURIOptions , AbsoluteURIParseOptions @@ -8,9 +8,9 @@ module Data.URI.AbsoluteURI , _scheme , _hierPart , _query - , module Data.URI.HierarchicalPart - , module Data.URI.Query - , module Data.URI.Scheme + , module URI.HierarchicalPart + , module URI.Query + , module URI.Scheme ) where import Prelude @@ -22,16 +22,16 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (URIPartParseError) -import Data.URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) -import Data.URI.HierarchicalPart as HPart -import Data.URI.Query (Query) -import Data.URI.Query as Query -import Data.URI.Scheme (Scheme) -import Data.URI.Scheme as Scheme import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) +import URI.Common (URIPartParseError) +import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) +import URI.HierarchicalPart as HPart +import URI.Query (Query) +import URI.Query as Query +import URI.Scheme (Scheme) +import URI.Scheme as Scheme -- | A generic AbsoluteURI data AbsoluteURI userInfo hosts path hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts path hierPath) (Maybe query) diff --git a/src/Data/URI/Authority.purs b/src/URI/Authority.purs similarity index 88% rename from src/Data/URI/Authority.purs rename to src/URI/Authority.purs index 5fa1272..0a6dd51 100644 --- a/src/Data/URI/Authority.purs +++ b/src/URI/Authority.purs @@ -1,4 +1,4 @@ -module Data.URI.Authority +module URI.Authority ( Authority(..) , AuthorityOptions , AuthorityParseOptions @@ -8,9 +8,9 @@ module Data.URI.Authority , print , _userInfo , _hosts - , module Data.URI.Host - , module Data.URI.Port - , module Data.URI.UserInfo + , module URI.Host + , module URI.Port + , module URI.UserInfo ) where import Prelude @@ -21,14 +21,14 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.List (List) import Data.Maybe (Maybe(..)) -import Data.URI.Common (URIPartParseError) -import Data.URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) -import Data.URI.Port (Port) -import Data.URI.UserInfo (UserInfo) -import Data.URI.UserInfo as UserInfo import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe, try) import Text.Parsing.Parser.String (char, string) +import URI.Common (URIPartParseError) +import URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) +import URI.Port (Port) +import URI.UserInfo (UserInfo) +import URI.UserInfo as UserInfo -- | The authority part of a URI. For example: `purescript.org`, -- | `localhost:3000`, `user@example.net` diff --git a/src/Data/URI/Common.purs b/src/URI/Common.purs similarity index 99% rename from src/Data/URI/Common.purs rename to src/URI/Common.purs index 1fa639d..af931e5 100644 --- a/src/Data/URI/Common.purs +++ b/src/URI/Common.purs @@ -1,4 +1,4 @@ -module Data.URI.Common +module URI.Common ( URIPartParseError(..) , wrapParser , alpha diff --git a/src/Data/URI/Extra/MultiHostPortPair.purs b/src/URI/Extra/MultiHostPortPair.purs similarity index 86% rename from src/Data/URI/Extra/MultiHostPortPair.purs rename to src/URI/Extra/MultiHostPortPair.purs index 663f171..610bdf7 100644 --- a/src/Data/URI/Extra/MultiHostPortPair.purs +++ b/src/URI/Extra/MultiHostPortPair.purs @@ -1,4 +1,4 @@ -module Data.URI.Extra.MultiHostPortPair +module URI.Extra.MultiHostPortPair ( MultiHostPortPair , parser , print @@ -13,18 +13,18 @@ import Data.Maybe (Maybe(..)) import Data.String as String import Data.String.NonEmpty as NES import Data.These (These(..)) -import Data.URI.Common (URIPartParseError, parseUnreserved, pctEncoded, wrapParser) -import Data.URI.Host (Host(..), RegName) -import Data.URI.Host.IPv4Address as IPv4Address -import Data.URI.Host.IPv6Address as IPv6Address -import Data.URI.Host.RegName as RegName -import Data.URI.HostPortPair as HostPortPair -import Data.URI.Port (Port) -import Data.URI.Port as Port import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.Combinators (optionMaybe, sepBy, try) import Text.Parsing.Parser.String (char, oneOf) +import URI.Common (URIPartParseError, parseUnreserved, pctEncoded, wrapParser) +import URI.Host (Host(..), RegName) +import URI.Host.IPv4Address as IPv4Address +import URI.Host.IPv6Address as IPv6Address +import URI.Host.RegName as RegName +import URI.HostPortPair as HostPortPair +import URI.Port (Port) +import URI.Port as Port -- | Multi-host/port pairs, where host & port combinations can be separated by -- | `,`, as used by some connection URI schemes. This is not strictly diff --git a/src/Data/URI/Extra/QueryPairs.purs b/src/URI/Extra/QueryPairs.purs similarity index 96% rename from src/Data/URI/Extra/QueryPairs.purs rename to src/URI/Extra/QueryPairs.purs index ebda11e..2b44b2e 100644 --- a/src/Data/URI/Extra/QueryPairs.purs +++ b/src/URI/Extra/QueryPairs.purs @@ -1,4 +1,4 @@ -module Data.URI.Extra.QueryPairs +module URI.Extra.QueryPairs ( Key , keyFromString , keyToString @@ -27,12 +27,12 @@ import Data.Monoid (class Monoid) import Data.String as String import Data.Traversable (traverse) import Data.Tuple (Tuple(..)) -import Data.URI.Common (URIPartParseError(..), parseUnreserved, pctEncoded, printEncoded, wrapParser) -import Data.URI.Query as Q import Global (decodeURIComponent) import Text.Parsing.Parser (ParseError(..), Parser, runParser) import Text.Parsing.Parser.Combinators (optionMaybe, sepBy) import Text.Parsing.Parser.String (char, oneOf) +import URI.Common (URIPartParseError(..), parseUnreserved, pctEncoded, printEncoded, wrapParser) +import URI.Query as Q newtype Key = Key String diff --git a/src/Data/URI/Extra/UserPassInfo.purs b/src/URI/Extra/UserPassInfo.purs similarity index 89% rename from src/Data/URI/Extra/UserPassInfo.purs rename to src/URI/Extra/UserPassInfo.purs index 595f714..f21497c 100644 --- a/src/Data/URI/Extra/UserPassInfo.purs +++ b/src/URI/Extra/UserPassInfo.purs @@ -1,4 +1,4 @@ -module Data.URI.Extra.UserPassInfo +module URI.Extra.UserPassInfo ( UserPassInfo(..) , parse , print @@ -10,11 +10,11 @@ import Control.Alt ((<|>)) import Data.Either (Either) import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (parseSubDelims, parseUnreserved, printEncoded) -import Data.URI.UserInfo (UserInfo) -import Data.URI.UserInfo as UserInfo import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) +import URI.Common (parseSubDelims, parseUnreserved, printEncoded) +import URI.UserInfo (UserInfo) +import URI.UserInfo as UserInfo newtype UserPassInfo = UserPassInfo { user ∷ String, password ∷ Maybe String } diff --git a/src/Data/URI/Fragment.purs b/src/URI/Fragment.purs similarity index 92% rename from src/Data/URI/Fragment.purs rename to src/URI/Fragment.purs index 5a64622..9475a1c 100644 --- a/src/Data/URI/Fragment.purs +++ b/src/URI/Fragment.purs @@ -1,4 +1,4 @@ -module Data.URI.Fragment +module URI.Fragment ( Fragment , fromString , toString @@ -15,10 +15,10 @@ import Data.Array as Array import Data.Either (Either) import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) +import URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) -- | The hash fragment of a URI. newtype Fragment = Fragment String diff --git a/src/Data/URI/HierarchicalPart.purs b/src/URI/HierarchicalPart.purs similarity index 84% rename from src/Data/URI/HierarchicalPart.purs rename to src/URI/HierarchicalPart.purs index f23c870..6e41f23 100644 --- a/src/Data/URI/HierarchicalPart.purs +++ b/src/URI/HierarchicalPart.purs @@ -1,4 +1,4 @@ -module Data.URI.HierarchicalPart +module URI.HierarchicalPart ( HierarchicalPart(..) , HierarchicalPartOptions , HierarchicalPartParseOptions @@ -9,10 +9,10 @@ module Data.URI.HierarchicalPart , _authority , _path , _hierPath - , module Data.URI.Authority - , module Data.URI.Path - , module Data.URI.Path.Absolute - , module Data.URI.Path.Rootless + , module URI.Authority + , module URI.Path + , module URI.Path.Absolute + , module URI.Path.Rootless ) where import Prelude @@ -25,17 +25,17 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) import Data.String as String -import Data.URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) -import Data.URI.Authority as Authority -import Data.URI.Common (URIPartParseError) -import Data.URI.Path (Path(..)) -import Data.URI.Path as Path -import Data.URI.Path.Absolute (PathAbsolute(..)) -import Data.URI.Path.Absolute as PathAbs -import Data.URI.Path.Rootless (PathRootless(..)) -import Data.URI.Path.Rootless as PathRootless import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) +import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import URI.Authority as Authority +import URI.Common (URIPartParseError) +import URI.Path (Path(..)) +import URI.Path as Path +import URI.Path.Absolute (PathAbsolute(..)) +import URI.Path.Absolute as PathAbs +import URI.Path.Rootless (PathRootless(..)) +import URI.Path.Rootless as PathRootless -- | The "hierarchical part" of a generic or absolute URI. data HierarchicalPart userInfo hosts path hierPath diff --git a/src/Data/URI/Host.purs b/src/URI/Host.purs similarity index 76% rename from src/Data/URI/Host.purs rename to src/URI/Host.purs index ee36d3e..b374d6f 100644 --- a/src/Data/URI/Host.purs +++ b/src/URI/Host.purs @@ -1,13 +1,13 @@ -module Data.URI.Host +module URI.Host ( Host(..) , parser , print , _IPv6Address , _IPv4Address , _NameAddress - , module Data.URI.Host.IPv4Address - , module Data.URI.Host.IPv6Address - , module Data.URI.Host.RegName + , module URI.Host.IPv4Address + , module URI.Host.IPv6Address + , module URI.Host.RegName ) where import Prelude @@ -18,15 +18,15 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Prism', prism') import Data.Maybe (Maybe(..)) -import Data.URI.Common (URIPartParseError, wrapParser) -import Data.URI.Host.IPv4Address (IPv4Address) -import Data.URI.Host.IPv4Address as IPv4Address -import Data.URI.Host.IPv6Address (IPv6Address) -import Data.URI.Host.IPv6Address as IPv6Address -import Data.URI.Host.RegName (RegName) -import Data.URI.Host.RegName as RegName import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) +import URI.Common (URIPartParseError, wrapParser) +import URI.Host.IPv4Address (IPv4Address) +import URI.Host.IPv4Address as IPv4Address +import URI.Host.IPv6Address (IPv6Address) +import URI.Host.IPv6Address as IPv6Address +import URI.Host.RegName (RegName) +import URI.Host.RegName as RegName -- | A host address. data Host diff --git a/src/Data/URI/Host/Gen.purs b/src/URI/Host/Gen.purs similarity index 70% rename from src/Data/URI/Host/Gen.purs rename to src/URI/Host/Gen.purs index c67adef..7dd1db5 100644 --- a/src/Data/URI/Host/Gen.purs +++ b/src/URI/Host/Gen.purs @@ -1,10 +1,10 @@ -module Data.URI.Host.Gen where +module URI.Host.Gen where import Prelude import Control.Monad.Gen as Gen -import Data.URI.Host (IPv4Address) -import Data.URI.Host.IPv4Address as IPv4Address +import URI.Host (IPv4Address) +import URI.Host.IPv4Address as IPv4Address genIPv4 ∷ ∀ m. Gen.MonadGen m ⇒ m IPv4Address genIPv4 = do diff --git a/src/Data/URI/Host/IPv4Address.purs b/src/URI/Host/IPv4Address.purs similarity index 96% rename from src/Data/URI/Host/IPv4Address.purs rename to src/URI/Host/IPv4Address.purs index 58acfb6..596b8ad 100644 --- a/src/Data/URI/Host/IPv4Address.purs +++ b/src/URI/Host/IPv4Address.purs @@ -1,4 +1,4 @@ -module Data.URI.Host.IPv4Address +module URI.Host.IPv4Address ( IPv4Address , fromInts , unsafeFromInts @@ -13,11 +13,11 @@ import Data.Either (Either(..)) import Data.Int as Int import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (URIPartParseError(..), digit, wrapParser) import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) import Text.Parsing.Parser.String (char, satisfy) +import URI.Common (URIPartParseError(..), digit, wrapParser) data IPv4Address = IPv4Address Int Int Int Int diff --git a/src/Data/URI/Host/IPv6Address.purs b/src/URI/Host/IPv6Address.purs similarity index 94% rename from src/Data/URI/Host/IPv6Address.purs rename to src/URI/Host/IPv6Address.purs index 8fb1b83..34bb7cd 100644 --- a/src/Data/URI/Host/IPv6Address.purs +++ b/src/URI/Host/IPv6Address.purs @@ -1,4 +1,4 @@ -module Data.URI.Host.IPv6Address +module URI.Host.IPv6Address ( IPv6Address , unsafeFromString , unsafeToString @@ -10,10 +10,10 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.String as String -import Data.URI.Common (hexDigit) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (()) import Text.Parsing.Parser.String (char) +import URI.Common (hexDigit) -- | This type and parser are much too forgiving currently, allowing almost -- | anything through that looks vaguely IPv6ish. diff --git a/src/Data/URI/Host/RegName.purs b/src/URI/Host/RegName.purs similarity index 94% rename from src/Data/URI/Host/RegName.purs rename to src/URI/Host/RegName.purs index 6d9c9d4..38f1c57 100644 --- a/src/Data/URI/Host/RegName.purs +++ b/src/URI/Host/RegName.purs @@ -1,4 +1,4 @@ -module Data.URI.Host.RegName +module URI.Host.RegName ( RegName , fromString , toString @@ -15,9 +15,9 @@ import Data.Monoid (class Monoid) import Data.String as String import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES -import Data.URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) +import URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) newtype RegName = RegName String diff --git a/src/Data/URI/HostPortPair.purs b/src/URI/HostPortPair.purs similarity index 84% rename from src/Data/URI/HostPortPair.purs rename to src/URI/HostPortPair.purs index 124f26f..7e4ca8b 100644 --- a/src/Data/URI/HostPortPair.purs +++ b/src/URI/HostPortPair.purs @@ -1,17 +1,17 @@ -module Data.URI.HostPortPair where +module URI.HostPortPair where import Prelude import Data.Either (Either) import Data.Maybe (Maybe(..)) import Data.These (These(..)) -import Data.URI.Common (URIPartParseError) -import Data.URI.Host (Host) -import Data.URI.Host as Host -import Data.URI.Port (Port) -import Data.URI.Port as Port import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) +import URI.Common (URIPartParseError) +import URI.Host (Host) +import URI.Host as Host +import URI.Port (Port) +import URI.Port as Port type HostPortPair host port = Maybe (These host port) diff --git a/src/Data/URI/Path.purs b/src/URI/Path.purs similarity index 84% rename from src/Data/URI/Path.purs rename to src/URI/Path.purs index f7ee47f..3200b8b 100644 --- a/src/Data/URI/Path.purs +++ b/src/URI/Path.purs @@ -1,4 +1,4 @@ -module Data.URI.Path where +module URI.Path where import Prelude @@ -8,10 +8,10 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (URIPartParseError, wrapParser) -import Data.URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) +import URI.Common (URIPartParseError, wrapParser) +import URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) newtype Path = Path (Array PathSegment) diff --git a/src/Data/URI/Path/Absolute.purs b/src/URI/Path/Absolute.purs similarity index 85% rename from src/Data/URI/Path/Absolute.purs rename to src/URI/Path/Absolute.purs index afba2e0..bc7ce47 100644 --- a/src/Data/URI/Path/Absolute.purs +++ b/src/URI/Path/Absolute.purs @@ -1,4 +1,4 @@ -module Data.URI.Path.Absolute where +module URI.Path.Absolute where import Prelude @@ -9,11 +9,11 @@ import Data.Generic.Rep.Show (genericShow) import Data.Maybe (Maybe(..)) import Data.String as String import Data.Tuple (Tuple(..)) -import Data.URI.Common (URIPartParseError, wrapParser) -import Data.URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (char) +import URI.Common (URIPartParseError, wrapParser) +import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) newtype PathAbsolute = PathAbsolute (Maybe (Tuple PathSegmentNZ (Array PathSegment))) diff --git a/src/Data/URI/Path/NoScheme.purs b/src/URI/Path/NoScheme.purs similarity index 81% rename from src/Data/URI/Path/NoScheme.purs rename to src/URI/Path/NoScheme.purs index e9d853b..131c442 100644 --- a/src/Data/URI/Path/NoScheme.purs +++ b/src/URI/Path/NoScheme.purs @@ -1,4 +1,4 @@ -module Data.URI.Path.NoScheme where +module URI.Path.NoScheme where import Prelude @@ -8,10 +8,10 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.String as String import Data.Tuple (Tuple(..)) -import Data.URI.Common (URIPartParseError, wrapParser) -import Data.URI.Path.Segment (PathSegment, PathSegmentNZNC, parseSegment, parseSegmentNonZeroNoColon, unsafeSegmentNZNCToString, unsafeSegmentToString) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) +import URI.Common (URIPartParseError, wrapParser) +import URI.Path.Segment (PathSegment, PathSegmentNZNC, parseSegment, parseSegmentNonZeroNoColon, unsafeSegmentNZNCToString, unsafeSegmentToString) newtype PathNoScheme = PathNoScheme (Tuple PathSegmentNZNC (Array PathSegment)) diff --git a/src/Data/URI/Path/Rootless.purs b/src/URI/Path/Rootless.purs similarity index 82% rename from src/Data/URI/Path/Rootless.purs rename to src/URI/Path/Rootless.purs index 05cdc42..b9727b7 100644 --- a/src/Data/URI/Path/Rootless.purs +++ b/src/URI/Path/Rootless.purs @@ -1,4 +1,4 @@ -module Data.URI.Path.Rootless where +module URI.Path.Rootless where import Prelude @@ -8,10 +8,10 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.String as String import Data.Tuple (Tuple(..)) -import Data.URI.Common (URIPartParseError, wrapParser) -import Data.URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) +import URI.Common (URIPartParseError, wrapParser) +import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) newtype PathRootless = PathRootless (Tuple PathSegmentNZ (Array PathSegment)) diff --git a/src/Data/URI/Path/Segment.purs b/src/URI/Path/Segment.purs similarity index 97% rename from src/Data/URI/Path/Segment.purs rename to src/URI/Path/Segment.purs index b59fca9..db9471f 100644 --- a/src/Data/URI/Path/Segment.purs +++ b/src/URI/Path/Segment.purs @@ -1,4 +1,4 @@ -module Data.URI.Path.Segment +module URI.Path.Segment ( PathSegment , parseSegment , segmentFromString @@ -26,10 +26,10 @@ import Data.Array as Array import Data.String as String import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES -import Data.URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) +import URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) newtype PathSegment = PathSegment String diff --git a/src/Data/URI/Port.purs b/src/URI/Port.purs similarity index 95% rename from src/Data/URI/Port.purs rename to src/URI/Port.purs index 5181b17..41a7b01 100644 --- a/src/Data/URI/Port.purs +++ b/src/URI/Port.purs @@ -1,4 +1,4 @@ -module Data.URI.Port +module URI.Port ( Port , toInt , fromInt @@ -16,11 +16,11 @@ import Data.Generic.Rep.Show (genericShow) import Data.Int (fromNumber) import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (URIPartParseError, digit, wrapParser) import Global (readInt) import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.String (char) +import URI.Common (URIPartParseError, digit, wrapParser) newtype Port = Port Int diff --git a/src/Data/URI/Query.purs b/src/URI/Query.purs similarity index 91% rename from src/Data/URI/Query.purs rename to src/URI/Query.purs index 2063780..6f39b03 100644 --- a/src/Data/URI/Query.purs +++ b/src/URI/Query.purs @@ -1,4 +1,4 @@ -module Data.URI.Query +module URI.Query ( Query , fromString , toString @@ -15,10 +15,10 @@ import Data.Array as Array import Data.Either (Either) import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) +import URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) newtype Query = Query String diff --git a/src/Data/URI/RelativePart.purs b/src/URI/RelativePart.purs similarity index 84% rename from src/Data/URI/RelativePart.purs rename to src/URI/RelativePart.purs index 840a049..0915176 100644 --- a/src/Data/URI/RelativePart.purs +++ b/src/URI/RelativePart.purs @@ -1,4 +1,4 @@ -module Data.URI.RelativePart +module URI.RelativePart ( RelativePart(..) , RelativePartOptions , RelativePartParseOptions @@ -9,10 +9,10 @@ module Data.URI.RelativePart , _authority , _path , _relPath - , module Data.URI.Authority - , module Data.URI.Path - , module Data.URI.Path.Absolute - , module Data.URI.Path.NoScheme + , module URI.Authority + , module URI.Path + , module URI.Path.Absolute + , module URI.Path.NoScheme ) where import Prelude @@ -25,17 +25,17 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) import Data.String as String -import Data.URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) -import Data.URI.Authority as Authority -import Data.URI.Common (URIPartParseError) -import Data.URI.Path (Path) -import Data.URI.Path as Path -import Data.URI.Path.Absolute (PathAbsolute) -import Data.URI.Path.Absolute as PathAbs -import Data.URI.Path.NoScheme (PathNoScheme) -import Data.URI.Path.NoScheme as PathNoScheme import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) +import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import URI.Authority as Authority +import URI.Common (URIPartParseError) +import URI.Path (Path) +import URI.Path as Path +import URI.Path.Absolute (PathAbsolute) +import URI.Path.Absolute as PathAbs +import URI.Path.NoScheme (PathNoScheme) +import URI.Path.NoScheme as PathNoScheme -- | The "relative part" of a relative reference. data RelativePart userInfo hosts path relPath diff --git a/src/Data/URI/RelativeRef.purs b/src/URI/RelativeRef.purs similarity index 84% rename from src/Data/URI/RelativeRef.purs rename to src/URI/RelativeRef.purs index af88fe1..4a0e5e1 100644 --- a/src/Data/URI/RelativeRef.purs +++ b/src/URI/RelativeRef.purs @@ -1,4 +1,4 @@ -module Data.URI.RelativeRef +module URI.RelativeRef ( RelativeRef(..) , RelativeRefOptions , RelativeRefParseOptions @@ -8,9 +8,9 @@ module Data.URI.RelativeRef , _relPart , _query , _fragment - , module Data.URI.Fragment - , module Data.URI.Query - , module Data.URI.RelativePart + , module URI.Fragment + , module URI.Query + , module URI.RelativePart ) where import Prelude @@ -22,16 +22,16 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (URIPartParseError) -import Data.URI.Fragment (Fragment) -import Data.URI.Fragment as Fragment -import Data.URI.Query (Query) -import Data.URI.Query as Query -import Data.URI.RelativePart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path, PathAbsolute, PathNoScheme, Port, RegName, RelPath, RelativePart(..), RelativePartOptions, RelativePartParseOptions, RelativePartPrintOptions, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _relPath, _userInfo) -import Data.URI.RelativePart as RPart import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) +import URI.Common (URIPartParseError) +import URI.Fragment (Fragment) +import URI.Fragment as Fragment +import URI.Query (Query) +import URI.Query as Query +import URI.RelativePart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path, PathAbsolute, PathNoScheme, Port, RegName, RelPath, RelativePart(..), RelativePartOptions, RelativePartParseOptions, RelativePartPrintOptions, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _relPath, _userInfo) +import URI.RelativePart as RPart -- | A relative reference for a URI. data RelativeRef userInfo hosts path relPath query fragment = RelativeRef (RelativePart userInfo hosts path relPath) (Maybe query) (Maybe fragment) diff --git a/src/Data/URI/Scheme.purs b/src/URI/Scheme.purs similarity index 95% rename from src/Data/URI/Scheme.purs rename to src/URI/Scheme.purs index 9839f85..1bdae04 100644 --- a/src/Data/URI/Scheme.purs +++ b/src/URI/Scheme.purs @@ -1,4 +1,4 @@ -module Data.URI.Scheme +module URI.Scheme ( Scheme , fromString , unsafeFromString @@ -13,10 +13,10 @@ import Data.Array as Array import Data.Either (hush) import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (alpha, alphaNum) import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, runParser) import Text.Parsing.Parser.String (char) +import URI.Common (alpha, alphaNum) -- | The scheme part of an absolute URI. For example: `http`, `ftp`, `git`. newtype Scheme = Scheme String diff --git a/src/Data/URI/URI.purs b/src/URI/URI.purs similarity index 82% rename from src/Data/URI/URI.purs rename to src/URI/URI.purs index 15bcb70..09fffbd 100644 --- a/src/Data/URI/URI.purs +++ b/src/URI/URI.purs @@ -1,4 +1,4 @@ -module Data.URI.URI +module URI.URI ( URI(..) , URIOptions , URIParseOptions @@ -9,9 +9,9 @@ module Data.URI.URI , _hierPart , _query , _fragment - , module Data.URI.HierarchicalPart - , module Data.URI.Query - , module Data.URI.Scheme + , module URI.HierarchicalPart + , module URI.Query + , module URI.Scheme ) where import Prelude @@ -23,18 +23,18 @@ import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) import Data.Maybe (Maybe(..)) import Data.String as String -import Data.URI.Common (URIPartParseError) -import Data.URI.Fragment (Fragment) -import Data.URI.Fragment as Fragment -import Data.URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) -import Data.URI.HierarchicalPart as HPart -import Data.URI.Query (Query) -import Data.URI.Query as Query -import Data.URI.Scheme (Scheme) -import Data.URI.Scheme as Scheme import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) +import URI.Common (URIPartParseError) +import URI.Fragment (Fragment) +import URI.Fragment as Fragment +import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) +import URI.HierarchicalPart as HPart +import URI.Query (Query) +import URI.Query as Query +import URI.Scheme (Scheme) +import URI.Scheme as Scheme -- | A generic URI data URI userInfo hosts path hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts path hierPath) (Maybe query) (Maybe fragment) diff --git a/src/Data/URI/URIRef.purs b/src/URI/URIRef.purs similarity index 67% rename from src/Data/URI/URIRef.purs rename to src/URI/URIRef.purs index 11c4446..cefb118 100644 --- a/src/Data/URI/URIRef.purs +++ b/src/URI/URIRef.purs @@ -1,47 +1,47 @@ -module Data.URI.URIRef +module URI.URIRef ( URIRef , URIRefOptions , URIRefParseOptions , URIRefPrintOptions , parser , print - , module Data.URI.Authority - , module Data.URI.Fragment - , module Data.URI.Host - , module Data.URI.Path - , module Data.URI.Path.Absolute - , module Data.URI.Path.NoScheme - , module Data.URI.Path.Rootless - , module Data.URI.Port - , module Data.URI.Query - , module Data.URI.RelativeRef - , module Data.URI.Scheme - , module Data.URI.URI - , module Data.URI.UserInfo + , module URI.Authority + , module URI.Fragment + , module URI.Host + , module URI.Path + , module URI.Path.Absolute + , module URI.Path.NoScheme + , module URI.Path.Rootless + , module URI.Port + , module URI.Query + , module URI.RelativeRef + , module URI.Scheme + , module URI.URI + , module URI.UserInfo ) where import Prelude import Control.Alt ((<|>)) import Data.Either (Either(..), either) -import Data.URI.Authority (Authority(..), HostsParseOptions) -import Data.URI.Common (URIPartParseError) -import Data.URI.Fragment (Fragment) -import Data.URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) -import Data.URI.Path (Path(..)) -import Data.URI.Path.Absolute (PathAbsolute(..)) -import Data.URI.Path.NoScheme (PathNoScheme(..)) -import Data.URI.Path.Rootless (PathRootless(..)) -import Data.URI.Port (Port) -import Data.URI.Query (Query) -import Data.URI.RelativeRef (RelativeRef(..), RelativePart(..), RelPath) -import Data.URI.RelativeRef as RelativeRef -import Data.URI.Scheme (Scheme) -import Data.URI.URI (URI(..), HierarchicalPart(..), HierPath) -import Data.URI.URI as URI -import Data.URI.UserInfo (UserInfo) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) +import URI.Authority (Authority(..), HostsParseOptions) +import URI.Common (URIPartParseError) +import URI.Fragment (Fragment) +import URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) +import URI.Path (Path(..)) +import URI.Path.Absolute (PathAbsolute(..)) +import URI.Path.NoScheme (PathNoScheme(..)) +import URI.Path.Rootless (PathRootless(..)) +import URI.Port (Port) +import URI.Query (Query) +import URI.RelativeRef (RelativeRef(..), RelativePart(..), RelPath) +import URI.RelativeRef as RelativeRef +import URI.Scheme (Scheme) +import URI.URI (URI(..), HierarchicalPart(..), HierPath) +import URI.URI as URI +import URI.UserInfo (UserInfo) -- | An alias for the most common use case of resource identifiers. type URIRef userInfo hosts path hierPath relPath query fragment = diff --git a/src/Data/URI/UserInfo.purs b/src/URI/UserInfo.purs similarity index 94% rename from src/Data/URI/UserInfo.purs rename to src/URI/UserInfo.purs index c93f0aa..8691a81 100644 --- a/src/Data/URI/UserInfo.purs +++ b/src/URI/UserInfo.purs @@ -1,4 +1,4 @@ -module Data.URI.UserInfo +module URI.UserInfo ( UserInfo , fromString , toString @@ -15,10 +15,10 @@ import Data.Array as Array import Data.Either (Either) import Data.Monoid (class Monoid) import Data.String as String -import Data.URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) +import URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) -- | The user info part of an `Authority`. For example: `user`, `foo:bar`. newtype UserInfo = UserInfo String diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs index e1f1cd6..a82c678 100644 --- a/test/URI/AbsoluteURI.purs +++ b/test/URI/AbsoluteURI.purs @@ -7,18 +7,18 @@ import Data.Maybe (Maybe(..)) import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.Tuple (Tuple(..)) -import Data.URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port, Query, AbsoluteURI(..), AbsoluteURIOptions, UserInfo) -import Data.URI.AbsoluteURI as AbsoluteURI -import Data.URI.Host.RegName as RegName -import Data.URI.HostPortPair (HostPortPair) -import Data.URI.HostPortPair as HostPortPair -import Data.URI.Path.Segment as PathSegment -import Data.URI.Port as Port -import Data.URI.Query as Query -import Data.URI.Scheme as Scheme import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port, Query, AbsoluteURI(..), AbsoluteURIOptions, UserInfo) +import URI.AbsoluteURI as AbsoluteURI +import URI.Host.RegName as RegName +import URI.HostPortPair (HostPortPair) +import URI.HostPortPair as HostPortPair +import URI.Path.Segment as PathSegment +import URI.Port as Port +import URI.Query as Query +import URI.Scheme as Scheme spec ∷ ∀ eff. Spec eff Unit spec = diff --git a/test/URI/Authority.purs b/test/URI/Authority.purs index 7053dbd..8007bed 100644 --- a/test/URI/Authority.purs +++ b/test/URI/Authority.purs @@ -5,16 +5,16 @@ import Prelude import Data.Maybe (Maybe(..)) import Data.String.NonEmpty as NES import Data.These (These(..)) -import Data.URI.Authority (Authority(..), AuthorityOptions, Host(..), Port, UserInfo) -import Data.URI.Authority as Authority -import Data.URI.Host.RegName as RegName -import Data.URI.HostPortPair (HostPortPair) -import Data.URI.HostPortPair as HostPortPair -import Data.URI.Port as Port -import Data.URI.UserInfo as UserInfo import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Authority (Authority(..), AuthorityOptions, Host(..), Port, UserInfo) +import URI.Authority as Authority +import URI.Host.RegName as RegName +import URI.HostPortPair (HostPortPair) +import URI.HostPortPair as HostPortPair +import URI.Port as Port +import URI.UserInfo as UserInfo spec ∷ ∀ eff. Spec eff Unit spec = diff --git a/test/URI/Extra/MultiHostPortPair.purs b/test/URI/Extra/MultiHostPortPair.purs index baa1808..6cdd30b 100644 --- a/test/URI/Extra/MultiHostPortPair.purs +++ b/test/URI/Extra/MultiHostPortPair.purs @@ -6,22 +6,22 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.String.NonEmpty as NES import Data.These (These(..)) -import Data.URI.Authority (Authority(..), Host(..), Port, UserInfo) -import Data.URI.Authority as Authority -import Data.URI.Extra.MultiHostPortPair (MultiHostPortPair) -import Data.URI.Extra.MultiHostPortPair as MultiHostPortPair -import Data.URI.Host.IPv4Address as IPv4Address -import Data.URI.Host.RegName as RegName -import Data.URI.Path.Segment as PathSegment -import Data.URI.Port as Port -import Data.URI.Query as Query -import Data.URI.Scheme as Scheme -import Data.URI.URIRef (Fragment, HierPath, HierarchicalPart(..), Path(..), Query, RelPath, URI(..), URIRefOptions) -import Data.URI.URIRef as URIRef -import Data.URI.UserInfo as UserInfo import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Authority (Authority(..), Host(..), Port, UserInfo) +import URI.Authority as Authority +import URI.Extra.MultiHostPortPair (MultiHostPortPair) +import URI.Extra.MultiHostPortPair as MultiHostPortPair +import URI.Host.IPv4Address as IPv4Address +import URI.Host.RegName as RegName +import URI.Path.Segment as PathSegment +import URI.Port as Port +import URI.Query as Query +import URI.Scheme as Scheme +import URI.URIRef (Fragment, HierPath, HierarchicalPart(..), Path(..), Query, RelPath, URI(..), URIRefOptions) +import URI.URIRef as URIRef +import URI.UserInfo as UserInfo spec ∷ ∀ eff. Spec eff Unit spec = do diff --git a/test/URI/Extra/QueryPairs.purs b/test/URI/Extra/QueryPairs.purs index 4ea678a..101ee71 100644 --- a/test/URI/Extra/QueryPairs.purs +++ b/test/URI/Extra/QueryPairs.purs @@ -4,10 +4,10 @@ import Prelude import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple(..)) -import Data.URI.Extra.QueryPairs as NQP -import Data.URI.Query as Query import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Extra.QueryPairs as NQP +import URI.Query as Query spec ∷ ∀ eff. Spec eff Unit spec = diff --git a/test/URI/Extra/UserPassInfo.purs b/test/URI/Extra/UserPassInfo.purs index 2cfeba5..d3794fc 100644 --- a/test/URI/Extra/UserPassInfo.purs +++ b/test/URI/Extra/UserPassInfo.purs @@ -5,17 +5,17 @@ import Prelude import Data.Maybe (Maybe(..)) import Data.String.NonEmpty as NES import Data.These (These(..)) -import Data.URI.Authority (Authority(..), Host(..), Port) -import Data.URI.Authority as Authority -import Data.URI.Extra.UserPassInfo (UserPassInfo(..)) -import Data.URI.Extra.UserPassInfo as UserPassInfo -import Data.URI.Host.RegName as RegName -import Data.URI.HostPortPair (HostPortPair) -import Data.URI.HostPortPair as HostPortPair -import Data.URI.URIRef (Fragment, HierPath, Path, Query, RelPath, URIRefOptions) import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Authority (Authority(..), Host(..), Port) +import URI.Authority as Authority +import URI.Extra.UserPassInfo (UserPassInfo(..)) +import URI.Extra.UserPassInfo as UserPassInfo +import URI.Host.RegName as RegName +import URI.HostPortPair (HostPortPair) +import URI.HostPortPair as HostPortPair +import URI.URIRef (Fragment, HierPath, Path, Query, RelPath, URIRefOptions) spec ∷ ∀ eff. Spec eff Unit spec = do diff --git a/test/URI/Fragment.purs b/test/URI/Fragment.purs index bc12918..dafb45c 100644 --- a/test/URI/Fragment.purs +++ b/test/URI/Fragment.purs @@ -2,9 +2,9 @@ module Test.URI.Fragment where import Prelude -import Data.URI.Fragment as Fragment import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Fragment as Fragment spec ∷ ∀ eff. Spec eff Unit spec = diff --git a/test/URI/Host.purs b/test/URI/Host.purs index e02f7e9..12768a2 100644 --- a/test/URI/Host.purs +++ b/test/URI/Host.purs @@ -4,18 +4,18 @@ import Prelude import Data.Either (Either(..)) import Data.String.NonEmpty as NES -import Data.URI.Host (Host(..)) -import Data.URI.Host as Host -import Data.URI.Host.Gen as Host.Gen -import Data.URI.Host.IPv4Address as IPv4Address -import Data.URI.Host.IPv6Address as IPv6Address -import Data.URI.Host.RegName as RegName import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((===)) import Test.Spec (Spec, describe, it) import Test.Spec.Assertions (shouldEqual) import Test.Util (TestEffects, forAll, testIso) import Text.Parsing.Parser (runParser) +import URI.Host (Host(..)) +import URI.Host as Host +import URI.Host.Gen as Host.Gen +import URI.Host.IPv4Address as IPv4Address +import URI.Host.IPv6Address as IPv6Address +import URI.Host.RegName as RegName spec ∷ ∀ eff. Spec (TestEffects eff) Unit spec = do diff --git a/test/URI/Path.purs b/test/URI/Path.purs index a48b10c..8bf91ce 100644 --- a/test/URI/Path.purs +++ b/test/URI/Path.purs @@ -2,11 +2,11 @@ module Test.URI.Path where import Prelude -import Data.URI.Path (Path(..)) -import Data.URI.Path as Path -import Data.URI.Path.Segment as PathSegment import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Path (Path(..)) +import URI.Path as Path +import URI.Path.Segment as PathSegment spec ∷ ∀ eff. Spec eff Unit spec = diff --git a/test/URI/Port.purs b/test/URI/Port.purs index 251dc52..2b0d8ca 100644 --- a/test/URI/Port.purs +++ b/test/URI/Port.purs @@ -2,9 +2,9 @@ module Test.URI.Port where import Prelude -import Data.URI.Port as Port import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Port as Port spec ∷ ∀ eff. Spec eff Unit spec = diff --git a/test/URI/Scheme.purs b/test/URI/Scheme.purs index 2ddb6ce..d51c9c9 100644 --- a/test/URI/Scheme.purs +++ b/test/URI/Scheme.purs @@ -2,9 +2,9 @@ module Test.URI.Scheme where import Prelude -import Data.URI.Scheme as Scheme import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Scheme as Scheme spec ∷ ∀ eff. Spec eff Unit spec = diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index 936cd4d..ce78ee6 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -7,22 +7,22 @@ import Data.Maybe (Maybe(..)) import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.Tuple (Tuple(..)) -import Data.URI.Fragment as Fragment -import Data.URI.Host.IPv4Address as IPv4Address -import Data.URI.Host.IPv6Address as IPv6Address -import Data.URI.Host.RegName as RegName -import Data.URI.HostPortPair (HostPortPair) -import Data.URI.HostPortPair as HostPortPair -import Data.URI.Path.Segment as PathSegment -import Data.URI.Port as Port -import Data.URI.Query as Query -import Data.URI.Scheme as Scheme -import Data.URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), PathRootless(..), Port, Query, RelPath, RelativePart(..), RelativeRef(..), URI(..), URIRefOptions, UserInfo) -import Data.URI.URIRef as URIRef -import Data.URI.UserInfo as UserInfo import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Fragment as Fragment +import URI.Host.IPv4Address as IPv4Address +import URI.Host.IPv6Address as IPv6Address +import URI.Host.RegName as RegName +import URI.HostPortPair (HostPortPair) +import URI.HostPortPair as HostPortPair +import URI.Path.Segment as PathSegment +import URI.Port as Port +import URI.Query as Query +import URI.Scheme as Scheme +import URI.URIRef (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathNoScheme(..), PathRootless(..), Port, Query, RelPath, RelativePart(..), RelativeRef(..), URI(..), URIRefOptions, UserInfo) +import URI.URIRef as URIRef +import URI.UserInfo as UserInfo spec ∷ ∀ eff. Spec eff Unit spec = diff --git a/test/URI/UserInfo.purs b/test/URI/UserInfo.purs index 6870bc6..9cd489b 100644 --- a/test/URI/UserInfo.purs +++ b/test/URI/UserInfo.purs @@ -2,9 +2,9 @@ module Test.URI.UserInfo where import Prelude -import Data.URI.UserInfo as UserInfo import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.UserInfo as UserInfo spec ∷ ∀ eff. Spec eff Unit spec = From 308c2eed3ce25846c53d82acb4c45f5988594bc5 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 01:06:50 +0000 Subject: [PATCH 33/69] Add details about the new setup to the README --- README.md | 134 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 133 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 43ff46d..3ba934e 100644 --- a/README.md +++ b/README.md @@ -12,6 +12,138 @@ A type-safe parser, printer, and ADT for URLs and URIs based on [RFC 3986](http: bower install purescript-uri ``` -## Documentation +## Getting started + +The types and names here are a fairly faithful representation of the components described in the spec. + +- [`URI`][URI] is for absolutely specified URIs that can also have path, query, and fragment (hash) parts. +- [`AbsoluteURI`][AbsoluteURI] is a variation on `URI` that drops the ability for the URI to carry a fragment. +- [`RelativeRef`][RelativeRef] is for relatively specified URIs that can also have path, query, and fragment (hash) parts. +- [`URIRef`][URIRef] is combination of `URI` and `RelativeRef`, allowing the full range of representable URIs. + +The absolute/relative terminology when applied to URIs does not relate to the paths that a URI may carry, it refers to whether the URI has a "scheme" or not. For example `http://example.com` and `file://../test.txt` are absolute URIs but `//example.com` and `/test.txt` are relative. + +Assuming none of the `unsafe`-prefixed functions are used when constructing a URI, it should be impossible to construct a URI that is invalid using the types this library provides*. The slight downside of this is the data structures are relatively complex so as to only admit correct possibilities. + +\* Actually, there is one exception to that - `IPv6Address` is far too forgiving in what it allows currently. Contributions welcome! + +### URI component representations + +Due to the differing needs of users of this library, the URI types are all parameterised to allow for custom representations to be used for parts of the URI. Take a look at the most heavily parametrised type, `URIRef`: + +``` purescript +type URIRef userInfo hosts path hierPath relPath query fragment = ... +``` + +This allows us to provide hooks into the parsing and printing processes for a URI, so that types better suited to the intended use case can be used. + +Taking `userInfo` as an example, according to the spec, the `user-info` part of an authority is just an arbitrary string of characters terminated by an `@` before a hostname. An extremely common usage for this is the `user:password` scheme, so by leaving the choice of representation as a type variable we can switch it out for a type specifically designed to handle that (this library includes one actually, under [`URI.Extra.UserPassInfo`][UserPassInfo]). + +### App-specific URI type definitions + +When using this library, you'll probably want to define type synonyms for the URIs that make sense for your use case. A URI type that uses the simple representations for each component will look something like this: + +``` purescript +type MyURI = URIRef UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment +``` + +Along with these types, you'll want to define an options record that specifies how to parse and print URIs that look like this: + +``` purescript +options ∷ Record (URIRefOptions UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) +options = + { parseUserInfo: pure + , printUserInfo: id + , parseHosts: HostPortPair.parser pure pure + , printHosts: HostPortPair.print id id + , parsePath: pure + , printPath: id + , parseHierPath: pure + , printHierPath: id + , parseRelPath: pure + , printRelPath: id + , parseQuery: pure + , printQuery: id + , parseFragment: pure + , printFragment: id + } +``` + +As you can see by all the `pure` and `id`, we're not doing a whole lot here. `parseHosts` is a bit of an exception, but that's just due to the way that case is handled (see [later in this README](#host-parsing) for more details about that). + +These types ([`UserInfo`][UserInfo], [`HostPortPair`][HostPortPair], [`Host`][Host], etc.) are all provided by the library, and where necessary can only be constructed via smart constructor. This ensures that percent-encoding is applied to characters where necessary to ensure the constructed values will print as valid URIs, and so on. + +If we decided that we wanted to support `user:password` style user-info, we'd modify this by changing our type to use [`UserPassInfo`][UserPassInfo]: + +``` purescript +type MyURI = URIRef UserPassInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment +``` + +And update our options to use the appropriate parse/print functions accordingly: + +``` purescript +options ∷ Record (URIRefOptions UserPassInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) +options = + { parseUserInfo: UserPassInfo.parse + , printUserInfo: UserPassInfo.print + , ... +``` + +### Writing custom component types + +These `parse/print` functions all share much the same shape of signature. For the case in the previous example, they come out as: + +``` purescript +parseUserInfo ∷ UserInfo → Either URIPartParseError UserPassInfo +printUserInfo ∷ UserPassInfo → UserInfo +``` + +So you can see that for each component, when the options hooks/custom representation stuff is used, we take one of these library-provided component types and parse it into our new representation, and also print it back to that simple type later. + +Each of the library-provided component types have a `toString` function that extracts the inner value as a string after applying percent-decoding, and an `unsafeToString` that provides exactly the value that was parsed, preserving percent decoding. Similarly, there's a `fromString` that performs the minimal amount of required percent encoding for that part of the URI, and an `unsafeFromString` that performs no encoding at all. + +You may ask why it's ever useful to have access to the encoded values, or to be able to print without encoding, so here's a motivating example: + +For the [`UserPassInfo`][UserPassInfo] example, the typical way of encoding a username or password that contains a colon within it is to use `%3A` (`us:er` becomes `us%3Aer`). This allows colons-within-the-values to be recongised as independent from the colon-separating-username-and-password (`us%3Aer:password`). + +According to the spec it is not a requirement to encode colons in this part of the URI scheme, so just using [`toString`][UserInfo.toString] on `us:er` will get us back a `us:er`, resulting in `us:er:password`, so we'd have no way of knowing where the user ends and where the password starts. + +The solution when printing is to do some custom encoding that also replaces `:` with `%3A` for the user/password parts, and then joins them with the unencoded `:` afterwards. If we constructed the resulting [`UserInfo`][UserInfo] value with [`fromString`][UserInfo.fromString] it would re-encode our already encoded user/password parts (giving us `%253A` instead of `%3A`), so we use [`unsafeFromString`][UserInfo.unsafeFromString] since we've done the encoding ourselves. + +Similarly, when parsing these values back, we want to split on `:` and then percent-decode the user/password parts individually, so we need to use [`unsafeToString`][UserInfo.unsafeToString] to ensure we get the encoded version. + +Another example where this sort of thing might be useful is if you would like to encode/decode spaces in paths as `+` rather than `%20`. Having the ability to hook into the parse/print stage and choose to examine or print with or without percent encoding/decoding applied gives us the flexibility to produce and consume values exactly as we want, rather than the library attempting to know best in all cases. + +### Host parsing + +The host printing/parsing setup is a little different. This is to accommodate something that lies outside of the RFC 3986 spec: multiple host definitions within a URI. The motivating case for this is things like connection strings for MongoDB, where host/port pairs can be defined separated by commas within a single URI: + +``` +mongodb://db1.example.net:27017,db2.example.net:2500/?replicaSet=test +``` + +This doesn't jive with what is said in RFC 3986, as there a comma is allowed as part of a hostname, but the multiple ports don't fit into the schema. To get around this, when it comes to parsing hosts, the parsing is entirely handed over to the `parseHosts` parser in the options (in the cases for the other parameters, a normal function is run on a value that has been parsed according to the spec already). + +For normal URIs the [`HostPortPair`][HostPortPair] parser/printer should serve well enough. This accepts functions to deal with the host/port parts allowing for those aspects to be dealt with much like all the other options. + +For URIs that are like the MongoDB connection string, this library provides [`URI.Extra.MultiHostPortPair`][MultiHostPortPair]. Given that both of these allow for custom `Host` / `Port` types, hopefully nobody else will need to write anything for the general host-section-parsing part! + +## Further documentation + +[The tests](test/) contain many examples of URI constructions using the basic types this library provides. Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-uri). + +[AbsoluteURI]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.AbsoluteURI +[Host]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.Host +[HostPortPair]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.HostPortPair +[MultiHostPortPair]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.Extra.MultiHostPortPair +[RelativeRef]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.RelativeRef +[URI]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.URI +[URIRef]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.URIRef +[UserInfo.fromString]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo#v:fromString +[UserInfo.toString]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo#v:toString +[UserInfo.unsafeFromString]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo#v:unsafeFromString +[UserInfo.unsafeToString]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo#v:unsafeToString +[UserInfo]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.UserInfo +[UserPassInfo]: https://pursuit.purescript.org/packages/purescript-uri/docs/URI.Extra.UserPassInfo From c6b8ceccbfe0722fdf7594ee207952e489c77c96 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 13:39:40 +0000 Subject: [PATCH 34/69] Add doc comments for Scheme / use NES internally --- src/URI/Scheme.purs | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/src/URI/Scheme.purs b/src/URI/Scheme.purs index 1bdae04..027ad0c 100644 --- a/src/URI/Scheme.purs +++ b/src/URI/Scheme.purs @@ -13,36 +13,57 @@ import Data.Array as Array import Data.Either (hush) import Data.Maybe (Maybe(..)) import Data.String as String +import Data.String.NonEmpty (NonEmptyString) +import Data.String.NonEmpty as NES import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, runParser) import Text.Parsing.Parser.String (char) import URI.Common (alpha, alphaNum) -- | The scheme part of an absolute URI. For example: `http`, `ftp`, `git`. -newtype Scheme = Scheme String +newtype Scheme = Scheme NonEmptyString derive newtype instance eqScheme ∷ Eq Scheme derive newtype instance ordScheme ∷ Ord Scheme instance showScheme ∷ Show Scheme where - show (Scheme s) = "(Scheme.unsafeFromString " <> show s <> ")" + show (Scheme s) = "(Scheme.unsafeFromString " <> show (NES.toString s) <> ")" +-- | Attempts to create a `Scheme` from the passed string. The scheme component +-- | of a URI has no escape sequences, so this function will return `Nothing` +-- | if an invalid value is provided. +-- | +-- | ``` purescript +-- | fromString "http" == Just (Scheme.unsafeFromString "http") +-- | fromString "git+ssh" == Just (Scheme.unsafeFromString "git+ssh") +-- | fromString "!!!" == Nothing +-- | fromString "" == Nothing +-- | ``` fromString ∷ String → Maybe Scheme fromString = map Scheme <<< hush <<< flip runParser parseScheme +-- | Constructs a `Scheme` part unsafely: if the value is not an acceptable +-- | scheme a runtime error will be thrown. +-- | +-- | This is intended as a convenience when describing `Scheme`s statically in +-- | PureScript code, in all other cases `fromString` should be used. unsafeFromString ∷ String → Scheme unsafeFromString s = case fromString s of - Nothing → unsafeCrashWith $ "Got invalid scheme in unsafeFromString : `" <> show s <> "`" Just s' → s' + Nothing → unsafeCrashWith $ "Scheme value is invalid: `" <> show s <> "`" +-- | A parser for the scheme component of a URI. Expects a scheme string +-- | followed by `':'`. parser ∷ Parser String Scheme parser = Scheme <$> parseScheme <* char ':' -parseScheme ∷ Parser String String +parseScheme ∷ Parser String NonEmptyString parseScheme = do init ← alpha rest ← Array.many (alphaNum <|> char '+' <|> char '-' <|> char '.') - pure $ String.singleton init <> String.fromCharArray rest + pure $ NES.singleton init `NES.appendString` String.fromCharArray rest +-- | A printer for the scheme component of a URI. Prints a scheme value +-- | followed by a `':'`. print ∷ Scheme → String -print (Scheme s) = s <> ":" +print (Scheme s) = NES.toString s <> ":" From e26df370ab59a4852116bd3326a176f78abe68a3 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 14:12:00 +0000 Subject: [PATCH 35/69] Use NES for UserInfo internally, decouple parser composition --- src/URI/Authority.purs | 6 ++-- src/URI/Common.purs | 15 +++++++++- src/URI/Extra/UserPassInfo.purs | 39 +++++++++++++----------- src/URI/UserInfo.purs | 43 ++++++++++++++++----------- test/URI/Authority.purs | 12 ++++---- test/URI/Extra/MultiHostPortPair.purs | 38 +++++++++++------------ test/URI/Extra/UserPassInfo.purs | 14 ++++----- test/URI/URIRef.purs | 12 ++++---- test/URI/UserInfo.purs | 12 ++++---- test/Util.purs | 6 ++++ 10 files changed, 113 insertions(+), 84 deletions(-) diff --git a/src/URI/Authority.purs b/src/URI/Authority.purs index 0a6dd51..1bfd518 100644 --- a/src/URI/Authority.purs +++ b/src/URI/Authority.purs @@ -24,7 +24,7 @@ import Data.Maybe (Maybe(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe, try) import Text.Parsing.Parser.String (char, string) -import URI.Common (URIPartParseError) +import URI.Common (URIPartParseError, wrapParser) import URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) import URI.Port (Port) import URI.UserInfo (UserInfo) @@ -67,7 +67,7 @@ parser → Parser String (Authority userInfo hosts) parser opts = do _ ← string "//" - ui ← optionMaybe $ try (UserInfo.parser opts.parseUserInfo <* char '@') + ui ← optionMaybe $ try (wrapParser opts.parseUserInfo UserInfo.parser <* char '@') hosts ← opts.parseHosts pure $ Authority ui hosts @@ -77,7 +77,7 @@ print → Authority userInfo hosts → String print opts (Authority mui hs) = case mui of - Just ui → "//" <> UserInfo.print opts.printUserInfo ui <> "@" <> opts.printHosts hs + Just ui → "//" <> UserInfo.print (opts.printUserInfo ui) <> "@" <> opts.printHosts hs Nothing → "//" <> opts.printHosts hs _userInfo diff --git a/src/URI/Common.purs b/src/URI/Common.purs index af931e5..d2e154e 100644 --- a/src/URI/Common.purs +++ b/src/URI/Common.purs @@ -9,6 +9,8 @@ module URI.Common , pctEncoded , parseSubDelims , printEncoded + , printEncoded' + , decodeURIComponent' ) where import Prelude @@ -22,7 +24,10 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Newtype (class Newtype, un) import Data.String as String -import Global (encodeURIComponent) +import Data.String.NonEmpty (NonEmptyString) +import Data.String.NonEmpty as NES +import Global (decodeURIComponent, encodeURIComponent) +import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (ParseError(..), ParseState(..), Parser, ParserT(..), runParser) import Text.Parsing.Parser.String (anyChar, char, eof, oneOf, satisfy) @@ -82,3 +87,11 @@ printEncoded p s = either (const s) id (runParser s parse) simpleChar = String.singleton <$> p encodedChar ∷ Parser String String encodedChar = encodeURIComponent <<< String.singleton <$> anyChar + +printEncoded' ∷ Parser String Char → NonEmptyString → NonEmptyString +printEncoded' p = + unsafePartial NES.unsafeFromString <<< printEncoded p <<< NES.toString + +decodeURIComponent' ∷ NonEmptyString → NonEmptyString +decodeURIComponent' = + unsafePartial NES.unsafeFromString <<< decodeURIComponent <<< NES.toString diff --git a/src/URI/Extra/UserPassInfo.purs b/src/URI/Extra/UserPassInfo.purs index f21497c..5cf8c84 100644 --- a/src/URI/Extra/UserPassInfo.purs +++ b/src/URI/Extra/UserPassInfo.purs @@ -7,16 +7,17 @@ module URI.Extra.UserPassInfo import Prelude import Control.Alt ((<|>)) -import Data.Either (Either) +import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.String as String -import Global (decodeURIComponent) +import Data.String.NonEmpty (NonEmptyString) +import Data.String.NonEmpty as NES import Text.Parsing.Parser (Parser) -import URI.Common (parseSubDelims, parseUnreserved, printEncoded) +import URI.Common (URIPartParseError(..), decodeURIComponent', parseSubDelims, parseUnreserved, printEncoded') import URI.UserInfo (UserInfo) import URI.UserInfo as UserInfo -newtype UserPassInfo = UserPassInfo { user ∷ String, password ∷ Maybe String } +newtype UserPassInfo = UserPassInfo { user ∷ NonEmptyString, password ∷ Maybe NonEmptyString } derive instance eqUserPassInfo ∷ Eq UserPassInfo derive instance ordUserPassInfo ∷ Ord UserPassInfo @@ -25,29 +26,33 @@ instance showUserPassInfo ∷ Show UserPassInfo where show (UserPassInfo { user, password }) = "(UserPassInfo { user: " <> show user <> ", password: " <> show password <> "})" -parse ∷ ∀ e. UserInfo → Either e UserPassInfo +parse ∷ UserInfo → Either URIPartParseError UserPassInfo parse ui = let s = UserInfo.unsafeToString ui in - pure $ UserPassInfo - case flip String.splitAt s =<< String.indexOf (String.Pattern ":") s of - Just { before, after } → - { user: decodeURIComponent before - , password: Just (decodeURIComponent (String.drop 1 after)) - } - Nothing → - { user: decodeURIComponent s, password: Nothing } + case flip NES.splitAt s =<< NES.indexOf (String.Pattern ":") s of + Just { before: Nothing } → + Left (URIPartParseError "Expected a username before a password segment") + Just { before: Just before, after: Just after } → + Right $ UserPassInfo + { user: decodeURIComponent' before + , password: decodeURIComponent' <$> NES.drop 1 after + } + _ → + Right $ UserPassInfo + { user: decodeURIComponent' s, password: Nothing } print ∷ UserPassInfo → UserInfo print (UserPassInfo { user, password }) = case password of Nothing → - UserInfo.unsafeFromString (printEncoded userPassInfoChar user) + UserInfo.unsafeFromString (printEncoded' userPassInfoChar user) Just p → - UserInfo.unsafeFromString (printEncoded userPassInfoChar user) - <> UserInfo.unsafeFromString ":" - <> UserInfo.unsafeFromString (printEncoded userPassInfoChar p) + UserInfo.unsafeFromString + $ printEncoded' userPassInfoChar user + <> NES.singleton ':' + <> printEncoded' userPassInfoChar p userPassInfoChar ∷ Parser String Char userPassInfoChar = parseUnreserved <|> parseSubDelims diff --git a/src/URI/UserInfo.purs b/src/URI/UserInfo.purs index 8691a81..2661957 100644 --- a/src/URI/UserInfo.purs +++ b/src/URI/UserInfo.purs @@ -12,21 +12,25 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Either (Either) -import Data.Monoid (class Monoid) import Data.String as String +import Data.String.NonEmpty (NonEmptyString) +import Data.String.NonEmpty as NES import Global (decodeURIComponent) +import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) +import URI.Common (parseSubDelims, parseUnreserved, pctEncoded, printEncoded) -- | The user info part of an `Authority`. For example: `user`, `foo:bar`. -newtype UserInfo = UserInfo String +-- | +-- | This type treats the entire string as an undifferentiated blob, if you +-- | would like to specifically deal with the `user:password` format, take a +-- | look at `URI.Extra.UserPassInfo`. +newtype UserInfo = UserInfo NonEmptyString derive newtype instance eqUserInfo ∷ Eq UserInfo derive newtype instance ordUserInfo ∷ Ord UserInfo derive newtype instance semigroupUserInfo ∷ Semigroup UserInfo -derive newtype instance monoidUserInfo ∷ Monoid UserInfo instance showUserInfo ∷ Show UserInfo where show (UserInfo s) = "(UserInfo.unsafeFromString " <> show s <> ")" @@ -34,18 +38,18 @@ instance showUserInfo ∷ Show UserInfo where -- | Constructs a `UserInfo` part safely: percent-encoding will be -- | applied to any character that requires it for the user-info component of a -- | URI. -fromString ∷ String → UserInfo -fromString = UserInfo <<< printEncoded userInfoChar +fromString ∷ NonEmptyString → UserInfo +fromString = UserInfo <<< nes <<< printEncoded userInfoChar <<< NES.toString --- | Prints `UserInfo` as a string, decoding any percent-encoded --- | characters contained within. -toString ∷ UserInfo → String -toString (UserInfo s) = decodeURIComponent s +-- | Prints `UserInfo` as a string, decoding any percent-encoded characters +-- | contained within. +toString ∷ UserInfo → NonEmptyString +toString (UserInfo s) = nes (decodeURIComponent (NES.toString s)) -- | Constructs a `UserInfo` part unsafely: no encoding will be applied -- | to the value. If an incorrect value is provided, the URI will be invalid -- | when printed back. -unsafeFromString ∷ String → UserInfo +unsafeFromString ∷ NonEmptyString → UserInfo unsafeFromString = UserInfo -- | Prints `UserInfo` as a string without performing any decoding of @@ -53,18 +57,23 @@ unsafeFromString = UserInfo -- | produces will need further decoding, the name is more for symmetry with -- | the `fromString`/`toString` and `unsafeFromString`/`unsafeToString` -- | pairings. -unsafeToString ∷ UserInfo → String +unsafeToString ∷ UserInfo → NonEmptyString unsafeToString (UserInfo s) = s -parser ∷ ∀ ui. (UserInfo → Either URIPartParseError ui) → Parser String ui -parser p = wrapParser p (UserInfo <<< String.joinWith "" <$> Array.some parse) +-- | A parser for the `UserInfo` part of a URI. +parser ∷ Parser String UserInfo +parser = UserInfo <<< nes <<< String.joinWith "" <$> Array.some parse where parse ∷ Parser String String parse = String.singleton <$> userInfoChar <|> pctEncoded -print ∷ ∀ ui. (ui → UserInfo) → ui → String -print = map unsafeToString +-- | A printer for the `UserInfo` part of a URI. +print ∷ UserInfo → String +print = NES.toString <<< unsafeToString -- | The supported user info characters, excluding percent-encodings. userInfoChar ∷ Parser String Char userInfoChar = parseUnreserved <|> parseSubDelims <|> char ':' + +nes ∷ String → NonEmptyString +nes = unsafePartial NES.unsafeFromString diff --git a/test/URI/Authority.purs b/test/URI/Authority.purs index 8007bed..7e009e1 100644 --- a/test/URI/Authority.purs +++ b/test/URI/Authority.purs @@ -3,11 +3,9 @@ module Test.URI.Authority where import Prelude import Data.Maybe (Maybe(..)) -import Data.String.NonEmpty as NES import Data.These (These(..)) -import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) -import Test.Util (testIso) +import Test.Util (nes, testIso) import URI.Authority (Authority(..), AuthorityOptions, Host(..), Port, UserInfo) import URI.Authority as Authority import URI.Host.RegName as RegName @@ -25,21 +23,21 @@ spec = "//localhost" (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString (nes "localhost")))))) testIso (Authority.parser options) (Authority.print options) "//localhost:3000" (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) + (Just (Both (NameAddress (RegName.unsafeFromString (nes "localhost"))) (Port.unsafeFromInt 3000)))) testIso (Authority.parser options) (Authority.print options) "//user@localhost:3000" (Authority - (Just (UserInfo.unsafeFromString "user")) - (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 3000)))) + (Just (UserInfo.unsafeFromString (nes "user"))) + (Just (Both (NameAddress (RegName.unsafeFromString (nes "localhost"))) (Port.unsafeFromInt 3000)))) testIso (Authority.parser options) (Authority.print options) diff --git a/test/URI/Extra/MultiHostPortPair.purs b/test/URI/Extra/MultiHostPortPair.purs index 6cdd30b..a728e8c 100644 --- a/test/URI/Extra/MultiHostPortPair.purs +++ b/test/URI/Extra/MultiHostPortPair.purs @@ -4,11 +4,9 @@ import Prelude import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) -import Data.String.NonEmpty as NES import Data.These (These(..)) -import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) -import Test.Util (testIso) +import Test.Util (nes, testIso) import URI.Authority (Authority(..), Host(..), Port, UserInfo) import URI.Authority as Authority import URI.Extra.MultiHostPortPair (MultiHostPortPair) @@ -32,8 +30,8 @@ spec = do "//mongo-1,mongo-2" (Authority Nothing - [ This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) - , This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) + [ This (NameAddress (RegName.unsafeFromString $ nes "mongo-1")) + , This (NameAddress (RegName.unsafeFromString $ nes "mongo-2")) ]) testIso (Authority.parser options) @@ -41,8 +39,8 @@ spec = do "//mongo-1:2000,mongo-2:3000" (Authority Nothing - [ Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) - , Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) + [ Both (NameAddress (RegName.unsafeFromString $ nes "mongo-1")) (Port.unsafeFromInt 2000) + , Both (NameAddress (RegName.unsafeFromString $ nes "mongo-2")) (Port.unsafeFromInt 3000) ]) testIso (Authority.parser options) @@ -50,8 +48,8 @@ spec = do "//mongo-1:2000,mongo-2" (Authority Nothing - [ Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) (Port.unsafeFromInt 2000) - , This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) + [ Both (NameAddress (RegName.unsafeFromString $ nes "mongo-1")) (Port.unsafeFromInt 2000) + , This (NameAddress (RegName.unsafeFromString $ nes "mongo-2")) ]) testIso (Authority.parser options) @@ -59,8 +57,8 @@ spec = do "//mongo-1,mongo-2:3000" (Authority Nothing - [ This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) - , Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) (Port.unsafeFromInt 3000) + [ This (NameAddress (RegName.unsafeFromString $ nes "mongo-1")) + , Both (NameAddress (RegName.unsafeFromString $ nes "mongo-2")) (Port.unsafeFromInt 3000) ]) testIso (Authority.parser options) @@ -76,9 +74,9 @@ spec = do (Authority.print options) "//user@mongo-1,mongo-2" (Authority - (Just (UserInfo.unsafeFromString "user")) - [ This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-1")) - , This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "mongo-2")) + (Just (UserInfo.unsafeFromString (nes "user"))) + [ This (NameAddress (RegName.unsafeFromString $ nes "mongo-1")) + , This (NameAddress (RegName.unsafeFromString $ nes "mongo-2")) ]) describe "URIRef+MultiHostPortPair parser/printer" do testIso @@ -90,9 +88,9 @@ spec = do (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority - (Just (UserInfo.unsafeFromString "foo:bar")) - [ This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "db1.example.net")) - , Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) + (Just (UserInfo.unsafeFromString (nes "foo:bar"))) + [ This (NameAddress (RegName.unsafeFromString $ nes "db1.example.net")) + , Both (NameAddress (RegName.unsafeFromString $ nes "db2.example.net")) (Port.unsafeFromInt 2500) ]) (path ["authdb"])) (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) @@ -106,9 +104,9 @@ spec = do (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority - (Just (UserInfo.unsafeFromString "foo:bar")) - [ Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "db1.example.net")) (Port.unsafeFromInt 6) - , Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "db2.example.net")) (Port.unsafeFromInt 2500) + (Just (UserInfo.unsafeFromString (nes "foo:bar"))) + [ Both (NameAddress (RegName.unsafeFromString $ nes "db1.example.net")) (Port.unsafeFromInt 6) + , Both (NameAddress (RegName.unsafeFromString $ nes "db2.example.net")) (Port.unsafeFromInt 2500) ]) (path ["authdb"])) (Just (Query.unsafeFromString "replicaSet=test&connectTimeoutMS=300000")) diff --git a/test/URI/Extra/UserPassInfo.purs b/test/URI/Extra/UserPassInfo.purs index d3794fc..4f45150 100644 --- a/test/URI/Extra/UserPassInfo.purs +++ b/test/URI/Extra/UserPassInfo.purs @@ -7,7 +7,7 @@ import Data.String.NonEmpty as NES import Data.These (These(..)) import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) -import Test.Util (testIso) +import Test.Util (nes, testIso) import URI.Authority (Authority(..), Host(..), Port) import URI.Authority as Authority import URI.Extra.UserPassInfo (UserPassInfo(..)) @@ -25,42 +25,42 @@ spec = do (Authority.print options) "//user@host" (Authority - (Just (UserPassInfo { user: "user", password: Nothing })) + (Just (UserPassInfo { user: nes "user", password: Nothing })) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//user:pass@host" (Authority - (Just (UserPassInfo { user: "user", password: Just "pass" })) + (Just (UserPassInfo { user: nes "user", password: Just (nes "pass") })) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//user:pa%3Ass@host" (Authority - (Just (UserPassInfo { user: "user", password: Just "pa:ss" })) + (Just (UserPassInfo { user: nes "user", password: Just (nes "pa:ss") })) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//us%3Aer:pa%3Ass@host" (Authority - (Just (UserPassInfo { user: "us:er", password: Just "pa:ss" })) + (Just (UserPassInfo { user: nes "us:er", password: Just (nes "pa:ss") })) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//us%3Aer:pa%3Ass@host" (Authority - (Just (UserPassInfo { user: "us:er", password: Just "pa:ss" })) + (Just (UserPassInfo { user: nes "us:er", password: Just (nes "pa:ss") })) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) testIso (Authority.parser options) (Authority.print options) "//user:p%40ss@host" (Authority - (Just (UserPassInfo { user: "user", password: Just "p@ss" })) + (Just (UserPassInfo { user: nes "user", password: Just (nes "p@ss") })) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) options ∷ Record (URIRefOptions UserPassInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index ce78ee6..0ff68ce 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -9,7 +9,7 @@ import Data.These (These(..)) import Data.Tuple (Tuple(..)) import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) -import Test.Util (testIso) +import Test.Util (nes, testIso) import URI.Fragment as Fragment import URI.Host.IPv4Address as IPv4Address import URI.Host.IPv6Address as IPv6Address @@ -134,7 +134,7 @@ spec = (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority - (Just (UserInfo.unsafeFromString "sysop:moon")) + (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) Nothing) Nothing @@ -148,7 +148,7 @@ spec = (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority - (Just (UserInfo.unsafeFromString "sysop:moon")) + (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) (path [""])) Nothing @@ -162,7 +162,7 @@ spec = (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority - (Just (UserInfo.unsafeFromString "sysop:moon")) + (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) (path ["records"])) Nothing @@ -176,7 +176,7 @@ spec = (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority - (Just (UserInfo.unsafeFromString "sysop:moon")) + (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) (path ["records", "etc", ""])) Nothing @@ -330,7 +330,7 @@ spec = (Scheme.unsafeFromString "ftp") (HierarchicalPartAuth (Authority - (Just (UserInfo.unsafeFromString "cnn.example.com&story=breaking_news")) + (Just (UserInfo.unsafeFromString (nes "cnn.example.com&story=breaking_news"))) (Just (This (IPv4Address (IPv4Address.unsafeFromInts 10 0 0 1))))) (path ["top_story.htm"])) Nothing diff --git a/test/URI/UserInfo.purs b/test/URI/UserInfo.purs index 9cd489b..ac60c87 100644 --- a/test/URI/UserInfo.purs +++ b/test/URI/UserInfo.purs @@ -3,14 +3,14 @@ module Test.URI.UserInfo where import Prelude import Test.Spec (Spec, describe) -import Test.Util (testIso) +import Test.Util (nes, testIso) import URI.UserInfo as UserInfo spec ∷ ∀ eff. Spec eff Unit spec = describe "UserInfo parser/printer" do - testIso (UserInfo.parser pure) (UserInfo.print id) "user" (UserInfo.fromString "user") - testIso (UserInfo.parser pure) (UserInfo.print id) "spaced%20user" (UserInfo.fromString "spaced user") - testIso (UserInfo.parser pure) (UserInfo.print id) "user:password" (UserInfo.fromString "user:password") - testIso (UserInfo.parser pure) (UserInfo.print id) "spaced%20user:password%25%C2%A3" (UserInfo.fromString "spaced user:password%£") - testIso (UserInfo.parser pure) (UserInfo.print id) "a:b:c" (UserInfo.fromString "a:b:c") + testIso UserInfo.parser UserInfo.print "user" (UserInfo.fromString (nes "user")) + testIso UserInfo.parser UserInfo.print "spaced%20user" (UserInfo.fromString (nes "spaced user")) + testIso UserInfo.parser UserInfo.print "user:password" (UserInfo.fromString (nes "user:password")) + testIso UserInfo.parser UserInfo.print "spaced%20user:password%25%C2%A3" (UserInfo.fromString (nes "spaced user:password%£")) + testIso UserInfo.parser UserInfo.print "a:b:c" (UserInfo.fromString (nes "a:b:c")) diff --git a/test/Util.purs b/test/Util.purs index 662ced3..41143ca 100644 --- a/test/Util.purs +++ b/test/Util.purs @@ -8,6 +8,9 @@ import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) import Data.Either (Either(..)) +import Data.String.NonEmpty (NonEmptyString) +import Data.String.NonEmpty as NES +import Partial.Unsafe (unsafePartial) import Test.QuickCheck as QC import Test.QuickCheck.Gen as QCG import Test.Spec (Spec, it) @@ -45,3 +48,6 @@ forAll = quickCheck quickCheck ∷ ∀ eff prop. QC.Testable prop ⇒ prop → Aff (TestEffects eff) Unit quickCheck = liftEff <<< QC.quickCheck' 100 + +nes ∷ String → NonEmptyString +nes = unsafePartial NES.unsafeFromString From c4323ccf9aca657576ffdfaa9109732016700dd5 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 14:24:38 +0000 Subject: [PATCH 36/69] Decouple parser composition from component parsers --- src/URI/AbsoluteURI.purs | 4 ++-- src/URI/Extra/MultiHostPortPair.purs | 2 +- src/URI/Fragment.purs | 9 ++++----- src/URI/HierarchicalPart.purs | 8 ++++---- src/URI/Host.purs | 12 +++++------- src/URI/HostPortPair.purs | 6 +++--- src/URI/Path.purs | 6 ++---- src/URI/Path/Absolute.purs | 6 ++---- src/URI/Path/NoScheme.purs | 6 ++---- src/URI/Path/Rootless.purs | 6 ++---- src/URI/Port.purs | 7 +++---- src/URI/Query.purs | 12 +++++------- src/URI/RelativePart.purs | 8 ++++---- src/URI/RelativeRef.purs | 6 +++--- src/URI/URI.purs | 6 +++--- test/URI/Extra/QueryPairs.purs | 3 ++- test/URI/Fragment.purs | 8 ++++---- test/URI/Host.purs | 14 +++++++------- test/URI/Path.purs | 2 +- test/URI/Port.purs | 6 +++--- 20 files changed, 62 insertions(+), 75 deletions(-) diff --git a/src/URI/AbsoluteURI.purs b/src/URI/AbsoluteURI.purs index e9e4c71..d08f152 100644 --- a/src/URI/AbsoluteURI.purs +++ b/src/URI/AbsoluteURI.purs @@ -25,7 +25,7 @@ import Data.String as String import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) -import URI.Common (URIPartParseError) +import URI.Common (URIPartParseError, wrapParser) import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) import URI.HierarchicalPart as HPart import URI.Query (Query) @@ -70,7 +70,7 @@ parser parser opts = AbsoluteURI <$> Scheme.parser <*> HPart.parser opts - <*> optionMaybe (Query.parser opts.parseQuery) + <*> optionMaybe (wrapParser opts.parseQuery Query.parser) <* eof print diff --git a/src/URI/Extra/MultiHostPortPair.purs b/src/URI/Extra/MultiHostPortPair.purs index 610bdf7..8f5a0cf 100644 --- a/src/URI/Extra/MultiHostPortPair.purs +++ b/src/URI/Extra/MultiHostPortPair.purs @@ -47,7 +47,7 @@ parsePair → Parser String (These host port) parsePair parseHost parsePort = do mh ← optionMaybe (parseHost' parseHost) - mp ← optionMaybe (Port.parser parsePort) + mp ← optionMaybe (wrapParser parsePort Port.parser) case mh, mp of Just h, Nothing → pure (This h) Nothing, Just p → pure (That p) diff --git a/src/URI/Fragment.purs b/src/URI/Fragment.purs index 9475a1c..43b9ef8 100644 --- a/src/URI/Fragment.purs +++ b/src/URI/Fragment.purs @@ -12,13 +12,12 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Either (Either) import Data.Monoid (class Monoid) import Data.String as String import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) +import URI.Common (parseSubDelims, parseUnreserved, pctEncoded, printEncoded) -- | The hash fragment of a URI. newtype Fragment = Fragment String @@ -43,10 +42,10 @@ unsafeFromString = Fragment unsafeToString ∷ Fragment → String unsafeToString (Fragment s) = s -parser ∷ ∀ f. (Fragment → Either URIPartParseError f) → Parser String f -parser parseF = +parser ∷ Parser String Fragment +parser = char '#' *> - wrapParser parseF (Fragment <<< String.joinWith "" + (Fragment <<< String.joinWith "" <$> Array.many (pctEncoded <|> String.singleton <$> fragmentChar)) print ∷ Fragment → String diff --git a/src/URI/HierarchicalPart.purs b/src/URI/HierarchicalPart.purs index 6e41f23..448845b 100644 --- a/src/URI/HierarchicalPart.purs +++ b/src/URI/HierarchicalPart.purs @@ -29,7 +29,7 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import URI.Authority as Authority -import URI.Common (URIPartParseError) +import URI.Common (URIPartParseError, wrapParser) import URI.Path (Path(..)) import URI.Path as Path import URI.Path.Absolute (PathAbsolute(..)) @@ -78,12 +78,12 @@ parser opts = withAuth <|> withoutAuth withAuth = HierarchicalPartAuth <$> Authority.parser opts - <*> optionMaybe (Path.parser opts.parsePath) + <*> optionMaybe (wrapParser opts.parsePath Path.parser) withoutAuth = HierarchicalPartNoAuth <$> noAuthPath noAuthPath - = (Just <$> PathAbs.parse (opts.parseHierPath <<< Left)) - <|> (Just <$> PathRootless.parse (opts.parseHierPath <<< Right)) + = (Just <$> wrapParser (opts.parseHierPath <<< Left) PathAbs.parse) + <|> (Just <$> wrapParser (opts.parseHierPath <<< Right) PathRootless.parse) <|> pure Nothing print diff --git a/src/URI/Host.purs b/src/URI/Host.purs index b374d6f..999d5fe 100644 --- a/src/URI/Host.purs +++ b/src/URI/Host.purs @@ -13,14 +13,12 @@ module URI.Host import Prelude import Control.Alt ((<|>)) -import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Prism', prism') import Data.Maybe (Maybe(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) -import URI.Common (URIPartParseError, wrapParser) import URI.Host.IPv4Address (IPv4Address) import URI.Host.IPv4Address as IPv4Address import URI.Host.IPv6Address (IPv6Address) @@ -39,11 +37,11 @@ derive instance ordHost ∷ Ord Host derive instance genericHost ∷ Generic Host _ instance showHost ∷ Show Host where show = genericShow -parser ∷ ∀ h. (Host → Either URIPartParseError h) → Parser String h -parser p = wrapParser p - $ (IPv6Address <$> IPv6Address.parser) - <|> try (IPv4Address <$> IPv4Address.parser) - <|> (NameAddress <$> RegName.parser) +parser ∷ Parser String Host +parser = + (IPv6Address <$> IPv6Address.parser) + <|> try (IPv4Address <$> IPv4Address.parser) + <|> (NameAddress <$> RegName.parser) print ∷ Host → String print = case _ of diff --git a/src/URI/HostPortPair.purs b/src/URI/HostPortPair.purs index 7e4ca8b..27a11f9 100644 --- a/src/URI/HostPortPair.purs +++ b/src/URI/HostPortPair.purs @@ -7,7 +7,7 @@ import Data.Maybe (Maybe(..)) import Data.These (These(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) -import URI.Common (URIPartParseError) +import URI.Common (URIPartParseError, wrapParser) import URI.Host (Host) import URI.Host as Host import URI.Port (Port) @@ -21,8 +21,8 @@ parser → (Port → Either URIPartParseError port) → Parser String (HostPortPair host port) parser parseHost parsePort = do - mh ← optionMaybe (Host.parser parseHost) - mp ← optionMaybe (Port.parser parsePort) + mh ← optionMaybe (wrapParser parseHost Host.parser) + mp ← optionMaybe (wrapParser parsePort Port.parser) pure case mh, mp of Just h, Nothing → Just (This h) Nothing, Just p → Just (That p) diff --git a/src/URI/Path.purs b/src/URI/Path.purs index 3200b8b..a77b111 100644 --- a/src/URI/Path.purs +++ b/src/URI/Path.purs @@ -3,14 +3,12 @@ module URI.Path where import Prelude import Data.Array as Array -import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Monoid (class Monoid) import Data.String as String import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (URIPartParseError, wrapParser) import URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) newtype Path = Path (Array PathSegment) @@ -22,8 +20,8 @@ derive newtype instance monoidPath ∷ Monoid Path derive instance genericPath ∷ Generic Path _ instance showPath ∷ Show Path where show = genericShow -parser ∷ ∀ p. (Path → Either URIPartParseError p) → Parser String p -parser p = wrapParser p $ Path <$> Array.some (char '/' *> parseSegment) +parser ∷ Parser String Path +parser = Path <$> Array.some (char '/' *> parseSegment) print ∷ Path → String print (Path segs) = "/" <> String.joinWith "/" (map unsafeSegmentToString segs) diff --git a/src/URI/Path/Absolute.purs b/src/URI/Path/Absolute.purs index bc7ce47..dda98c6 100644 --- a/src/URI/Path/Absolute.purs +++ b/src/URI/Path/Absolute.purs @@ -3,7 +3,6 @@ module URI.Path.Absolute where import Prelude import Data.Array as Array -import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Maybe (Maybe(..)) @@ -12,7 +11,6 @@ import Data.Tuple (Tuple(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (char) -import URI.Common (URIPartParseError, wrapParser) import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) newtype PathAbsolute = PathAbsolute (Maybe (Tuple PathSegmentNZ (Array PathSegment))) @@ -22,8 +20,8 @@ derive instance ordPathAbsolute ∷ Ord PathAbsolute derive instance genericPathAbsolute ∷ Generic PathAbsolute _ instance showPathAbsolute ∷ Show PathAbsolute where show = genericShow -parse ∷ ∀ p. (PathAbsolute → Either URIPartParseError p) → Parser String p -parse p = wrapParser p do +parse ∷ Parser String PathAbsolute +parse = do _ ← char '/' optionMaybe parseSegmentNonZero >>= case _ of Just head → diff --git a/src/URI/Path/NoScheme.purs b/src/URI/Path/NoScheme.purs index 131c442..b5a0c40 100644 --- a/src/URI/Path/NoScheme.purs +++ b/src/URI/Path/NoScheme.purs @@ -3,14 +3,12 @@ module URI.Path.NoScheme where import Prelude import Data.Array as Array -import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.String as String import Data.Tuple (Tuple(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (URIPartParseError, wrapParser) import URI.Path.Segment (PathSegment, PathSegmentNZNC, parseSegment, parseSegmentNonZeroNoColon, unsafeSegmentNZNCToString, unsafeSegmentToString) newtype PathNoScheme = PathNoScheme (Tuple PathSegmentNZNC (Array PathSegment)) @@ -20,8 +18,8 @@ derive instance ordPathNoScheme ∷ Ord PathNoScheme derive instance genericPathNoScheme ∷ Generic PathNoScheme _ instance showPathNoScheme ∷ Show PathNoScheme where show = genericShow -parse ∷ ∀ p. (PathNoScheme → Either URIPartParseError p) → Parser String p -parse p = wrapParser p do +parse ∷ Parser String PathNoScheme +parse = do head ← parseSegmentNonZeroNoColon tail ← Array.many (char '/' *> parseSegment) pure (PathNoScheme (Tuple head tail)) diff --git a/src/URI/Path/Rootless.purs b/src/URI/Path/Rootless.purs index b9727b7..2f63c9f 100644 --- a/src/URI/Path/Rootless.purs +++ b/src/URI/Path/Rootless.purs @@ -3,14 +3,12 @@ module URI.Path.Rootless where import Prelude import Data.Array as Array -import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.String as String import Data.Tuple (Tuple(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (URIPartParseError, wrapParser) import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) newtype PathRootless = PathRootless (Tuple PathSegmentNZ (Array PathSegment)) @@ -20,8 +18,8 @@ derive instance ordPathRootless ∷ Ord PathRootless derive instance genericPathRootless ∷ Generic PathRootless _ instance showPathRootless ∷ Show PathRootless where show = genericShow -parse ∷ ∀ p. (PathRootless → Either URIPartParseError p) → Parser String p -parse p = wrapParser p do +parse ∷ Parser String PathRootless +parse = do head ← parseSegmentNonZero tail ← Array.many (char '/' *> parseSegment) pure (PathRootless (Tuple head tail)) diff --git a/src/URI/Port.purs b/src/URI/Port.purs index 41a7b01..662661e 100644 --- a/src/URI/Port.purs +++ b/src/URI/Port.purs @@ -10,7 +10,6 @@ module URI.Port import Prelude import Data.Array as Array -import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Int (fromNumber) @@ -20,7 +19,7 @@ import Global (readInt) import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.String (char) -import URI.Common (URIPartParseError, digit, wrapParser) +import URI.Common (digit) newtype Port = Port Int @@ -50,8 +49,8 @@ unsafeFromInt n = Just addr → addr Nothing → unsafeCrashWith "Port was out of range" -parser ∷ ∀ p. (Port → Either URIPartParseError p) → Parser String p -parser p = wrapParser p do +parser ∷ Parser String Port +parser = do s ← String.fromCharArray <$> (char ':' *> Array.some digit) case fromNumber $ readInt 10 s of Just x → pure (Port x) diff --git a/src/URI/Query.purs b/src/URI/Query.purs index 6f39b03..9873823 100644 --- a/src/URI/Query.purs +++ b/src/URI/Query.purs @@ -12,13 +12,12 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Either (Either) import Data.Monoid (class Monoid) import Data.String as String import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (URIPartParseError, parseSubDelims, parseUnreserved, pctEncoded, printEncoded, wrapParser) +import URI.Common (parseSubDelims, parseUnreserved, pctEncoded, printEncoded) newtype Query = Query String @@ -42,12 +41,11 @@ unsafeFromString = Query unsafeToString ∷ Query → String unsafeToString (Query s) = s -parser ∷ ∀ q. (Query → Either URIPartParseError q) → Parser String q -parser parseQ = +parser ∷ Parser String Query +parser = char '?' *> - wrapParser parseQ (Query <<< String.joinWith "" <$> Array.many p) - where - p = String.singleton <$> queryChar <|> pctEncoded + (Query <<< String.joinWith "" + <$> Array.many (String.singleton <$> queryChar <|> pctEncoded)) print ∷ Query → String print (Query s) = "?" <> s diff --git a/src/URI/RelativePart.purs b/src/URI/RelativePart.purs index 0915176..3b4d803 100644 --- a/src/URI/RelativePart.purs +++ b/src/URI/RelativePart.purs @@ -29,7 +29,7 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import URI.Authority as Authority -import URI.Common (URIPartParseError) +import URI.Common (URIPartParseError, wrapParser) import URI.Path (Path) import URI.Path as Path import URI.Path.Absolute (PathAbsolute) @@ -78,12 +78,12 @@ parser opts = withAuth <|> withoutAuth withAuth = RelativePartAuth <$> Authority.parser opts - <*> optionMaybe (Path.parser opts.parsePath) + <*> optionMaybe (wrapParser opts.parsePath Path.parser) withoutAuth = RelativePartNoAuth <$> noAuthPath noAuthPath - = (Just <$> PathAbs.parse (opts.parseRelPath <<< Left)) - <|> (Just <$> PathNoScheme.parse (opts.parseRelPath <<< Right)) + = (Just <$> wrapParser (opts.parseRelPath <<< Left) PathAbs.parse) + <|> (Just <$> wrapParser (opts.parseRelPath <<< Right) PathNoScheme.parse) <|> pure Nothing print diff --git a/src/URI/RelativeRef.purs b/src/URI/RelativeRef.purs index 4a0e5e1..41b3552 100644 --- a/src/URI/RelativeRef.purs +++ b/src/URI/RelativeRef.purs @@ -25,7 +25,7 @@ import Data.String as String import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) -import URI.Common (URIPartParseError) +import URI.Common (URIPartParseError, wrapParser) import URI.Fragment (Fragment) import URI.Fragment as Fragment import URI.Query (Query) @@ -72,8 +72,8 @@ parser parser opts = RelativeRef <$> RPart.parser opts - <*> optionMaybe (Query.parser opts.parseQuery) - <*> optionMaybe (Fragment.parser opts.parseFragment) + <*> optionMaybe (wrapParser opts.parseQuery Query.parser) + <*> optionMaybe (wrapParser opts.parseFragment Fragment.parser) <* eof print diff --git a/src/URI/URI.purs b/src/URI/URI.purs index 09fffbd..79a329f 100644 --- a/src/URI/URI.purs +++ b/src/URI/URI.purs @@ -26,7 +26,7 @@ import Data.String as String import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) -import URI.Common (URIPartParseError) +import URI.Common (URIPartParseError, wrapParser) import URI.Fragment (Fragment) import URI.Fragment as Fragment import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) @@ -75,8 +75,8 @@ parser parser opts = URI <$> Scheme.parser <*> HPart.parser opts - <*> optionMaybe (Query.parser opts.parseQuery) - <*> optionMaybe (Fragment.parser opts.parseFragment) + <*> optionMaybe (wrapParser opts.parseQuery Query.parser) + <*> optionMaybe (wrapParser opts.parseFragment Fragment.parser) <* eof print diff --git a/test/URI/Extra/QueryPairs.purs b/test/URI/Extra/QueryPairs.purs index 101ee71..e9a8f5d 100644 --- a/test/URI/Extra/QueryPairs.purs +++ b/test/URI/Extra/QueryPairs.purs @@ -6,13 +6,14 @@ import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple(..)) import Test.Spec (Spec, describe) import Test.Util (testIso) +import URI.Common (wrapParser) import URI.Extra.QueryPairs as NQP import URI.Query as Query spec ∷ ∀ eff. Spec eff Unit spec = describe "QueryPairs printer/parser" do - let parser = Query.parser (NQP.parse pure pure) + let parser = wrapParser (NQP.parse pure pure) Query.parser let printer = Query.print <<< NQP.print id id testIso parser printer "?key1=value1&key2=value2&key1=value3" diff --git a/test/URI/Fragment.purs b/test/URI/Fragment.purs index dafb45c..5c3f0c2 100644 --- a/test/URI/Fragment.purs +++ b/test/URI/Fragment.purs @@ -9,7 +9,7 @@ import URI.Fragment as Fragment spec ∷ ∀ eff. Spec eff Unit spec = describe "Fragment parser/printer" do - testIso (Fragment.parser pure) Fragment.print "#" (Fragment.fromString "") - testIso (Fragment.parser pure) Fragment.print "#foo" (Fragment.fromString "foo") - testIso (Fragment.parser pure) Fragment.print "#foo%23bar" (Fragment.fromString "foo#bar") - testIso (Fragment.parser pure) Fragment.print "#foo%23bar" (Fragment.unsafeFromString "foo%23bar") + testIso Fragment.parser Fragment.print "#" (Fragment.fromString "") + testIso Fragment.parser Fragment.print "#foo" (Fragment.fromString "foo") + testIso Fragment.parser Fragment.print "#foo%23bar" (Fragment.fromString "foo#bar") + testIso Fragment.parser Fragment.print "#foo%23bar" (Fragment.unsafeFromString "foo%23bar") diff --git a/test/URI/Host.purs b/test/URI/Host.purs index 12768a2..68ae84e 100644 --- a/test/URI/Host.purs +++ b/test/URI/Host.purs @@ -25,17 +25,17 @@ spec = do forAll do ipv4 <- Host.Gen.genIPv4 let printed = IPv4Address.print ipv4 - let parsed = runParser printed (Host.parser pure) + let parsed = runParser printed Host.parser pure $ pure (IPv4Address ipv4) === parsed it "should not parse 0-lead octets as an IP address" do shouldEqual (Right (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "192.168.001.1"))) - (runParser "192.168.001.1" (Host.parser pure)) + (runParser "192.168.001.1" Host.parser) describe "Host parser/printer" do - testIso (Host.parser pure) Host.print "localhost" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) - testIso (Host.parser pure) Host.print "github.com" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "github.com")) - testIso (Host.parser pure) Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "www.multipart.domain.example.com")) - testIso (Host.parser pure) Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) - testIso (Host.parser pure) Host.print "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")) + testIso Host.parser Host.print "localhost" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) + testIso Host.parser Host.print "github.com" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "github.com")) + testIso Host.parser Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "www.multipart.domain.example.com")) + testIso Host.parser Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) + testIso Host.parser Host.print "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")) diff --git a/test/URI/Path.purs b/test/URI/Path.purs index 8bf91ce..7b56c88 100644 --- a/test/URI/Path.purs +++ b/test/URI/Path.purs @@ -11,4 +11,4 @@ import URI.Path.Segment as PathSegment spec ∷ ∀ eff. Spec eff Unit spec = describe "Path parser/printer" do - testIso (Path.parser pure) Path.print "/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23" (Path [PathSegment.segmentFromString "Пациенты# #"]) + testIso Path.parser Path.print "/%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23" (Path [PathSegment.segmentFromString "Пациенты# #"]) diff --git a/test/URI/Port.purs b/test/URI/Port.purs index 2b0d8ca..a05cebe 100644 --- a/test/URI/Port.purs +++ b/test/URI/Port.purs @@ -9,6 +9,6 @@ import URI.Port as Port spec ∷ ∀ eff. Spec eff Unit spec = describe "Port parser/printer" do - testIso (Port.parser pure) Port.print ":0" (Port.unsafeFromInt 0) - testIso (Port.parser pure) Port.print ":1234" (Port.unsafeFromInt 1234) - testIso (Port.parser pure) Port.print ":63174" (Port.unsafeFromInt 63174) + testIso Port.parser Port.print ":0" (Port.unsafeFromInt 0) + testIso Port.parser Port.print ":1234" (Port.unsafeFromInt 1234) + testIso Port.parser Port.print ":63174" (Port.unsafeFromInt 63174) From 678bbbefb1fbb629cdf669404790b74e9de47fb5 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 14:27:11 +0000 Subject: [PATCH 37/69] Clean up NES usage in UserInfo --- src/URI/UserInfo.purs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/URI/UserInfo.purs b/src/URI/UserInfo.purs index 2661957..a6f9ae9 100644 --- a/src/URI/UserInfo.purs +++ b/src/URI/UserInfo.purs @@ -15,11 +15,10 @@ import Data.Array as Array import Data.String as String import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES -import Global (decodeURIComponent) import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (parseSubDelims, parseUnreserved, pctEncoded, printEncoded) +import URI.Common (decodeURIComponent', parseSubDelims, parseUnreserved, pctEncoded, printEncoded') -- | The user info part of an `Authority`. For example: `user`, `foo:bar`. -- | @@ -39,12 +38,12 @@ instance showUserInfo ∷ Show UserInfo where -- | applied to any character that requires it for the user-info component of a -- | URI. fromString ∷ NonEmptyString → UserInfo -fromString = UserInfo <<< nes <<< printEncoded userInfoChar <<< NES.toString +fromString = UserInfo <<< printEncoded' userInfoChar -- | Prints `UserInfo` as a string, decoding any percent-encoded characters -- | contained within. toString ∷ UserInfo → NonEmptyString -toString (UserInfo s) = nes (decodeURIComponent (NES.toString s)) +toString (UserInfo s) = decodeURIComponent' s -- | Constructs a `UserInfo` part unsafely: no encoding will be applied -- | to the value. If an incorrect value is provided, the URI will be invalid @@ -62,7 +61,10 @@ unsafeToString (UserInfo s) = s -- | A parser for the `UserInfo` part of a URI. parser ∷ Parser String UserInfo -parser = UserInfo <<< nes <<< String.joinWith "" <$> Array.some parse +parser = + UserInfo + <<< unsafePartial NES.unsafeFromString + <<< String.joinWith "" <$> Array.some parse where parse ∷ Parser String String parse = String.singleton <$> userInfoChar <|> pctEncoded @@ -74,6 +76,3 @@ print = NES.toString <<< unsafeToString -- | The supported user info characters, excluding percent-encodings. userInfoChar ∷ Parser String Char userInfoChar = parseUnreserved <|> parseSubDelims <|> char ':' - -nes ∷ String → NonEmptyString -nes = unsafePartial NES.unsafeFromString From 4d993d70089d77b813664cdbe012647cb8e2f95a Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 14:29:33 +0000 Subject: [PATCH 38/69] Use NonEmptyString for RegName --- src/URI/Host.purs | 3 ++- src/URI/Host/RegName.purs | 23 ++++++++++++----------- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/URI/Host.purs b/src/URI/Host.purs index 999d5fe..dc10c1d 100644 --- a/src/URI/Host.purs +++ b/src/URI/Host.purs @@ -17,6 +17,7 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Prism', prism') import Data.Maybe (Maybe(..)) +import Data.String.NonEmpty as NES import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) import URI.Host.IPv4Address (IPv4Address) @@ -47,7 +48,7 @@ print ∷ Host → String print = case _ of IPv6Address addr → IPv6Address.unsafeToString addr IPv4Address addr → IPv4Address.print addr - NameAddress addr → RegName.unsafeToString addr + NameAddress addr → NES.toString (RegName.unsafeToString addr) _IPv6Address ∷ Prism' Host IPv6Address _IPv6Address = prism' IPv6Address case _ of diff --git a/src/URI/Host/RegName.purs b/src/URI/Host/RegName.purs index 38f1c57..d237cfb 100644 --- a/src/URI/Host/RegName.purs +++ b/src/URI/Host/RegName.purs @@ -11,20 +11,18 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.Monoid (class Monoid) import Data.String as String import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES -import Global (decodeURIComponent) +import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) -import URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) +import URI.Common (decodeURIComponent', parseSubDelims, parseUnreserved, pctEncoded, printEncoded') -newtype RegName = RegName String +newtype RegName = RegName NonEmptyString derive newtype instance eqRegName ∷ Eq RegName derive newtype instance ordRegName ∷ Ord RegName derive newtype instance semigroupRegName ∷ Semigroup RegName -derive newtype instance monoidRegName ∷ Monoid RegName instance showRegName ∷ Show RegName where show (RegName s) = "(RegName.unsafeFromString " <> show s <> ")" @@ -33,29 +31,32 @@ instance showRegName ∷ Show RegName where -- | applied to any character that requires it for the user-info component of a -- | URI. fromString ∷ NonEmptyString → RegName -fromString s = RegName (printEncoded regNameChar $ NES.toString s) +fromString = RegName <<< printEncoded' regNameChar -- | Prints `RegName` as a string, decoding any percent-encoded -- | characters contained within. -toString ∷ RegName → String -toString (RegName s) = decodeURIComponent s +toString ∷ RegName → NonEmptyString +toString (RegName s) = decodeURIComponent' s -- | Constructs a `RegName` part unsafely: no encoding will be applied -- | to the value. If an incorrect value is provided, the URI will be invalid -- | when printed back. unsafeFromString ∷ NonEmptyString → RegName -unsafeFromString = NES.toString >>> RegName +unsafeFromString = RegName -- | Prints `RegName` as a string without performing any decoding of -- | percent-encoded octets. Only "unsafe" in the sense that values this -- | produces will need further decoding, the name is more for symmetry with -- | the `fromString`/`toString` and `unsafeFromString`/`unsafeToString` -- | pairings. -unsafeToString ∷ RegName → String +unsafeToString ∷ RegName → NonEmptyString unsafeToString (RegName s) = s parser ∷ Parser String RegName -parser = RegName <<< String.joinWith "" <$> Array.some p +parser = + RegName + <<< unsafePartial NES.unsafeFromString + <<< String.joinWith "" <$> Array.some p where p = pctEncoded <|> String.singleton <$> regNameChar From 56975f1a7963ce427752c4c2e1eb52af91322d7c Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 14:30:37 +0000 Subject: [PATCH 39/69] Simplify tests slightly with `nes` helper --- test/URI/AbsoluteURI.purs | 12 ++++---- test/URI/Extra/UserPassInfo.purs | 14 ++++----- test/URI/Host.purs | 12 ++++---- test/URI/URIRef.purs | 50 +++++++++++++++----------------- 4 files changed, 40 insertions(+), 48 deletions(-) diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs index a82c678..19ec0f7 100644 --- a/test/URI/AbsoluteURI.purs +++ b/test/URI/AbsoluteURI.purs @@ -4,12 +4,10 @@ import Prelude import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) -import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.Tuple (Tuple(..)) -import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) -import Test.Util (testIso) +import Test.Util (nes, testIso) import URI.AbsoluteURI (Authority(..), HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), PathRootless(..), Port, Query, AbsoluteURI(..), AbsoluteURIOptions, UserInfo) import URI.AbsoluteURI as AbsoluteURI import URI.Host.RegName as RegName @@ -32,7 +30,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "localhost"))))) (path ["testBucket"])) (Just (Query.unsafeFromString "password=&docTypeKey="))) testIso @@ -44,7 +42,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 9999)))) + (Just (Both (NameAddress (RegName.unsafeFromString $ nes "localhost")) (Port.unsafeFromInt 9999)))) (path ["testBucket"])) (Just (Query.unsafeFromString "password=pass&docTypeKey=type&queryTimeoutSeconds=20"))) testIso @@ -54,7 +52,7 @@ spec = (AbsoluteURI (Scheme.unsafeFromString "foo") (HierarchicalPartNoAuth - (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "abc") [PathSegment.unsafeSegmentFromString "def"])))))) + (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString $ nes "abc") [PathSegment.unsafeSegmentFromString "def"])))))) Nothing) testIso (AbsoluteURI.parser options) @@ -63,7 +61,7 @@ spec = (AbsoluteURI (Scheme.unsafeFromString "foo") (HierarchicalPartNoAuth - (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "abc") [PathSegment.unsafeSegmentFromString "def"]))))) + (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes "abc") [PathSegment.unsafeSegmentFromString "def"]))))) Nothing) path ∷ Array String → Maybe Path diff --git a/test/URI/Extra/UserPassInfo.purs b/test/URI/Extra/UserPassInfo.purs index 4f45150..4bcbe57 100644 --- a/test/URI/Extra/UserPassInfo.purs +++ b/test/URI/Extra/UserPassInfo.purs @@ -3,9 +3,7 @@ module Test.URI.Extra.UserPassInfo where import Prelude import Data.Maybe (Maybe(..)) -import Data.String.NonEmpty as NES import Data.These (These(..)) -import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (nes, testIso) import URI.Authority (Authority(..), Host(..), Port) @@ -26,42 +24,42 @@ spec = do "//user@host" (Authority (Just (UserPassInfo { user: nes "user", password: Nothing })) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "host"))))) testIso (Authority.parser options) (Authority.print options) "//user:pass@host" (Authority (Just (UserPassInfo { user: nes "user", password: Just (nes "pass") })) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "host"))))) testIso (Authority.parser options) (Authority.print options) "//user:pa%3Ass@host" (Authority (Just (UserPassInfo { user: nes "user", password: Just (nes "pa:ss") })) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "host"))))) testIso (Authority.parser options) (Authority.print options) "//us%3Aer:pa%3Ass@host" (Authority (Just (UserPassInfo { user: nes "us:er", password: Just (nes "pa:ss") })) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "host"))))) testIso (Authority.parser options) (Authority.print options) "//us%3Aer:pa%3Ass@host" (Authority (Just (UserPassInfo { user: nes "us:er", password: Just (nes "pa:ss") })) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "host"))))) testIso (Authority.parser options) (Authority.print options) "//user:p%40ss@host" (Authority (Just (UserPassInfo { user: nes "user", password: Just (nes "p@ss") })) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "host"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "host"))))) options ∷ Record (URIRefOptions UserPassInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) options = diff --git a/test/URI/Host.purs b/test/URI/Host.purs index 68ae84e..cb25b6d 100644 --- a/test/URI/Host.purs +++ b/test/URI/Host.purs @@ -3,12 +3,10 @@ module Test.URI.Host where import Prelude import Data.Either (Either(..)) -import Data.String.NonEmpty as NES -import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((===)) import Test.Spec (Spec, describe, it) import Test.Spec.Assertions (shouldEqual) -import Test.Util (TestEffects, forAll, testIso) +import Test.Util (TestEffects, forAll, nes, testIso) import Text.Parsing.Parser (runParser) import URI.Host (Host(..)) import URI.Host as Host @@ -30,12 +28,12 @@ spec = do it "should not parse 0-lead octets as an IP address" do shouldEqual - (Right (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "192.168.001.1"))) + (Right (NameAddress (RegName.unsafeFromString $ nes "192.168.001.1"))) (runParser "192.168.001.1" Host.parser) describe "Host parser/printer" do - testIso Host.parser Host.print "localhost" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) - testIso Host.parser Host.print "github.com" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "github.com")) - testIso Host.parser Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "www.multipart.domain.example.com")) + testIso Host.parser Host.print "localhost" (NameAddress (RegName.unsafeFromString $ nes "localhost")) + testIso Host.parser Host.print "github.com" (NameAddress (RegName.unsafeFromString $ nes "github.com")) + testIso Host.parser Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString $ nes "www.multipart.domain.example.com")) testIso Host.parser Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) testIso Host.parser Host.print "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")) diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index 0ff68ce..2142edf 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -4,10 +4,8 @@ import Prelude import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) -import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.Tuple (Tuple(..)) -import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe) import Test.Util (nes, testIso) import URI.Fragment as Fragment @@ -81,7 +79,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "localhost"))))) Nothing) Nothing Nothing)) @@ -95,7 +93,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "1a.example.com"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "1a.example.com"))))) Nothing) Nothing Nothing)) @@ -109,7 +107,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "en.wikipedia.org"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "en.wikipedia.org"))))) (path ["wiki", "URI_scheme"])) Nothing Nothing)) @@ -135,7 +133,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "localhost"))))) Nothing) Nothing Nothing)) @@ -149,7 +147,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "localhost"))))) (path [""])) Nothing Nothing)) @@ -163,7 +161,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "localhost"))))) (path ["records"])) Nothing Nothing)) @@ -177,7 +175,7 @@ spec = (HierarchicalPartAuth (Authority (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "localhost"))))) (path ["records", "etc", ""])) Nothing Nothing)) @@ -233,7 +231,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "ftp.is.co.za"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "ftp.is.co.za"))))) (path ["rfc", "rfc1808.txt"])) Nothing Nothing)) @@ -247,7 +245,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "www.ietf.org"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "www.ietf.org"))))) (path ["rfc", "rfc2396.txt"])) Nothing Nothing)) @@ -289,7 +287,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "example.com")) (Port.unsafeFromInt 8042)))) + (Just (Both (NameAddress (RegName.unsafeFromString $ nes "example.com")) (Port.unsafeFromInt 8042)))) (path ["over", "there"])) (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "nose")))) @@ -303,7 +301,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "example.com")) (Port.unsafeFromInt 8042)))) + (Just (Both (NameAddress (RegName.unsafeFromString $ nes "example.com")) (Port.unsafeFromInt 8042)))) (path ["over", "there"])) (Just (Query.unsafeFromString "name=ferret")) (Just (Fragment.unsafeFromString "")))) @@ -317,7 +315,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "info.example.com"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "info.example.com"))))) Nothing) (Just (Query.unsafeFromString "fred")) Nothing)) @@ -341,7 +339,7 @@ spec = "top_story.htm" (Right (RelativeRef - (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString $ unsafePartial $ NES.unsafeFromString "top_story.htm") []))))) + (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString $ nes "top_story.htm") []))))) Nothing Nothing)) testIso @@ -350,7 +348,7 @@ spec = "../top_story.htm" (Right (RelativeRef - (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString $ unsafePartial $ NES.unsafeFromString "..") [PathSegment.unsafeSegmentFromString "top_story.htm"]))))) + (RelativePartNoAuth (Just (Right (PathNoScheme (Tuple (PathSegment.unsafeSegmentNZNCFromString $ nes "..") [PathSegment.unsafeSegmentFromString "top_story.htm"]))))) Nothing Nothing)) testIso @@ -359,7 +357,7 @@ spec = "/top_story.htm" (Right (RelativeRef - (RelativePartNoAuth (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "top_story.htm") [])))))) + (RelativePartNoAuth (Just (Left (PathAbsolute (Just (Tuple (PathSegment.unsafeSegmentNZFromString $ nes "top_story.htm") [])))))) Nothing Nothing)) testIso @@ -388,7 +386,7 @@ spec = (URI (Scheme.unsafeFromString "http") (HierarchicalPartAuth - (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "www.example.com"))))) + (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString $ nes "www.example.com"))))) (path ["some%20invented", "url%20with%20spaces.html"])) Nothing Nothing)) @@ -400,7 +398,7 @@ spec = (URI (Scheme.unsafeFromString "http") (HierarchicalPartAuth - (Authority Nothing (Just (Both (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost")) (Port.unsafeFromInt 53174)))) + (Authority Nothing (Just (Both (NameAddress (RegName.unsafeFromString $ nes "localhost")) (Port.unsafeFromInt 53174)))) (path ["metadata", "fs", "test", "%D0%9F%D0%B0%D1%86%D0%B8%D0%B5%D0%BD%D1%82%D1%8B%23%20%23"])) (Just (Query.unsafeFromString "")) Nothing)) @@ -411,7 +409,7 @@ spec = (Left (URI (Scheme.unsafeFromString "news") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "comp.infosystems.www.servers.unix") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes "comp.infosystems.www.servers.unix") []))))) Nothing Nothing)) testIso @@ -421,7 +419,7 @@ spec = (Left (URI (Scheme.unsafeFromString "tel") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "+1-816-555-1212") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes "+1-816-555-1212") []))))) Nothing Nothing)) testIso @@ -431,7 +429,7 @@ spec = (Left (URI (Scheme.unsafeFromString "urn") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "oasis:names:specification:docbook:dtd:xml:4.1.2") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes "oasis:names:specification:docbook:dtd:xml:4.1.2") []))))) Nothing Nothing)) testIso @@ -441,7 +439,7 @@ spec = (Left (URI (Scheme.unsafeFromString "mailto") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "John.Doe@example.com") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes "John.Doe@example.com") []))))) Nothing Nothing)) testIso @@ -451,7 +449,7 @@ spec = (Left (URI (Scheme.unsafeFromString "mailto") - (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ unsafePartial $ NES.unsafeFromString "fred@example.com") []))))) + (HierarchicalPartNoAuth (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes "fred@example.com") []))))) Nothing Nothing)) testIso @@ -464,7 +462,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "local.slamdata.com"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "local.slamdata.com"))))) (path [""])) (Just (Query.unsafeFromString "")) (Just (Fragment.unsafeFromString "?sort=asc&q=path%3A%2F&salt=1177214")))) @@ -478,7 +476,7 @@ spec = (HierarchicalPartAuth (Authority Nothing - (Just (This (NameAddress (RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "local.slamdata.com"))))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "local.slamdata.com"))))) (path [""])) (Just (Query.unsafeFromString "")) (Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214")))) From b11ee9a372d733b364bd5eb70836d6c4309acfde Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 14:54:22 +0000 Subject: [PATCH 40/69] Add fragment doc comments --- src/URI/Fragment.purs | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/src/URI/Fragment.purs b/src/URI/Fragment.purs index 43b9ef8..df8df5f 100644 --- a/src/URI/Fragment.purs +++ b/src/URI/Fragment.purs @@ -19,7 +19,7 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Common (parseSubDelims, parseUnreserved, pctEncoded, printEncoded) --- | The hash fragment of a URI. +-- | The fragment component (hash) of a URI. newtype Fragment = Fragment String derive newtype instance eqFragment ∷ Eq Fragment @@ -30,24 +30,52 @@ derive newtype instance monoidFragment ∷ Monoid Fragment instance showFragment ∷ Show Fragment where show (Fragment s) = "(Fragment.unsafeFromString " <> show s <> ")" +-- | Constructs a fragment value from a string, percent-encoding any characters +-- | that require it. Note that running this on a string that has already had +-- | percent-encoding applied will double-encode it, for those situations use +-- | `unsafeFromString` instead. +-- | +-- | ``` purescript +-- | fromString "foo" = unsafeFromString "foo" +-- | fromString "foo#bar" = unsafeFromString "foo%23bar" +-- | fromString "foo%23bar" = unsafeFromString "foo%2523bar" +-- | ``` fromString ∷ String → Fragment fromString = Fragment <<< printEncoded fragmentChar +-- | Returns the string value for a fragment, percent-decoding any characters +-- | that require it. +-- | +-- | ``` purescript +-- | toString (unsafeFromString "foo") = "foo" +-- | toString (unsafeFromString "foo%23bar") = "foo#bar" +-- | ``` toString ∷ Fragment → String toString (Fragment s) = decodeURIComponent s +-- | Constructs a fragment value from a string directly - no percent-encoding +-- | will be applied. This is useful when using a custom encoding scheme for +-- | the fragment, to prevent double-encoding. unsafeFromString ∷ String → Fragment unsafeFromString = Fragment +-- | Returns the string value for the fragment without percent-decoding. Only +-- | "unsafe" in the sense that values this produces may need further decoding, +-- | the name is more for symmetry with the `fromString`/`unsafeFromString` +-- | pairing. unsafeToString ∷ Fragment → String unsafeToString (Fragment s) = s +-- | A parser for the fragment component of a URI. Expects values with a `'#'` +-- | prefix. parser ∷ Parser String Fragment parser = char '#' *> (Fragment <<< String.joinWith "" <$> Array.many (pctEncoded <|> String.singleton <$> fragmentChar)) +-- | A printer for the fragment component of the URI. Will print the value with +-- | a `'#'` prefix. print ∷ Fragment → String print (Fragment f) = "#" <> f From 9cbc350dc086120496aaad9843a6a809baf9512a Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 15:00:08 +0000 Subject: [PATCH 41/69] Add query doc comments --- src/URI/Query.purs | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/src/URI/Query.purs b/src/URI/Query.purs index 9873823..05aa25d 100644 --- a/src/URI/Query.purs +++ b/src/URI/Query.purs @@ -19,6 +19,11 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Common (parseSubDelims, parseUnreserved, pctEncoded, printEncoded) +-- | The query component of a URI. +-- | +-- | This type treats the entire string as an undifferentiated blob, if you +-- | would like to deal with the common `?key1=value1&key2=value2` format, take +-- | a look at `URI.Extra.QueryPairs`. newtype Query = Query String derive newtype instance eqQuery ∷ Eq Query @@ -29,27 +34,56 @@ derive newtype instance monoidQuery ∷ Monoid Query instance showQuery ∷ Show Query where show (Query s) = "(Query.unsafeFromString " <> show s <> ")" +-- | Constructs a query value from a string, percent-encoding any characters +-- | that require it. Note that running this on a string that has already had +-- | percent-encoding applied will double-encode it, for those situations use +-- | `unsafeFromString` instead. +-- | +-- | ``` purescript +-- | fromString "foo" = unsafeFromString "foo" +-- | fromString "foo#bar" = unsafeFromString "foo%23bar" +-- | fromString "foo%23bar" = unsafeFromString "foo%2523bar" +-- | ``` fromString ∷ String → Query fromString = Query <<< printEncoded queryChar +-- | Returns the string value for a query, percent-decoding any characters +-- | that require it. +-- | +-- | ``` purescript +-- | toString (unsafeFromString "foo") = "foo" +-- | toString (unsafeFromString "foo%23bar") = "foo#bar" +-- | ``` toString ∷ Query → String toString (Query s) = decodeURIComponent s +-- | Constructs a query value from a string directly - no percent-encoding +-- | will be applied. This is useful when using a custom encoding scheme for +-- | the query, to prevent double-encoding. unsafeFromString ∷ String → Query unsafeFromString = Query +-- | Returns the string value for the query without percent-decoding. Only +-- | "unsafe" in the sense that values this produces may need further decoding, +-- | the name is more for symmetry with the `fromString`/`unsafeFromString` +-- | pairing. unsafeToString ∷ Query → String unsafeToString (Query s) = s +-- | A parser for the query component of a URI. Expects values with a `'?'` +-- | prefix. parser ∷ Parser String Query parser = char '?' *> (Query <<< String.joinWith "" <$> Array.many (String.singleton <$> queryChar <|> pctEncoded)) +-- | A printer for the query component of the URI. Will print the value with +-- | a `'?'` prefix. print ∷ Query → String print (Query s) = "?" <> s +-- | The supported query characters, excluding percent-encodings. queryChar ∷ Parser String Char queryChar = parseUnreserved From df188b521b61ee25613d73a5fa370990ac2b70e2 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 15:13:16 +0000 Subject: [PATCH 42/69] Tweak wording and add examples in UserInfo --- src/URI/UserInfo.purs | 41 ++++++++++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/src/URI/UserInfo.purs b/src/URI/UserInfo.purs index a6f9ae9..1d3b63c 100644 --- a/src/URI/UserInfo.purs +++ b/src/URI/UserInfo.purs @@ -34,32 +34,43 @@ derive newtype instance semigroupUserInfo ∷ Semigroup UserInfo instance showUserInfo ∷ Show UserInfo where show (UserInfo s) = "(UserInfo.unsafeFromString " <> show s <> ")" --- | Constructs a `UserInfo` part safely: percent-encoding will be --- | applied to any character that requires it for the user-info component of a --- | URI. +-- | Constructs a user-info value from a string, percent-encoding any characters +-- | that require it. Note that running this on a string that has already had +-- | percent-encoding applied will double-encode it, for those situations use +-- | `unsafeFromString` instead. +-- | +-- | ``` purescript +-- | fromString "foo" = unsafeFromString "foo" +-- | fromString "foo@bar" = unsafeFromString "foo%40bar" +-- | fromString "foo%40bar" = unsafeFromString "foo%2540bar" +-- | ``` fromString ∷ NonEmptyString → UserInfo fromString = UserInfo <<< printEncoded' userInfoChar --- | Prints `UserInfo` as a string, decoding any percent-encoded characters --- | contained within. +-- | Returns the string value for user-info, percent-decoding any characters +-- | that require it. +-- | +-- | ``` purescript +-- | toString (unsafeFromString "foo") = "foo" +-- | toString (unsafeFromString "foo%40bar") = "foo@bar" +-- | ``` toString ∷ UserInfo → NonEmptyString toString (UserInfo s) = decodeURIComponent' s --- | Constructs a `UserInfo` part unsafely: no encoding will be applied --- | to the value. If an incorrect value is provided, the URI will be invalid --- | when printed back. +-- | Constructs a user-info value from a string directly - no percent-encoding +-- | will be applied. This is useful when using a custom encoding scheme for +-- | the query, to prevent double-encoding. unsafeFromString ∷ NonEmptyString → UserInfo unsafeFromString = UserInfo --- | Prints `UserInfo` as a string without performing any decoding of --- | percent-encoded octets. Only "unsafe" in the sense that values this --- | produces will need further decoding, the name is more for symmetry with --- | the `fromString`/`toString` and `unsafeFromString`/`unsafeToString` --- | pairings. +-- | Returns the string value for user-info without percent-decoding. Only +-- | "unsafe" in the sense that values this produces may need further decoding, +-- | the name is more for symmetry with the `fromString`/`unsafeFromString` +-- | pairing. unsafeToString ∷ UserInfo → NonEmptyString unsafeToString (UserInfo s) = s --- | A parser for the `UserInfo` part of a URI. +-- | A parser for the user-info component of a URI. parser ∷ Parser String UserInfo parser = UserInfo @@ -69,7 +80,7 @@ parser = parse ∷ Parser String String parse = String.singleton <$> userInfoChar <|> pctEncoded --- | A printer for the `UserInfo` part of a URI. +-- | A printer for the user-info component of a URI. print ∷ UserInfo → String print = NES.toString <<< unsafeToString From 35d065849b2bdb5f020e045d4663ed290c0e1f77 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 15:25:54 +0000 Subject: [PATCH 43/69] Add doc comments for RegName, and print function --- src/URI/Host.purs | 3 +-- src/URI/Host/RegName.purs | 47 ++++++++++++++++++++++++++++----------- 2 files changed, 35 insertions(+), 15 deletions(-) diff --git a/src/URI/Host.purs b/src/URI/Host.purs index dc10c1d..81a7358 100644 --- a/src/URI/Host.purs +++ b/src/URI/Host.purs @@ -17,7 +17,6 @@ import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Prism', prism') import Data.Maybe (Maybe(..)) -import Data.String.NonEmpty as NES import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) import URI.Host.IPv4Address (IPv4Address) @@ -48,7 +47,7 @@ print ∷ Host → String print = case _ of IPv6Address addr → IPv6Address.unsafeToString addr IPv4Address addr → IPv4Address.print addr - NameAddress addr → NES.toString (RegName.unsafeToString addr) + NameAddress addr → RegName.print addr _IPv6Address ∷ Prism' Host IPv6Address _IPv6Address = prism' IPv6Address case _ of diff --git a/src/URI/Host/RegName.purs b/src/URI/Host/RegName.purs index d237cfb..76852ab 100644 --- a/src/URI/Host/RegName.purs +++ b/src/URI/Host/RegName.purs @@ -5,6 +5,7 @@ module URI.Host.RegName , unsafeFromString , unsafeToString , parser + , print ) where import Prelude @@ -18,6 +19,9 @@ import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) import URI.Common (decodeURIComponent', parseSubDelims, parseUnreserved, pctEncoded, printEncoded') +-- | The reg-name variation of the host part of a URI. A reg-name is probably +-- | more commonly referred to as just a host name or domain name (but it is +-- | actually a name, rather than an IP address). newtype RegName = RegName NonEmptyString derive newtype instance eqRegName ∷ Eq RegName @@ -27,31 +31,43 @@ derive newtype instance semigroupRegName ∷ Semigroup RegName instance showRegName ∷ Show RegName where show (RegName s) = "(RegName.unsafeFromString " <> show s <> ")" --- | Constructs a `RegName` part safely: percent-encoding will be --- | applied to any character that requires it for the user-info component of a --- | URI. +-- | Constructs a reg-name value from a string, percent-encoding any characters +-- | that require it. Note that running this on a string that has already had +-- | percent-encoding applied will double-encode it, for those situations use +-- | `unsafeFromString` instead. +-- | +-- | ``` purescript +-- | fromString "foo.com" = unsafeFromString "foo.com" +-- | fromString "foo:bar" = unsafeFromString "foo%3Abar" +-- | fromString "foo%3Abar" = unsafeFromString "foo%253Abar" +-- | ``` fromString ∷ NonEmptyString → RegName fromString = RegName <<< printEncoded' regNameChar --- | Prints `RegName` as a string, decoding any percent-encoded --- | characters contained within. +-- | Returns the string value for a reg-name, percent-decoding any characters +-- | that require it. +-- | +-- | ``` purescript +-- | toString (unsafeFromString "foo.com") = "foo.com" +-- | toString (unsafeFromString "foo%3Abar") = "foo:bar" +-- | ``` toString ∷ RegName → NonEmptyString toString (RegName s) = decodeURIComponent' s --- | Constructs a `RegName` part unsafely: no encoding will be applied --- | to the value. If an incorrect value is provided, the URI will be invalid --- | when printed back. +-- | Constructs a query value from a string directly - no percent-encoding +-- | will be applied. This is useful when using a custom encoding scheme for +-- | the query, to prevent double-encoding. unsafeFromString ∷ NonEmptyString → RegName unsafeFromString = RegName --- | Prints `RegName` as a string without performing any decoding of --- | percent-encoded octets. Only "unsafe" in the sense that values this --- | produces will need further decoding, the name is more for symmetry with --- | the `fromString`/`toString` and `unsafeFromString`/`unsafeToString` --- | pairings. +-- | Returns the string value for the reg-name without percent-decoding. Only +-- | "unsafe" in the sense that values this produces may need further decoding, +-- | the name is more for symmetry with the `fromString`/`unsafeFromString` +-- | pairing. unsafeToString ∷ RegName → NonEmptyString unsafeToString (RegName s) = s +-- | A parser for reg-names. parser ∷ Parser String RegName parser = RegName @@ -60,5 +76,10 @@ parser = where p = pctEncoded <|> String.singleton <$> regNameChar +-- | A printer for reg-names. +print ∷ RegName → String +print = NES.toString <<< unsafeToString + +-- | The supported reg-name characters, excluding percent-encodings. regNameChar ∷ Parser String Char regNameChar = parseUnreserved <|> parseSubDelims From b4843b0a5b237580418706159f9752e87e5882a9 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 16:46:17 +0000 Subject: [PATCH 44/69] Doc comments for IPv4Address --- src/URI/Host/IPv4Address.purs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/URI/Host/IPv4Address.purs b/src/URI/Host/IPv4Address.purs index 596b8ad..a14f55b 100644 --- a/src/URI/Host/IPv4Address.purs +++ b/src/URI/Host/IPv4Address.purs @@ -19,6 +19,7 @@ import Text.Parsing.Parser.Combinators (try) import Text.Parsing.Parser.String (char, satisfy) import URI.Common (URIPartParseError(..), digit, wrapParser) +-- | The IPv4 address variation of the host part of a URI. data IPv4Address = IPv4Address Int Int Int Int derive instance eqIPv4Address ∷ Eq IPv4Address @@ -43,13 +44,14 @@ fromInts o1 o2 o3 o4 = -- | -- | This is intended as a convenience when describing `IPv4Address`es -- | statically in PureScript code, in all other cases `fromInts` should be --- | preferred. +-- | used. unsafeFromInts ∷ Int → Int → Int → Int → IPv4Address unsafeFromInts o1 o2 o3 o4 = case fromInts o1 o2 o3 o4 of Just addr → addr Nothing → unsafeCrashWith "IPv4Address octet was out of range" +-- | A parser for IPv4 addresses. parser ∷ Parser String IPv4Address parser = do o1 ← octet <* char '.' @@ -58,6 +60,7 @@ parser = do o4 ← octet pure $ IPv4Address o1 o2 o3 o4 +-- | A printer for IPv4 adddresses. print ∷ IPv4Address → String print (IPv4Address o1 o2 o3 o4) = show o1 <> "." <> show o2 <> "." <> show o3 <> "." <> show o4 From a6dfbc20d559ee4605d67ce72eff0b0c00acd165 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 17:18:52 +0000 Subject: [PATCH 45/69] Add more `Gen`s, doc comments, tests --- src/URI/Host.purs | 7 ++++++- src/URI/Host/Gen.purs | 21 ++++++++++++++++++++- src/URI/HostPortPair/Gen.purs | 35 +++++++++++++++++++++++++++++++++++ src/URI/Port/Gen.purs | 11 +++++++++++ test/URI/Host.purs | 25 ++++++++++++++++--------- test/URI/Port.purs | 14 +++++++++++--- 6 files changed, 99 insertions(+), 14 deletions(-) create mode 100644 src/URI/HostPortPair/Gen.purs create mode 100644 src/URI/Port/Gen.purs diff --git a/src/URI/Host.purs b/src/URI/Host.purs index 81a7358..9c84f84 100644 --- a/src/URI/Host.purs +++ b/src/URI/Host.purs @@ -26,7 +26,7 @@ import URI.Host.IPv6Address as IPv6Address import URI.Host.RegName (RegName) import URI.Host.RegName as RegName --- | A host address. +-- | A host address. Supports named addresses, IPv4, and IPv6. data Host = IPv6Address IPv6Address | IPv4Address IPv4Address @@ -37,28 +37,33 @@ derive instance ordHost ∷ Ord Host derive instance genericHost ∷ Generic Host _ instance showHost ∷ Show Host where show = genericShow +-- | A parser for host addresses. parser ∷ Parser String Host parser = (IPv6Address <$> IPv6Address.parser) <|> try (IPv4Address <$> IPv4Address.parser) <|> (NameAddress <$> RegName.parser) +-- | A printer for host addresses. print ∷ Host → String print = case _ of IPv6Address addr → IPv6Address.unsafeToString addr IPv4Address addr → IPv4Address.print addr NameAddress addr → RegName.print addr +-- | A prism for the `IPv6Address` constructor. _IPv6Address ∷ Prism' Host IPv6Address _IPv6Address = prism' IPv6Address case _ of IPv6Address addr → Just addr _ → Nothing +-- | A prism for the `IPv4Address` constructor. _IPv4Address ∷ Prism' Host IPv4Address _IPv4Address = prism' IPv4Address case _ of IPv4Address addr → Just addr _ → Nothing +-- | A prism for the `NameAddress` constructor. _NameAddress ∷ Prism' Host RegName _NameAddress = prism' NameAddress case _ of NameAddress addr → Just addr diff --git a/src/URI/Host/Gen.purs b/src/URI/Host/Gen.purs index 7dd1db5..ad5aa34 100644 --- a/src/URI/Host/Gen.purs +++ b/src/URI/Host/Gen.purs @@ -3,9 +3,15 @@ module URI.Host.Gen where import Prelude import Control.Monad.Gen as Gen -import URI.Host (IPv4Address) +import Control.Monad.Rec.Class (class MonadRec) +import Data.Char.Gen as GenChar +import Data.String.Gen as GenString +import Data.String.NonEmpty as NES +import URI.Host (Host(..), IPv4Address, RegName) import URI.Host.IPv4Address as IPv4Address +import URI.Host.RegName as RegName +-- | Generates a random `IPv4Address` for testing purposes. genIPv4 ∷ ∀ m. Gen.MonadGen m ⇒ m IPv4Address genIPv4 = do a ← Gen.chooseInt 0 255 @@ -13,3 +19,16 @@ genIPv4 = do c ← Gen.chooseInt 0 255 d ← Gen.chooseInt 0 255 pure $ IPv4Address.unsafeFromInts a b c d + +-- | Generates a random `RegName` for testing purposes. +genRegName ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ m RegName +genRegName = do + head ← genAlphaNumeric + tail ← GenString.genString genAlphaNumeric + pure $ RegName.fromString $ NES.cons head tail + where + genAlphaNumeric = Gen.choose GenChar.genAlpha GenChar.genDigitChar + +-- | Generates a random `Host` for testing purposes. +genHost ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ m Host +genHost = Gen.choose (NameAddress <$> genRegName) (IPv4Address <$> genIPv4) diff --git a/src/URI/HostPortPair/Gen.purs b/src/URI/HostPortPair/Gen.purs new file mode 100644 index 0000000..7b10124 --- /dev/null +++ b/src/URI/HostPortPair/Gen.purs @@ -0,0 +1,35 @@ +module URI.HostPortPair.Gen + ( genHostPortPair + , module URI.Host.Gen + , module URI.Port.Gen + ) where + +import Prelude + +import Control.Monad.Gen as Gen +import Data.Maybe (Maybe(..)) +import Data.These (These(..)) +import URI.Host.Gen (genHost, genIPv4, genRegName) +import URI.HostPortPair (HostPortPair) +import URI.Port.Gen (genPort) + +-- | Generates a random `HostPortPair` for testing purposes. +genHostPortPair + ∷ ∀ m host port + . Gen.MonadGen m + ⇒ m host + → m port + → m (HostPortPair host port) +genHostPortPair host port = do + h ← sometimes 0.75 host + p ← sometimes 0.25 port + pure case h, p of + Just h', Just p' → Just (Both h' p') + Just h', Nothing → Just (This h') + Nothing, Just p' → Just (That p') + Nothing, Nothing → Nothing + where + sometimes ∷ ∀ a. Number → m a → m (Maybe a) + sometimes chance g = do + n ← Gen.chooseFloat 0.0 1.0 + if n > chance then Just <$> g else pure Nothing diff --git a/src/URI/Port/Gen.purs b/src/URI/Port/Gen.purs new file mode 100644 index 0000000..fce9a95 --- /dev/null +++ b/src/URI/Port/Gen.purs @@ -0,0 +1,11 @@ +module URI.Port.Gen where + +import Prelude + +import Control.Monad.Gen as Gen +import URI.Port (Port) +import URI.Port as Port + +-- | Generates a random `Port` for testing purposes. +genPort ∷ ∀ m. Gen.MonadGen m ⇒ m Port +genPort = Port.unsafeFromInt <$> Gen.chooseInt 0 65535 diff --git a/test/URI/Host.purs b/test/URI/Host.purs index cb25b6d..65853d9 100644 --- a/test/URI/Host.purs +++ b/test/URI/Host.purs @@ -17,11 +17,18 @@ import URI.Host.RegName as RegName spec ∷ ∀ eff. Spec (TestEffects eff) Unit spec = do - describe "parseIPv4Address" do + describe "Host parser/printer" do + testIso Host.parser Host.print "localhost" (NameAddress (RegName.unsafeFromString $ nes "localhost")) + testIso Host.parser Host.print "github.com" (NameAddress (RegName.unsafeFromString $ nes "github.com")) + testIso Host.parser Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString $ nes "www.multipart.domain.example.com")) + testIso Host.parser Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) + testIso Host.parser Host.print "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")) - it "Should successfully roundtrip values sent through parseIPv4Address / Host.print" do + describe "IPv4Address" do + + it "should successfully roundtrip values sent through Host parse/print" do forAll do - ipv4 <- Host.Gen.genIPv4 + ipv4 ← Host.Gen.genIPv4 let printed = IPv4Address.print ipv4 let parsed = runParser printed Host.parser pure $ pure (IPv4Address ipv4) === parsed @@ -31,9 +38,9 @@ spec = do (Right (NameAddress (RegName.unsafeFromString $ nes "192.168.001.1"))) (runParser "192.168.001.1" Host.parser) - describe "Host parser/printer" do - testIso Host.parser Host.print "localhost" (NameAddress (RegName.unsafeFromString $ nes "localhost")) - testIso Host.parser Host.print "github.com" (NameAddress (RegName.unsafeFromString $ nes "github.com")) - testIso Host.parser Host.print "www.multipart.domain.example.com" (NameAddress (RegName.unsafeFromString $ nes "www.multipart.domain.example.com")) - testIso Host.parser Host.print "192.168.0.1" (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) - testIso Host.parser Host.print "[2001:cdba:0000:0000:0000:0000:3257:9652]" (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652")) + describe "NameAddress" do + + it "should uphold toString / fromString property" do + forAll do + regName ← Host.Gen.genRegName + pure $ RegName.fromString (RegName.toString regName) === regName diff --git a/test/URI/Port.purs b/test/URI/Port.purs index a05cebe..a2f8a41 100644 --- a/test/URI/Port.purs +++ b/test/URI/Port.purs @@ -2,13 +2,21 @@ module Test.URI.Port where import Prelude -import Test.Spec (Spec, describe) -import Test.Util (testIso) +import Data.Maybe (Maybe(..)) +import Test.QuickCheck ((===)) +import Test.Spec (Spec, describe, it) +import Test.Util (TestEffects, forAll, testIso) import URI.Port as Port +import URI.Port.Gen as Port.Gen -spec ∷ ∀ eff. Spec eff Unit +spec ∷ ∀ eff. Spec (TestEffects eff) Unit spec = describe "Port parser/printer" do testIso Port.parser Port.print ":0" (Port.unsafeFromInt 0) testIso Port.parser Port.print ":1234" (Port.unsafeFromInt 1234) testIso Port.parser Port.print ":63174" (Port.unsafeFromInt 63174) + + it "should uphold toString / fromString property" do + forAll do + port ← Port.Gen.genPort + pure $ Port.fromInt (Port.toInt port) === Just port From 2d2f2647155d8ee6b4cc1f4e662ff9365aa4138e Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 12:24:44 +0000 Subject: [PATCH 46/69] Avoid redefining some token parsers & rename some --- src/URI/Common.purs | 40 +++++++++++++++++----------- src/URI/Extra/MultiHostPortPair.purs | 4 +-- src/URI/Extra/QueryPairs.purs | 4 +-- src/URI/Extra/UserPassInfo.purs | 4 +-- src/URI/Fragment.purs | 4 +-- src/URI/Host/IPv4Address.purs | 3 ++- src/URI/Host/IPv6Address.purs | 7 +++-- src/URI/Host/RegName.purs | 4 +-- src/URI/Path/Segment.purs | 4 +-- src/URI/Port.purs | 2 +- src/URI/Query.purs | 6 ++--- src/URI/UserInfo.purs | 4 +-- 12 files changed, 50 insertions(+), 36 deletions(-) diff --git a/src/URI/Common.purs b/src/URI/Common.purs index d2e154e..dfacd7a 100644 --- a/src/URI/Common.purs +++ b/src/URI/Common.purs @@ -2,12 +2,10 @@ module URI.Common ( URIPartParseError(..) , wrapParser , alpha - , digit , alphaNum - , hexDigit - , parseUnreserved + , unreserved , pctEncoded - , parseSubDelims + , subDelims , printEncoded , printEncoded' , decodeURIComponent' @@ -30,6 +28,7 @@ import Global (decodeURIComponent, encodeURIComponent) import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (ParseError(..), ParseState(..), Parser, ParserT(..), runParser) import Text.Parsing.Parser.String (anyChar, char, eof, oneOf, satisfy) +import Text.Parsing.Parser.Token (digit, hexDigit) newtype URIPartParseError = URIPartParseError String @@ -39,6 +38,8 @@ derive instance newtypeURIPartParseError :: Newtype URIPartParseError _ derive instance genericURIPartParseError :: Generic URIPartParseError _ instance showURIPartParseError :: Show URIPartParseError where show = genericShow +-- | Adapts a parser with a parser-esque function. First the original +-- | parser runs, then it attempts to refine the result with the function. wrapParser ∷ ∀ s m a b . Monad m @@ -52,21 +53,25 @@ wrapParser parseA p = ParserT do Left (URIPartParseError err) → throwError (ParseError err pos) Right b → pure b +-- | Parser for ascii alphabetical characters (upper and lowercase). alpha ∷ Parser String Char alpha = satisfy \c → (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') -digit ∷ Parser String Char -digit = satisfy \c → (c >= '0' && c <= '9') - +-- | Parser for ascii alphanumeric characters (upper and lowercase for letters). alphaNum ∷ Parser String Char alphaNum = alpha <|> digit -hexDigit ∷ Parser String Char -hexDigit = satisfy \c → (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F') +-- | Parser for characters that are allowed in a URI but do not have a reserved +-- | purpose. +unreserved ∷ Parser String Char +unreserved = alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~' -parseUnreserved ∷ Parser String Char -parseUnreserved = alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~' +-- | Parser for the "sub-delims" group of reserved characters. +subDelims ∷ Parser String Char +subDelims = + oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '=', ','] +-- | Parser for a percent-encoded character. pctEncoded ∷ Parser String String pctEncoded = do d0 ← char '%' @@ -74,10 +79,11 @@ pctEncoded = do d2 ← hexDigit pure $ String.fromCharArray [d0, d1, d2] -parseSubDelims ∷ Parser String Char -parseSubDelims = - oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '=', ','] - +-- | A helper function for printing URI components using percent-encoding for +-- | characters that require it. +-- | +-- | Accepts a parser that is used to determine whether a character is allowed +-- | to appear un-encoded in the URI component and the string to encode. printEncoded ∷ Parser String Char → String → String printEncoded p s = either (const s) id (runParser s parse) where @@ -88,10 +94,14 @@ printEncoded p s = either (const s) id (runParser s parse) encodedChar ∷ Parser String String encodedChar = encodeURIComponent <<< String.singleton <$> anyChar +-- | A version of [`printEncoded`](#v:printEncoded) that operates on non-empty +-- | strings. printEncoded' ∷ Parser String Char → NonEmptyString → NonEmptyString printEncoded' p = unsafePartial NES.unsafeFromString <<< printEncoded p <<< NES.toString +-- | A version of [`decodeURIComponent`](https://pursuit.purescript.org/packages/purescript-globals/docs/Global#v:decodeURIComponent) +-- | that operates on non-empty strings. decodeURIComponent' ∷ NonEmptyString → NonEmptyString decodeURIComponent' = unsafePartial NES.unsafeFromString <<< decodeURIComponent <<< NES.toString diff --git a/src/URI/Extra/MultiHostPortPair.purs b/src/URI/Extra/MultiHostPortPair.purs index 8f5a0cf..60afcc4 100644 --- a/src/URI/Extra/MultiHostPortPair.purs +++ b/src/URI/Extra/MultiHostPortPair.purs @@ -17,7 +17,7 @@ import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.Combinators (optionMaybe, sepBy, try) import Text.Parsing.Parser.String (char, oneOf) -import URI.Common (URIPartParseError, parseUnreserved, pctEncoded, wrapParser) +import URI.Common (URIPartParseError, unreserved, pctEncoded, wrapParser) import URI.Host (Host(..), RegName) import URI.Host.IPv4Address as IPv4Address import URI.Host.IPv6Address as IPv6Address @@ -68,7 +68,7 @@ parseRegName' = do Nothing → unsafeCrashWith "This must be unPathSegment.unsafeSegmentNZFromStringreachable as we shuold parse at least one char in `pctEncoded`" where p = pctEncoded <|> String.singleton <$> c - c = parseUnreserved <|> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '='] + c = unreserved <|> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '='] print ∷ ∀ host port diff --git a/src/URI/Extra/QueryPairs.purs b/src/URI/Extra/QueryPairs.purs index 2b44b2e..d2fe749 100644 --- a/src/URI/Extra/QueryPairs.purs +++ b/src/URI/Extra/QueryPairs.purs @@ -31,7 +31,7 @@ import Global (decodeURIComponent) import Text.Parsing.Parser (ParseError(..), Parser, runParser) import Text.Parsing.Parser.Combinators (optionMaybe, sepBy) import Text.Parsing.Parser.String (char, oneOf) -import URI.Common (URIPartParseError(..), parseUnreserved, pctEncoded, printEncoded, wrapParser) +import URI.Common (URIPartParseError(..), unreserved, pctEncoded, printEncoded, wrapParser) import URI.Query as Q newtype Key = Key String @@ -119,7 +119,7 @@ parsePart parseK parseV = do keyPartChar ∷ Parser String Char keyPartChar - = parseUnreserved + = unreserved <|> oneOf ['!', '$', '\'', '(', ')', '*', '+', ';', ',', ':', '@', '/', '?'] valuePartChar ∷ Parser String Char diff --git a/src/URI/Extra/UserPassInfo.purs b/src/URI/Extra/UserPassInfo.purs index 5cf8c84..e212f6b 100644 --- a/src/URI/Extra/UserPassInfo.purs +++ b/src/URI/Extra/UserPassInfo.purs @@ -13,7 +13,7 @@ import Data.String as String import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES import Text.Parsing.Parser (Parser) -import URI.Common (URIPartParseError(..), decodeURIComponent', parseSubDelims, parseUnreserved, printEncoded') +import URI.Common (URIPartParseError(..), decodeURIComponent', subDelims, unreserved, printEncoded') import URI.UserInfo (UserInfo) import URI.UserInfo as UserInfo @@ -55,4 +55,4 @@ print (UserPassInfo { user, password }) = <> printEncoded' userPassInfoChar p userPassInfoChar ∷ Parser String Char -userPassInfoChar = parseUnreserved <|> parseSubDelims +userPassInfoChar = unreserved <|> subDelims diff --git a/src/URI/Fragment.purs b/src/URI/Fragment.purs index df8df5f..1f46ba6 100644 --- a/src/URI/Fragment.purs +++ b/src/URI/Fragment.purs @@ -17,7 +17,7 @@ import Data.String as String import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (parseSubDelims, parseUnreserved, pctEncoded, printEncoded) +import URI.Common (subDelims, unreserved, pctEncoded, printEncoded) -- | The fragment component (hash) of a URI. newtype Fragment = Fragment String @@ -82,5 +82,5 @@ print (Fragment f) = "#" <> f -- | The supported fragment characters, excluding percent-encodings. fragmentChar ∷ Parser String Char fragmentChar = - parseUnreserved <|> parseSubDelims + unreserved <|> subDelims <|> char ':' <|> char '@' <|> char '/' <|> char '?' diff --git a/src/URI/Host/IPv4Address.purs b/src/URI/Host/IPv4Address.purs index a14f55b..112f628 100644 --- a/src/URI/Host/IPv4Address.purs +++ b/src/URI/Host/IPv4Address.purs @@ -17,7 +17,8 @@ import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) import Text.Parsing.Parser.String (char, satisfy) -import URI.Common (URIPartParseError(..), digit, wrapParser) +import Text.Parsing.Parser.Token (digit) +import URI.Common (URIPartParseError(..), wrapParser) -- | The IPv4 address variation of the host part of a URI. data IPv4Address = IPv4Address Int Int Int Int diff --git a/src/URI/Host/IPv6Address.purs b/src/URI/Host/IPv6Address.purs index 34bb7cd..83ff714 100644 --- a/src/URI/Host/IPv6Address.purs +++ b/src/URI/Host/IPv6Address.purs @@ -13,7 +13,7 @@ import Data.String as String import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (()) import Text.Parsing.Parser.String (char) -import URI.Common (hexDigit) +import Text.Parsing.Parser.Token (hexDigit) -- | This type and parser are much too forgiving currently, allowing almost -- | anything through that looks vaguely IPv6ish. @@ -32,7 +32,10 @@ unsafeToString ∷ IPv6Address → String unsafeToString (IPv6Address s) = "[" <> s <> "]" parser ∷ Parser String IPv6Address -parser = IPv6Address <$> (char '[' *> (String.fromCharArray <$> Array.some ipv6Char) <* char ']') "IPv6 address" +parser = + IPv6Address + <$> (char '[' *> (String.fromCharArray <$> Array.some ipv6Char) <* char ']') + "IPv6 address" where ipv6Char ∷ Parser String Char ipv6Char = hexDigit <|> char ':' <|> char '.' diff --git a/src/URI/Host/RegName.purs b/src/URI/Host/RegName.purs index 76852ab..b1216ea 100644 --- a/src/URI/Host/RegName.purs +++ b/src/URI/Host/RegName.purs @@ -17,7 +17,7 @@ import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) -import URI.Common (decodeURIComponent', parseSubDelims, parseUnreserved, pctEncoded, printEncoded') +import URI.Common (decodeURIComponent', subDelims, unreserved, pctEncoded, printEncoded') -- | The reg-name variation of the host part of a URI. A reg-name is probably -- | more commonly referred to as just a host name or domain name (but it is @@ -82,4 +82,4 @@ print = NES.toString <<< unsafeToString -- | The supported reg-name characters, excluding percent-encodings. regNameChar ∷ Parser String Char -regNameChar = parseUnreserved <|> parseSubDelims +regNameChar = unreserved <|> subDelims diff --git a/src/URI/Path/Segment.purs b/src/URI/Path/Segment.purs index db9471f..0bb068a 100644 --- a/src/URI/Path/Segment.purs +++ b/src/URI/Path/Segment.purs @@ -29,7 +29,7 @@ import Data.String.NonEmpty as NES import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (pctEncoded, parseSubDelims, parseUnreserved, printEncoded) +import URI.Common (pctEncoded, subDelims, unreserved, printEncoded) newtype PathSegment = PathSegment String @@ -113,4 +113,4 @@ segmentChar ∷ Parser String Char segmentChar = segmentNCChar <|> char ':' segmentNCChar ∷ Parser String Char -segmentNCChar = parseUnreserved <|> parseSubDelims <|> char '@' +segmentNCChar = unreserved <|> subDelims <|> char '@' diff --git a/src/URI/Port.purs b/src/URI/Port.purs index 662661e..026fb53 100644 --- a/src/URI/Port.purs +++ b/src/URI/Port.purs @@ -19,7 +19,7 @@ import Global (readInt) import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.String (char) -import URI.Common (digit) +import Text.Parsing.Parser.Token (digit) newtype Port = Port Int diff --git a/src/URI/Query.purs b/src/URI/Query.purs index 05aa25d..8ea8c15 100644 --- a/src/URI/Query.purs +++ b/src/URI/Query.purs @@ -17,7 +17,7 @@ import Data.String as String import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (parseSubDelims, parseUnreserved, pctEncoded, printEncoded) +import URI.Common (subDelims, unreserved, pctEncoded, printEncoded) -- | The query component of a URI. -- | @@ -86,8 +86,8 @@ print (Query s) = "?" <> s -- | The supported query characters, excluding percent-encodings. queryChar ∷ Parser String Char queryChar - = parseUnreserved - <|> parseSubDelims + = unreserved + <|> subDelims <|> char ':' <|> char '@' <|> char '/' diff --git a/src/URI/UserInfo.purs b/src/URI/UserInfo.purs index 1d3b63c..6ef3943 100644 --- a/src/URI/UserInfo.purs +++ b/src/URI/UserInfo.purs @@ -18,7 +18,7 @@ import Data.String.NonEmpty as NES import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (decodeURIComponent', parseSubDelims, parseUnreserved, pctEncoded, printEncoded') +import URI.Common (decodeURIComponent', subDelims, unreserved, pctEncoded, printEncoded') -- | The user info part of an `Authority`. For example: `user`, `foo:bar`. -- | @@ -86,4 +86,4 @@ print = NES.toString <<< unsafeToString -- | The supported user info characters, excluding percent-encodings. userInfoChar ∷ Parser String Char -userInfoChar = parseUnreserved <|> parseSubDelims <|> char ':' +userInfoChar = unreserved <|> subDelims <|> char ':' From 0015d5ab5160aa1fe1163ca778126f7d1fb90671 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 12:26:06 +0000 Subject: [PATCH 47/69] Last few doc comments for common --- src/URI/Common.purs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/URI/Common.purs b/src/URI/Common.purs index dfacd7a..915c985 100644 --- a/src/URI/Common.purs +++ b/src/URI/Common.purs @@ -1,3 +1,4 @@ +-- | Common functions used in parsing and printing URI components. module URI.Common ( URIPartParseError(..) , wrapParser @@ -30,6 +31,7 @@ import Text.Parsing.Parser (ParseError(..), ParseState(..), Parser, ParserT(..), import Text.Parsing.Parser.String (anyChar, char, eof, oneOf, satisfy) import Text.Parsing.Parser.Token (digit, hexDigit) +-- | An error type used when a custom component parser fails to handle a value. newtype URIPartParseError = URIPartParseError String derive newtype instance eqURIPartParseError :: Eq URIPartParseError From daae75223449f9319a156c7fb492c1fab3e8dce9 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 12:31:07 +0000 Subject: [PATCH 48/69] Authority doc comments, remove unused synonym --- src/URI/AbsoluteURI.purs | 2 +- src/URI/Authority.purs | 28 +++++++++++++++++++--------- src/URI/HierarchicalPart.purs | 2 +- src/URI/RelativePart.purs | 2 +- src/URI/RelativeRef.purs | 2 +- src/URI/URI.purs | 2 +- src/URI/URIRef.purs | 2 +- 7 files changed, 25 insertions(+), 15 deletions(-) diff --git a/src/URI/AbsoluteURI.purs b/src/URI/AbsoluteURI.purs index d08f152..1b29e7c 100644 --- a/src/URI/AbsoluteURI.purs +++ b/src/URI/AbsoluteURI.purs @@ -26,7 +26,7 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (eof) import URI.Common (URIPartParseError, wrapParser) -import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) +import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) import URI.HierarchicalPart as HPart import URI.Query (Query) import URI.Query as Query diff --git a/src/URI/Authority.purs b/src/URI/Authority.purs index 1bfd518..e70c083 100644 --- a/src/URI/Authority.purs +++ b/src/URI/Authority.purs @@ -3,7 +3,6 @@ module URI.Authority , AuthorityOptions , AuthorityParseOptions , AuthorityPrintOptions - , HostsParseOptions , parser , print , _userInfo @@ -19,7 +18,6 @@ import Data.Either (Either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Lens', lens) -import Data.List (List) import Data.Maybe (Maybe(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe, try) @@ -31,7 +29,7 @@ import URI.UserInfo (UserInfo) import URI.UserInfo as UserInfo -- | The authority part of a URI. For example: `purescript.org`, --- | `localhost:3000`, `user@example.net` +-- | `localhost:3000`, `user@example.net`. data Authority userInfo hosts = Authority (Maybe userInfo) hosts derive instance eqAuthority ∷ (Eq userInfo, Eq hosts) ⇒ Eq (Authority userInfo hosts) @@ -39,28 +37,36 @@ derive instance ordAuthority ∷ (Ord userInfo, Ord hosts) ⇒ Ord (Authority us derive instance genericAuthority ∷ Generic (Authority userInfo hosts) _ instance showAuthority ∷ (Show userInfo, Show hosts) ⇒ Show (Authority userInfo hosts) where show = genericShow +-- | A row type for describing the options fields used by the authority parser +-- | and printer. +-- | +-- | Used as `Record (AuthorityOptions userInfo hosts)` when typing a value. type AuthorityOptions userInfo hosts = AuthorityParseOptions userInfo hosts (AuthorityPrintOptions userInfo hosts ()) +-- | A row type for describing the options fields used by the authority parser. +-- | +-- | Used as `Record (AuthorityParseOptions userInfo hosts)` when typing a +-- | value. type AuthorityParseOptions userInfo hosts r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo , parseHosts ∷ Parser String hosts | r ) +-- | A row type for describing the options fields used by the authority printer. +-- | +-- | Used as `Record (AuthorityPrintOptions userInfo hosts)` when typing a +-- | value. type AuthorityPrintOptions userInfo hosts r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts → String | r ) -type HostsParseOptions hosts - = ∀ a - . Either - (Maybe a → hosts a) - { split ∷ Parser String Unit, build ∷ List a → hosts a } - +-- | A parser for the authority part of a URI. Expects values with a `"//"` +-- | prefix. parser ∷ ∀ userInfo hosts r . Record (AuthorityParseOptions userInfo hosts r) @@ -71,6 +77,8 @@ parser opts = do hosts ← opts.parseHosts pure $ Authority ui hosts +-- | A printer for the authority part of a URI. Will print the value with a +-- | `"//"` prefix. print ∷ ∀ userInfo hosts r . Record (AuthorityPrintOptions userInfo hosts r) @@ -80,6 +88,7 @@ print opts (Authority mui hs) = case mui of Just ui → "//" <> UserInfo.print (opts.printUserInfo ui) <> "@" <> opts.printHosts hs Nothing → "//" <> opts.printHosts hs +-- | A lens for the user-info component of the authority. _userInfo ∷ ∀ userInfo hosts . Lens' @@ -90,6 +99,7 @@ _userInfo = (\(Authority ui _) → ui) (\(Authority _ hs) ui → Authority ui hs) +-- | A lens for the host(s) component of the authority. _hosts ∷ ∀ userInfo hosts . Lens' diff --git a/src/URI/HierarchicalPart.purs b/src/URI/HierarchicalPart.purs index 448845b..9ef3d24 100644 --- a/src/URI/HierarchicalPart.purs +++ b/src/URI/HierarchicalPart.purs @@ -27,7 +27,7 @@ import Data.Maybe (Maybe(..), maybe) import Data.String as String import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) -import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import URI.Authority as Authority import URI.Common (URIPartParseError, wrapParser) import URI.Path (Path(..)) diff --git a/src/URI/RelativePart.purs b/src/URI/RelativePart.purs index 3b4d803..1e2cb4e 100644 --- a/src/URI/RelativePart.purs +++ b/src/URI/RelativePart.purs @@ -27,7 +27,7 @@ import Data.Maybe (Maybe(..), maybe) import Data.String as String import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) -import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) +import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import URI.Authority as Authority import URI.Common (URIPartParseError, wrapParser) import URI.Path (Path) diff --git a/src/URI/RelativeRef.purs b/src/URI/RelativeRef.purs index 41b3552..0aad8b5 100644 --- a/src/URI/RelativeRef.purs +++ b/src/URI/RelativeRef.purs @@ -30,7 +30,7 @@ import URI.Fragment (Fragment) import URI.Fragment as Fragment import URI.Query (Query) import URI.Query as Query -import URI.RelativePart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path, PathAbsolute, PathNoScheme, Port, RegName, RelPath, RelativePart(..), RelativePartOptions, RelativePartParseOptions, RelativePartPrintOptions, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _relPath, _userInfo) +import URI.RelativePart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), IPv4Address, IPv6Address, Path, PathAbsolute, PathNoScheme, Port, RegName, RelPath, RelativePart(..), RelativePartOptions, RelativePartParseOptions, RelativePartPrintOptions, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _relPath, _userInfo) import URI.RelativePart as RPart -- | A relative reference for a URI. diff --git a/src/URI/URI.purs b/src/URI/URI.purs index 79a329f..1475edb 100644 --- a/src/URI/URI.purs +++ b/src/URI/URI.purs @@ -29,7 +29,7 @@ import Text.Parsing.Parser.String (eof) import URI.Common (URIPartParseError, wrapParser) import URI.Fragment (Fragment) import URI.Fragment as Fragment -import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), HostsParseOptions, IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) +import URI.HierarchicalPart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, HierPath, HierarchicalPart(..), HierarchicalPartOptions, HierarchicalPartParseOptions, HierarchicalPartPrintOptions, Host(..), IPv4Address, IPv6Address, Path(..), PathAbsolute(..), PathRootless(..), Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hierPath, _hosts, _path, _userInfo) import URI.HierarchicalPart as HPart import URI.Query (Query) import URI.Query as Query diff --git a/src/URI/URIRef.purs b/src/URI/URIRef.purs index cefb118..12cc33e 100644 --- a/src/URI/URIRef.purs +++ b/src/URI/URIRef.purs @@ -26,7 +26,7 @@ import Control.Alt ((<|>)) import Data.Either (Either(..), either) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (try) -import URI.Authority (Authority(..), HostsParseOptions) +import URI.Authority (Authority(..)) import URI.Common (URIPartParseError) import URI.Fragment (Fragment) import URI.Host (Host(..), IPv4Address, IPv6Address, RegName, _IPv4Address, _IPv6Address, _NameAddress) From 23df58eb097b7dba654ea31cfee1a1b7450cddf8 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 12:32:50 +0000 Subject: [PATCH 49/69] Wording consistency tweak --- src/URI/Fragment.purs | 2 +- src/URI/Query.purs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/URI/Fragment.purs b/src/URI/Fragment.purs index 1f46ba6..b1c8ac6 100644 --- a/src/URI/Fragment.purs +++ b/src/URI/Fragment.purs @@ -74,7 +74,7 @@ parser = (Fragment <<< String.joinWith "" <$> Array.many (pctEncoded <|> String.singleton <$> fragmentChar)) --- | A printer for the fragment component of the URI. Will print the value with +-- | A printer for the fragment component of a URI. Will print the value with -- | a `'#'` prefix. print ∷ Fragment → String print (Fragment f) = "#" <> f diff --git a/src/URI/Query.purs b/src/URI/Query.purs index 8ea8c15..349c508 100644 --- a/src/URI/Query.purs +++ b/src/URI/Query.purs @@ -78,7 +78,7 @@ parser = (Query <<< String.joinWith "" <$> Array.many (String.singleton <$> queryChar <|> pctEncoded)) --- | A printer for the query component of the URI. Will print the value with +-- | A printer for the query component of a URI. Will print the value with -- | a `'?'` prefix. print ∷ Query → String print (Query s) = "?" <> s From 78119e544708825766e55c251a2cfb109f0dc2d1 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 12:44:18 +0000 Subject: [PATCH 50/69] Doc comments for HostPortPair --- src/URI/HostPortPair.purs | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/URI/HostPortPair.purs b/src/URI/HostPortPair.purs index 27a11f9..4fa15a2 100644 --- a/src/URI/HostPortPair.purs +++ b/src/URI/HostPortPair.purs @@ -13,8 +13,23 @@ import URI.Host as Host import URI.Port (Port) import URI.Port as Port +-- | A spec-conformant host/port pair (may also be empty). +-- | For example: `purescript.org`, `localhost:3000`, `:9000`. type HostPortPair host port = Maybe (These host port) +-- | A parser for a spec-conformant host/port pair. +-- | +-- | Additionally, this function allows for the `Host` and `Port` components to +-- | be parsed into custom representations. If this is not necessary, use `pure` +-- | for both these arguments. +-- | +-- | Host parsing is dealt with a little differently to all the other URI +-- | components, as for hosts the control is passed entirely to the component +-- | parser. This is to accomodate multi-host URIs that are used sometimes for +-- | connection strings and the like, but as these are not spec-conforming this +-- | part of parsing may need to bend the rules a little. See +-- | [`URI.Extra.MultiHostPortPair`](../URI.Extra.MultiHostPortPair) for an +-- | example of this. parser ∷ ∀ host port . (Host → Either URIPartParseError host) @@ -29,6 +44,11 @@ parser parseHost parsePort = do Just h, Just p → Just (Both h p) Nothing, Nothing → Nothing +-- | A printer for a spec-conformant host/port pair. +-- | +-- | As a counterpart to the `parser` this function also requires the `Host` +-- | and `Port` components to be printed back from their custom representations. +-- | If no custom types are being used, pass `id` for both of these arguments. print ∷ ∀ host port . (host → Host) From 98e99ad20d27ec10b898e6eb31028603936e4b57 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 12:50:16 +0000 Subject: [PATCH 51/69] Port doc comments --- src/URI/Port.purs | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/src/URI/Port.purs b/src/URI/Port.purs index 026fb53..77fd8f4 100644 --- a/src/URI/Port.purs +++ b/src/URI/Port.purs @@ -10,8 +10,6 @@ module URI.Port import Prelude import Data.Array as Array -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) import Data.Int (fromNumber) import Data.Maybe (Maybe(..)) import Data.String as String @@ -21,40 +19,47 @@ import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.String (char) import Text.Parsing.Parser.Token (digit) +-- | The port component of a host in a URI. newtype Port = Port Int derive newtype instance eqPort ∷ Eq Port derive newtype instance ordPort ∷ Ord Port -derive instance genericPort ∷ Generic Port _ -instance showPort ∷ Show Port where show = genericShow +instance showPort ∷ Show Port where + show (Port i) = "(Port.unsafeFromInt " <> show i <> ")" + +-- | Returns the port number as an integer. toInt ∷ Port → Int toInt (Port i) = i --- | Constructs a `Port` safely: bounds-checks the value to ensure it occurs --- | within the range 0-65535 (inclusive). +-- | Attempts to create a port from the passed integer. If the value falls +-- | outside of the range 0-65535 (inclusive) `Nothing` will be returned. fromInt ∷ Int → Maybe Port -fromInt n - | n >= 0 && n <= 65535 = Just (Port n) +fromInt i + | i >= 0 && i <= 65535 = Just (Port i) | otherwise = Nothing --- | Constructs a `Port` unsafely: if the value is outside the allowable range, --- | a runtime error will be thrown. +-- | Constructs a port from an integer directly: if the value is not an +-- | acceptable port number a runtime error will be thrown. -- | -- | This is intended as a convenience when describing `Port`s statically in -- | PureScript code, in all other cases `fromInt` should be preferred. unsafeFromInt ∷ Int → Port -unsafeFromInt n = - case fromInt n of +unsafeFromInt i = + case fromInt i of Just addr → addr - Nothing → unsafeCrashWith "Port was out of range" + Nothing → unsafeCrashWith $ "Port value " <> show i <> " is out of range" +-- | A parser for the port component of a host in a URI. Expects values with a +-- | `':'` prefix. parser ∷ Parser String Port parser = do s ← String.fromCharArray <$> (char ':' *> Array.some digit) case fromNumber $ readInt 10 s of Just x → pure (Port x) - _ → fail "Expected valid port number" + _ → fail "Expected a valid port number" +-- | A printer for the port component of a host in a URI. Will print the value +-- | with a `':'` prefix. print ∷ Port → String print (Port x) = ":" <> show x From 64478e6922c89c155dccd162d867ee5214b8ad72 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 12:54:26 +0000 Subject: [PATCH 52/69] Tweak examples of authority option types usage --- src/URI/Authority.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/URI/Authority.purs b/src/URI/Authority.purs index e70c083..35a808e 100644 --- a/src/URI/Authority.purs +++ b/src/URI/Authority.purs @@ -47,7 +47,7 @@ type AuthorityOptions userInfo hosts = -- | A row type for describing the options fields used by the authority parser. -- | --- | Used as `Record (AuthorityParseOptions userInfo hosts)` when typing a +-- | Used as `Record (AuthorityParseOptions userInfo hosts ())` when typing a -- | value. type AuthorityParseOptions userInfo hosts r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo @@ -57,7 +57,7 @@ type AuthorityParseOptions userInfo hosts r = -- | A row type for describing the options fields used by the authority printer. -- | --- | Used as `Record (AuthorityPrintOptions userInfo hosts)` when typing a +-- | Used as `Record (AuthorityPrintOptions userInfo hosts ())` when typing a -- | value. type AuthorityPrintOptions userInfo hosts r = ( printUserInfo ∷ userInfo → UserInfo From 5d81aa9306e1410acf3b65cbeeb6880268bfb0bf Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 13:07:52 +0000 Subject: [PATCH 53/69] HierarchicalPart doc comments --- src/URI/HierarchicalPart.purs | 47 ++++++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) diff --git a/src/URI/HierarchicalPart.purs b/src/URI/HierarchicalPart.purs index 9ef3d24..737ca3b 100644 --- a/src/URI/HierarchicalPart.purs +++ b/src/URI/HierarchicalPart.purs @@ -37,7 +37,13 @@ import URI.Path.Absolute as PathAbs import URI.Path.Rootless (PathRootless(..)) import URI.Path.Rootless as PathRootless --- | The "hierarchical part" of a generic or absolute URI. +-- | The "hierarchical part" of a generic or absolute URI. This combines an +-- | authority (optional) with a path value. +-- | +-- | When the authority is present a generic path representation can be used, +-- | otherwise there are some restrictions on the path construction to ensure +-- | no ambiguity in parsing (this is per the spec, not a restriction of the +-- | library). data HierarchicalPart userInfo hosts path hierPath = HierarchicalPartAuth (Authority userInfo hosts) (Maybe path) | HierarchicalPartNoAuth (Maybe hierPath) @@ -47,10 +53,20 @@ derive instance ordHierarchicalPart ∷ (Ord userInfo, Ord hosts, Ord path, Ord derive instance genericHierarchicalPart ∷ Generic (HierarchicalPart userInfo hosts path hierPath) _ instance showHierarchicalPart ∷ (Show userInfo, Show hosts, Show path, Show hierPath) ⇒ Show (HierarchicalPart userInfo hosts path hierPath) where show = genericShow +-- | A row type for describing the options fields used by the hierarchical-part +-- | parser and printer. +-- | +-- | Used as `Record (HierarchicalPartOptions userInfo hosts path hierPath)` +-- | when typing a value. type HierarchicalPartOptions userInfo hosts path hierPath = HierarchicalPartParseOptions userInfo hosts path hierPath (HierarchicalPartPrintOptions userInfo hosts path hierPath ()) +-- | A row type for describing the options fields used by the hierarchical-part +-- | parser. +-- | +-- | Used as `Record (HierarchicalPartParseOptions userInfo hosts path hierPath ())` +-- | when typing a value. type HierarchicalPartParseOptions userInfo hosts path hierPath r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo , parseHosts ∷ Parser String hosts @@ -59,6 +75,11 @@ type HierarchicalPartParseOptions userInfo hosts path hierPath r = | r ) +-- | A row type for describing the options fields used by the hierarchical-part +-- | printer. +-- | +-- | Used as `Record (HierarchicalPartPrintOptions userInfo hosts path hierPath ())` +-- | when typing a value. type HierarchicalPartPrintOptions userInfo hosts path hierPath r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts → String @@ -67,8 +88,19 @@ type HierarchicalPartPrintOptions userInfo hosts path hierPath r = | r ) +-- | The specific path types supported in a hierarchical-part when there is no +-- | authority present. See [`URI.Path.Absolute`](../URI.Path.Absolute) and +-- | [`URI.Path.Rootless`](../URI.Path.Rootless) for an explanation of these +-- | forms. type HierPath = Either PathAbsolute PathRootless +-- | A parser for the hierarchical-part of a URI. +-- | +-- | Accepts an options record to allow custom representations to be used for +-- | the URI components. If this is not necessary, `pure` can be used for all +-- | the options aside from `parseHosts`, which will typically be +-- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) +-- | for more information on the host/port pair parser. parser ∷ ∀ userInfo hosts path hierPath r . Record (HierarchicalPartParseOptions userInfo hosts path hierPath r) @@ -86,6 +118,14 @@ parser opts = withAuth <|> withoutAuth <|> (Just <$> wrapParser (opts.parseHierPath <<< Right) PathRootless.parse) <|> pure Nothing +-- | A printer for the hierarchical-part of a URI. +-- | +-- | As a counterpart to the `parser` this function also requires an options +-- | record that specifies how to print values back from custom representations. +-- | If this is not necessary, `id` can be used for all the options aside from +-- | `printHosts`, which will typically be `HostPortPair.printHosts id id`. +-- | See [`URI.HostPortPair`](../URI.HostPortPair) for more information on the +-- | host/port pair printer. print ∷ ∀ userInfo hosts path hierPath r . Record (HierarchicalPartPrintOptions userInfo hosts path hierPath r) @@ -99,6 +139,7 @@ print opts = case _ of HierarchicalPartNoAuth p → maybe "" (either PathAbs.print PathRootless.print <<< opts.printHierPath) p +-- | An affine traversal for the authority component of a hierarchical-part. _authority ∷ ∀ userInfo hosts path hierPath . Traversal' @@ -108,6 +149,8 @@ _authority = wander \f → case _ of HierarchicalPartAuth a p → flip HierarchicalPartAuth p <$> f a a → pure a +-- | An affine traversal for the path component of a hierarchical-part, this +-- | succeeds when the authority is present also. _path ∷ ∀ userInfo hosts path hierPath . Traversal' @@ -117,6 +160,8 @@ _path = wander \f → case _ of HierarchicalPartAuth a p → HierarchicalPartAuth a <$> f p a → pure a +-- | An affine traversal for the path component of a hierarchical-part, this +-- | succeeds when the authority is not present. _hierPath ∷ ∀ userInfo hosts path hierPath . Traversal' From 6316dd06696e29061ee8c1de90a9aa6bad950cdb Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 2 Mar 2018 17:41:09 +0400 Subject: [PATCH 54/69] Newtype instance for UserPassInfo --- src/URI/Extra/UserPassInfo.purs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/URI/Extra/UserPassInfo.purs b/src/URI/Extra/UserPassInfo.purs index e212f6b..3921a08 100644 --- a/src/URI/Extra/UserPassInfo.purs +++ b/src/URI/Extra/UserPassInfo.purs @@ -9,6 +9,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype) import Data.String as String import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES @@ -21,6 +22,7 @@ newtype UserPassInfo = UserPassInfo { user ∷ NonEmptyString, password ∷ Mayb derive instance eqUserPassInfo ∷ Eq UserPassInfo derive instance ordUserPassInfo ∷ Ord UserPassInfo +derive instance newtypeUserPassInfo ∷ Newtype UserPassInfo _ instance showUserPassInfo ∷ Show UserPassInfo where show (UserPassInfo { user, password }) = From f868610ef38e18786ec52d623aadc3325cad7684 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 14:15:09 +0000 Subject: [PATCH 55/69] Path doc comments (and added TODO for NEA note) --- src/URI/Path.purs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/URI/Path.purs b/src/URI/Path.purs index a77b111..ba607d8 100644 --- a/src/URI/Path.purs +++ b/src/URI/Path.purs @@ -11,7 +11,11 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) -newtype Path = Path (Array PathSegment) +-- | A generic absolute path. Used in both hierarchical-part and relative-parts +-- | when an authority component is present. Corresponds to path-abempty in +-- | the spec (although the empty part is tracked in a `Maybe` in +-- | `HierarchicalPart` or `RelativePart` in this library). +newtype Path = Path (Array PathSegment) -- TODO: this should use `NonEmptyArray` derive newtype instance eqPath ∷ Eq Path derive newtype instance ordPath ∷ Ord Path @@ -20,8 +24,10 @@ derive newtype instance monoidPath ∷ Monoid Path derive instance genericPath ∷ Generic Path _ instance showPath ∷ Show Path where show = genericShow +-- | A parser for a generic absolute path URI component. parser ∷ Parser String Path parser = Path <$> Array.some (char '/' *> parseSegment) +-- | A printer for a generic absolute path URI component. print ∷ Path → String print (Path segs) = "/" <> String.joinWith "/" (map unsafeSegmentToString segs) From 8dbdf12fd3c4f0f942613a01da620621feb08db7 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 15:48:46 +0000 Subject: [PATCH 56/69] Make `Path` match path-abempty from the spec --- src/URI/HierarchicalPart.purs | 14 ++++--------- src/URI/Path.purs | 17 ++++++++------- src/URI/RelativePart.purs | 14 ++++--------- test/URI/AbsoluteURI.purs | 4 ++-- test/URI/Extra/MultiHostPortPair.purs | 6 +++--- test/URI/URIRef.purs | 30 ++++++++++++++------------- 6 files changed, 39 insertions(+), 46 deletions(-) diff --git a/src/URI/HierarchicalPart.purs b/src/URI/HierarchicalPart.purs index 737ca3b..6884c3d 100644 --- a/src/URI/HierarchicalPart.purs +++ b/src/URI/HierarchicalPart.purs @@ -18,15 +18,12 @@ module URI.HierarchicalPart import Prelude import Control.Alt ((<|>)) -import Data.Array as Array import Data.Either (Either(..), either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) -import Data.String as String import Text.Parsing.Parser (Parser) -import Text.Parsing.Parser.Combinators (optionMaybe) import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import URI.Authority as Authority import URI.Common (URIPartParseError, wrapParser) @@ -45,7 +42,7 @@ import URI.Path.Rootless as PathRootless -- | no ambiguity in parsing (this is per the spec, not a restriction of the -- | library). data HierarchicalPart userInfo hosts path hierPath - = HierarchicalPartAuth (Authority userInfo hosts) (Maybe path) + = HierarchicalPartAuth (Authority userInfo hosts) path | HierarchicalPartNoAuth (Maybe hierPath) derive instance eqHierarchicalPart ∷ (Eq userInfo, Eq hosts, Eq path, Eq hierPath) ⇒ Eq (HierarchicalPart userInfo hosts path hierPath) @@ -110,7 +107,7 @@ parser opts = withAuth <|> withoutAuth withAuth = HierarchicalPartAuth <$> Authority.parser opts - <*> optionMaybe (wrapParser opts.parsePath Path.parser) + <*> wrapParser opts.parsePath Path.parser withoutAuth = HierarchicalPartNoAuth <$> noAuthPath noAuthPath @@ -132,10 +129,7 @@ print → HierarchicalPart userInfo hosts path hierPath → String print opts = case _ of HierarchicalPartAuth a p → - String.joinWith "" $ Array.catMaybes - [ pure $ Authority.print opts a - , Path.print <<< opts.printPath <$> p - ] + Authority.print opts a <> Path.print (opts.printPath p) HierarchicalPartNoAuth p → maybe "" (either PathAbs.print PathRootless.print <<< opts.printHierPath) p @@ -155,7 +149,7 @@ _path ∷ ∀ userInfo hosts path hierPath . Traversal' (HierarchicalPart userInfo hosts path hierPath) - (Maybe path) + path _path = wander \f → case _ of HierarchicalPartAuth a p → HierarchicalPartAuth a <$> f p a → pure a diff --git a/src/URI/Path.purs b/src/URI/Path.purs index ba607d8..cd386a3 100644 --- a/src/URI/Path.purs +++ b/src/URI/Path.purs @@ -11,11 +11,12 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) --- | A generic absolute path. Used in both hierarchical-part and relative-parts --- | when an authority component is present. Corresponds to path-abempty in --- | the spec (although the empty part is tracked in a `Maybe` in --- | `HierarchicalPart` or `RelativePart` in this library). -newtype Path = Path (Array PathSegment) -- TODO: this should use `NonEmptyArray` +-- | A generic absolute (or empty) path, used in both hierarchical-part and +-- | relative-parts when an authority component is present. Corresponds to +-- | path-abempty in the spec. +-- | +-- | A path value of `/` corresponds to `Path [""]`, an empty path is `Path []`. +newtype Path = Path (Array PathSegment) derive newtype instance eqPath ∷ Eq Path derive newtype instance ordPath ∷ Ord Path @@ -26,8 +27,10 @@ instance showPath ∷ Show Path where show = genericShow -- | A parser for a generic absolute path URI component. parser ∷ Parser String Path -parser = Path <$> Array.some (char '/' *> parseSegment) +parser = Path <$> Array.many (char '/' *> parseSegment) -- | A printer for a generic absolute path URI component. print ∷ Path → String -print (Path segs) = "/" <> String.joinWith "/" (map unsafeSegmentToString segs) +print (Path segs) + | Array.null segs = "" + | otherwise = "/" <> String.joinWith "/" (map unsafeSegmentToString segs) diff --git a/src/URI/RelativePart.purs b/src/URI/RelativePart.purs index 1e2cb4e..f5f02c6 100644 --- a/src/URI/RelativePart.purs +++ b/src/URI/RelativePart.purs @@ -18,15 +18,12 @@ module URI.RelativePart import Prelude import Control.Alt ((<|>)) -import Data.Array as Array import Data.Either (Either(..), either) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Lens (Traversal', wander) import Data.Maybe (Maybe(..), maybe) -import Data.String as String import Text.Parsing.Parser (Parser) -import Text.Parsing.Parser.Combinators (optionMaybe) import URI.Authority (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), IPv4Address, IPv6Address, Port, RegName, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _hosts, _userInfo) import URI.Authority as Authority import URI.Common (URIPartParseError, wrapParser) @@ -39,7 +36,7 @@ import URI.Path.NoScheme as PathNoScheme -- | The "relative part" of a relative reference. data RelativePart userInfo hosts path relPath - = RelativePartAuth (Authority userInfo hosts) (Maybe path) + = RelativePartAuth (Authority userInfo hosts) path | RelativePartNoAuth (Maybe relPath) derive instance eqRelativePart ∷ (Eq userInfo, Eq hosts, Eq path, Eq relPath) ⇒ Eq (RelativePart userInfo hosts path relPath) @@ -78,7 +75,7 @@ parser opts = withAuth <|> withoutAuth withAuth = RelativePartAuth <$> Authority.parser opts - <*> optionMaybe (wrapParser opts.parsePath Path.parser) + <*> wrapParser opts.parsePath Path.parser withoutAuth = RelativePartNoAuth <$> noAuthPath noAuthPath @@ -92,10 +89,7 @@ print → RelativePart userInfo hosts path relPath → String print opts = case _ of RelativePartAuth a p → - String.joinWith "" $ Array.catMaybes - [ pure $ Authority.print opts a - , Path.print <<< opts.printPath <$> p - ] + Authority.print opts a <> Path.print (opts.printPath p) RelativePartNoAuth p → maybe "" (either PathAbs.print PathNoScheme.print <<< opts.printRelPath) p @@ -112,7 +106,7 @@ _path ∷ ∀ userInfo hosts path relPath . Traversal' (RelativePart userInfo hosts path relPath) - (Maybe path) + path _path = wander \f → case _ of RelativePartAuth a p → RelativePartAuth a <$> f p a → pure a diff --git a/test/URI/AbsoluteURI.purs b/test/URI/AbsoluteURI.purs index 19ec0f7..947cb9a 100644 --- a/test/URI/AbsoluteURI.purs +++ b/test/URI/AbsoluteURI.purs @@ -64,8 +64,8 @@ spec = (Just (Right (PathRootless (Tuple (PathSegment.unsafeSegmentNZFromString $ nes "abc") [PathSegment.unsafeSegmentFromString "def"]))))) Nothing) -path ∷ Array String → Maybe Path -path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString +path ∷ Array String → Path +path = Path <<< map PathSegment.unsafeSegmentFromString options ∷ Record (AbsoluteURIOptions UserInfo (HostPortPair Host Port) Path HierPath Query) options = diff --git a/test/URI/Extra/MultiHostPortPair.purs b/test/URI/Extra/MultiHostPortPair.purs index a728e8c..e1c5fad 100644 --- a/test/URI/Extra/MultiHostPortPair.purs +++ b/test/URI/Extra/MultiHostPortPair.purs @@ -124,12 +124,12 @@ spec = do [ This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1)) , This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 2)) ]) - Nothing) + (path [])) Nothing Nothing)) -path ∷ Array String → Maybe Path -path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString +path ∷ Array String → Path +path = Path <<< map PathSegment.unsafeSegmentFromString options ∷ Record (URIRefOptions UserInfo (MultiHostPortPair Host Port) Path HierPath RelPath Query Fragment) options = diff --git a/test/URI/URIRef.purs b/test/URI/URIRef.purs index 2142edf..76b0df7 100644 --- a/test/URI/URIRef.purs +++ b/test/URI/URIRef.purs @@ -46,7 +46,7 @@ spec = (Scheme.unsafeFromString "sql2") (HierarchicalPartAuth (Authority Nothing Nothing) - Nothing) + (path [])) (Just (Query.unsafeFromString "q=foo&var.bar=baz")) Nothing)) testIso @@ -80,7 +80,7 @@ spec = (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString $ nes "localhost"))))) - Nothing) + (path [])) Nothing Nothing)) testIso @@ -94,7 +94,7 @@ spec = (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString $ nes "1a.example.com"))))) - Nothing) + (path [])) Nothing Nothing)) testIso @@ -119,8 +119,10 @@ spec = (URI (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth - (Authority Nothing (Just (This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1))))) - Nothing) + (Authority + Nothing + (Just (This (IPv4Address (IPv4Address.unsafeFromInts 192 168 0 1))))) + (path [])) Nothing Nothing)) testIso @@ -132,9 +134,9 @@ spec = (Scheme.unsafeFromString "mongodb") (HierarchicalPartAuth (Authority - (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) - (Just (This (NameAddress (RegName.unsafeFromString $ nes "localhost"))))) - Nothing) + (Just (UserInfo.unsafeFromString (nes "sysop:moon"))) + (Just (This (NameAddress (RegName.unsafeFromString $ nes "localhost"))))) + (path [])) Nothing Nothing)) testIso @@ -190,7 +192,7 @@ spec = (Authority Nothing (Just (This (IPv6Address (IPv6Address.unsafeFromString "2001:cdba:0000:0000:0000:0000:3257:9652"))))) - Nothing) + (path [])) Nothing Nothing)) testIso @@ -204,7 +206,7 @@ spec = (Authority Nothing (Just (This (IPv6Address (IPv6Address.unsafeFromString "FE80::0202:B3FF:FE1E:8329"))))) - Nothing) + (path [])) Nothing Nothing)) testIso @@ -218,7 +220,7 @@ spec = (Authority Nothing (Just (Both (IPv6Address (IPv6Address.unsafeFromString "2001:db8::1")) (Port.unsafeFromInt 80)))) - Nothing) + (path [])) Nothing Nothing)) testIso @@ -316,7 +318,7 @@ spec = (Authority Nothing (Just (This (NameAddress (RegName.unsafeFromString $ nes "info.example.com"))))) - Nothing) + (path [])) (Just (Query.unsafeFromString "fred")) Nothing)) testIso @@ -481,8 +483,8 @@ spec = (Just (Query.unsafeFromString "")) (Just (Fragment.unsafeFromString "?sort=asc&q=path:/&salt=1177214")))) -path ∷ Array String → Maybe Path -path = Just <<< Path <<< map PathSegment.unsafeSegmentFromString +path ∷ Array String → Path +path = Path <<< map PathSegment.unsafeSegmentFromString options ∷ Record (URIRefOptions UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment) options = From ae42bc5beccfaa44e19860e5fd89b8c857de3ba3 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 17:55:57 +0000 Subject: [PATCH 57/69] Doc comments for path varieties --- src/URI/Path.purs | 8 ++++---- src/URI/Path/Absolute.purs | 12 ++++++++++++ src/URI/Path/NoScheme.purs | 7 +++++++ src/URI/Path/Rootless.purs | 5 +++++ 4 files changed, 28 insertions(+), 4 deletions(-) diff --git a/src/URI/Path.purs b/src/URI/Path.purs index cd386a3..6da05b2 100644 --- a/src/URI/Path.purs +++ b/src/URI/Path.purs @@ -11,9 +11,9 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Path.Segment (PathSegment, parseSegment, unsafeSegmentToString) --- | A generic absolute (or empty) path, used in both hierarchical-part and +-- | A generic absolute-or-empty path, used in both hierarchical-part and -- | relative-parts when an authority component is present. Corresponds to --- | path-abempty in the spec. +-- | _path-abempty_ in the spec. -- | -- | A path value of `/` corresponds to `Path [""]`, an empty path is `Path []`. newtype Path = Path (Array PathSegment) @@ -25,11 +25,11 @@ derive newtype instance monoidPath ∷ Monoid Path derive instance genericPath ∷ Generic Path _ instance showPath ∷ Show Path where show = genericShow --- | A parser for a generic absolute path URI component. +-- | A parser for a _path-abempty_ URI component. parser ∷ Parser String Path parser = Path <$> Array.many (char '/' *> parseSegment) --- | A printer for a generic absolute path URI component. +-- | A printer for a _path-abempty_ URI component. print ∷ Path → String print (Path segs) | Array.null segs = "" diff --git a/src/URI/Path/Absolute.purs b/src/URI/Path/Absolute.purs index dda98c6..23009a2 100644 --- a/src/URI/Path/Absolute.purs +++ b/src/URI/Path/Absolute.purs @@ -13,6 +13,16 @@ import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (char) import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) +-- | An absolute path, corresponding to _path-absolute_ in the spec. This path +-- | cannot represent the value `//` - it must either be `/`, or start with a +-- | segment that is not empty, for example: `/something`, `/.`, `/..`. This +-- | type can appear in both hierarchical-part and relative-parts to represent +-- | an absolute path when no authority component is present. +-- | +-- | This restriction exists as a value begining with `//` at this point in the +-- | grammar must be an authority, attempting to decide whether a value is an +-- | authority or a path would be ambiguous if `//` paths were allowed. The `//` +-- | path means the same thing as `/` anyway! newtype PathAbsolute = PathAbsolute (Maybe (Tuple PathSegmentNZ (Array PathSegment))) derive instance eqPathAbsolute ∷ Eq PathAbsolute @@ -20,6 +30,7 @@ derive instance ordPathAbsolute ∷ Ord PathAbsolute derive instance genericPathAbsolute ∷ Generic PathAbsolute _ instance showPathAbsolute ∷ Show PathAbsolute where show = genericShow +-- | A parser for a _path-absolute_ URI component. parse ∷ Parser String PathAbsolute parse = do _ ← char '/' @@ -29,6 +40,7 @@ parse = do Nothing → pure (PathAbsolute Nothing) +-- | A printer for a _path-absolute_ URI component. print ∷ PathAbsolute → String print = case _ of PathAbsolute Nothing → diff --git a/src/URI/Path/NoScheme.purs b/src/URI/Path/NoScheme.purs index b5a0c40..5b05665 100644 --- a/src/URI/Path/NoScheme.purs +++ b/src/URI/Path/NoScheme.purs @@ -11,6 +11,11 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Path.Segment (PathSegment, PathSegmentNZNC, parseSegment, parseSegmentNonZeroNoColon, unsafeSegmentNZNCToString, unsafeSegmentToString) +-- | A relative path that doesn't look like a URI scheme, corresponding to +-- | _path-noscheme_ in the spec. This path cannot start with the character +-- | `/`, contain the character `:` before the first `/`, or be entirely empty. +-- | This type can appear in a relative-part when there is no authority +-- | component. newtype PathNoScheme = PathNoScheme (Tuple PathSegmentNZNC (Array PathSegment)) derive instance eqPathNoScheme ∷ Eq PathNoScheme @@ -18,12 +23,14 @@ derive instance ordPathNoScheme ∷ Ord PathNoScheme derive instance genericPathNoScheme ∷ Generic PathNoScheme _ instance showPathNoScheme ∷ Show PathNoScheme where show = genericShow +-- | A parser for a _path-noscheme_ URI component. parse ∷ Parser String PathNoScheme parse = do head ← parseSegmentNonZeroNoColon tail ← Array.many (char '/' *> parseSegment) pure (PathNoScheme (Tuple head tail)) +-- | A printer for a _path-noscheme_ URI component. print ∷ PathNoScheme → String print (PathNoScheme (Tuple head tail)) = case tail of diff --git a/src/URI/Path/Rootless.purs b/src/URI/Path/Rootless.purs index 2f63c9f..f9105fe 100644 --- a/src/URI/Path/Rootless.purs +++ b/src/URI/Path/Rootless.purs @@ -11,6 +11,9 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) +-- | A relative path, corresponding to _path-rootless_ in the spec. This path +-- | cannot start with the character `/` or be entirely empty. This type can +-- | appear in a hierarchical-part when there is no authority component. newtype PathRootless = PathRootless (Tuple PathSegmentNZ (Array PathSegment)) derive instance eqPathRootless ∷ Eq PathRootless @@ -18,12 +21,14 @@ derive instance ordPathRootless ∷ Ord PathRootless derive instance genericPathRootless ∷ Generic PathRootless _ instance showPathRootless ∷ Show PathRootless where show = genericShow +-- | A parser for a _path-rootless_ URI component. parse ∷ Parser String PathRootless parse = do head ← parseSegmentNonZero tail ← Array.many (char '/' *> parseSegment) pure (PathRootless (Tuple head tail)) +-- | A printer for a _path-rootless_ URI component. print ∷ PathRootless → String print = case _ of PathRootless (Tuple head []) → From 2d3a801e77bed040b45bdc3fd86af56cc73f8d6e Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 18:04:16 +0000 Subject: [PATCH 58/69] Adjust some segment stuff for consistency --- src/URI/Path/Absolute.purs | 10 ++--- src/URI/Path/NoScheme.purs | 8 ++-- src/URI/Path/Rootless.purs | 10 ++--- src/URI/Path/Segment.purs | 85 ++++++++++++++++++++++---------------- 4 files changed, 64 insertions(+), 49 deletions(-) diff --git a/src/URI/Path/Absolute.purs b/src/URI/Path/Absolute.purs index 23009a2..09428d6 100644 --- a/src/URI/Path/Absolute.purs +++ b/src/URI/Path/Absolute.purs @@ -11,7 +11,7 @@ import Data.Tuple (Tuple(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.Combinators (optionMaybe) import Text.Parsing.Parser.String (char) -import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) +import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNZ, printSegmentNZ, printSegment) -- | An absolute path, corresponding to _path-absolute_ in the spec. This path -- | cannot represent the value `//` - it must either be `/`, or start with a @@ -34,7 +34,7 @@ instance showPathAbsolute ∷ Show PathAbsolute where show = genericShow parse ∷ Parser String PathAbsolute parse = do _ ← char '/' - optionMaybe parseSegmentNonZero >>= case _ of + optionMaybe parseSegmentNZ >>= case _ of Just head → PathAbsolute <<< Just <<< Tuple head <$> Array.many (char '/' *> parseSegment) Nothing → @@ -46,9 +46,9 @@ print = case _ of PathAbsolute Nothing → "/" PathAbsolute (Just (Tuple head [])) → - "/" <> unsafeSegmentNZToString head + "/" <> printSegmentNZ head PathAbsolute (Just (Tuple head tail)) → "/" - <> unsafeSegmentNZToString head + <> printSegmentNZ head <> "/" - <> String.joinWith "/" (map unsafeSegmentToString tail) + <> String.joinWith "/" (map printSegment tail) diff --git a/src/URI/Path/NoScheme.purs b/src/URI/Path/NoScheme.purs index 5b05665..362b5c8 100644 --- a/src/URI/Path/NoScheme.purs +++ b/src/URI/Path/NoScheme.purs @@ -9,7 +9,7 @@ import Data.String as String import Data.Tuple (Tuple(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Path.Segment (PathSegment, PathSegmentNZNC, parseSegment, parseSegmentNonZeroNoColon, unsafeSegmentNZNCToString, unsafeSegmentToString) +import URI.Path.Segment (PathSegment, PathSegmentNZNC, parseSegment, parseSegmentNZNC, printSegmentNZNC, printSegment) -- | A relative path that doesn't look like a URI scheme, corresponding to -- | _path-noscheme_ in the spec. This path cannot start with the character @@ -26,7 +26,7 @@ instance showPathNoScheme ∷ Show PathNoScheme where show = genericShow -- | A parser for a _path-noscheme_ URI component. parse ∷ Parser String PathNoScheme parse = do - head ← parseSegmentNonZeroNoColon + head ← parseSegmentNZNC tail ← Array.many (char '/' *> parseSegment) pure (PathNoScheme (Tuple head tail)) @@ -34,5 +34,5 @@ parse = do print ∷ PathNoScheme → String print (PathNoScheme (Tuple head tail)) = case tail of - [] → unsafeSegmentNZNCToString head - ps → unsafeSegmentNZNCToString head <> "/" <> String.joinWith "/" (map unsafeSegmentToString tail) + [] → printSegmentNZNC head + ps → printSegmentNZNC head <> "/" <> String.joinWith "/" (map printSegment tail) diff --git a/src/URI/Path/Rootless.purs b/src/URI/Path/Rootless.purs index f9105fe..302b511 100644 --- a/src/URI/Path/Rootless.purs +++ b/src/URI/Path/Rootless.purs @@ -9,7 +9,7 @@ import Data.String as String import Data.Tuple (Tuple(..)) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNonZero, unsafeSegmentNZToString, unsafeSegmentToString) +import URI.Path.Segment (PathSegment, PathSegmentNZ, parseSegment, parseSegmentNZ, printSegmentNZ, printSegment) -- | A relative path, corresponding to _path-rootless_ in the spec. This path -- | cannot start with the character `/` or be entirely empty. This type can @@ -24,7 +24,7 @@ instance showPathRootless ∷ Show PathRootless where show = genericShow -- | A parser for a _path-rootless_ URI component. parse ∷ Parser String PathRootless parse = do - head ← parseSegmentNonZero + head ← parseSegmentNZ tail ← Array.many (char '/' *> parseSegment) pure (PathRootless (Tuple head tail)) @@ -32,8 +32,8 @@ parse = do print ∷ PathRootless → String print = case _ of PathRootless (Tuple head []) → - unsafeSegmentNZToString head + printSegmentNZ head PathRootless (Tuple head tail) → - unsafeSegmentNZToString head + printSegmentNZ head <> "/" - <> String.joinWith "/" (map unsafeSegmentToString tail) + <> String.joinWith "/" (map printSegment tail) diff --git a/src/URI/Path/Segment.purs b/src/URI/Path/Segment.purs index 0bb068a..626ea38 100644 --- a/src/URI/Path/Segment.purs +++ b/src/URI/Path/Segment.purs @@ -1,22 +1,25 @@ module URI.Path.Segment ( PathSegment - , parseSegment , segmentFromString , segmentToString , unsafeSegmentFromString , unsafeSegmentToString + , parseSegment + , printSegment , PathSegmentNZ - , parseSegmentNonZero , segmentNZFromString , segmentNZToString , unsafeSegmentNZFromString , unsafeSegmentNZToString + , parseSegmentNZ + , printSegmentNZ , PathSegmentNZNC - , parseSegmentNonZeroNoColon , segmentNZNCFromString , segmentNZNCToString , unsafeSegmentNZNCFromString , unsafeSegmentNZNCToString + , parseSegmentNZNC + , printSegmentNZNC ) where import Prelude @@ -27,9 +30,10 @@ import Data.String as String import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES import Global (decodeURIComponent) +import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) -import URI.Common (pctEncoded, subDelims, unreserved, printEncoded) +import URI.Common (decodeURIComponent', pctEncoded, printEncoded, printEncoded', subDelims, unreserved) newtype PathSegment = PathSegment String @@ -39,12 +43,6 @@ derive newtype instance ordPathSegment ∷ Ord PathSegment instance showPathSegment ∷ Show PathSegment where show (PathSegment s) = "(PathSegment.unsafeFromString " <> show s <> ")" -parseSegment ∷ Parser String PathSegment -parseSegment = - PathSegment - <<< String.joinWith "" - <$> Array.many (pctEncoded <|> String.singleton <$> segmentChar) - segmentFromString ∷ String → PathSegment segmentFromString = PathSegment <<< printEncoded segmentChar @@ -57,7 +55,16 @@ unsafeSegmentFromString = PathSegment unsafeSegmentToString ∷ PathSegment → String unsafeSegmentToString (PathSegment s) = s -newtype PathSegmentNZ = PathSegmentNZ String +parseSegment ∷ Parser String PathSegment +parseSegment = + PathSegment + <<< String.joinWith "" + <$> Array.many (pctEncoded <|> String.singleton <$> segmentChar) + +printSegment ∷ PathSegment → String +printSegment = unsafeSegmentToString + +newtype PathSegmentNZ = PathSegmentNZ NonEmptyString derive newtype instance eqPathSegmentNZ ∷ Eq PathSegmentNZ derive newtype instance ordPathSegmentNZ ∷ Ord PathSegmentNZ @@ -65,25 +72,29 @@ derive newtype instance ordPathSegmentNZ ∷ Ord PathSegmentNZ instance showPathSegmentNZ ∷ Show PathSegmentNZ where show (PathSegmentNZ s) = "(PathSegmentNZ.unsafeFromString " <> show s <> ")" -parseSegmentNonZero ∷ Parser String PathSegmentNZ -parseSegmentNonZero = - PathSegmentNZ - <<< String.joinWith "" - <$> Array.some (pctEncoded <|> String.singleton <$> segmentChar) - segmentNZFromString ∷ NonEmptyString → PathSegmentNZ -segmentNZFromString s = PathSegmentNZ (printEncoded segmentChar $ NES.toString s) +segmentNZFromString = PathSegmentNZ <<< printEncoded' segmentChar -segmentNZToString ∷ PathSegmentNZ → String -segmentNZToString (PathSegmentNZ s) = decodeURIComponent s +segmentNZToString ∷ PathSegmentNZ → NonEmptyString +segmentNZToString (PathSegmentNZ s) = decodeURIComponent' s unsafeSegmentNZFromString ∷ NonEmptyString → PathSegmentNZ -unsafeSegmentNZFromString = NES.toString >>> PathSegmentNZ +unsafeSegmentNZFromString = PathSegmentNZ -unsafeSegmentNZToString ∷ PathSegmentNZ → String +unsafeSegmentNZToString ∷ PathSegmentNZ → NonEmptyString unsafeSegmentNZToString (PathSegmentNZ s) = s -newtype PathSegmentNZNC = PathSegmentNZNC String +parseSegmentNZ ∷ Parser String PathSegmentNZ +parseSegmentNZ = + PathSegmentNZ + <<< unsafePartial NES.unsafeFromString + <<< String.joinWith "" + <$> Array.some (pctEncoded <|> String.singleton <$> segmentChar) + +printSegmentNZ ∷ PathSegmentNZ → String +printSegmentNZ = NES.toString <<< unsafeSegmentNZToString + +newtype PathSegmentNZNC = PathSegmentNZNC NonEmptyString derive newtype instance eqPathSegmentNZNC ∷ Eq PathSegmentNZNC derive newtype instance ordPathSegmentNZNC ∷ Ord PathSegmentNZNC @@ -91,23 +102,27 @@ derive newtype instance ordPathSegmentNZNC ∷ Ord PathSegmentNZNC instance showPathSegmentNZNC ∷ Show PathSegmentNZNC where show (PathSegmentNZNC s) = "(PathSegmentNZNC.unsafeFromString " <> show s <> ")" -parseSegmentNonZeroNoColon ∷ Parser String PathSegmentNZNC -parseSegmentNonZeroNoColon = - PathSegmentNZNC - <<< String.joinWith "" - <$> Array.some (pctEncoded <|> String.singleton <$> segmentNCChar) +segmentNZNCFromString ∷ NonEmptyString → PathSegmentNZNC +segmentNZNCFromString = PathSegmentNZNC <<< printEncoded' segmentNCChar + +unsafeSegmentNZNCFromString ∷ NonEmptyString → PathSegmentNZNC +unsafeSegmentNZNCFromString = PathSegmentNZNC -segmentNZNCToString ∷ PathSegmentNZNC → String -segmentNZNCToString (PathSegmentNZNC s) = decodeURIComponent s +segmentNZNCToString ∷ PathSegmentNZNC → NonEmptyString +segmentNZNCToString (PathSegmentNZNC s) = decodeURIComponent' s -unsafeSegmentNZNCToString ∷ PathSegmentNZNC → String +unsafeSegmentNZNCToString ∷ PathSegmentNZNC → NonEmptyString unsafeSegmentNZNCToString (PathSegmentNZNC s) = s -segmentNZNCFromString ∷ NonEmptyString → PathSegmentNZNC -segmentNZNCFromString s = PathSegmentNZNC (printEncoded segmentNCChar $ NES.toString s) +parseSegmentNZNC ∷ Parser String PathSegmentNZNC +parseSegmentNZNC = + PathSegmentNZNC + <<< unsafePartial NES.unsafeFromString + <<< String.joinWith "" + <$> Array.some (pctEncoded <|> String.singleton <$> segmentNCChar) -unsafeSegmentNZNCFromString ∷ NonEmptyString → PathSegmentNZNC -unsafeSegmentNZNCFromString = NES.toString >>> PathSegmentNZNC +printSegmentNZNC ∷ PathSegmentNZNC → String +printSegmentNZNC = NES.toString <<< unsafeSegmentNZNCToString segmentChar ∷ Parser String Char segmentChar = segmentNCChar <|> char ':' From 131b869b5d23a18e52565d96dec1897fecd1e8b3 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 18:11:25 +0000 Subject: [PATCH 59/69] The -> a --- src/URI/Query.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/URI/Query.purs b/src/URI/Query.purs index 349c508..c4cf757 100644 --- a/src/URI/Query.purs +++ b/src/URI/Query.purs @@ -63,7 +63,7 @@ toString (Query s) = decodeURIComponent s unsafeFromString ∷ String → Query unsafeFromString = Query --- | Returns the string value for the query without percent-decoding. Only +-- | Returns the string value for a query without percent-decoding. Only -- | "unsafe" in the sense that values this produces may need further decoding, -- | the name is more for symmetry with the `fromString`/`unsafeFromString` -- | pairing. From 18365fd2a71010c88d24fa745d2e2c101baa712c Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 18:18:02 +0000 Subject: [PATCH 60/69] Path segment doc comments --- src/URI/Path/Segment.purs | 68 +++++++++++++++++++++++++++++++++++---- 1 file changed, 62 insertions(+), 6 deletions(-) diff --git a/src/URI/Path/Segment.purs b/src/URI/Path/Segment.purs index 626ea38..4009d63 100644 --- a/src/URI/Path/Segment.purs +++ b/src/URI/Path/Segment.purs @@ -35,55 +35,90 @@ import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Common (decodeURIComponent', pctEncoded, printEncoded, printEncoded', subDelims, unreserved) +-- | A path segment. Can be empty, as this is required to represent some paths - +-- | segments are joined together with slashes, so in cases where a path +-- | contains multiple contiguous slashes this is represented by a group of +-- | empty path segments. Corresponds to _segment_ in the spec. newtype PathSegment = PathSegment String derive newtype instance eqPathSegment ∷ Eq PathSegment derive newtype instance ordPathSegment ∷ Ord PathSegment instance showPathSegment ∷ Show PathSegment where - show (PathSegment s) = "(PathSegment.unsafeFromString " <> show s <> ")" + show (PathSegment s) = "(Segment.unsafeSegmentToString " <> show s <> ")" +-- | Constructs a segment value from a string, percent-encoding any characters +-- | that require it. Note that running this on a string that has already had +-- | percent-encoding applied will double-encode it, for those situations use +-- | `unsafeSegmentFromString` instead. segmentFromString ∷ String → PathSegment segmentFromString = PathSegment <<< printEncoded segmentChar +-- | Returns the string value for a segment, percent-decoding any characters +-- | that require it. segmentToString ∷ PathSegment → String segmentToString (PathSegment s) = decodeURIComponent s +-- | Constructs a segment value from a string directly - no percent-encoding +-- | will be applied. This is useful when using a custom encoding scheme for +-- | the segment, to prevent double-encoding. unsafeSegmentFromString ∷ String → PathSegment unsafeSegmentFromString = PathSegment +-- | Returns the string value for the segment without percent-decoding. Only +-- | "unsafe" in the sense that values this produces may need further decoding, +-- | the name is more for symmetry with the `segmentFromString`/ +-- | `unsafeSegmentFromString` pairing. unsafeSegmentToString ∷ PathSegment → String unsafeSegmentToString (PathSegment s) = s +-- | A parser for a _segment_ component of a URI. parseSegment ∷ Parser String PathSegment parseSegment = PathSegment <<< String.joinWith "" <$> Array.many (pctEncoded <|> String.singleton <$> segmentChar) +-- | A printer for a _segment_ component of a URI. printSegment ∷ PathSegment → String printSegment = unsafeSegmentToString +-- | A path segment that cannot be empty. Corresponds to _segment-nz_ in the +-- | spec. newtype PathSegmentNZ = PathSegmentNZ NonEmptyString derive newtype instance eqPathSegmentNZ ∷ Eq PathSegmentNZ derive newtype instance ordPathSegmentNZ ∷ Ord PathSegmentNZ instance showPathSegmentNZ ∷ Show PathSegmentNZ where - show (PathSegmentNZ s) = "(PathSegmentNZ.unsafeFromString " <> show s <> ")" + show (PathSegmentNZ s) = "(Segment.unsafeSegmentNZFromString " <> show s <> ")" +-- | Constructs a non-empty segment value from a string, percent-encoding any +-- | characters that require it. Note that running this on a string that has +-- | already had percent-encoding applied will double-encode it, for those +-- | situations use `unsafeSegmentNZFromString` instead. segmentNZFromString ∷ NonEmptyString → PathSegmentNZ segmentNZFromString = PathSegmentNZ <<< printEncoded' segmentChar +-- | Returns the string value for a non-empty segment, percent-decoding any +-- | characters that require it. segmentNZToString ∷ PathSegmentNZ → NonEmptyString segmentNZToString (PathSegmentNZ s) = decodeURIComponent' s +-- | Constructs a non-empty segment value from a string directly - no +-- | percent-encoding will be applied. This is useful when using a custom +-- | encoding scheme for the segment, to prevent double-encoding. unsafeSegmentNZFromString ∷ NonEmptyString → PathSegmentNZ unsafeSegmentNZFromString = PathSegmentNZ +-- | Returns the string value for a non-empty segment without percent-decoding. +-- | Only "unsafe" in the sense that values this produces may need further +-- | decoding, the name is more for symmetry with the `segmentNZFromString`/ +-- | `unsafeSegmentNZFromString` pairing. unsafeSegmentNZToString ∷ PathSegmentNZ → NonEmptyString unsafeSegmentNZToString (PathSegmentNZ s) = s +-- | A parser for a _segment-nz_ component of a URI. parseSegmentNZ ∷ Parser String PathSegmentNZ parseSegmentNZ = PathSegmentNZ @@ -91,29 +126,46 @@ parseSegmentNZ = <<< String.joinWith "" <$> Array.some (pctEncoded <|> String.singleton <$> segmentChar) +-- | A printer for a _segment-nz_ component of a URI. printSegmentNZ ∷ PathSegmentNZ → String printSegmentNZ = NES.toString <<< unsafeSegmentNZToString +-- | A path segment that cannot be empty or contain the `:` character. +-- | Corresponds to _segment-nz-nc_ in the spec. newtype PathSegmentNZNC = PathSegmentNZNC NonEmptyString derive newtype instance eqPathSegmentNZNC ∷ Eq PathSegmentNZNC derive newtype instance ordPathSegmentNZNC ∷ Ord PathSegmentNZNC instance showPathSegmentNZNC ∷ Show PathSegmentNZNC where - show (PathSegmentNZNC s) = "(PathSegmentNZNC.unsafeFromString " <> show s <> ")" + show (PathSegmentNZNC s) = "(Segment.unsafeSegmentNZNCToString " <> show s <> ")" +-- | Constructs a non-empty-no-colon segment value from a string, +-- | percent-encoding any characters that require it. Note that running this on +-- | a string that has already had percent-encoding applied will double-encode +-- | it, for those situations use `unsafeSegmentNZNCFromString` instead. segmentNZNCFromString ∷ NonEmptyString → PathSegmentNZNC segmentNZNCFromString = PathSegmentNZNC <<< printEncoded' segmentNCChar -unsafeSegmentNZNCFromString ∷ NonEmptyString → PathSegmentNZNC -unsafeSegmentNZNCFromString = PathSegmentNZNC - +-- | Constructs a non-empty-no-colon segment value from a string directly - no +-- | percent-encoding will be applied. This is useful when using a custom +-- | encoding scheme for the segment, to prevent double-encoding. segmentNZNCToString ∷ PathSegmentNZNC → NonEmptyString segmentNZNCToString (PathSegmentNZNC s) = decodeURIComponent' s +-- | Returns the string value for a non-empty-no-colon segment, percent-decoding +-- | any characters that require it. +unsafeSegmentNZNCFromString ∷ NonEmptyString → PathSegmentNZNC +unsafeSegmentNZNCFromString = PathSegmentNZNC + +-- | Returns the string value for the non-empty-no-colon segment without +-- | percent-decoding. Only "unsafe" in the sense that values this produces may +-- | need further decoding, the name is more for symmetry with the +-- | `segmentNZNCFromString`/`unsafeSegmentNZNCFromString` pairing. unsafeSegmentNZNCToString ∷ PathSegmentNZNC → NonEmptyString unsafeSegmentNZNCToString (PathSegmentNZNC s) = s +-- | A parser for a _segment-nz-nc_ component of a URI. parseSegmentNZNC ∷ Parser String PathSegmentNZNC parseSegmentNZNC = PathSegmentNZNC @@ -121,11 +173,15 @@ parseSegmentNZNC = <<< String.joinWith "" <$> Array.some (pctEncoded <|> String.singleton <$> segmentNCChar) +-- | A printer for a _segment-nz-nc_ component of a URI. printSegmentNZNC ∷ PathSegmentNZNC → String printSegmentNZNC = NES.toString <<< unsafeSegmentNZNCToString +-- | The supported path segment characters, excluding percent-encodings. segmentChar ∷ Parser String Char segmentChar = segmentNCChar <|> char ':' +-- | The supported no-colon path segment characters, excluding +-- | percent-encodings. segmentNCChar ∷ Parser String Char segmentNCChar = unreserved <|> subDelims <|> char '@' From d3cc1785b52ea5144d874d6161bc1b2719383161 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 16 Mar 2018 15:26:21 +0100 Subject: [PATCH 61/69] Remove `';'` from `keyPartChar` --- src/URI/Extra/QueryPairs.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/URI/Extra/QueryPairs.purs b/src/URI/Extra/QueryPairs.purs index d2fe749..5455f37 100644 --- a/src/URI/Extra/QueryPairs.purs +++ b/src/URI/Extra/QueryPairs.purs @@ -120,7 +120,7 @@ parsePart parseK parseV = do keyPartChar ∷ Parser String Char keyPartChar = unreserved - <|> oneOf ['!', '$', '\'', '(', ')', '*', '+', ';', ',', ':', '@', '/', '?'] + <|> oneOf ['!', '$', '\'', '(', ')', '*', '+', ',', ':', '@', '/', '?'] valuePartChar ∷ Parser String Char valuePartChar = keyPartChar <|> char '=' From 4fb7a710332897abaf6737022f0d49e6b46e3da3 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 16 Mar 2018 15:32:26 +0100 Subject: [PATCH 62/69] use in QueryPairs tests --- test/URI/Extra/QueryPairs.purs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/URI/Extra/QueryPairs.purs b/test/URI/Extra/QueryPairs.purs index e9a8f5d..d2085cf 100644 --- a/test/URI/Extra/QueryPairs.purs +++ b/test/URI/Extra/QueryPairs.purs @@ -23,13 +23,13 @@ spec = , Tuple (NQP.unsafeKeyFromString "key1") (Just (NQP.unsafeValueFromString "value3")) ]) testIso parser printer - "?k%3Dey=value%3D1" + "?k%3Dey=value%3D1%3B2" (NQP.QueryPairs - [ Tuple (NQP.unsafeKeyFromString "k%3Dey") (Just (NQP.unsafeValueFromString "value%3D1")) ]) + [ Tuple (NQP.unsafeKeyFromString "k%3Dey") (Just (NQP.unsafeValueFromString "value%3D1%3B2")) ]) testIso parser printer - "?k%3Dey=value%3D1" + "?k%3Dey=value%3D1%3B2" (NQP.QueryPairs - [ Tuple (NQP.keyFromString "k=ey") (Just (NQP.valueFromString "value=1")) ]) + [ Tuple (NQP.keyFromString "k=ey") (Just (NQP.valueFromString "value=1;2")) ]) testIso parser printer "?" (NQP.QueryPairs []) From 58a08b7e61fbbe0ef852ab5803033464e93e0e76 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 19 Mar 2018 13:08:39 +0000 Subject: [PATCH 63/69] Add common URI schemes --- src/URI/Scheme/Common.purs | 377 +++++++++++++++++++++++++++++++++++++ 1 file changed, 377 insertions(+) create mode 100644 src/URI/Scheme/Common.purs diff --git a/src/URI/Scheme/Common.purs b/src/URI/Scheme/Common.purs new file mode 100644 index 0000000..dc7310e --- /dev/null +++ b/src/URI/Scheme/Common.purs @@ -0,0 +1,377 @@ +-- | Common URI schemes, taken from the list of permanent URI schemes +-- | [assigned by IANA](https://www.iana.org/assignments/uri-schemes/uri-schemes.xhtml). +module URI.Scheme.Common where + +import URI.Scheme (Scheme, unsafeFromString) + +-- | Diameter Protocol ([RFC6733](https://tools.ietf.org/html/rfc6733)) +aaa ∷ Scheme +aaa = unsafeFromString "aaa" + +-- | Diameter Protocol with Secure ([RFC6733](https://tools.ietf.org/html/rfc6733)) +aaas ∷ Scheme +aaas = unsafeFromString "aaas" + +-- | about ([RFC6694](https://tools.ietf.org/html/rfc6694)) +about ∷ Scheme +about = unsafeFromString "about" + +-- | application configuration access ([RFC2244](https://tools.ietf.org/html/rfc2244)) +acap ∷ Scheme +acap = unsafeFromString "acap" + +-- | acct ([RFC7565](https://tools.ietf.org/html/rfc7565)) +acct ∷ Scheme +acct = unsafeFromString "acct" + +-- | Calendar Access Protocol ([RFC4324](https://tools.ietf.org/html/rfc4324)) +cap ∷ Scheme +cap = unsafeFromString "cap" + +-- | content identifier ([RFC2392](https://tools.ietf.org/html/rfc2392)) +cid ∷ Scheme +cid = unsafeFromString "cid" + +-- | coap ([RFC7252](https://tools.ietf.org/html/rfc7252)) +coap ∷ Scheme +coap = unsafeFromString "coap" + +-- | coap+tcp ([RFC8323](https://tools.ietf.org/html/rfc8323)) +coaptcp ∷ Scheme +coaptcp = unsafeFromString "coap+tcp" + +-- | coap+ws ([RFC8323](https://tools.ietf.org/html/rfc8323)) +coapws ∷ Scheme +coapws = unsafeFromString "coap+ws" + +-- | coaps ([RFC7252](https://tools.ietf.org/html/rfc7252)) +coaps ∷ Scheme +coaps = unsafeFromString "coaps" + +-- | coaps+tcp ([RFC8323](https://tools.ietf.org/html/rfc8323)) +coapstcp ∷ Scheme +coapstcp = unsafeFromString "coaps+tcp" + +-- | coaps+ws ([RFC8323](https://tools.ietf.org/html/rfc8323)) +coapsws ∷ Scheme +coapsws = unsafeFromString "coaps+ws" + +-- | TV-Anytime Content Reference ([RFC4078](https://tools.ietf.org/html/rfc4078)) +crid ∷ Scheme +crid = unsafeFromString "crid" + +-- | data ([RFC2397](https://tools.ietf.org/html/rfc2397)) +data_ ∷ Scheme +data_ = unsafeFromString "data" + +-- | dav ([RFC4918](https://tools.ietf.org/html/rfc4918)) +dav ∷ Scheme +dav = unsafeFromString "dav" + +-- | dictionary service protocol ([RFC2229](https://tools.ietf.org/html/rfc2229)) +dict ∷ Scheme +dict = unsafeFromString "dict" + +-- | Domain Name System ([RFC4501](https://tools.ietf.org/html/rfc4501)) +dns ∷ Scheme +dns = unsafeFromString "dns" + +-- | example ([RFC7595](https://tools.ietf.org/html/rfc7595)) +example ∷ Scheme +example = unsafeFromString "example" + +-- | Host-specific file names ([RFC8089](https://tools.ietf.org/html/rfc8089)) +file ∷ Scheme +file = unsafeFromString "file" + +-- | File Transfer Protocol ([RFC1738](https://tools.ietf.org/html/rfc1738)) +ftp ∷ Scheme +ftp = unsafeFromString "ftp" + +-- | Geographic Locations ([RFC5870](https://tools.ietf.org/html/rfc5870)) +geo ∷ Scheme +geo = unsafeFromString "geo" + +-- | go ([RFC3368](https://tools.ietf.org/html/rfc3368)) +go ∷ Scheme +go = unsafeFromString "go" + +-- | The Gopher Protocol ([RFC4266](https://tools.ietf.org/html/rfc4266)) +gopher ∷ Scheme +gopher = unsafeFromString "gopher" + +-- | H.323 ([RFC3508](https://tools.ietf.org/html/rfc3508)) +h323 ∷ Scheme +h323 = unsafeFromString "h323" + +-- | Hypertext Transfer Protocol ([RFC7230, Section 2.7.1](https://tools.ietf.org/html/rfc7230#section-2.7.1)) +http ∷ Scheme +http = unsafeFromString "http" + +-- | Hypertext Transfer Protocol Secure ([RFC7230, Section 2.7.2](https://tools.ietf.org/html/rfc7230#section-2.7.2)) +https ∷ Scheme +https = unsafeFromString "https" + +-- | Inter-Asterisk eXchange Version 2 ([RFC5456](https://tools.ietf.org/html/rfc5456)) +iax ∷ Scheme +iax = unsafeFromString "iax" + +-- | Internet Content Adaptation Protocol ([RFC3507](https://tools.ietf.org/html/rfc3507)) +icap ∷ Scheme +icap = unsafeFromString "icap" + +-- | Instant Messaging ([RFC3860](https://tools.ietf.org/html/rfc3860)) +im ∷ Scheme +im = unsafeFromString "im" + +-- | internet message access protocol ([RFC5092](https://tools.ietf.org/html/rfc5092)) +imap ∷ Scheme +imap = unsafeFromString "imap" + +-- | registry of public namespaces, which ([RFC4452](https://tools.ietf.org/html/rfc4452)) +info ∷ Scheme +info = unsafeFromString "info" + +-- | Internet Printing Protocol ([RFC3510](https://tools.ietf.org/html/rfc3510)) +ipp ∷ Scheme +ipp = unsafeFromString "ipp" + +-- | Internet Printing Protocol over ([RFC7472](https://tools.ietf.org/html/rfc7472)) +ipps ∷ Scheme +ipps = unsafeFromString "ipps" + +-- | Internet Registry Information ([RFC3981](https://tools.ietf.org/html/rfc3981)) +iris ∷ Scheme +iris = unsafeFromString "iris" + +-- | iris.beep ([RFC3983](https://tools.ietf.org/html/rfc3983)) +irisbeep ∷ Scheme +irisbeep = unsafeFromString "iris.beep" + +-- | iris.lwz ([RFC4993](https://tools.ietf.org/html/rfc4993)) +irislwz ∷ Scheme +irislwz = unsafeFromString "iris.lwz" + +-- | iris.xpc ([RFC4992](https://tools.ietf.org/html/rfc4992)) +irisxpc ∷ Scheme +irisxpc = unsafeFromString "iris.xpc" + +-- | iris.xpcs ([RFC4992](https://tools.ietf.org/html/rfc4992)) +irisxpcs ∷ Scheme +irisxpcs = unsafeFromString "iris.xpcs" + +-- | Lightweight Directory Access ([RFC4516](https://tools.ietf.org/html/rfc4516)) +ldap ∷ Scheme +ldap = unsafeFromString "ldap" + +-- | Electronic mail address ([RFC6068](https://tools.ietf.org/html/rfc6068)) +mailto ∷ Scheme +mailto = unsafeFromString "mailto" + +-- | message identifier ([RFC2392](https://tools.ietf.org/html/rfc2392)) +mid ∷ Scheme +mid = unsafeFromString "mid" + +-- | Message Session Relay Protocol ([RFC4975](https://tools.ietf.org/html/rfc4975)) +msrp ∷ Scheme +msrp = unsafeFromString "msrp" + +-- | Message Session Relay Protocol ([RFC4975](https://tools.ietf.org/html/rfc4975)) +msrps ∷ Scheme +msrps = unsafeFromString "msrps" + +-- | Message Tracking Query Protocol ([RFC3887](https://tools.ietf.org/html/rfc3887)) +mtqp ∷ Scheme +mtqp = unsafeFromString "mtqp" + +-- | Mailbox Update (MUPDATE) Protocol ([RFC3656](https://tools.ietf.org/html/rfc3656)) +mupdate ∷ Scheme +mupdate = unsafeFromString "mupdate" + +-- | USENET news ([RFC5538](https://tools.ietf.org/html/rfc5538)) +news ∷ Scheme +news = unsafeFromString "news" + +-- | network file system protocol ([RFC2224](https://tools.ietf.org/html/rfc2224)) +nfs ∷ Scheme +nfs = unsafeFromString "nfs" + +-- | ni ([RFC6920](https://tools.ietf.org/html/rfc6920)) +ni ∷ Scheme +ni = unsafeFromString "ni" + +-- | nih ([RFC6920](https://tools.ietf.org/html/rfc6920)) +nih ∷ Scheme +nih = unsafeFromString "nih" + +-- | USENET news using NNTP access ([RFC5538](https://tools.ietf.org/html/rfc5538)) +nntp ∷ Scheme +nntp = unsafeFromString "nntp" + +-- | opaquelocktokent ([RFC4918](https://tools.ietf.org/html/rfc4918)) +opaquelocktoken ∷ Scheme +opaquelocktoken = unsafeFromString "opaquelocktoken" + +-- | PKCS#11 ([RFC7512](https://tools.ietf.org/html/rfc7512)) +pkcs11 ∷ Scheme +pkcs11 = unsafeFromString "pkcs11" + +-- | Post Office Protocol v3 ([RFC2384](https://tools.ietf.org/html/rfc2384)) +pop ∷ Scheme +pop = unsafeFromString "pop" + +-- | Presence ([RFC3859](https://tools.ietf.org/html/rfc3859)) +pres ∷ Scheme +pres = unsafeFromString "pres" + +-- | reload ([RFC6940](https://tools.ietf.org/html/rfc6940)) +reload ∷ Scheme +reload = unsafeFromString "reload" + +-- | Real-Time Streaming Protocol (RTSP) ([RFC2326](https://tools.ietf.org/html/rfc2326), [RFC7826](https://tools.ietf.org/html/rfc7826)) +rtsp ∷ Scheme +rtsp = unsafeFromString "rtsp" + +-- | Real-Time Streaming Protocol (RTSP) ([RFC2326](https://tools.ietf.org/html/rfc2326), [RFC7826](https://tools.ietf.org/html/rfc7826)) +rtsps ∷ Scheme +rtsps = unsafeFromString "rtsps" + +-- | Real-Time Streaming Protocol (RTSP) ([RFC2326](https://tools.ietf.org/html/rfc2326)) +rtspu ∷ Scheme +rtspu = unsafeFromString "rtspu" + +-- | service location ([RFC2609](https://tools.ietf.org/html/rfc2609)) +service ∷ Scheme +service = unsafeFromString "service" + +-- | session ([RFC6787](https://tools.ietf.org/html/rfc6787)) +session ∷ Scheme +session = unsafeFromString "session" + +-- | Secure Hypertext Transfer Protocol ([RFC2660](https://tools.ietf.org/html/rfc2660)) +shttp ∷ Scheme +shttp = unsafeFromString "shttp" + +-- | ManageSieve Protocol ([RFC5804](https://tools.ietf.org/html/rfc5804)) +sieve ∷ Scheme +sieve = unsafeFromString "sieve" + +-- | session initiation protocol ([RFC3261](https://tools.ietf.org/html/rfc3261)) +sip ∷ Scheme +sip = unsafeFromString "sip" + +-- | secure session initiation protocol ([RFC3261](https://tools.ietf.org/html/rfc3261)) +sips ∷ Scheme +sips = unsafeFromString "sips" + +-- | Short Message Service ([RFC5724](https://tools.ietf.org/html/rfc5724)) +sms ∷ Scheme +sms = unsafeFromString "sms" + +-- | Simple Network Management Protocol ([RFC4088](https://tools.ietf.org/html/rfc4088)) +snmp ∷ Scheme +snmp = unsafeFromString "snmp" + +-- | soap.beep ([RFC4227](https://tools.ietf.org/html/rfc4227)) +soapbeep ∷ Scheme +soapbeep = unsafeFromString "soap.beep" + +-- | soap.beeps ([RFC4227](https://tools.ietf.org/html/rfc4227)) +soapbeeps ∷ Scheme +soapbeeps = unsafeFromString "soap.beeps" + +-- | stun ([RFC7064](https://tools.ietf.org/html/rfc7064)) +stun ∷ Scheme +stun = unsafeFromString "stun" + +-- | stuns ([RFC7064](https://tools.ietf.org/html/rfc7064)) +stuns ∷ Scheme +stuns = unsafeFromString "stuns" + +-- | tag ([RFC4151](https://tools.ietf.org/html/rfc4151)) +tag ∷ Scheme +tag = unsafeFromString "tag" + +-- | telephone ([RFC3966](https://tools.ietf.org/html/rfc3966)) +tel ∷ Scheme +tel = unsafeFromString "tel" + +-- | Reference to interactive sessions ([RFC4248](https://tools.ietf.org/html/rfc4248)) +telnet ∷ Scheme +telnet = unsafeFromString "telnet" + +-- | Trivial File Transfer Protocol ([RFC3617](https://tools.ietf.org/html/rfc3617)) +tftp ∷ Scheme +tftp = unsafeFromString "tftp" + +-- | multipart/related relative reference ([RFC2557](https://tools.ietf.org/html/rfc2557)) +thismessage ∷ Scheme +thismessage = unsafeFromString "thismessage" + +-- | Transaction Internet Protocol ([RFC2371](https://tools.ietf.org/html/rfc2371)) +tip ∷ Scheme +tip = unsafeFromString "tip" + +-- | Interactive 3270 emulation sessions ([RFC6270](https://tools.ietf.org/html/rfc6270)) +tn3270 ∷ Scheme +tn3270 = unsafeFromString "tn3270" + +-- | turn ([RFC7065](https://tools.ietf.org/html/rfc7065)) +turn ∷ Scheme +turn = unsafeFromString "turn" + +-- | turns ([RFC7065](https://tools.ietf.org/html/rfc7065)) +turns ∷ Scheme +turns = unsafeFromString "turns" + +-- | TV Broadcasts ([RFC2838](https://tools.ietf.org/html/rfc2838)) +tv ∷ Scheme +tv = unsafeFromString "tv" + +-- | Uniform Resource Names ([RFC8141](https://tools.ietf.org/html/rfc8141)) +urn ∷ Scheme +urn = unsafeFromString "urn" + +-- | versatile multimedia interface ([RFC2122](https://tools.ietf.org/html/rfc2122)) +vemmi ∷ Scheme +vemmi = unsafeFromString "vemmi" + +-- | Remote Framebuffer Protocol ([RFC7869](https://tools.ietf.org/html/rfc7869)) +vnc ∷ Scheme +vnc = unsafeFromString "vnc" + +-- | WebSocket connections ([RFC6455](https://tools.ietf.org/html/rfc6455)) +ws ∷ Scheme +ws = unsafeFromString "ws" + +-- | Encrypted WebSocket connections ([RFC6455](https://tools.ietf.org/html/rfc6455)) +wss ∷ Scheme +wss = unsafeFromString "wss" + +-- | xcon ([RFC6501](https://tools.ietf.org/html/rfc6501)) +xcon ∷ Scheme +xcon = unsafeFromString "xcon" + +-- | xcon-userid ([RFC6501](https://tools.ietf.org/html/rfc6501)) +xconuserid ∷ Scheme +xconuserid = unsafeFromString "xcon-userid" + +-- | xmlrpc.beep ([RFC3529](https://tools.ietf.org/html/rfc3529)) +xmlrpcbeep ∷ Scheme +xmlrpcbeep = unsafeFromString "xmlrpc.beep" + +-- | xmlrpc.beeps ([RFC3529](https://tools.ietf.org/html/rfc3529)) +xmlrpcbeeps ∷ Scheme +xmlrpcbeeps = unsafeFromString "xmlrpc.beeps" + +-- | Extensible Messaging and Presence ([RFC5122](https://tools.ietf.org/html/rfc5122)) +xmpp ∷ Scheme +xmpp = unsafeFromString "xmpp" + +-- | Z39.50 Retrieval ([RFC2056](https://tools.ietf.org/html/rfc2056)) +z3950r ∷ Scheme +z3950r = unsafeFromString "z39.50r" + +-- | Z39.50 Session ([RFC2056](https://tools.ietf.org/html/rfc2056)) +z3950s ∷ Scheme +z3950s = unsafeFromString "z39.50s" From 5dd71e8894d2735d24cae7960f8cd88aaa2cfc86 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 19 Mar 2018 13:17:07 +0000 Subject: [PATCH 64/69] Scheme `fromString` should fail if input is not fully consumed --- src/URI/Scheme.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/URI/Scheme.purs b/src/URI/Scheme.purs index 027ad0c..9364371 100644 --- a/src/URI/Scheme.purs +++ b/src/URI/Scheme.purs @@ -17,7 +17,7 @@ import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, runParser) -import Text.Parsing.Parser.String (char) +import Text.Parsing.Parser.String (char, eof) import URI.Common (alpha, alphaNum) -- | The scheme part of an absolute URI. For example: `http`, `ftp`, `git`. @@ -40,7 +40,7 @@ instance showScheme ∷ Show Scheme where -- | fromString "" == Nothing -- | ``` fromString ∷ String → Maybe Scheme -fromString = map Scheme <<< hush <<< flip runParser parseScheme +fromString = map Scheme <<< hush <<< flip runParser (parseScheme <* eof) -- | Constructs a `Scheme` part unsafely: if the value is not an acceptable -- | scheme a runtime error will be thrown. From 8047c1b0c2d014c3e1cfd47fc1a3fc5320b20a52 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 19 Mar 2018 13:55:21 +0000 Subject: [PATCH 65/69] Make `pctEncoded` return a `NonEmptyString` --- bower.json | 1 + src/URI/Common.purs | 4 ++-- src/URI/Extra/MultiHostPortPair.purs | 10 +++------- src/URI/Extra/QueryPairs.purs | 5 +++-- src/URI/Fragment.purs | 6 +++--- src/URI/Host/RegName.purs | 11 +++-------- src/URI/Path/Segment.purs | 17 +++++++---------- src/URI/Query.purs | 6 +++--- src/URI/UserInfo.purs | 13 ++++--------- 9 files changed, 29 insertions(+), 44 deletions(-) diff --git a/bower.json b/bower.json index 475dae5..00481e1 100755 --- a/bower.json +++ b/bower.json @@ -17,6 +17,7 @@ "package.json" ], "dependencies": { + "purescript-arrays": "^4.3.0", "purescript-generics-rep": "^5.2.0", "purescript-globals": "^3.0.0", "purescript-integers": "^3.0.0", diff --git a/src/URI/Common.purs b/src/URI/Common.purs index 915c985..c0e4b73 100644 --- a/src/URI/Common.purs +++ b/src/URI/Common.purs @@ -74,12 +74,12 @@ subDelims = oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '=', ','] -- | Parser for a percent-encoded character. -pctEncoded ∷ Parser String String +pctEncoded ∷ Parser String NonEmptyString pctEncoded = do d0 ← char '%' d1 ← hexDigit d2 ← hexDigit - pure $ String.fromCharArray [d0, d1, d2] + pure $ NES.singleton d0 <> NES.singleton d1 <> NES.singleton d2 -- | A helper function for printing URI components using percent-encoding for -- | characters that require it. diff --git a/src/URI/Extra/MultiHostPortPair.purs b/src/URI/Extra/MultiHostPortPair.purs index 60afcc4..ad5ee9e 100644 --- a/src/URI/Extra/MultiHostPortPair.purs +++ b/src/URI/Extra/MultiHostPortPair.purs @@ -8,12 +8,12 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array +import Data.Array.NonEmpty as NEA import Data.Either (Either) import Data.Maybe (Maybe(..)) import Data.String as String import Data.String.NonEmpty as NES import Data.These (These(..)) -import Partial.Unsafe (unsafeCrashWith) import Text.Parsing.Parser (Parser, fail) import Text.Parsing.Parser.Combinators (optionMaybe, sepBy, try) import Text.Parsing.Parser.String (char, oneOf) @@ -61,13 +61,9 @@ parseHost' p = wrapParser p <|> (NameAddress <$> parseRegName') parseRegName' ∷ Parser String RegName -parseRegName' = do - n ← Array.some p - case NES.fromString $ String.joinWith "" n of - Just x → pure $ RegName.unsafeFromString x - Nothing → unsafeCrashWith "This must be unPathSegment.unsafeSegmentNZFromStringreachable as we shuold parse at least one char in `pctEncoded`" +parseRegName' = RegName.unsafeFromString <<< NES.join1With "" <$> NEA.some p where - p = pctEncoded <|> String.singleton <$> c + p = pctEncoded <|> NES.singleton <$> c c = unreserved <|> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '='] print diff --git a/src/URI/Extra/QueryPairs.purs b/src/URI/Extra/QueryPairs.purs index 5455f37..c91ae4c 100644 --- a/src/URI/Extra/QueryPairs.purs +++ b/src/URI/Extra/QueryPairs.purs @@ -25,6 +25,7 @@ import Data.Generic.Rep.Show (genericShow) import Data.Maybe (Maybe(..)) import Data.Monoid (class Monoid) import Data.String as String +import Data.String.NonEmpty as NES import Data.Traversable (traverse) import Data.Tuple (Tuple(..)) import Global (decodeURIComponent) @@ -110,10 +111,10 @@ parsePart → Parser String (Tuple k (Maybe v)) parsePart parseK parseV = do key ← wrapParser (parseK <<< Key) $ - String.joinWith "" <$> Array.some (String.singleton <$> keyPartChar <|> pctEncoded) + NES.joinWith "" <$> Array.some (NES.singleton <$> keyPartChar <|> pctEncoded) value ← wrapParser (traverse (parseV <<< Value)) $ optionMaybe do _ ← char '=' - String.joinWith "" <$> Array.many (String.singleton <$> valuePartChar <|> pctEncoded) + NES.joinWith "" <$> Array.many (NES.singleton <$> valuePartChar <|> pctEncoded) pure $ Tuple key value diff --git a/src/URI/Fragment.purs b/src/URI/Fragment.purs index b1c8ac6..3dd0c67 100644 --- a/src/URI/Fragment.purs +++ b/src/URI/Fragment.purs @@ -13,7 +13,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.Monoid (class Monoid) -import Data.String as String +import Data.String.NonEmpty as NES import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) @@ -71,8 +71,8 @@ unsafeToString (Fragment s) = s parser ∷ Parser String Fragment parser = char '#' *> - (Fragment <<< String.joinWith "" - <$> Array.many (pctEncoded <|> String.singleton <$> fragmentChar)) + (Fragment <<< NES.joinWith "" + <$> Array.many (pctEncoded <|> NES.singleton <$> fragmentChar)) -- | A printer for the fragment component of a URI. Will print the value with -- | a `'#'` prefix. diff --git a/src/URI/Host/RegName.purs b/src/URI/Host/RegName.purs index b1216ea..3e931d6 100644 --- a/src/URI/Host/RegName.purs +++ b/src/URI/Host/RegName.purs @@ -11,11 +11,9 @@ module URI.Host.RegName import Prelude import Control.Alt ((<|>)) -import Data.Array as Array -import Data.String as String +import Data.Array.NonEmpty as NEA import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES -import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) import URI.Common (decodeURIComponent', subDelims, unreserved, pctEncoded, printEncoded') @@ -69,12 +67,9 @@ unsafeToString (RegName s) = s -- | A parser for reg-names. parser ∷ Parser String RegName -parser = - RegName - <<< unsafePartial NES.unsafeFromString - <<< String.joinWith "" <$> Array.some p +parser = RegName <<< NES.join1With "" <$> NEA.some p where - p = pctEncoded <|> String.singleton <$> regNameChar + p = pctEncoded <|> NES.singleton <$> regNameChar -- | A printer for reg-names. print ∷ RegName → String diff --git a/src/URI/Path/Segment.purs b/src/URI/Path/Segment.purs index 4009d63..e746b72 100644 --- a/src/URI/Path/Segment.purs +++ b/src/URI/Path/Segment.purs @@ -26,11 +26,10 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array -import Data.String as String +import Data.Array.NonEmpty as NEA import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES import Global (decodeURIComponent) -import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Common (decodeURIComponent', pctEncoded, printEncoded, printEncoded', subDelims, unreserved) @@ -76,8 +75,8 @@ unsafeSegmentToString (PathSegment s) = s parseSegment ∷ Parser String PathSegment parseSegment = PathSegment - <<< String.joinWith "" - <$> Array.many (pctEncoded <|> String.singleton <$> segmentChar) + <<< NES.joinWith "" + <$> Array.many (pctEncoded <|> NES.singleton <$> segmentChar) -- | A printer for a _segment_ component of a URI. printSegment ∷ PathSegment → String @@ -122,9 +121,8 @@ unsafeSegmentNZToString (PathSegmentNZ s) = s parseSegmentNZ ∷ Parser String PathSegmentNZ parseSegmentNZ = PathSegmentNZ - <<< unsafePartial NES.unsafeFromString - <<< String.joinWith "" - <$> Array.some (pctEncoded <|> String.singleton <$> segmentChar) + <<< NES.join1With "" + <$> NEA.some (pctEncoded <|> NES.singleton <$> segmentChar) -- | A printer for a _segment-nz_ component of a URI. printSegmentNZ ∷ PathSegmentNZ → String @@ -169,9 +167,8 @@ unsafeSegmentNZNCToString (PathSegmentNZNC s) = s parseSegmentNZNC ∷ Parser String PathSegmentNZNC parseSegmentNZNC = PathSegmentNZNC - <<< unsafePartial NES.unsafeFromString - <<< String.joinWith "" - <$> Array.some (pctEncoded <|> String.singleton <$> segmentNCChar) + <<< NES.join1With "" + <$> NEA.some (pctEncoded <|> NES.singleton <$> segmentNCChar) -- | A printer for a _segment-nz-nc_ component of a URI. printSegmentNZNC ∷ PathSegmentNZNC → String diff --git a/src/URI/Query.purs b/src/URI/Query.purs index c4cf757..7cd426b 100644 --- a/src/URI/Query.purs +++ b/src/URI/Query.purs @@ -13,7 +13,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Array as Array import Data.Monoid (class Monoid) -import Data.String as String +import Data.String.NonEmpty as NES import Global (decodeURIComponent) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) @@ -75,8 +75,8 @@ unsafeToString (Query s) = s parser ∷ Parser String Query parser = char '?' *> - (Query <<< String.joinWith "" - <$> Array.many (String.singleton <$> queryChar <|> pctEncoded)) + (Query <<< NES.joinWith "" + <$> Array.many (NES.singleton <$> queryChar <|> pctEncoded)) -- | A printer for the query component of a URI. Will print the value with -- | a `'?'` prefix. diff --git a/src/URI/UserInfo.purs b/src/URI/UserInfo.purs index 6ef3943..ec40829 100644 --- a/src/URI/UserInfo.purs +++ b/src/URI/UserInfo.purs @@ -11,11 +11,9 @@ module URI.UserInfo import Prelude import Control.Alt ((<|>)) -import Data.Array as Array -import Data.String as String +import Data.Array.NonEmpty as NEA import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES -import Partial.Unsafe (unsafePartial) import Text.Parsing.Parser (Parser) import Text.Parsing.Parser.String (char) import URI.Common (decodeURIComponent', subDelims, unreserved, pctEncoded, printEncoded') @@ -72,13 +70,10 @@ unsafeToString (UserInfo s) = s -- | A parser for the user-info component of a URI. parser ∷ Parser String UserInfo -parser = - UserInfo - <<< unsafePartial NES.unsafeFromString - <<< String.joinWith "" <$> Array.some parse +parser = UserInfo <<< NES.join1With "" <$> NEA.some parse where - parse ∷ Parser String String - parse = String.singleton <$> userInfoChar <|> pctEncoded + parse ∷ Parser String NonEmptyString + parse = NES.singleton <$> userInfoChar <|> pctEncoded -- | A printer for the user-info component of a URI. print ∷ UserInfo → String From 7e612b3bf45309ffd06dc63d4aedeac821d4a7e2 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 19 Mar 2018 14:37:26 +0000 Subject: [PATCH 66/69] More doc comment changes --- src/URI/AbsoluteURI.purs | 37 +++++++++++++++++++++++++++++- src/URI/Authority.purs | 11 +++++---- src/URI/HierarchicalPart.purs | 19 +++------------- src/URI/RelativePart.purs | 34 ++++++++++++++++++++++++++- src/URI/RelativeRef.purs | 33 ++++++++++++++++++++++++++- src/URI/URI.purs | 37 +++++++++++++++++++++++++++++- src/URI/URIRef.purs | 43 +++++++++++++++++++++++++++-------- 7 files changed, 180 insertions(+), 34 deletions(-) diff --git a/src/URI/AbsoluteURI.purs b/src/URI/AbsoluteURI.purs index 1b29e7c..afcb1aa 100644 --- a/src/URI/AbsoluteURI.purs +++ b/src/URI/AbsoluteURI.purs @@ -33,7 +33,8 @@ import URI.Query as Query import URI.Scheme (Scheme) import URI.Scheme as Scheme --- | A generic AbsoluteURI +-- | A strictly absolute URI. An absolute URI can still contain relative paths +-- | but is required to have a `Scheme` component. data AbsoluteURI userInfo hosts path hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts path hierPath) (Maybe query) derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq hosts, Eq path, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts path hierPath query) @@ -41,10 +42,28 @@ derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord hosts, Ord path, Ord hierP derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts path hierPath query) _ instance showAbsoluteURI ∷ (Show userInfo, Show hosts, Show path, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts path hierPath query) where show = genericShow +-- | A row type for describing the options fields used by the absolute URI +-- | parser and printer. +-- | +-- | Used as `Record (AbsoluteURIOptions userInfo hosts path hierPath query)` +-- | when type anotating an options record. +-- | +-- | See below for details of how to use these configuration options. type AbsoluteURIOptions userInfo hosts path hierPath query = AbsoluteURIParseOptions userInfo hosts path hierPath query (AbsoluteURIPrintOptions userInfo hosts path hierPath query ()) +-- | A row type for describing the options fields used by the absolute URI +-- | parser. +-- | +-- | Used as `Record (AbsoluteURIParseOptions userInfo hosts path hierPath query ())` +-- | when type anotating an options record. +-- | +-- | Having this options record allows custom representations to be used for +-- | the URI components. If this is not necessary, `pure` can be used for all +-- | the options aside from `parseHosts`, which will typically be +-- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) +-- | for more information on the host/port pair parser. type AbsoluteURIParseOptions userInfo hosts path hierPath query r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo , parseHosts ∷ Parser String hosts @@ -54,6 +73,17 @@ type AbsoluteURIParseOptions userInfo hosts path hierPath query r = | r ) +-- | A row type for describing the options fields used by the absolute URI +-- | printer. +-- | +-- | Used as `Record (AbsoluteURIPrintOptions userInfo hosts path hierPath query ())` +-- | when type anotating an options record. +-- | +-- | As a reverse of the parse options, this specifies how to print values back +-- | from custom representations. If this is not necessary, `id` can be used for +-- | all the options aside from `printHosts`, which will typically be +-- | `HostPortPair.printHosts id id`. See [`URI.HostPortPair`](../URI.HostPortPair) +-- | for more information on the host/port pair printer. type AbsoluteURIPrintOptions userInfo hosts path hierPath query r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts → String @@ -63,6 +93,7 @@ type AbsoluteURIPrintOptions userInfo hosts path hierPath query r = | r ) +-- | A parser for an absolute URI. parser ∷ ∀ userInfo hosts path hierPath query r . Record (AbsoluteURIParseOptions userInfo hosts path hierPath query r) @@ -73,6 +104,7 @@ parser opts = AbsoluteURI <*> optionMaybe (wrapParser opts.parseQuery Query.parser) <* eof +-- | A printer for an absolute URI. print ∷ ∀ userInfo hosts path hierPath query r . Record (AbsoluteURIPrintOptions userInfo hosts path hierPath query r) @@ -85,6 +117,7 @@ print opts (AbsoluteURI s h q) = , Query.print <<< opts.printQuery <$> q ] +-- | The scheme component of an absolute URI. _scheme ∷ ∀ userInfo hosts path hierPath query . Lens' @@ -95,6 +128,7 @@ _scheme = (\(AbsoluteURI s _ _) → s) (\(AbsoluteURI _ h q) s → AbsoluteURI s h q) +-- | The hierarchical-part component of an absolute URI. _hierPart ∷ ∀ userInfo hosts path hierPath query . Lens' @@ -105,6 +139,7 @@ _hierPart = (\(AbsoluteURI _ h _) → h) (\(AbsoluteURI s _ q) h → AbsoluteURI s h q) +-- | The query component of an absolute URI. _query ∷ ∀ userInfo hosts path hierPath query . Lens' diff --git a/src/URI/Authority.purs b/src/URI/Authority.purs index 35a808e..83913c0 100644 --- a/src/URI/Authority.purs +++ b/src/URI/Authority.purs @@ -40,15 +40,16 @@ instance showAuthority ∷ (Show userInfo, Show hosts) ⇒ Show (Authority userI -- | A row type for describing the options fields used by the authority parser -- | and printer. -- | --- | Used as `Record (AuthorityOptions userInfo hosts)` when typing a value. +-- | Used as `Record (AuthorityOptions userInfo hosts)` when type annotating an +-- | options record. type AuthorityOptions userInfo hosts = AuthorityParseOptions userInfo hosts (AuthorityPrintOptions userInfo hosts ()) -- | A row type for describing the options fields used by the authority parser. -- | --- | Used as `Record (AuthorityParseOptions userInfo hosts ())` when typing a --- | value. +-- | Used as `Record (AuthorityParseOptions userInfo hosts ())` when type +-- | annotating an options record. type AuthorityParseOptions userInfo hosts r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo , parseHosts ∷ Parser String hosts @@ -57,8 +58,8 @@ type AuthorityParseOptions userInfo hosts r = -- | A row type for describing the options fields used by the authority printer. -- | --- | Used as `Record (AuthorityPrintOptions userInfo hosts ())` when typing a --- | value. +-- | Used as `Record (AuthorityPrintOptions userInfo hosts ())` when type +-- | annotating an options record. type AuthorityPrintOptions userInfo hosts r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts → String diff --git a/src/URI/HierarchicalPart.purs b/src/URI/HierarchicalPart.purs index 6884c3d..2e6b2d2 100644 --- a/src/URI/HierarchicalPart.purs +++ b/src/URI/HierarchicalPart.purs @@ -54,7 +54,7 @@ instance showHierarchicalPart ∷ (Show userInfo, Show hosts, Show path, Show hi -- | parser and printer. -- | -- | Used as `Record (HierarchicalPartOptions userInfo hosts path hierPath)` --- | when typing a value. +-- | when type anotating an options record. type HierarchicalPartOptions userInfo hosts path hierPath = HierarchicalPartParseOptions userInfo hosts path hierPath (HierarchicalPartPrintOptions userInfo hosts path hierPath ()) @@ -63,7 +63,7 @@ type HierarchicalPartOptions userInfo hosts path hierPath = -- | parser. -- | -- | Used as `Record (HierarchicalPartParseOptions userInfo hosts path hierPath ())` --- | when typing a value. +-- | when type anotating an options record. type HierarchicalPartParseOptions userInfo hosts path hierPath r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo , parseHosts ∷ Parser String hosts @@ -76,7 +76,7 @@ type HierarchicalPartParseOptions userInfo hosts path hierPath r = -- | printer. -- | -- | Used as `Record (HierarchicalPartPrintOptions userInfo hosts path hierPath ())` --- | when typing a value. +-- | when type anotating an options record. type HierarchicalPartPrintOptions userInfo hosts path hierPath r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts → String @@ -92,12 +92,6 @@ type HierarchicalPartPrintOptions userInfo hosts path hierPath r = type HierPath = Either PathAbsolute PathRootless -- | A parser for the hierarchical-part of a URI. --- | --- | Accepts an options record to allow custom representations to be used for --- | the URI components. If this is not necessary, `pure` can be used for all --- | the options aside from `parseHosts`, which will typically be --- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) --- | for more information on the host/port pair parser. parser ∷ ∀ userInfo hosts path hierPath r . Record (HierarchicalPartParseOptions userInfo hosts path hierPath r) @@ -116,13 +110,6 @@ parser opts = withAuth <|> withoutAuth <|> pure Nothing -- | A printer for the hierarchical-part of a URI. --- | --- | As a counterpart to the `parser` this function also requires an options --- | record that specifies how to print values back from custom representations. --- | If this is not necessary, `id` can be used for all the options aside from --- | `printHosts`, which will typically be `HostPortPair.printHosts id id`. --- | See [`URI.HostPortPair`](../URI.HostPortPair) for more information on the --- | host/port pair printer. print ∷ ∀ userInfo hosts path hierPath r . Record (HierarchicalPartPrintOptions userInfo hosts path hierPath r) diff --git a/src/URI/RelativePart.purs b/src/URI/RelativePart.purs index f5f02c6..37001ef 100644 --- a/src/URI/RelativePart.purs +++ b/src/URI/RelativePart.purs @@ -34,7 +34,13 @@ import URI.Path.Absolute as PathAbs import URI.Path.NoScheme (PathNoScheme) import URI.Path.NoScheme as PathNoScheme --- | The "relative part" of a relative reference. +-- | The "relative part" of a relative reference. This combines an authority +-- | (optional) with a path value. +-- | +-- | When the authority is present a generic path representation can be used, +-- | otherwise there are some restrictions on the path construction to ensure +-- | no ambiguity in parsing (this is per the spec, not a restriction of the +-- | library). data RelativePart userInfo hosts path relPath = RelativePartAuth (Authority userInfo hosts) path | RelativePartNoAuth (Maybe relPath) @@ -44,10 +50,20 @@ derive instance ordRelativePart ∷ (Ord userInfo, Ord hosts, Ord path, Ord relP derive instance genericRelativePart ∷ Generic (RelativePart userInfo hosts path relPath) _ instance showRelativePart ∷ (Show userInfo, Show hosts, Show path, Show relPath) ⇒ Show (RelativePart userInfo hosts path relPath) where show = genericShow +-- | A row type for describing the options fields used by the relative-part +-- | parser and printer. +-- | +-- | Used as `Record (RelativePartOptions userInfo hosts path relPath)` +-- | when type annotating an options record. type RelativePartOptions userInfo hosts path relPath = RelativePartParseOptions userInfo hosts path relPath (RelativePartPrintOptions userInfo hosts path relPath ()) +-- | A row type for describing the options fields used by the relative-part +-- | parser. +-- | +-- | Used as `Record (RelativePartParseOptions userInfo hosts path relPath ())` +-- | when type annotating an options record. type RelativePartParseOptions userInfo hosts path relPath r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo , parseHosts ∷ Parser String hosts @@ -56,6 +72,11 @@ type RelativePartParseOptions userInfo hosts path relPath r = | r ) +-- | A row type for describing the options fields used by the relative-part +-- | printer. +-- | +-- | Used as `Record (RelativePartPrintOptions userInfo hosts path relPath ())` +-- | when type annotating an options record. type RelativePartPrintOptions userInfo hosts path relPath r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts → String @@ -64,8 +85,13 @@ type RelativePartPrintOptions userInfo hosts path relPath r = | r ) +-- | The specific path types supported in a relative-part when there is no +-- | authority present. See [`URI.Path.Absolute`](../URI.Path.Absolute) and +-- | [`URI.Path.PathNoScheme`](../URI.Path.PathNoScheme) for an explanation of +-- | these forms. type RelPath = Either PathAbsolute PathNoScheme +-- | A parser for the relative-part of a URI. parser ∷ ∀ userInfo hosts path relPath r . Record (RelativePartParseOptions userInfo hosts path relPath r) @@ -83,6 +109,7 @@ parser opts = withAuth <|> withoutAuth <|> (Just <$> wrapParser (opts.parseRelPath <<< Right) PathNoScheme.parse) <|> pure Nothing +-- | A printer for the relative-part of a URI. print ∷ ∀ userInfo hosts path relPath r . Record (RelativePartPrintOptions userInfo hosts path relPath r) @@ -93,6 +120,7 @@ print opts = case _ of RelativePartNoAuth p → maybe "" (either PathAbs.print PathNoScheme.print <<< opts.printRelPath) p +-- | An affine traversal for the authority component of a relative-part. _authority ∷ ∀ userInfo hosts path relPath . Traversal' @@ -102,6 +130,8 @@ _authority = wander \f → case _ of RelativePartAuth a p → flip RelativePartAuth p <$> f a a → pure a +-- | An affine traversal for the path component of a relative-part, this +-- | succeeds when the authority is present also. _path ∷ ∀ userInfo hosts path relPath . Traversal' @@ -111,6 +141,8 @@ _path = wander \f → case _ of RelativePartAuth a p → RelativePartAuth a <$> f p a → pure a +-- | An affine traversal for the path component of a relative-part, this +-- | succeeds when the authority is not present. _relPath ∷ ∀ userInfo hosts path relPath . Traversal' diff --git a/src/URI/RelativeRef.purs b/src/URI/RelativeRef.purs index 0aad8b5..ebeee17 100644 --- a/src/URI/RelativeRef.purs +++ b/src/URI/RelativeRef.purs @@ -33,7 +33,7 @@ import URI.Query as Query import URI.RelativePart (Authority(..), AuthorityOptions, AuthorityParseOptions, AuthorityPrintOptions, Host(..), IPv4Address, IPv6Address, Path, PathAbsolute, PathNoScheme, Port, RegName, RelPath, RelativePart(..), RelativePartOptions, RelativePartParseOptions, RelativePartPrintOptions, UserInfo, _IPv4Address, _IPv6Address, _NameAddress, _authority, _hosts, _path, _relPath, _userInfo) import URI.RelativePart as RPart --- | A relative reference for a URI. +-- | A relative URI. Relative in the sense that it lacks a `Scheme` component. data RelativeRef userInfo hosts path relPath query fragment = RelativeRef (RelativePart userInfo hosts path relPath) (Maybe query) (Maybe fragment) derive instance eqRelativeRef ∷ (Eq userInfo, Eq hosts, Eq path, Eq relPath, Eq query, Eq fragment) ⇒ Eq (RelativeRef userInfo hosts path relPath query fragment) @@ -41,10 +41,28 @@ derive instance ordRelativeRef ∷ (Ord userInfo, Ord hosts, Ord path, Ord relPa derive instance genericRelativeRef ∷ Generic (RelativeRef userInfo hosts path relPath query fragment) _ instance showRelativeRef ∷ (Show userInfo, Show hosts, Show path, Show relPath, Show query, Show fragment) ⇒ Show (RelativeRef userInfo hosts path relPath query fragment) where show = genericShow +-- | A row type for describing the options fields used by the relative URI +-- | parser and printer. +-- | +-- | Used as `Record (RelativeRefOptions userInfo hosts path relPath query fragment)` +-- | when type anotating an options record. +-- | +-- | See below for details of how to use these configuration options. type RelativeRefOptions userInfo hosts path relPath query fragment = RelativeRefParseOptions userInfo hosts path relPath query fragment (RelativeRefPrintOptions userInfo hosts path relPath query fragment ()) +-- | A row type for describing the options fields used by the relative URI +-- | parser. +-- | +-- | Used as `Record (RelativeRefParseOptions userInfo hosts path relPath query fragment ())` +-- | when type anotating an options record. +-- | +-- | Having this options record allows custom representations to be used for +-- | the URI components. If this is not necessary, `pure` can be used for all +-- | the options aside from `parseHosts`, which will typically be +-- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) +-- | for more information on the host/port pair parser. type RelativeRefParseOptions userInfo hosts path relPath query fragment r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo , parseHosts ∷ Parser String hosts @@ -55,6 +73,14 @@ type RelativeRefParseOptions userInfo hosts path relPath query fragment r = | r ) +-- | A row type for describing the options fields used by the relative URI +-- | printer. +-- | +-- | As a reverse of the parse options, this specifies how to print values back +-- | from custom representations. If this is not necessary, `id` can be used for +-- | all the options aside from `printHosts`, which will typically be +-- | `HostPortPair.printHosts id id`. See [`URI.HostPortPair`](../URI.HostPortPair) +-- | for more information on the host/port pair printer. type RelativeRefPrintOptions userInfo hosts path relPath query fragment r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts → String @@ -65,6 +91,7 @@ type RelativeRefPrintOptions userInfo hosts path relPath query fragment r = | r ) +-- | A parser for a relative URI. parser ∷ ∀ userInfo hosts path relPath query fragment r . Record (RelativeRefParseOptions userInfo hosts path relPath query fragment r) @@ -76,6 +103,7 @@ parser opts = <*> optionMaybe (wrapParser opts.parseFragment Fragment.parser) <* eof +-- | A printer for a relative URI. print ∷ ∀ userInfo hosts path relPath query fragment r . Record (RelativeRefPrintOptions userInfo hosts path relPath query fragment r) @@ -88,6 +116,7 @@ print opts (RelativeRef h q f) = , Fragment.print <<< opts.printFragment <$> f ] +-- | The relative-part component of a relative URI. _relPart ∷ ∀ userInfo hosts path relPath query fragment . Lens' @@ -98,6 +127,7 @@ _relPart = (\(RelativeRef r _ _) → r) (\(RelativeRef _ q f) r → RelativeRef r q f) +-- | The query component of a relative URI. _query ∷ ∀ userInfo hosts path relPath query fragment . Lens' @@ -108,6 +138,7 @@ _query = (\(RelativeRef _ q _) → q) (\(RelativeRef r _ f) q → RelativeRef r q f) +-- | The fragment component of a relative URI. _fragment ∷ ∀ userInfo hosts path relPath query fragment . Lens' diff --git a/src/URI/URI.purs b/src/URI/URI.purs index 1475edb..0ab0220 100644 --- a/src/URI/URI.purs +++ b/src/URI/URI.purs @@ -36,7 +36,9 @@ import URI.Query as Query import URI.Scheme (Scheme) import URI.Scheme as Scheme --- | A generic URI +-- | A general purpose absolute URI - similar to `AbsoluteURI` but also admits +-- | a fragment component. An absolute URI can still contain relative paths +-- | but is required to have a `Scheme` component. data URI userInfo hosts path hierPath query fragment = URI Scheme (HierarchicalPart userInfo hosts path hierPath) (Maybe query) (Maybe fragment) derive instance eqURI ∷ (Eq userInfo, Eq hosts, Eq path, Eq hierPath, Eq query, Eq fragment) ⇒ Eq (URI userInfo hosts path hierPath query fragment) @@ -44,10 +46,27 @@ derive instance ordURI ∷ (Ord userInfo, Ord hosts, Ord path, Ord hierPath, Ord derive instance genericURI ∷ Generic (URI userInfo hosts path hierPath query fragment) _ instance showURI ∷ (Show userInfo, Show hosts, Show path, Show hierPath, Show query, Show fragment) ⇒ Show (URI userInfo hosts path hierPath query fragment) where show = genericShow +-- | A row type for describing the options fields used by the URI parser and +-- | printer. +-- | +-- | Used as `Record (URIOptions userInfo hosts path hierPath query fragment)` +-- | when type anotating an options record. +-- | +-- | See below for details of how to use these configuration options. type URIOptions userInfo hosts path hierPath query fragment = URIParseOptions userInfo hosts path hierPath query fragment (URIPrintOptions userInfo hosts path hierPath query fragment ()) +-- | A row type for describing the options fields used by the URI parser. +-- | +-- | Used as `Record (URIParseOptions userInfo hosts path hierPath query fragment ())` +-- | when type anotating an options record. +-- | +-- | Having this options record allows custom representations to be used for +-- | the URI components. If this is not necessary, `pure` can be used for all +-- | the options aside from `parseHosts`, which will typically be +-- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) +-- | for more information on the host/port pair parser. type URIParseOptions userInfo hosts path hierPath query fragment r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo , parseHosts ∷ Parser String hosts @@ -58,6 +77,16 @@ type URIParseOptions userInfo hosts path hierPath query fragment r = | r ) +-- | A row type for describing the options fields used by the URI printer. +-- | +-- | Used as `Record (URIPrintOptions userInfo hosts path hierPath query fragment ())` +-- | when type anotating an options record. +-- | +-- | As a reverse of the parse options, this specifies how to print values back +-- | from custom representations. If this is not necessary, `id` can be used for +-- | all the options aside from `printHosts`, which will typically be +-- | `HostPortPair.printHosts id id`. See [`URI.HostPortPair`](../URI.HostPortPair) +-- | for more information on the host/port pair printer. type URIPrintOptions userInfo hosts path hierPath query fragment r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts → String @@ -68,6 +97,7 @@ type URIPrintOptions userInfo hosts path hierPath query fragment r = | r ) +-- | A parser for a URI. parser ∷ ∀ userInfo hosts path hierPath query fragment r . Record (URIParseOptions userInfo hosts path hierPath query fragment r) @@ -79,6 +109,7 @@ parser opts = URI <*> optionMaybe (wrapParser opts.parseFragment Fragment.parser) <* eof +-- | A printer for a URI. print ∷ ∀ userInfo hosts path hierPath query fragment r . Record (URIPrintOptions userInfo hosts path hierPath query fragment r) @@ -92,6 +123,7 @@ print opts (URI s h q f) = , Fragment.print <<< opts.printFragment <$> f ] +-- | The scheme component of a URI. _scheme ∷ ∀ userInfo hosts path hierPath query fragment . Lens' @@ -102,6 +134,7 @@ _scheme = (\(URI s _ _ _) → s) (\(URI _ h q f) s → URI s h q f) +-- | The hierarchical-part component of a URI. _hierPart ∷ ∀ userInfo hosts path hierPath query fragment . Lens' @@ -112,6 +145,7 @@ _hierPart = (\(URI _ h _ _) → h) (\(URI s _ q f) h → URI s h q f) +-- | The query component of a URI. _query ∷ ∀ userInfo hosts path hierPath query fragment . Lens' @@ -122,6 +156,7 @@ _query = (\(URI _ _ q _) → q) (\(URI s h _ f) q → URI s h q f) +-- | The fragment component of a URI. _fragment ∷ ∀ userInfo hosts path hierPath query fragment . Lens' diff --git a/src/URI/URIRef.purs b/src/URI/URIRef.purs index 12cc33e..9eba970 100644 --- a/src/URI/URIRef.purs +++ b/src/URI/URIRef.purs @@ -25,7 +25,6 @@ import Prelude import Control.Alt ((<|>)) import Data.Either (Either(..), either) import Text.Parsing.Parser (Parser) -import Text.Parsing.Parser.Combinators (try) import URI.Authority (Authority(..)) import URI.Common (URIPartParseError) import URI.Fragment (Fragment) @@ -43,16 +42,34 @@ import URI.URI (URI(..), HierarchicalPart(..), HierPath) import URI.URI as URI import URI.UserInfo (UserInfo) --- | An alias for the most common use case of resource identifiers. +-- | The most general kind of URI, can either be relative or absolute. type URIRef userInfo hosts path hierPath relPath query fragment = Either (URI.URI userInfo hosts path hierPath query fragment) (RelativeRef.RelativeRef userInfo hosts path relPath query fragment) +-- | A row type for describing the options fields used by the general URI +-- | parser and printer. +-- | +-- | Used as `Record (URIRefOptions userInfo hosts path hierPath relPath query fragment)` +-- | when type anotating an options record. +-- | +-- | See below for details of how to use these configuration options. type URIRefOptions userInfo hosts path hierPath relPath query fragment = URIRefParseOptions userInfo hosts path hierPath relPath query fragment (URIRefPrintOptions userInfo hosts path hierPath relPath query fragment ()) +-- | A row type for describing the options fields used by the general URI +-- | parser. +-- | +-- | Used as `Record (URIRefParseOptions userInfo hosts path hierPath relPath query fragment ())` +-- | when type anotating an options record. +-- | +-- | Having this options record allows custom representations to be used for +-- | the URI components. If this is not necessary, `pure` can be used for all +-- | the options aside from `parseHosts`, which will typically be +-- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair) +-- | for more information on the host/port pair parser. type URIRefParseOptions userInfo hosts path hierPath relPath query fragment r = ( parseUserInfo ∷ UserInfo → Either URIPartParseError userInfo , parseHosts ∷ Parser String hosts @@ -64,6 +81,17 @@ type URIRefParseOptions userInfo hosts path hierPath relPath query fragment r = | r ) +-- | A row type for describing the options fields used by the general URI +-- | printer. +-- | +-- | Used as `Record (URIRefPrintOptions userInfo hosts path hierPath relPath query fragment ())` +-- | when type anotating an options record. +-- | +-- | As a reverse of the parse options, this specifies how to print values back +-- | from custom representations. If this is not necessary, `id` can be used for +-- | all the options aside from `printHosts`, which will typically be +-- | `HostPortPair.printHosts id id`. See [`URI.HostPortPair`](../URI.HostPortPair) +-- | for more information on the host/port pair printer. type URIRefPrintOptions userInfo hosts path hierPath relPath query fragment r = ( printUserInfo ∷ userInfo → UserInfo , printHosts ∷ hosts → String @@ -75,20 +103,17 @@ type URIRefPrintOptions userInfo hosts path hierPath relPath query fragment r = | r ) +-- | A parser for a general URI. parser ∷ ∀ userInfo hosts path hierPath relPath query fragment r . Record (URIRefParseOptions userInfo hosts path hierPath relPath query fragment r) → Parser String (URIRef userInfo hosts path hierPath relPath query fragment) -parser opts - = (Left <$> try (URI.parser opts)) - <|> (Right <$> RelativeRef.parser opts) +parser opts = (Left <$> URI.parser opts) <|> (Right <$> RelativeRef.parser opts) +-- | A printer for a general URI. print ∷ ∀ userInfo hosts path hierPath relPath query fragment r . Record (URIRefPrintOptions userInfo hosts path hierPath relPath query fragment r) → URIRef userInfo hosts path hierPath relPath query fragment → String -print opts = - either - (URI.print opts) - (RelativeRef.print opts) +print opts = either (URI.print opts) (RelativeRef.print opts) From ed352317314f22145a52fc366f3ba7336c2b408f Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 20 Mar 2018 13:14:59 +0000 Subject: [PATCH 67/69] Export char parsers used for printEncoded, etc --- src/URI/Fragment.purs | 1 + src/URI/Host/RegName.purs | 1 + src/URI/HostPortPair.purs | 6 +++--- src/URI/Path/Segment.purs | 2 ++ src/URI/Query.purs | 1 + src/URI/UserInfo.purs | 1 + 6 files changed, 9 insertions(+), 3 deletions(-) diff --git a/src/URI/Fragment.purs b/src/URI/Fragment.purs index 3dd0c67..91ab32b 100644 --- a/src/URI/Fragment.purs +++ b/src/URI/Fragment.purs @@ -6,6 +6,7 @@ module URI.Fragment , unsafeToString , parser , print + , fragmentChar ) where import Prelude diff --git a/src/URI/Host/RegName.purs b/src/URI/Host/RegName.purs index 3e931d6..ba9d755 100644 --- a/src/URI/Host/RegName.purs +++ b/src/URI/Host/RegName.purs @@ -6,6 +6,7 @@ module URI.Host.RegName , unsafeToString , parser , print + , regNameChar ) where import Prelude diff --git a/src/URI/HostPortPair.purs b/src/URI/HostPortPair.purs index 4fa15a2..f5cfc85 100644 --- a/src/URI/HostPortPair.purs +++ b/src/URI/HostPortPair.purs @@ -19,9 +19,9 @@ type HostPortPair host port = Maybe (These host port) -- | A parser for a spec-conformant host/port pair. -- | --- | Additionally, this function allows for the `Host` and `Port` components to --- | be parsed into custom representations. If this is not necessary, use `pure` --- | for both these arguments. +-- | This function allows for the `Host` and `Port` components to be parsed into +-- | custom representations. If this is not necessary, use `pure` for both of +-- | these arguments. -- | -- | Host parsing is dealt with a little differently to all the other URI -- | components, as for hosts the control is passed entirely to the component diff --git a/src/URI/Path/Segment.purs b/src/URI/Path/Segment.purs index e746b72..cec5fdf 100644 --- a/src/URI/Path/Segment.purs +++ b/src/URI/Path/Segment.purs @@ -20,6 +20,8 @@ module URI.Path.Segment , unsafeSegmentNZNCToString , parseSegmentNZNC , printSegmentNZNC + , segmentChar + , segmentNCChar ) where import Prelude diff --git a/src/URI/Query.purs b/src/URI/Query.purs index 7cd426b..2907352 100644 --- a/src/URI/Query.purs +++ b/src/URI/Query.purs @@ -6,6 +6,7 @@ module URI.Query , unsafeToString , parser , print + , queryChar ) where import Prelude diff --git a/src/URI/UserInfo.purs b/src/URI/UserInfo.purs index ec40829..b31bc80 100644 --- a/src/URI/UserInfo.purs +++ b/src/URI/UserInfo.purs @@ -6,6 +6,7 @@ module URI.UserInfo , unsafeToString , parser , print + , userInfoChar ) where import Prelude From a0ee26014636125f5390cff88965a43fb4d9e312 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 20 Mar 2018 13:15:13 +0000 Subject: [PATCH 68/69] Fix accidental loss of `try` in `URIRef` parser --- src/URI/URIRef.purs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/URI/URIRef.purs b/src/URI/URIRef.purs index 9eba970..af540ce 100644 --- a/src/URI/URIRef.purs +++ b/src/URI/URIRef.purs @@ -25,6 +25,7 @@ import Prelude import Control.Alt ((<|>)) import Data.Either (Either(..), either) import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser.Combinators (try) import URI.Authority (Authority(..)) import URI.Common (URIPartParseError) import URI.Fragment (Fragment) @@ -108,7 +109,9 @@ parser ∷ ∀ userInfo hosts path hierPath relPath query fragment r . Record (URIRefParseOptions userInfo hosts path hierPath relPath query fragment r) → Parser String (URIRef userInfo hosts path hierPath relPath query fragment) -parser opts = (Left <$> URI.parser opts) <|> (Right <$> RelativeRef.parser opts) +parser opts + = try (Left <$> URI.parser opts) + <|> (Right <$> RelativeRef.parser opts) -- | A printer for a general URI. print From 4aec4c5ae99628af26f63231ea7b81223c7665d8 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 20 Mar 2018 18:00:06 +0000 Subject: [PATCH 69/69] Doc comments for the extras --- src/URI/Extra/MultiHostPortPair.purs | 13 ++ src/URI/Extra/QueryPairs.purs | 177 +++++++++++++++++++-------- src/URI/Extra/UserPassInfo.purs | 43 +++++-- 3 files changed, 169 insertions(+), 64 deletions(-) diff --git a/src/URI/Extra/MultiHostPortPair.purs b/src/URI/Extra/MultiHostPortPair.purs index ad5ee9e..c98cc25 100644 --- a/src/URI/Extra/MultiHostPortPair.purs +++ b/src/URI/Extra/MultiHostPortPair.purs @@ -30,8 +30,16 @@ import URI.Port as Port -- | `,`, as used by some connection URI schemes. This is not strictly -- | compatible with RFC 3986, as in that spec `RegName`s can contain `,`, and -- | only one port can be specified in the authority. +-- | +-- | A motivating example for where this may be useful: dealing with mongodb +-- | connection strings. type MultiHostPortPair host port = Array (These host port) +-- | A parser for multiple host/port pairs embedded in a URI. +-- | +-- | This function allows for the `Host` and `Port` components to be parsed into +-- | custom representations. If this is not necessary, use `pure` for both of +-- | these arguments. parser ∷ ∀ host port . (Host → Either URIPartParseError host) @@ -66,6 +74,11 @@ parseRegName' = RegName.unsafeFromString <<< NES.join1With "" <$> NEA.some p p = pctEncoded <|> NES.singleton <$> c c = unreserved <|> oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '='] +-- | A printer for multiple host/port pairs embedded in a URI. +-- | +-- | As a counterpart to the `parser` this function also requires the `Host` +-- | and `Port` components to be printed back from their custom representations. +-- | If no custom types are being used, pass `id` for both of these arguments. print ∷ ∀ host port . (host → Host) diff --git a/src/URI/Extra/QueryPairs.purs b/src/URI/Extra/QueryPairs.purs index c91ae4c..01f7ca7 100644 --- a/src/URI/Extra/QueryPairs.purs +++ b/src/URI/Extra/QueryPairs.purs @@ -1,5 +1,10 @@ module URI.Extra.QueryPairs - ( Key + ( QueryPairs(..) + , parse + , print + , keyPartChar + , valuePartChar + , Key , keyFromString , keyToString , unsafeKeyFromString @@ -9,9 +14,6 @@ module URI.Extra.QueryPairs , valueToString , unsafeValueFromString , unsafeValueToString - , QueryPairs(..) - , parse - , print ) where import Prelude @@ -35,6 +37,74 @@ import Text.Parsing.Parser.String (char, oneOf) import URI.Common (URIPartParseError(..), unreserved, pctEncoded, printEncoded, wrapParser) import URI.Query as Q +-- | A query string split into an array of key/value pairs. There is no precise +-- | spec for this, but the format is commonly used, so this attempts to handle +-- | these strings in a sensible way. +-- | +-- | - The representation uses an array rather than a map, so duplicate keys +-- | are supported. +-- | - Keys are not required to have a value associated. +-- | - `&` and `;` are both treated as pair delimiters. +newtype QueryPairs k v = QueryPairs (Array (Tuple k (Maybe v))) + +derive newtype instance eqQueryPairs ∷ (Eq k, Eq v) ⇒ Eq (QueryPairs k v) +derive newtype instance ordQueryPairs ∷ (Ord k, Ord v) ⇒ Ord (QueryPairs k v) +derive instance genericQueryPairs ∷ Generic (QueryPairs k v) _ +instance showQueryPairs ∷ (Show k, Show v) ⇒ Show (QueryPairs k v) where show = genericShow +derive newtype instance semigroupQueryPairs ∷ Semigroup (QueryPairs k v) +derive newtype instance monoidQueryPairs ∷ Monoid (QueryPairs k v) + +-- | Parses a query into key/value pairs. +-- | +-- | This function allows for the `Key` and `Value` components to be parsed +-- | into custom representations. If this is not necessary, use `pure` for both +-- | these arguments. +parse + ∷ ∀ k v + . (Key → Either URIPartParseError k) + → (Value → Either URIPartParseError v) + → Q.Query + → Either URIPartParseError (QueryPairs k v) +parse parseK parseV = + bimap (\(ParseError err _) → URIPartParseError err) QueryPairs + <<< flip runParser (Array.fromFoldable <$> sepBy (parsePart parseK parseV) (char '&')) + <<< Q.unsafeToString + +parsePart + ∷ ∀ k v + . (Key → Either URIPartParseError k) + → (Value → Either URIPartParseError v) + → Parser String (Tuple k (Maybe v)) +parsePart parseK parseV = do + key ← wrapParser (parseK <<< Key) $ + NES.joinWith "" <$> Array.some (NES.singleton <$> keyPartChar <|> pctEncoded) + value ← wrapParser (traverse (parseV <<< Value)) $ optionMaybe do + _ ← char '=' + NES.joinWith "" <$> Array.many (NES.singleton <$> valuePartChar <|> pctEncoded) + pure $ Tuple key value + +-- | A printer for key/value pairs style query string. +-- | +-- | As a counterpart to the `parser` this function also requires the `Key` +-- | and `Value` components to be printed back from their custom representations. +-- | If no custom types are being used, pass `id` for both of these arguments. +print + ∷ ∀ k v + . (k → Key) + → (v → Value) + → QueryPairs k v + → Q.Query +print printK printV (QueryPairs m) = + Q.unsafeFromString $ String.joinWith "&" $ Array.fromFoldable (printPart <$> m) + where + printPart ∷ Tuple k (Maybe v) → String + printPart = case _ of + Tuple k Nothing → + unsafeKeyToString (printK k) + Tuple k (Just v) → + unsafeKeyToString (printK k) <> "=" <> unsafeValueToString (printV v) + +-- | The default `Key` type used for `QueryPairs`. newtype Key = Key String derive newtype instance eqKey ∷ Eq Key @@ -45,18 +115,43 @@ derive newtype instance monoidKey ∷ Monoid Key instance showKey ∷ Show Key where show (Key s) = "(QueryPairs.unsafeKeyFromString " <> show s <> ")" +-- | Constructs a key value from a string, percent-encoding any characters +-- | that require it. Note that running this on a string that has already had +-- | percent-encoding applied will double-encode it, for those situations use +-- | `unsafeKeyFromString` instead. +-- | +-- | ``` purescript +-- | keyFromString "foo" = unsafeKeyFromString "foo" +-- | keyFromString "foo#bar" = unsafeKeyFromString "foo%23bar" +-- | keyFromString "foo%23bar" = unsafeKeyFromString "foo%2523bar" +-- | ``` keyFromString ∷ String → Key keyFromString = Key <<< printEncoded keyPartChar +-- | Returns the string value for a key, percent-decoding any characters +-- | that require it. +-- | +-- | ``` purescript +-- | keyToString (unsafeKeyFromString "foo") = "foo" +-- | keyToString (unsafeKeyFromString "foo%23bar") = "foo#bar" +-- | ``` keyToString ∷ Key → String keyToString (Key s) = decodeURIComponent s +-- | Constructs a key value from a string directly - no percent-encoding +-- | will be applied. This is useful when using a custom encoding scheme for +-- | the key, to prevent double-encoding. unsafeKeyFromString ∷ String → Key unsafeKeyFromString = Key +-- | Returns the string value for a key without percent-decoding. Only +-- | "unsafe" in the sense that values this produces may need further decoding, +-- | the name is more for symmetry with the `fromString`/`unsafeFromString` +-- | pairing. unsafeKeyToString ∷ Key → String unsafeKeyToString (Key s) = s +-- | The default `Value` type used for `QueryPairs`. newtype Value = Value String derive newtype instance eqValue ∷ Eq Value @@ -67,6 +162,16 @@ derive newtype instance monoidValue ∷ Monoid Value instance showValue ∷ Show Value where show (Value s) = "(QueryPairs.unsafeValueFromString " <> show s <> ")" +-- | Constructs a value from a string, percent-encoding any characters +-- | that require it. Note that running this on a string that has already had +-- | percent-encoding applied will double-encode it, for those situations use +-- | `unsafeValueFromString` instead. +-- | +-- | ``` purescript +-- | valueFromString "foo" = unsafeValueFromString "foo" +-- | valueFromString "foo#bar" = unsafeValueFromString "foo%23bar" +-- | valueFromString "foo%23bar" = unsafeValueFromString "foo%2523bar" +-- | ``` valueFromString ∷ String → Value valueFromString = -- `keyPartChar` is used intentionally here. It only differs from @@ -75,67 +180,35 @@ valueFromString = -- the right thing when printing Value <<< printEncoded keyPartChar +-- | Returns the string value for a value, percent-decoding any characters +-- | that require it. +-- | +-- | ``` purescript +-- | valueToString (unsafeValueFromString "foo") = "foo" +-- | valueToString (unsafeValueFromString "foo%23bar") = "foo#bar" +-- | ``` valueToString ∷ Value → String valueToString (Value s) = decodeURIComponent s +-- | Constructs a value from a string directly - no percent-encoding +-- | will be applied. This is useful when using a custom encoding scheme for +-- | the value, to prevent double-encoding. unsafeValueFromString ∷ String → Value unsafeValueFromString = Value +-- | Returns the string value for a value without percent-decoding. Only +-- | "unsafe" in the sense that values this produces may need further decoding, +-- | the name is more for symmetry with the `fromString`/`unsafeFromString` +-- | pairing. unsafeValueToString ∷ Value → String unsafeValueToString (Value s) = s -newtype QueryPairs k v = QueryPairs (Array (Tuple k (Maybe v))) - -derive newtype instance eqQueryPairs ∷ (Eq k, Eq v) ⇒ Eq (QueryPairs k v) -derive newtype instance ordQueryPairs ∷ (Ord k, Ord v) ⇒ Ord (QueryPairs k v) -derive instance genericQueryPairs ∷ Generic (QueryPairs k v) _ -instance showQueryPairs ∷ (Show k, Show v) ⇒ Show (QueryPairs k v) where show = genericShow -derive newtype instance semigroupQueryPairs ∷ Semigroup (QueryPairs k v) -derive newtype instance monoidQueryPairs ∷ Monoid (QueryPairs k v) - -parse - ∷ ∀ k v - . (Key → Either URIPartParseError k) - → (Value → Either URIPartParseError v) - → Q.Query - → Either URIPartParseError (QueryPairs k v) -parse parseK parseV = - bimap (\(ParseError err _) → URIPartParseError err) QueryPairs - <<< flip runParser (Array.fromFoldable <$> sepBy (parsePart parseK parseV) (char '&')) - <<< Q.unsafeToString - -parsePart - ∷ ∀ k v - . (Key → Either URIPartParseError k) - → (Value → Either URIPartParseError v) - → Parser String (Tuple k (Maybe v)) -parsePart parseK parseV = do - key ← wrapParser (parseK <<< Key) $ - NES.joinWith "" <$> Array.some (NES.singleton <$> keyPartChar <|> pctEncoded) - value ← wrapParser (traverse (parseV <<< Value)) $ optionMaybe do - _ ← char '=' - NES.joinWith "" <$> Array.many (NES.singleton <$> valuePartChar <|> pctEncoded) - pure $ Tuple key value - - +-- | The supported key characters, excluding percent-encodings. keyPartChar ∷ Parser String Char keyPartChar = unreserved <|> oneOf ['!', '$', '\'', '(', ')', '*', '+', ',', ':', '@', '/', '?'] +-- | The supported value characters, excluding percent-encodings. valuePartChar ∷ Parser String Char valuePartChar = keyPartChar <|> char '=' - -print - ∷ ∀ k v - . (k → Key) - → (v → Value) - → QueryPairs k v - → Q.Query -print printK printV (QueryPairs m) = Q.unsafeFromString $ String.joinWith "&" $ Array.fromFoldable (printPart <$> m) - where - printPart ∷ Tuple k (Maybe v) → String - printPart (Tuple k Nothing) = - unsafeKeyToString (printK k) - printPart (Tuple k (Just v)) = - unsafeKeyToString (printK k) <> "=" <> unsafeValueToString (printV v) diff --git a/src/URI/Extra/UserPassInfo.purs b/src/URI/Extra/UserPassInfo.purs index 3921a08..a4ebf3d 100644 --- a/src/URI/Extra/UserPassInfo.purs +++ b/src/URI/Extra/UserPassInfo.purs @@ -2,6 +2,7 @@ module URI.Extra.UserPassInfo ( UserPassInfo(..) , parse , print + , userPassInfoChar ) where import Prelude @@ -18,7 +19,22 @@ import URI.Common (URIPartParseError(..), decodeURIComponent', subDelims, unrese import URI.UserInfo (UserInfo) import URI.UserInfo as UserInfo -newtype UserPassInfo = UserPassInfo { user ∷ NonEmptyString, password ∷ Maybe NonEmptyString } +-- | `user:password` formatted user-info components for URI authorities. +-- | +-- | This format is considered deprecated according to RFC3986 but is still +-- | very common, so this is provided for cases where it is necessary. +-- | +-- | The username part is required, so a value like `:hello` will fail to parse +-- | for this type. +-- | +-- | The `:` characer will be percent-encoded in all locations other than the +-- | `user:password` separator, although the parser will accept passwords +-- | containing un-encoded `:` characters. +newtype UserPassInfo = + UserPassInfo + { user ∷ NonEmptyString + , password ∷ Maybe NonEmptyString + } derive instance eqUserPassInfo ∷ Eq UserPassInfo derive instance ordUserPassInfo ∷ Ord UserPassInfo @@ -28,23 +44,25 @@ instance showUserPassInfo ∷ Show UserPassInfo where show (UserPassInfo { user, password }) = "(UserPassInfo { user: " <> show user <> ", password: " <> show password <> "})" +-- | A parser for `user:password` formatted user-info. parse ∷ UserInfo → Either URIPartParseError UserPassInfo parse ui = let s = UserInfo.unsafeToString ui in - case flip NES.splitAt s =<< NES.indexOf (String.Pattern ":") s of - Just { before: Nothing } → - Left (URIPartParseError "Expected a username before a password segment") - Just { before: Just before, after: Just after } → - Right $ UserPassInfo - { user: decodeURIComponent' before - , password: decodeURIComponent' <$> NES.drop 1 after - } - _ → - Right $ UserPassInfo - { user: decodeURIComponent' s, password: Nothing } + case flip NES.splitAt s =<< NES.indexOf (String.Pattern ":") s of + Just { before: Nothing } → + Left (URIPartParseError "Expected a username before a password segment") + Just { before: Just before, after: Just after } → + Right $ UserPassInfo + { user: decodeURIComponent' before + , password: decodeURIComponent' <$> NES.drop 1 after + } + _ → + Right $ UserPassInfo + { user: decodeURIComponent' s, password: Nothing } +-- | A printer for `user:password` formatted user-info. print ∷ UserPassInfo → UserInfo print (UserPassInfo { user, password }) = case password of @@ -56,5 +74,6 @@ print (UserPassInfo { user, password }) = <> NES.singleton ':' <> printEncoded' userPassInfoChar p +-- | The supported user/password characters, excluding percent-encodings. userPassInfoChar ∷ Parser String Char userPassInfoChar = unreserved <|> subDelims