feat: resolveString, pathOrURLFromString

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

spago.yaml

@@ -31,6 +31,7 @@ package:
     - prelude
     - simple-json
     - strings
+    - stringutils
     - transformers
     - tuples
 workspace:

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

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