generated from tpl/purs
fix: initial commit
This commit is contained in:
parent
b9b3e981e5
commit
059a59b6c2
GPG Key ID:
6D4165AE4C928719
14
spago.yaml
14
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:
|
||||
|
||||
145
src/Data.URL.js
Normal file
145
src/Data.URL.js
Normal file
@ -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<string>} */
|
||||
export const queryKeysImpl = u => Array.from(u.searchParams.keys())
|
||||
|
||||
/** @type {(k: string) => (u: URL) => Array<string>} */
|
||||
export const queryLookupImpl = k => u => u.searchParams.getAll(k)
|
||||
|
||||
/** @type {(qs: Array<{k: string, vs: Array<string>}>) => (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<string>) => (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_
|
||||
}
|
||||
167
src/Data.URL.purs
Normal file
167
src/Data.URL.purs
Normal file
@ -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
|
||||
176
test/Test.Main.purs
Normal file
176
test/Test.Main.purs
Normal file
@ -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"
|
||||
Loading…
Reference in New Issue
Block a user