Migrate to record studio
This commit is contained in:
sigma-andex
parent
62e699a19c
commit
e914bbd998
@ -115,4 +115,3 @@ spago -x test.dhall test
|
||||
## 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 =
|
||||
https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220822/packages.dhall
|
||||
sha256:908b4ffbfba37a0a4edf806513a555d0dbcdd0cde7abd621f8d018d2e8ecf828
|
||||
https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20221115/packages.dhall
|
||||
sha256:cc53930f0ebfa5b1652f9e37eb7b1c424246ca78db3c7baf0b205e740e0e9e4e
|
||||
|
||||
in upstream
|
||||
|
||||
@ -29,6 +29,7 @@
|
||||
, "prelude"
|
||||
, "profunctor"
|
||||
, "record"
|
||||
, "record-studio"
|
||||
, "refs"
|
||||
, "routing-duplex"
|
||||
, "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.Query (Query)
|
||||
import HTTPurple.Query (read) as Query
|
||||
import HTTPurple.Record.Extra (pick)
|
||||
import HTTPurple.Record.Extra as Extra
|
||||
import HTTPurple.Utils (encodeURIComponent)
|
||||
import HTTPurple.Version (Version)
|
||||
import HTTPurple.Version (read) as Version
|
||||
@ -39,6 +37,8 @@ import Node.HTTP (requestURL)
|
||||
import Prim.Row (class Nub, class Union)
|
||||
import Prim.RowList (class RowToList)
|
||||
import Record (merge)
|
||||
import Record.Studio (shrink)
|
||||
import Record.Studio.Keys (class Keys)
|
||||
import Routing.Duplex as RD
|
||||
import Type.Prelude (Proxy)
|
||||
import Unsafe.Coerce (unsafeCoerce)
|
||||
@ -110,7 +110,7 @@ fromHTTPRequestExt ::
|
||||
Union ctx thru ctx =>
|
||||
Nub (RequestR route ctx) (RequestR route ctx) =>
|
||||
RowToList ctx ctxRL =>
|
||||
Extra.Keys ctxRL =>
|
||||
Keys ctx =>
|
||||
RD.RouteDuplex' route ->
|
||||
Proxy ctx ->
|
||||
HTTP.Request ->
|
||||
@ -118,7 +118,7 @@ fromHTTPRequestExt ::
|
||||
fromHTTPRequestExt route _ nodeRequest = do
|
||||
let
|
||||
extension :: Record ctx
|
||||
extension = pick (unsafeCoerce nodeRequest :: Record ctx)
|
||||
extension = shrink (unsafeCoerce nodeRequest :: Record ctx)
|
||||
|
||||
addExtension :: Request route -> ExtRequestNT route ctx
|
||||
addExtension = flip merge extension >>> ExtRequestNT
|
||||
|
||||
@ -28,7 +28,6 @@ import Effect.Class.Console (log)
|
||||
import Effect.Console (error)
|
||||
import Effect.Exception (Error)
|
||||
import HTTPurple.NodeMiddleware (MiddlewareResult(..), NextInvocation(..), NodeMiddlewareStack(..))
|
||||
import HTTPurple.Record.Extra as Extra
|
||||
import HTTPurple.Request (ExtRequest, ExtRequestNT, Request, RequestR, fromHTTPRequestExt, fromHTTPRequestUnit)
|
||||
import HTTPurple.Response (Response, ResponseM, internalServerError, notFound, send)
|
||||
import Justifill (justifill)
|
||||
@ -44,6 +43,7 @@ import Node.Process (onSignal)
|
||||
import Prim.Row (class Nub, class Union)
|
||||
import Prim.RowList (class RowToList)
|
||||
import Record (merge)
|
||||
import Record.Studio.Keys (class Keys, class KeysRL)
|
||||
import Routing.Duplex as RD
|
||||
import Safe.Coerce (coerce)
|
||||
import Type.Prelude (Proxy(..))
|
||||
@ -121,7 +121,7 @@ handleExtRequest ::
|
||||
forall ctx ctxRL thru route.
|
||||
Union ctx thru ctx =>
|
||||
RowToList ctx ctxRL =>
|
||||
Extra.Keys ctxRL =>
|
||||
Keys ctx =>
|
||||
Nub (RequestR route ctx) (RequestR route ctx) =>
|
||||
{ route :: RD.RouteDuplex' route
|
||||
, router :: ExtRequestNT route ctx -> ResponseM
|
||||
@ -139,7 +139,7 @@ handleRequest ::
|
||||
forall ctx ctxRL thru route.
|
||||
Union ctx thru ctx =>
|
||||
RowToList ctx ctxRL =>
|
||||
Extra.Keys ctxRL =>
|
||||
Keys ctx =>
|
||||
Nub (RequestR route ctx) (RequestR route ctx) =>
|
||||
{ route :: RD.RouteDuplex' route
|
||||
, router :: ExtRequestNT route ctx -> ResponseM
|
||||
@ -154,7 +154,7 @@ handleExtRequestWithMiddleware ::
|
||||
forall input output outputRL thru route.
|
||||
Union output thru output =>
|
||||
RowToList output outputRL =>
|
||||
Extra.Keys outputRL =>
|
||||
Keys output =>
|
||||
Nub (RequestR route output) (RequestR route output) =>
|
||||
{ route :: RD.RouteDuplex' route
|
||||
, nodeMiddleware :: NodeMiddlewareStack input output
|
||||
@ -196,7 +196,7 @@ serveInternal ::
|
||||
JustifiableFields fromRL from () via =>
|
||||
Union output thru output =>
|
||||
RowToList output outputRL =>
|
||||
Extra.Keys outputRL =>
|
||||
KeysRL outputRL =>
|
||||
Nub (RequestR route output) (RequestR route output) =>
|
||||
{ | from } ->
|
||||
Maybe (NodeMiddlewareStack input output) ->
|
||||
@ -263,7 +263,7 @@ serveNodeMiddleware ::
|
||||
JustifiableFields fromRL from () via =>
|
||||
Union output thru output =>
|
||||
RowToList output outputRL =>
|
||||
Extra.Keys outputRL =>
|
||||
KeysRL outputRL =>
|
||||
Nub (RequestR route output) (RequestR route output) =>
|
||||
{ | from } ->
|
||||
ExtRoutingSettings route input output ->
|
||||
|
||||
Loading…
Reference in New Issue
Block a user