From 059a59b6c25cd22346de2a1331c3e139cf64a254 Mon Sep 17 00:00:00 2001 From: Orion Kindel Date: Sun, 26 Nov 2023 15:59:53 -0600 Subject: [PATCH] fix: initial commit --- spago.yaml | 14 +++- src/Data.URL.js | 145 ++++++++++++++++++++++++++++++++++++ src/Data.URL.purs | 167 +++++++++++++++++++++++++++++++++++++++++ test/Test.Main.purs | 176 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 498 insertions(+), 4 deletions(-) create mode 100644 src/Data.URL.js create mode 100644 src/Data.URL.purs create mode 100644 test/Test.Main.purs diff --git a/spago.yaml b/spago.yaml index a8c16f6..27593a1 100644 --- a/spago.yaml +++ b/spago.yaml @@ -1,19 +1,25 @@ package: + name: url-immutable + test: + main: Test.Main + dependencies: + - spec dependencies: - - prelude - aff + - console - effect - either - - maybe + - filterable - foldable-traversable - - console + - maybe - newtype + - nullable + - prelude - strings - stringutils - transformers - tuples - typelevel-prelude - name: project workspace: extra_packages: {} package_set: diff --git a/src/Data.URL.js b/src/Data.URL.js new file mode 100644 index 0000000..ce8e716 --- /dev/null +++ b/src/Data.URL.js @@ -0,0 +1,145 @@ +/** @type {(u: URL) => URL} */ +const clone = u => new URL(u.href) + +/** @type {(s: string) => URL | null} */ +export const fromStringImpl = s => { + try { + return new URL(s) + } catch { + return null + } +} + +/** @type {(u: URL) => string | null} */ +export const hashImpl = u => u.hash + +/** @type {(u: URL) => string | null} */ +export const hostImpl = u => u.hostname + +/** @type {(u: URL) => string | null} */ +export const hrefImpl = u => u.href + +/** @type {(u: URL) => string | null} */ +export const originImpl = u => u.origin + +/** @type {(u: URL) => string | null} */ +export const passwordImpl = u => u.password + +/** @type {(u: URL) => string | null} */ +export const pathnameImpl = u => u.pathname + +/** @type {(u: URL) => string | null} */ +export const portImpl = u => u.port + +/** @type {(u: URL) => string | null} */ +export const protocolImpl = u => u.protocol + +/** @type {(u: URL) => string | null} */ +export const searchImpl = u => u.search + +/** @type {(u: URL) => URLSearchParams} */ +export const searchParamsImpl = u => u.searchParams + +/** @type {(u: URL) => string | null} */ +export const usernameImpl = u => u.username + +/** @type {(u: URL) => Array} */ +export const queryKeysImpl = u => Array.from(u.searchParams.keys()) + +/** @type {(k: string) => (u: URL) => Array} */ +export const queryLookupImpl = k => u => u.searchParams.getAll(k) + +/** @type {(qs: Array<{k: string, vs: Array}>) => (u: URL) => URL} */ +export const querySetAllImpl = qs => u => { + const u_ = clone(u) + u_.search = '' + qs.forEach(({ k, vs }) => { + vs.forEach(v => u_.searchParams.append(k, v)) + }) + return u_ +} + +/** @type {(k: string) => (vs: Array) => (u: URL) => URL} */ +export const queryPutImpl = k => vs => u => { + const u_ = clone(u) + u_.searchParams.delete(k) + vs.forEach(v => u_.searchParams.append(k, v)) + return u_ +} + +/** @type {(k: string) => (v: string | null) => (u: URL) => URL} */ +export const queryAppendImpl = k => v => u => { + const u_ = clone(u) + u_.searchParams.append(k, v || '') + return u_ +} + +/** @type {(k: string) => (u: URL) => URL} */ +export const queryDeleteImpl = k => u => { + const u_ = clone(u) + u_.searchParams.delete(k) + return u_ +} + +/** @type {(_s: string) => (u: URL) => URL} */ +export const setHashImpl = s => u => { + const u_ = clone(u) + u_.hash = s + return u_ +} + +/** @type {(_s: string) => (u: URL) => URL} */ +export const setHostImpl = s => u => { + const u_ = clone(u) + u_.hostname = s + return u_ +} + +/** @type {(_s: string) => (u: URL) => URL} */ +export const setHrefImpl = s => u => { + const u_ = clone(u) + u_.href = s + return u_ +} + +/** @type {(_s: string) => (u: URL) => URL} */ +export const setPasswordImpl = s => u => { + const u_ = clone(u) + u_.password = s + return u_ +} + +/** @type {(_s: string) => (u: URL) => URL} */ +export const setPathnameImpl = s => u => { + const u_ = clone(u) + u_.pathname = s + return u_ +} + +/** @type {(_s: string) => (u: URL) => URL} */ +export const setPortImpl = s => u => { + const u_ = clone(u) + u_.port = s + return u_ +} + +/** @type {(_s: string) => (u: URL) => URL} */ +export const setProtocolImpl = s => u => { + const u_ = clone(u) + u_.protocol = s + return u_ +} + +/** @type {(_s: string) => (u: URL) => URL} */ +export const setSearchImpl = s => u => { + const u_ = clone(u) + u_.search = s + return u_ +} + +/** @type {(_s: string) => (u: URL) => URL} */ +export const setUsernameImpl = s => u => { + const u_ = clone(u) + u_.username = s + return u_ +} diff --git a/src/Data.URL.purs b/src/Data.URL.purs new file mode 100644 index 0000000..dcf7763 --- /dev/null +++ b/src/Data.URL.purs @@ -0,0 +1,167 @@ +module Data.URL where + +import Prelude + +import Data.Array as Array +import Data.Filterable (filter) +import Data.Foldable (intercalate) +import Data.FoldableWithIndex (foldlWithIndex) +import Data.Generic.Rep (class Generic) +import Data.Int as Int +import Data.Map (Map) +import Data.Map as Map +import Data.Maybe (Maybe(..), maybe) +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.Tuple.Nested (type (/\), (/\)) + +class QueryParam a where + queryParamTuple :: a -> String /\ Array String + +instance QueryParam String where + queryParamTuple s = s /\ [ "" ] +else instance QueryParam (String /\ String) where + queryParamTuple (k /\ v) = k /\ [ v ] +else instance QueryParam (String /\ Array String) where + queryParamTuple = identity + +foreign import data URL :: Type +foreign import data SearchParams :: Type + +data Path + = PathAbsolute (Array String) + | PathRelative (Array String) + | PathEmpty + +derive instance Generic Path _ +derive instance Eq Path +instance Show Path where + show = genericShow + +foreign import fromStringImpl :: String -> Nullable URL + +foreign import hashImpl :: URL -> String +foreign import hrefImpl :: URL -> String +foreign import hostImpl :: URL -> String +foreign import passwordImpl :: URL -> String +foreign import pathnameImpl :: URL -> String +foreign import portImpl :: URL -> String +foreign import protocolImpl :: URL -> String +foreign import usernameImpl :: URL -> String +foreign import queryKeysImpl :: URL -> Array String +foreign import queryLookupImpl :: String -> URL -> Array String +foreign import querySetAllImpl :: Array { k :: String, vs :: Array String } -> URL -> URL +foreign import queryPutImpl :: String -> Array String -> URL -> URL +foreign import queryAppendImpl :: String -> Nullable String -> URL -> URL +foreign import queryDeleteImpl :: String -> URL -> URL + +foreign import setHashImpl :: String -> URL -> URL +foreign import setHostImpl :: String -> URL -> URL +foreign import setPasswordImpl :: String -> URL -> URL +foreign import setPathnameImpl :: String -> URL -> URL +foreign import setPortImpl :: String -> URL -> URL +foreign import setProtocolImpl :: String -> URL -> URL +foreign import setUsernameImpl :: String -> URL -> URL + +fromString :: String -> Maybe URL +fromString = Nullable.toMaybe <<< fromStringImpl + +toString :: URL -> String +toString = hrefImpl + +query :: URL -> Map String (Array String) +query u = + let + ks = queryKeysImpl u + vals k = queryLookupImpl k u + in + Map.fromFoldable $ map (\k -> k /\ vals k) ks + +setQuery :: Map String (Array String) -> URL -> URL +setQuery qs u = + let + asRecord = foldlWithIndex (\k a vs -> a <> [ { k, vs } ]) [] qs + in + querySetAllImpl asRecord u + +path :: URL -> Path +path u = + let + pathname = pathnameImpl u + segments = filter (not <<< String.null) <<< String.split (wrap "/") + in + maybe PathEmpty PathAbsolute + $ filter (not <<< Array.null) + $ Just + $ segments pathname + +addSegment :: URL -> String -> URL +addSegment u s = resolve (PathRelative [ s ]) u + +infixl 3 addSegment as / + +addHash :: URL -> String -> URL +addHash u s = setHash s u + +infixl 3 addHash as # + +addQuery :: forall q. QueryParam q => URL -> q -> URL +addQuery u p = + let + k /\ vs = queryParamTuple p + q = query u + q' + | Just _ <- Map.lookup k q = Map.update (Just <<< append vs) k q + | otherwise = Map.insert k vs q + in + setQuery q' u + +infixl 3 addQuery as ? +infixl 3 addQuery as & + +resolve :: Path -> URL -> URL +resolve p u = + case p /\ path u of + PathRelative to /\ PathAbsolute from -> setPathnameImpl (intercalate "/" $ from <> to) u + PathRelative to /\ _ -> setPathnameImpl (intercalate "/" to) u + PathAbsolute to /\ _ -> setPathnameImpl (intercalate "/" to) u + PathEmpty /\ _ -> u + +hash :: URL -> Maybe String +hash = filter (not <<< String.null) <<< Just <<< String.replace (wrap "#") (wrap "") <<< hashImpl + +host :: URL -> String +host = hostImpl + +password :: URL -> Maybe String +password = filter (not <<< String.null) <<< Just <<< passwordImpl + +port :: URL -> Maybe Int +port = Int.fromString <<< portImpl + +protocol :: URL -> String +protocol = String.replace (wrap ":") (wrap "") <<< protocolImpl + +username :: URL -> Maybe String +username = filter (not <<< String.null) <<< Just <<< usernameImpl + +setHash :: String -> URL -> URL +setHash = setHashImpl + +setHost :: String -> URL -> URL +setHost = setHostImpl + +setPassword :: String -> URL -> URL +setPassword = setPasswordImpl + +setPort :: Int -> URL -> URL +setPort = setPortImpl <<< Int.toStringAs Int.decimal + +setProtocol :: String -> URL -> URL +setProtocol = setProtocolImpl + +setUsername :: String -> URL -> URL +setUsername = setUsernameImpl diff --git a/test/Test.Main.purs b/test/Test.Main.purs new file mode 100644 index 0000000..82d9471 --- /dev/null +++ b/test/Test.Main.purs @@ -0,0 +1,176 @@ +module Test.Main where + +import Prelude hiding ((/), (#)) + +import Control.Monad.Error.Class (liftMaybe, throwError) +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 as URL +import Effect (Effect) +import Effect.Aff (Aff, launchAff_) +import Effect.Exception (error) +import Test.Spec (describe, it) +import Test.Spec.Assertions (shouldEqual) +import Test.Spec.Reporter.Console (consoleReporter) +import Test.Spec.Runner (runSpec) + +main :: Effect Unit +main = launchAff_ $ runSpec [ consoleReporter ] do + describe "URL" do + let + fromString_ :: String -> Aff URL + fromString_ u = liftMaybe (error $ "parsing failed: " <> u) $ URL.fromString u + + describe "fromString" do + it "returns Just on valid URL" do + void $ fromString_ "https://google.com" + void $ fromString_ "http://localhost?foo=bar&foo&foo&bar=baz" + void $ fromString_ "postgresql://user:pass@1.2.3.4:5432/dbname" + it "returns Nothing on invalid URL" do + let + case_ :: String -> Aff Unit + case_ u = maybe (pure unit) (const $ throwError $ error $ "parsing erroneously succeeded: " <> u) $ URL.fromString u + case_ "google.com" + case_ "localhost" + case_ "http://?feai#dfkvsj" + + describe "toString" do + it "stringifies" do + let + case_ :: String -> Aff Unit + case_ u = do + url <- fromString_ u + URL.toString url `shouldEqual` u + case_ "https://google.com/" + case_ "http://localhost/?foo=bar&foo&foo&bar=baz" + case_ "postgresql://user:pass@1.2.3.4:5432/dbname" + + describe "get" do + describe "path" do + let + cases = + [ "https://google.com/foo" /\ URL.PathAbsolute [ "foo" ] + , "http://localhost/bar?foo=bar" /\ URL.PathAbsolute [ "bar" ] + , "http://1.1.1.1:4142/asdf/foo/bingus#asdf" /\ URL.PathAbsolute [ "asdf", "foo", "bingus" ] + , "https://google.com/" /\ URL.PathEmpty + , "http://localhost/?foo=bar" /\ URL.PathEmpty + , "http://1.1.1.1:4142/#asdf" /\ URL.PathEmpty + ] + for_ cases \(u /\ expect) -> it (u <> " -> " <> show expect) do + url <- fromString_ u + URL.path url `shouldEqual` expect + + describe "query" do + let + cases = + [ "https://google.com " /\ Map.empty + , "https://google.com?k " /\ Map.singleton "k" [ "" ] + , "https://google.com?k&k&k " /\ Map.singleton "k" [ "", "", "" ] + , "https://localhost/foo?q#a" /\ Map.singleton "q" [ "" ] + , "https://a?a=a&b=b&b=c " /\ Map.fromFoldable [ "a" /\ [ "a" ], "b" /\ [ "b", "c" ] ] + ] + for_ cases \(u /\ expect) -> it (u <> " -> " <> show expect) do + url <- fromString_ u + let qs = URL.query url + qs `shouldEqual` expect + describe "host" do + let + cases = + [ "https://google.com " /\ "google.com" + , "https://localhost " /\ "localhost" + , "https://1.1.1.1 " /\ "1.1.1.1" + , "https://1.1.1.1:5432" /\ "1.1.1.1" + ] + for_ cases \(u /\ expect) -> it (u <> " -> " <> expect) do + url <- fromString_ u + URL.host url `shouldEqual` expect + describe "port" do + let + cases = + [ "https://google.com " /\ Nothing + , "https://localhost " /\ Nothing + , "https://1.1.1.1 " /\ Nothing + , "https://1.1.1.1:5432" /\ Just 5432 + ] + for_ cases \(u /\ expect) -> it (u <> " -> " <> show expect) do + url <- fromString_ u + URL.port url `shouldEqual` expect + describe "hash" do + let + cases = + [ "https://google.com " /\ Nothing + , "https://google.com#foo" /\ Just "foo" + , "https://localhost " /\ Nothing + , "https://1.1.1.1:5432 " /\ Nothing + ] + for_ cases \(u /\ expect) -> it (u <> " -> " <> show expect) do + url <- fromString_ u + URL.hash url `shouldEqual` expect + describe "username" do + let + cases = + [ "https://google.com " /\ Nothing + , "https://google.com#foo " /\ Nothing + , "https://:bar@google.com " /\ Nothing + , "https://foo@localhost " /\ Just "foo" + , "https://foo:bar@localhost" /\ Just "foo" + ] + for_ cases \(u /\ expect) -> it (u <> " -> " <> show expect) do + url <- fromString_ u + URL.username url `shouldEqual` expect + describe "password" do + let + cases = + [ "https://google.com " /\ Nothing + , "https://google.com#foo " /\ Nothing + , "https://:bar@google.com " /\ Just "bar" + , "https://foo@localhost " /\ Nothing + , "https://foo:bar@localhost" /\ Just "bar" + ] + for_ cases \(u /\ expect) -> + it (u <> " -> " <> show expect) do + url <- fromString_ u + URL.password url `shouldEqual` expect + describe "protocol" do + let + cases = + [ "https://google.com " /\ "https" + , "https://google.com#foo" /\ "https" + , "http://:bar@google.com" /\ "http" + , "http://1.1.1.1 " /\ "http" + , "coap://1.1.1.1 " /\ "coap" + , "ssh://1.1.1.1 " /\ "ssh" + , "data:text/plain,foo " /\ "data" + ] + for_ cases \(u /\ expect) -> + it (u <> " -> " <> expect) do + url <- fromString_ u + URL.protocol url `shouldEqual` expect + describe "set" do + it "resolve" do + u <- fromString_ "https://google.com/search" + let + rel = URL.resolve (URL.PathRelative [ "foo", "bar" ]) u + abs = URL.resolve (URL.PathAbsolute [ "foo", "bar" ]) u + URL.toString rel `shouldEqual` "https://google.com/search/foo/bar" + URL.toString abs `shouldEqual` "https://google.com/foo/bar" + it "setQuery" do + u <- fromString_ "https://google.com?k" + let + u' = URL.setQuery (Map.fromFoldable [ "a" /\ [ "b", "" ] ]) u + URL.toString u' `shouldEqual` "https://google.com/?a=b&a=" + it "setters do not mutate original url" do + url <- fromString_ "https://google.com/" + let + foo = URL.setHost "foo.com" url + fooBuilt = + URL.setUsername "user" + $ URL.setPassword "pass" + $ URL.setProtocol "https" + $ URL.setPort 1234 + $ foo / "cheese" / "brie" ? "k" /\ "v" & "k" # "foo" + URL.toString url `shouldEqual` "https://google.com/" + URL.toString fooBuilt `shouldEqual` "https://user:pass@foo.com:1234/cheese/brie?k=&k=v#foo"