diff --git a/spago.lock b/spago.lock index 91b23c3..d436396 100644 --- a/spago.lock +++ b/spago.lock @@ -18,6 +18,7 @@ workspace: - prelude - simple-json - strings + - stringutils - transformers - tuples test_dependencies: @@ -83,6 +84,7 @@ workspace: - spec - st - strings + - stringutils - tailrec - transformers - tuples @@ -6301,6 +6303,17 @@ packages: - tuples - unfoldable - unsafe-coerce + stringutils: + type: git + url: https://github.com/menelaos/purescript-stringutils.git + rev: 51d92cacd8c8102fc4e6137b4f709a2b11ca5186 + dependencies: + - arrays + - integers + - maybe + - partial + - prelude + - strings tailrec: type: git url: https://github.com/purescript/purescript-tailrec.git diff --git a/spago.yaml b/spago.yaml index 2a54727..1368b9d 100644 --- a/spago.yaml +++ b/spago.yaml @@ -31,6 +31,7 @@ package: - prelude - simple-json - strings + - stringutils - transformers - tuples workspace: diff --git a/src/Data.URL.purs b/src/Data.URL.purs index c51058f..e7d77ac 100644 --- a/src/Data.URL.purs +++ b/src/Data.URL.purs @@ -18,12 +18,14 @@ module Data.URL , parts , password , path + , pathOrURLFromString , port , query , setQuery , protocol , queryParamTuple , resolve + , resolveString , setHost , setPassword , setPort @@ -38,7 +40,7 @@ import Prelude import Control.Monad.Error.Class (liftEither, liftMaybe) import Data.Array as Array import Data.Bifunctor (lmap) -import Data.Either (Either) +import Data.Either (Either(..), note) import Data.Filterable (filter) import Data.Foldable (class Foldable, foldl, intercalate) import Data.FoldableWithIndex (foldlWithIndex) @@ -51,7 +53,8 @@ import Data.Newtype (wrap) import Data.Nullable (Nullable) import Data.Nullable as Nullable import Data.Show.Generic (genericShow) -import Data.String as String +import Data.String (null, replace, split) as String +import Data.String.Utils (startsWith) as String import Data.Tuple.Nested (type (/\), (/\)) import Foreign (ForeignError(..)) import Partial.Unsafe (unsafePartial) @@ -134,6 +137,9 @@ foreign import setUsernameImpl :: String -> URL -> URL fromString :: String -> Maybe URL fromString = Nullable.toMaybe <<< fromStringImpl +pathOrURLFromString :: String -> Either Path URL +pathOrURLFromString s = note (pathFromString s) $ fromString s + parse :: String -> Either String URL parse url = liftMaybe ("invalid URL: " <> url) $ Nullable.toMaybe $ fromStringImpl url @@ -192,9 +198,11 @@ setQuery qs u = pathFromString :: String -> Path pathFromString s = let - segments = filter (not <<< String.null) <<< String.split (wrap "/") + segments = + filter (not <<< String.null) + <<< String.split (wrap "/") in - maybe PathEmpty PathAbsolute + maybe PathEmpty (if String.startsWith "/" s then PathAbsolute else PathRelative) $ filter (not <<< Array.null) $ Just $ segments s @@ -231,6 +239,12 @@ addQuery u p = infixl 3 addQuery as ? infixl 3 addQuery as & +resolveString :: String -> URL -> URL +resolveString s a = + case pathOrURLFromString s of + Right b -> b + Left p -> resolve p a + resolve :: Path -> URL -> URL resolve p u = case p /\ path u of diff --git a/test/Test.Main.purs b/test/Test.Main.purs index 82d9471..5f8e325 100644 --- a/test/Test.Main.purs +++ b/test/Test.Main.purs @@ -3,11 +3,12 @@ module Test.Main where import Prelude hiding ((/), (#)) import Control.Monad.Error.Class (liftMaybe, throwError) +import Data.Either (Either(..), isRight) import Data.Map as Map import Data.Maybe (Maybe(..), maybe) import Data.Traversable (for_) import Data.Tuple.Nested ((/\)) -import Data.URL (URL, (#), (&), (/), (?)) +import Data.URL (Path(..), URL, pathOrURLFromString, resolveString, toString, (#), (&), (/), (?)) import Data.URL as URL import Effect (Effect) import Effect.Aff (Aff, launchAff_) @@ -37,6 +38,37 @@ main = launchAff_ $ runSpec [ consoleReporter ] do case_ "localhost" case_ "http://?feai#dfkvsj" + describe "pathOrURLFromString" do + it "returns Right on valid URL" do + isRight (pathOrURLFromString "https://google.com") `shouldEqual` true + isRight (pathOrURLFromString "http://localhost?foo=bar&foo&foo&bar=baz") `shouldEqual` true + isRight (pathOrURLFromString "postgresql://user:pass@1.2.3.4:5432/dbname") `shouldEqual` true + it "returns Left on anything else" do + (pathOrURLFromString "/foo") `shouldEqual` (Left $ PathAbsolute [ "foo" ]) + (pathOrURLFromString "./../../foo") `shouldEqual` (Left $ PathRelative [ ".", "..", "..", "foo" ]) + (pathOrURLFromString "foo") `shouldEqual` (Left $ PathRelative [ "foo" ]) + (pathOrURLFromString "") `shouldEqual` (Left PathEmpty) + (pathOrURLFromString "941389dfajifdjiao34910fd#$@?!") `shouldEqual` (Left $ PathRelative [ "941389dfajifdjiao34910fd#$@?!" ]) + + describe "resolveString" do + it "works" do + (shouldEqual "https://google.com/foo") + =<< toString + <$> resolveString "/foo" + <$> fromString_ "https://google.com/a/b/c/d/e" + (shouldEqual "https://google.com/foo/bar/baz/a") + =<< toString + <$> resolveString "./a" + <$> fromString_ "https://google.com/foo/bar/baz" + (shouldEqual "https://google.com/foo/a") + =<< toString + <$> resolveString "../../a" + <$> fromString_ "https://google.com/foo/bar/baz" + (shouldEqual "https://cheese.com/foo/bar") + =<< toString + <$> resolveString "https://cheese.com/foo/bar" + <$> fromString_ "https://google.com/foo/bar/baz" + describe "toString" do it "stringifies" do let