Migrate to record studio
This commit is contained in:
parent
62e699a19c
commit
e914bbd998
@ -115,4 +115,3 @@ spago -x test.dhall test
|
|||||||
## License
|
## License
|
||||||
|
|
||||||
This is a fork of [HTTPure](https://github.com/citizennet/purescript-httpure), which is licensed under MIT. See the [original license](./LICENSES/httpure.LICENSE). This work is similarly licensed under [MIT](./License).
|
This is a fork of [HTTPure](https://github.com/citizennet/purescript-httpure), which is licensed under MIT. See the [original license](./LICENSES/httpure.LICENSE). This work is similarly licensed under [MIT](./License).
|
||||||
It includes part of [`purescript-record-extra`](https://github.com/justinwoo/purescript-record-extra) as an inline dependency, which is licensed under MIT, see [original license](./LICENSES/record-extra.LICENSE).
|
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
let upstream =
|
let upstream =
|
||||||
https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220822/packages.dhall
|
https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20221115/packages.dhall
|
||||||
sha256:908b4ffbfba37a0a4edf806513a555d0dbcdd0cde7abd621f8d018d2e8ecf828
|
sha256:cc53930f0ebfa5b1652f9e37eb7b1c424246ca78db3c7baf0b205e740e0e9e4e
|
||||||
|
|
||||||
in upstream
|
in upstream
|
||||||
|
@ -29,6 +29,7 @@
|
|||||||
, "prelude"
|
, "prelude"
|
||||||
, "profunctor"
|
, "profunctor"
|
||||||
, "record"
|
, "record"
|
||||||
|
, "record-studio"
|
||||||
, "refs"
|
, "refs"
|
||||||
, "routing-duplex"
|
, "routing-duplex"
|
||||||
, "safe-coerce"
|
, "safe-coerce"
|
||||||
|
@ -1,8 +0,0 @@
|
|||||||
|
|
||||||
export const pickFn = function(ks, r) {
|
|
||||||
var copy = {};
|
|
||||||
for(var i = 0; i < ks.length; i++) {
|
|
||||||
copy[ks[i]] = r[ks[i]];
|
|
||||||
}
|
|
||||||
return copy;
|
|
||||||
};
|
|
@ -1,49 +0,0 @@
|
|||||||
module HTTPurple.Record.Extra where
|
|
||||||
|
|
||||||
import Prelude
|
|
||||||
|
|
||||||
import Data.Array (fromFoldable)
|
|
||||||
import Data.Function.Uncurried (Fn2, runFn2)
|
|
||||||
import Data.List (List, (:))
|
|
||||||
import Data.Symbol (class IsSymbol, reflectSymbol)
|
|
||||||
import Prim.Row as Row
|
|
||||||
import Prim.RowList as RL
|
|
||||||
import Type.Proxy (Proxy(..))
|
|
||||||
|
|
||||||
class Keys (xs :: RL.RowList Type) where
|
|
||||||
keysImpl :: Proxy xs -> List String
|
|
||||||
|
|
||||||
instance Keys RL.Nil where
|
|
||||||
keysImpl _ = mempty
|
|
||||||
|
|
||||||
instance
|
|
||||||
( IsSymbol name
|
|
||||||
, Keys tail
|
|
||||||
) =>
|
|
||||||
Keys (RL.Cons name ty tail) where
|
|
||||||
keysImpl _ = first : rest
|
|
||||||
where
|
|
||||||
first = reflectSymbol (Proxy :: _ name)
|
|
||||||
rest = keysImpl (Proxy :: _ tail)
|
|
||||||
|
|
||||||
keys ::
|
|
||||||
forall g row rl.
|
|
||||||
RL.RowToList row rl =>
|
|
||||||
Keys rl =>
|
|
||||||
g row -- this will work for any type with the row as a param!
|
|
||||||
->
|
|
||||||
List String
|
|
||||||
keys _ = keysImpl (Proxy :: _ rl)
|
|
||||||
|
|
||||||
foreign import pickFn :: forall r1 r2. Fn2 (Array String) (Record r1) (Record r2)
|
|
||||||
|
|
||||||
pick ::
|
|
||||||
forall a r b l.
|
|
||||||
Row.Union b r a =>
|
|
||||||
RL.RowToList b l =>
|
|
||||||
Keys l =>
|
|
||||||
Record a ->
|
|
||||||
Record b
|
|
||||||
pick = runFn2 pickFn ks
|
|
||||||
where
|
|
||||||
ks = fromFoldable $ keys (Proxy :: _ b)
|
|
@ -29,8 +29,6 @@ import HTTPurple.Path (Path)
|
|||||||
import HTTPurple.Path (read) as Path
|
import HTTPurple.Path (read) as Path
|
||||||
import HTTPurple.Query (Query)
|
import HTTPurple.Query (Query)
|
||||||
import HTTPurple.Query (read) as Query
|
import HTTPurple.Query (read) as Query
|
||||||
import HTTPurple.Record.Extra (pick)
|
|
||||||
import HTTPurple.Record.Extra as Extra
|
|
||||||
import HTTPurple.Utils (encodeURIComponent)
|
import HTTPurple.Utils (encodeURIComponent)
|
||||||
import HTTPurple.Version (Version)
|
import HTTPurple.Version (Version)
|
||||||
import HTTPurple.Version (read) as Version
|
import HTTPurple.Version (read) as Version
|
||||||
@ -39,6 +37,8 @@ import Node.HTTP (requestURL)
|
|||||||
import Prim.Row (class Nub, class Union)
|
import Prim.Row (class Nub, class Union)
|
||||||
import Prim.RowList (class RowToList)
|
import Prim.RowList (class RowToList)
|
||||||
import Record (merge)
|
import Record (merge)
|
||||||
|
import Record.Studio (shrink)
|
||||||
|
import Record.Studio.Keys (class Keys)
|
||||||
import Routing.Duplex as RD
|
import Routing.Duplex as RD
|
||||||
import Type.Prelude (Proxy)
|
import Type.Prelude (Proxy)
|
||||||
import Unsafe.Coerce (unsafeCoerce)
|
import Unsafe.Coerce (unsafeCoerce)
|
||||||
@ -110,7 +110,7 @@ fromHTTPRequestExt ::
|
|||||||
Union ctx thru ctx =>
|
Union ctx thru ctx =>
|
||||||
Nub (RequestR route ctx) (RequestR route ctx) =>
|
Nub (RequestR route ctx) (RequestR route ctx) =>
|
||||||
RowToList ctx ctxRL =>
|
RowToList ctx ctxRL =>
|
||||||
Extra.Keys ctxRL =>
|
Keys ctx =>
|
||||||
RD.RouteDuplex' route ->
|
RD.RouteDuplex' route ->
|
||||||
Proxy ctx ->
|
Proxy ctx ->
|
||||||
HTTP.Request ->
|
HTTP.Request ->
|
||||||
@ -118,7 +118,7 @@ fromHTTPRequestExt ::
|
|||||||
fromHTTPRequestExt route _ nodeRequest = do
|
fromHTTPRequestExt route _ nodeRequest = do
|
||||||
let
|
let
|
||||||
extension :: Record ctx
|
extension :: Record ctx
|
||||||
extension = pick (unsafeCoerce nodeRequest :: Record ctx)
|
extension = shrink (unsafeCoerce nodeRequest :: Record ctx)
|
||||||
|
|
||||||
addExtension :: Request route -> ExtRequestNT route ctx
|
addExtension :: Request route -> ExtRequestNT route ctx
|
||||||
addExtension = flip merge extension >>> ExtRequestNT
|
addExtension = flip merge extension >>> ExtRequestNT
|
||||||
|
@ -28,7 +28,6 @@ import Effect.Class.Console (log)
|
|||||||
import Effect.Console (error)
|
import Effect.Console (error)
|
||||||
import Effect.Exception (Error)
|
import Effect.Exception (Error)
|
||||||
import HTTPurple.NodeMiddleware (MiddlewareResult(..), NextInvocation(..), NodeMiddlewareStack(..))
|
import HTTPurple.NodeMiddleware (MiddlewareResult(..), NextInvocation(..), NodeMiddlewareStack(..))
|
||||||
import HTTPurple.Record.Extra as Extra
|
|
||||||
import HTTPurple.Request (ExtRequest, ExtRequestNT, Request, RequestR, fromHTTPRequestExt, fromHTTPRequestUnit)
|
import HTTPurple.Request (ExtRequest, ExtRequestNT, Request, RequestR, fromHTTPRequestExt, fromHTTPRequestUnit)
|
||||||
import HTTPurple.Response (Response, ResponseM, internalServerError, notFound, send)
|
import HTTPurple.Response (Response, ResponseM, internalServerError, notFound, send)
|
||||||
import Justifill (justifill)
|
import Justifill (justifill)
|
||||||
@ -44,6 +43,7 @@ import Node.Process (onSignal)
|
|||||||
import Prim.Row (class Nub, class Union)
|
import Prim.Row (class Nub, class Union)
|
||||||
import Prim.RowList (class RowToList)
|
import Prim.RowList (class RowToList)
|
||||||
import Record (merge)
|
import Record (merge)
|
||||||
|
import Record.Studio.Keys (class Keys, class KeysRL)
|
||||||
import Routing.Duplex as RD
|
import Routing.Duplex as RD
|
||||||
import Safe.Coerce (coerce)
|
import Safe.Coerce (coerce)
|
||||||
import Type.Prelude (Proxy(..))
|
import Type.Prelude (Proxy(..))
|
||||||
@ -121,7 +121,7 @@ handleExtRequest ::
|
|||||||
forall ctx ctxRL thru route.
|
forall ctx ctxRL thru route.
|
||||||
Union ctx thru ctx =>
|
Union ctx thru ctx =>
|
||||||
RowToList ctx ctxRL =>
|
RowToList ctx ctxRL =>
|
||||||
Extra.Keys ctxRL =>
|
Keys ctx =>
|
||||||
Nub (RequestR route ctx) (RequestR route ctx) =>
|
Nub (RequestR route ctx) (RequestR route ctx) =>
|
||||||
{ route :: RD.RouteDuplex' route
|
{ route :: RD.RouteDuplex' route
|
||||||
, router :: ExtRequestNT route ctx -> ResponseM
|
, router :: ExtRequestNT route ctx -> ResponseM
|
||||||
@ -139,7 +139,7 @@ handleRequest ::
|
|||||||
forall ctx ctxRL thru route.
|
forall ctx ctxRL thru route.
|
||||||
Union ctx thru ctx =>
|
Union ctx thru ctx =>
|
||||||
RowToList ctx ctxRL =>
|
RowToList ctx ctxRL =>
|
||||||
Extra.Keys ctxRL =>
|
Keys ctx =>
|
||||||
Nub (RequestR route ctx) (RequestR route ctx) =>
|
Nub (RequestR route ctx) (RequestR route ctx) =>
|
||||||
{ route :: RD.RouteDuplex' route
|
{ route :: RD.RouteDuplex' route
|
||||||
, router :: ExtRequestNT route ctx -> ResponseM
|
, router :: ExtRequestNT route ctx -> ResponseM
|
||||||
@ -154,7 +154,7 @@ handleExtRequestWithMiddleware ::
|
|||||||
forall input output outputRL thru route.
|
forall input output outputRL thru route.
|
||||||
Union output thru output =>
|
Union output thru output =>
|
||||||
RowToList output outputRL =>
|
RowToList output outputRL =>
|
||||||
Extra.Keys outputRL =>
|
Keys output =>
|
||||||
Nub (RequestR route output) (RequestR route output) =>
|
Nub (RequestR route output) (RequestR route output) =>
|
||||||
{ route :: RD.RouteDuplex' route
|
{ route :: RD.RouteDuplex' route
|
||||||
, nodeMiddleware :: NodeMiddlewareStack input output
|
, nodeMiddleware :: NodeMiddlewareStack input output
|
||||||
@ -196,7 +196,7 @@ serveInternal ::
|
|||||||
JustifiableFields fromRL from () via =>
|
JustifiableFields fromRL from () via =>
|
||||||
Union output thru output =>
|
Union output thru output =>
|
||||||
RowToList output outputRL =>
|
RowToList output outputRL =>
|
||||||
Extra.Keys outputRL =>
|
KeysRL outputRL =>
|
||||||
Nub (RequestR route output) (RequestR route output) =>
|
Nub (RequestR route output) (RequestR route output) =>
|
||||||
{ | from } ->
|
{ | from } ->
|
||||||
Maybe (NodeMiddlewareStack input output) ->
|
Maybe (NodeMiddlewareStack input output) ->
|
||||||
@ -263,7 +263,7 @@ serveNodeMiddleware ::
|
|||||||
JustifiableFields fromRL from () via =>
|
JustifiableFields fromRL from () via =>
|
||||||
Union output thru output =>
|
Union output thru output =>
|
||||||
RowToList output outputRL =>
|
RowToList output outputRL =>
|
||||||
Extra.Keys outputRL =>
|
KeysRL outputRL =>
|
||||||
Nub (RequestR route output) (RequestR route output) =>
|
Nub (RequestR route output) (RequestR route output) =>
|
||||||
{ | from } ->
|
{ | from } ->
|
||||||
ExtRoutingSettings route input output ->
|
ExtRoutingSettings route input output ->
|
||||||
|
Loading…
Reference in New Issue
Block a user