master..76aad1b · purestack-dev/purescript-purestack-server

git.iko.soy/purestack-dev/purescript-purestack-server

on 76aad1b help sign in

spago.dhall+2−13

since splitsnapshots

unifiedsplit

@@ -6,28 +6,17 @@

6 , "arrays"

7 , "console"

8 , "control"

9− , "datetime"

10 , "effect"

9 , "effect"

11 , "either"

10 , "either"

12− , "foldable-traversable"

13− , "foreign-object"

14− , "formatters"

15− , "integers"

16− , "lists"

17 , "maybe"

11 , "maybe"

18− , "now"

19− , "numbers"

20− , "ordered-collections"

21− , "parsing"

22 , "prelude"

12 , "prelude"

23− , "profunctor-lenses"

24 , "record"

13 , "record"

25 , "run"

14 , "run"

26− , "strings"

27− , "transformers"

28 , "tuples"

15 , "tuples"

29 , "typelevel-prelude"

16 , "typelevel-prelude"

17+ , "unsafe-coerce"

30 , "url-immutable"

18 , "url-immutable"

19+ , "variant"

31 ]

20 ]

32, packages = ./packages.dhall

21, packages = ./packages.dhall

33, sources = [ "src/**/*.purs", "test/**/*.purs" ]

22, sources = [ "src/**/*.purs", "test/**/*.purs" ]

src/Bun/Request.js−4

@@ -9,7 +9,3 @@ export function method(req) {

9export function url(req) {

10 return req.url

11}

12−

13−export function headers(req) {

14− return Object.fromEntries(req.headers.entries());

15−}

src/Bun/Request.purs−4

@@ -3,7 +3,6 @@ module Bun.Request

3 , method

4 , url

5 , json

6− , headers

7 ) where

6 ) where

9import Prelude

8import Prelude

@@ -12,7 +11,6 @@ import Control.Promise (Promise)

12import Control.Promise as Promise

11import Control.Promise as Promise

13import Data.Argonaut (Json)

12import Data.Argonaut (Json)

14import Effect.Aff (Aff)

13import Effect.Aff (Aff)

15−import Foreign.Object (Object)

17foreign import data Request :: Type

15foreign import data Request :: Type

@@ -24,5 +22,3 @@ json = jsonPromise >>> Promise.toAff

24foreign import method :: Request -> String

22foreign import method :: Request -> String

26foreign import url :: Request -> String

24foreign import url :: Request -> String

27−

28−foreign import headers :: Request -> Object String

src/Bun/Response.js−23

@@ -10,26 +10,3 @@ export function string(s) {

10 return new Response(s, options)

11 }

12}

13−

14−

15−export function stream(s) {

16− return function(options) {

17− return new Response(s, options)

18− }

19−}

20−

21−export function body(resp) {

22− return resp.body

23−}

24−

25−export function status(resp) {

26− return resp.status

27−}

28−

29−export function statusText(resp) {

30− return resp.statusText

31−}

32−

33−export function headers(resp) {

34− return Object.fromEntries(resp.headers.entries());

35−}

src/Bun/Response.purs+3−9

@@ -1,18 +1,12 @@

1module Bun.Response where

3import Data.Argonaut (Json)

4−import Foreign.Object (Object)

4+import Data.Tuple.Nested (type (/\))

5+import Effect (Effect)

6foreign import data Response :: Type

7foreign import data Response :: Type

7−foreign import data ReadableStream :: Type

9−type Options = { status :: Int, statusText :: String, headers :: Object String }

9+type Options = { status :: Int, statusText :: String, headers :: Array (String /\ String) }

11foreign import json :: Json -> Options -> Response

12foreign import string :: String -> Options -> Response

13−foreign import stream :: ReadableStream -> Options -> Response

14−foreign import body :: Response -> ReadableStream

15−foreign import headers :: Response -> Object String

16−foreign import status :: Response -> Int

17−foreign import statusText :: Response -> String

18−

src/Bun/Server.js+1−1

@@ -1,4 +1,4 @@

1−export function serve_(f) {

1+export function serve(f) {

2 return function() {

3 return Bun.serve({

4 fetch(req) {

src/Bun/Server.purs+1−7

@@ -4,12 +4,6 @@ import Prelude

5import Bun.Request (Request)

6import Bun.Response (Response)

7−import Control.Promise (Promise)

8−import Control.Promise as Promise

9import Effect (Effect)

7import Effect (Effect)

10−import Effect.Aff (Aff)

12−foreign import serve_ :: (Request -> Effect (Promise Response)) -> Effect Unit

9+foreign import serve :: (Request -> Effect Response) -> Effect Unit

13−

14−serve :: (Request -> Aff Response) -> Effect Unit

15−serve f = serve_ (\req -> Promise.fromAff (f req))

src/Main.purs+7−19

@@ -3,35 +3,23 @@ module Main where

3import Prelude

5import Bun.Server as Bun

6−import Data.Maybe (Maybe)

7import Effect (Effect)

6import Effect (Effect)

8import Effect.Aff (Aff)

7import Effect.Aff (Aff)

9import Effect.Console (log)

8import Effect.Console (log)

10−import PureStack.Route (type (/), GET, Headers(..), Middleware, POST)

9+import PureStack.Route (type (/), GET, POST)

11import PureStack.Route as Router

10import PureStack.Route as Router

12−import PureStack.Server as Server

13import Run (AFF, Run(..), runBaseAff)

11import Run (AFF, Run(..), runBaseAff)

14import Type.Row (type (+))

12import Type.Row (type (+))

16−type Foo = { a :: String, b :: Maybe Int, c :: Array Number }

17−

18type API =

14type API =

19− ( foo :: "foo" / "bar" / Foo / GET Unit { a :: Int, b :: Number, c :: Foo }

15+ ( foo :: "foo" / "bar" / "foo" / GET { a :: Int, b :: Number }

20− , bar :: "foo" / Middleware "auth" / "qux" / POST (Headers { foo :: String } Unit) { a :: Int, s :: String }

16+ , bar :: "foo" / "qux" / POST Unit { a :: Int }

21− , deep ::

22− "deep" /

23− ( something :: "something" / GET Unit { a :: String }

24− )

25 )

17 )

19+x :: { foo :: Run (AFF + ()) { a :: Int, b :: Number }, bar :: Run (AFF + ()) { a :: Int } }

20+x = { foo: pure { a: 1, b: 1.0 }, bar: pure { a: 8 } }

21+

27main :: Effect Unit

22main :: Effect Unit

28main = do

23main = do

29 log "🍝"

24 log "🍝"

30− Bun.serve $ Server.run @API identity

25+-- Bun.serve $ Router.run @API

31− { handlers:

32− { foo: \x -> pure { a: 1, b: 1.0, c: x }

33− , bar: \i (Headers x _) -> pure { a: 8, s: x.foo }

34− , deep: { something: pure { a: "something" } }

35− }

36− , middlewares: { auth: \req -> pure 1 }

37− }

src/PureStack/Cookie.pursdeleted−57

@@ -1,57 +0,0 @@

1−-- | This module allows parsing and generating cookie headers. You'll generally use

2−-- | the `Cookie.new` function to create a cookie from a name/value pair and the

3−-- | `Cookie.set*` functions to set attributes on a cookie.

4−-- |

5−-- | `Cookie.stringify` generates the string representation of a cookie, suitable for

6−-- | writing to an HTTP header.

7−-- |

8−-- | `Cookie.parse` parses the string representation of a cookie, returning an

9−-- | `Either ParseError Cookie`.

10−-- |

11−-- | ```purescript

12−-- | import PureStack.Cookie as Cookie

13−-- |

14−-- | > Cookie.stringify $ Cookie.setSecure $ Cookie.new "key" "value"

15−-- | key=value; Secure

16−-- |

17−-- | > Cookie.parse "key=value; Secure"

18−-- | (Right { name: "key", value: "value", secure: true, ... })

19−-- | ```

20−module PureStack.Cookie

21− ( module PureStack.Cookie.Generator

22− , module PureStack.Cookie.Parser

23− , module PureStack.Cookie.Types

24− ) where

25−

26−import PureStack.Cookie.Generator (stringify)

27−import PureStack.Cookie.Parser (parse, parseMany)

28−import PureStack.Cookie.Types

29− ( Cookie

30− , SameSite(..)

31− , _domain

32− , _expires

33− , _httpOnly

34− , _maxAge

35− , _name

36− , _path

37− , _secure

38− , _value

39− , expire

40− , fromFields

41− , getDomain

42− , getExpires

43− , getHttpOnly

44− , getMaxAge

45− , getName

46− , getPath

47− , getSecure

48− , getValue

49− , new

50− , setDomain

51− , setExpires

52− , setHttpOnly

53− , setMaxAge

54− , setPath

55− , setSameSite

56− , setSecure

57− )

src/PureStack/Cookie/Formatter.pursdeleted−65

@@ -1,65 +0,0 @@

1−-- | This module is responsible for formatting and parsing the `Expires`

2−-- | attribute of a `Cookie`.

3−module PureStack.Cookie.Formatter

4− ( domainTag

5− , expiresTag

6− , formatDateTime

7− , httpOnlyTag

8− , maxAgeTag

9− , pathTag

10− , sameSiteTag

11− , secureTag

12− , unformatDateTime

13− ) where

14−

15−import Data.DateTime (DateTime)

16−import Data.Either (Either)

17−import Data.Formatter.DateTime (Formatter, FormatterCommand(..))

18−import Data.Formatter.DateTime as Formatter

19−import Data.List as List

20−

21−domainTag :: String

22−domainTag = "Domain"

23−

24−expiresTag :: String

25−expiresTag = "Expires"

26−

27−httpOnlyTag :: String

28−httpOnlyTag = "HttpOnly"

29−

30−maxAgeTag :: String

31−maxAgeTag = "Max-Age"

32−

33−pathTag :: String

34−pathTag = "Path"

35−

36−secureTag :: String

37−secureTag = "Secure"

38−

39−sameSiteTag :: String

40−sameSiteTag = "SameSite"

41−

42−expiresFormatter :: Formatter

43−expiresFormatter =

44− List.fromFoldable

45− [ DayOfWeekNameShort

46− , Placeholder ", "

47− , DayOfMonthTwoDigits

48− , Placeholder " "

49− , MonthShort

50− , Placeholder " "

51− , YearFull

52− , Placeholder " "

53− , Hours24

54− , Placeholder ":"

55− , MinutesTwoDigits

56− , Placeholder ":"

57− , SecondsTwoDigits

58− , Placeholder " GMT"

59− ]

60−

61−formatDateTime :: DateTime -> String

62−formatDateTime = Formatter.format expiresFormatter

63−

64−unformatDateTime :: String -> Either String DateTime

65−unformatDateTime = Formatter.unformat expiresFormatter

src/PureStack/Cookie/Generator.pursdeleted−62

@@ -1,62 +0,0 @@

1−-- | This module is responsible for generating the string representation

2−-- | of a `Cookie`.

3−module PureStack.Cookie.Generator

4− ( stringify

5− ) where

6−

7−import Prelude

8−import PureStack.Cookie.Formatter

9− ( domainTag

10− , expiresTag

11− , formatDateTime

12− , httpOnlyTag

13− , maxAgeTag

14− , pathTag

15− , sameSiteTag

16− , secureTag

17− )

18−import PureStack.Cookie.Types

19− ( Cookie

20− , getDomain

21− , getExpires

22− , getHttpOnly

23− , getMaxAge

24− , getName

25− , getPath

26− , getSameSite

27− , getSecure

28− , getValue

29− )

30−import Data.Array (catMaybes)

31−import Data.Foldable (intercalate)

32−import Data.Maybe (Maybe(..))

33−

34−-- | Return the `String` representation of a `Cookie`.

35−-- |

36−-- | ```purescript

37−-- | > Generator.stringify $ Cookie.setSecure $ Cookie.new "key" "value"

38−-- | key=value; Secure

39−-- | ```

40−stringify :: Cookie -> String

41−stringify cookie =

42− intercalate "; "

43− $ catMaybes

44− [ attr (getName cookie) $ Just (getValue cookie)

45− , attr domainTag $ getDomain cookie

46− , attr pathTag $ getPath cookie

47− , attr expiresTag $ formatDateTime <$> getExpires cookie

48− , attr maxAgeTag $ show <$> getMaxAge cookie

49− , attr sameSiteTag $ show <$> getSameSite cookie

50− , flag secureTag $ getSecure cookie

51− , flag httpOnlyTag $ getHttpOnly cookie

52− ]

53−

54−attr :: String -> Maybe String -> Maybe String

55−attr name = case _ of

56− Nothing -> Nothing

57− Just value -> Just $ name <> "=" <> value

58−

59−flag :: String -> Boolean -> Maybe String

60−flag name = case _ of

61− false -> Nothing

62− true -> Just name

src/PureStack/Cookie/Parser.pursdeleted−128

@@ -1,128 +0,0 @@

1−-- | This module is responsible for parsing a string into an

2−-- | `Either ParseError Cookie`.

3−module PureStack.Cookie.Parser

4− ( parse

5− , parseMany

6− ) where

7−

8−import Prelude

9−

10−import Control.Alt ((<|>))

11−import Data.Array as Array

12−import Data.Either (Either(..))

13−import Data.Foldable (class Foldable, foldl)

14−import Data.Int as Int

15−import Data.List (List)

16−import Data.Maybe (Maybe(..))

17−import Data.String as String

18−import Parsing (ParseError, Parser, fail, runParser)

19−import Parsing.Combinators (many, sepBy)

20−import Parsing.String (eof, string)

21−import Parsing.String.Basic (noneOf)

22−import PureStack.Cookie.Formatter (domainTag, expiresTag, httpOnlyTag, maxAgeTag, pathTag, sameSiteTag, secureTag, unformatDateTime)

23−import PureStack.Cookie.Types (Cookie, SameSite(..))

24−import PureStack.Cookie.Types as Cookie

25−

26−type Attribute = Cookie -> Cookie

27−

28−dropSeperator :: Parser String Unit

29−dropSeperator = (string "; " $> unit) <|> (pure unit)

30−

31−asString :: forall f. Functor f => Foldable f => f Char -> String

32−asString = String.fromCodePointArray <<< Array.fromFoldable <<< map String.codePointFromChar

33−

34−stringWithout :: Array Char -> Parser String String

35−stringWithout = map asString <<< many <<< noneOf

36−

37−attributeValue :: Parser String String

38−attributeValue = stringWithout [ ';' ]

39−

40−whitespaceChars :: Array Char

41−whitespaceChars = [ ' ', '\n', '\r', '\t' ]

42−

43−parseDomain :: Parser String Attribute

44−parseDomain = do

45− domain <- (string $ domainTag <> "=") *> attributeValue

46− pure $ Cookie.setDomain domain

47−

48−parsePath :: Parser String Attribute

49−parsePath = do

50− path <- (string $ pathTag <> "=") *> attributeValue

51− pure $ Cookie.setPath path

52−

53−parseExpires :: Parser String Attribute

54−parseExpires = do

55− expiresString <- (string $ expiresTag <> "=") *> attributeValue

56− case unformatDateTime expiresString of

57− Left e -> fail e

58− Right expires -> pure $ Cookie.setExpires expires

59−

60−parseMaxAge :: Parser String Attribute

61−parseMaxAge = do

62− maxAgeString <- (string $ maxAgeTag <> "=") *> attributeValue

63− case Int.fromString maxAgeString of

64− Nothing -> fail "invalid integer"

65− Just maxAge -> pure $ Cookie.setMaxAge maxAge

66−

67−parseSecure :: Parser String Attribute

68−parseSecure = (string secureTag) $> Cookie.setSecure

69−

70−parseHttpOnly :: Parser String Attribute

71−parseHttpOnly = (string httpOnlyTag) $> Cookie.setHttpOnly

72−

73−parseSameSite :: Parser String Attribute

74−parseSameSite = do

75− sameSiteString <- (string $ sameSiteTag <> "=") *> attributeValue

76− case sameSiteString of

77− "Strict" -> pure $ Cookie.setSameSite Strict

78− "Lax" -> pure $ Cookie.setSameSite Lax

79− "None" -> pure $ Cookie.setSameSite None

80− val -> fail $ "unknown SiteSite value " <> val

81−

82−parseAttribute :: Parser String Attribute

83−parseAttribute =

84− parseDomain

85− <|> parsePath

86− <|> parseExpires

87− <|> parseMaxAge

88− <|> parseSecure

89− <|> parseHttpOnly

90− <|> parseSameSite

91−

92−parseSimpleCookie :: Parser String Cookie

93−parseSimpleCookie = do

94− name <- stringWithout ([ ';', ',', '=' ] <> whitespaceChars) <* string "="

95− value <- stringWithout ([ ';', ',' ] <> whitespaceChars)

96− pure $ Cookie.new name value

97−

98−parseCookie :: Parser String Cookie

99−parseCookie = do

100− cookie <- parseSimpleCookie <* dropSeperator

101− attributes <- sepBy parseAttribute (string "; ") <* eof

102− pure $ foldl (#) cookie attributes

103−

104−parseCookies :: Parser String (List Cookie)

105−parseCookies = sepBy parseSimpleCookie (string "; ") <* eof

106−

107−-- | Parses a `String` into an `Either ParseError Cookie`. This

108−-- | function is primarily intended to parse the `Set-Cookie`

109−-- | header on the client.

110−-- |

111−-- | ```purescript

112−-- | > Parser.parse "key=value; Secure"

113−-- | (Right { name: "key", value: "value", secure: true, ... })

114−-- | ```

115−parse :: String -> Either ParseError Cookie

116−parse = flip runParser parseCookie

117−

118−-- | Parses a `String` into an `Either ParseError (List Cookie)`.

119−-- | HTTP requests can include multiple cookies in a single

120−-- | `Cookie` header consisting of only name/value pairs. This

121−-- | function can be used to parse this header.

122−-- |

123−-- | ```purescript

124−-- | > parseMany "key1=value1; key2=value2"

125−-- | (Right ({ name: "key1", value: "value1", ... } : { name: "key2", value: "value2", ... } : Nil))

126−-- | ```

127−parseMany :: String -> Either ParseError (List Cookie)

128−parseMany = flip runParser parseCookies

src/PureStack/Cookie/Types.pursdeleted−189

@@ -1,189 +0,0 @@

1−-- | This module contains the `Cookie` type and functions for operating on data within it.

2−module PureStack.Cookie.Types

3− ( Cookie

4− , SameSite(..)

5− , _domain

6− , _expires

7− , _httpOnly

8− , _maxAge

9− , _name

10− , _path

11− , _secure

12− , _value

13− , expire

14− , fromFields

15− , getDomain

16− , getExpires

17− , getHttpOnly

18− , getMaxAge

19− , getName

20− , getPath

21− , getSameSite

22− , getSecure

23− , getValue

24− , new

25− , setDomain

26− , setExpires

27− , setHttpOnly

28− , setMaxAge

29− , setPath

30− , setSameSite

31− , setSecure

32− ) where

33−

34−import Prelude

35−import Data.DateTime (DateTime)

36−import Data.DateTime as DateTime

37−import Data.Either (Either(..))

38−import Data.Lens (Iso', Lens', iso)

39−import Data.Lens as Lens

40−import Data.Lens.Record (prop)

41−import Data.Maybe (Maybe(..))

42−import Data.Time.Duration (Days(..))

43−import Effect.Now (nowDateTime)

44−import Effect (Effect)

45−import Type.Prelude (Proxy(..))

46−

47−-- | Type representing a `Cookie`'s optional `SameSite` attribute.

48−data SameSite

49− = Strict

50− | Lax

51− | None

52−

53−derive instance eqSameSite :: Eq SameSite

54−

55−derive instance ordSameSite :: Ord SameSite

56−

57−instance showSameSite :: Show SameSite where

58− show :: SameSite -> String

59− show Strict = "Strict"

60− show Lax = "Lax"

61− show None = "None"

62−

63−type CookieFields =

64− { name :: String

65− , value :: String

66− , domain :: Maybe String

67− , path :: Maybe String

68− , expires :: Maybe DateTime

69− , maxAge :: Maybe Int

70− , sameSite :: Maybe SameSite

71− , secure :: Boolean

72− , httpOnly :: Boolean

73− }

74−

75−-- | The `Cookie` type

76−newtype Cookie = Cookie CookieFields

77−

78−derive newtype instance eqCookie :: Eq Cookie

79−

80−derive newtype instance ordCookie :: Ord Cookie

81−

82−derive newtype instance showCookie :: Show Cookie

83−

84−-- | The constructor for `Cookie`

85−new :: String -> String -> Cookie

86−new name value =

87− Cookie

88− { name

89− , value

90− , domain: Nothing

91− , path: Nothing

92− , expires: Nothing

93− , maxAge: Nothing

94− , sameSite: Nothing

95− , secure: false

96− , httpOnly: false

97− }

98−

99−fromFields :: CookieFields -> Cookie

100−fromFields = Cookie

101−

102−-- | Expire an existing `Cookie`. This sets the `Expires` attribute of

103−-- | the cookie to yesterday's date.

104−expire :: Cookie -> Effect (Either String Cookie)

105−expire cookie = do

106− now <- nowDateTime

107− let maybeDate = DateTime.adjust (Days $ -1.0) now

108−

109− case maybeDate of

110− Nothing -> pure $ Left "Invalid date"

111− Just yesterday -> pure $ Right $ setExpires yesterday cookie

112−

113−getDomain :: Cookie -> Maybe String

114−getDomain = Lens.view _domain

115−

116−getExpires :: Cookie -> Maybe DateTime

117−getExpires = Lens.view _expires

118−

119−getHttpOnly :: Cookie -> Boolean

120−getHttpOnly = Lens.view _httpOnly

121−

122−getMaxAge :: Cookie -> Maybe Int

123−getMaxAge = Lens.view _maxAge

124−

125−getName :: Cookie -> String

126−getName = Lens.view _name

127−

128−getPath :: Cookie -> Maybe String

129−getPath = Lens.view _path

130−

131−getSameSite :: Cookie -> Maybe SameSite

132−getSameSite = Lens.view _sameSite

133−

134−getSecure :: Cookie -> Boolean

135−getSecure = Lens.view _secure

136−

137−getValue :: Cookie -> String

138−getValue = Lens.view _value

139−

140−setDomain :: String -> Cookie -> Cookie

141−setDomain = Lens.setJust _domain

142−

143−setExpires :: DateTime -> Cookie -> Cookie

144−setExpires = Lens.setJust _expires

145−

146−setHttpOnly :: Cookie -> Cookie

147−setHttpOnly = Lens.set _httpOnly true

148−

149−setMaxAge :: Int -> Cookie -> Cookie

150−setMaxAge = Lens.setJust _maxAge

151−

152−setPath :: String -> Cookie -> Cookie

153−setPath = Lens.setJust _path

154−

155−setSameSite :: SameSite -> Cookie -> Cookie

156−setSameSite = Lens.setJust _sameSite

157−

158−setSecure :: Cookie -> Cookie

159−setSecure = Lens.set _secure true

160−

161−_Cookie :: Iso' Cookie CookieFields

162−_Cookie = iso (\(Cookie fields) -> fields) Cookie

163−

164−_domain :: Lens' Cookie (Maybe String)

165−_domain = _Cookie <<< prop (Proxy :: Proxy "domain")

166−

167−_expires :: Lens' Cookie (Maybe DateTime)

168−_expires = _Cookie <<< prop (Proxy :: Proxy "expires")

169−

170−_httpOnly :: Lens' Cookie Boolean

171−_httpOnly = _Cookie <<< prop (Proxy :: Proxy "httpOnly")

172−

173−_maxAge :: Lens' Cookie (Maybe Int)

174−_maxAge = _Cookie <<< prop (Proxy :: Proxy "maxAge")

175−

176−_name :: Lens' Cookie String

177−_name = _Cookie <<< prop (Proxy :: Proxy "name")

178−

179−_path :: Lens' Cookie (Maybe String)

180−_path = _Cookie <<< prop (Proxy :: Proxy "path")

181−

182−_sameSite :: Lens' Cookie (Maybe SameSite)

183−_sameSite = _Cookie <<< prop (Proxy :: Proxy "sameSite")

184−

185−_secure :: Lens' Cookie Boolean

186−_secure = _Cookie <<< prop (Proxy :: Proxy "secure")

187−

188−_value :: Lens' Cookie String

189−_value = _Cookie <<< prop (Proxy :: Proxy "value")

src/PureStack/Route.purs+10−31

@@ -1,45 +1,27 @@

1module PureStack.Route

2 ( type (/)

3 , Slash

4− , HttpMethod

5− , class MethodName

6− , methodName

7 , GET

4 , GET

8 , POST

5 , POST

9 , PUT

6 , PUT

10 , DELETE

7 , DELETE

11 , PATCH

8 , PATCH

12− , Headers(..)

13− , Middleware

14 ) where

9 ) where

16−data HttpMethod

11+data GET :: Type -> Type

12+data GET resp

18−-- | The `req` can only ever be `Unit`

14+data POST :: Type -> Type -> Type

19−foreign import data GET :: Type -> Type -> HttpMethod

15+data POST req resp

20−foreign import data POST :: Type -> Type -> HttpMethod

21−foreign import data PUT :: Type -> Type -> HttpMethod

22−foreign import data DELETE :: Type -> Type -> HttpMethod

23−foreign import data PATCH :: Type -> Type -> HttpMethod

25−class MethodName :: HttpMethod -> Constraint

17+data PUT :: Type -> Type -> Type

26−class MethodName method where

18+data PUT req resp

27− methodName :: String

29−instance MethodName (GET req resp) where

20+data DELETE :: Type -> Type -> Type

30− methodName = "GET"

21+data DELETE req resp

32−instance MethodName (POST req resp) where

23+data PATCH :: Type -> Type -> Type

33− methodName = "POST"

34−

35−instance MethodName (PUT req resp) where

36− methodName = "PUT"

37−

38−instance MethodName (DELETE req resp) where

39− methodName = "DELETE"

40−

41−instance MethodName (PATCH req resp) where

24+data PATCH req resp

42− methodName = "PATCH"

44data Slash :: forall k1 k2. k1 -> k2 -> Type

26data Slash :: forall k1 k2. k1 -> k2 -> Type

45data Slash x y

27data Slash x y

@@ -50,6 +32,3 @@ data Slash x y

50-- | Other types are captured path pieces.

32-- | Other types are captured path pieces.

51infixr 1 type Slash as /

33infixr 1 type Slash as /

53−data Headers headers r = Headers headers r

54−

55−data Middleware tag

src/PureStack/Server.purs+118−312

@@ -1,245 +1,101 @@

1module PureStack.Server

2 ( Server

3− , Response(..)

3+ , serve

4− , ResponseBody(..)

5− , class ToResponse

6− , toResponse

7− , class FromRequest

8− , fromRequest

9− , run

10− , notFound

11− , internalServerError

12− , badRequest

13− -------------------------------------------------------------------------------------------------

14 , class ServeAPI

4 , class ServeAPI

15 , serveAPI

5 , serveAPI

16 , Nt(..)

6 , Nt(..)

17− , class ServeRoute

18− , serveRoute

19− , class ServeQuery

20− , serveQuery

21− , class ParsePathPiece

22− , parsePathPiece

23− , class FromHeaders

24− , fromHeaders

25− , class FromHeader

26− , fromHeader

27 ) where

7 ) where

29import Prelude

9import Prelude

30import PureStack.Route

10import PureStack.Route

32import Bun.Request (Request)

12import Bun.Request (Request)

33−import Bun.Request as Bun

34import Bun.Request as Request

13import Bun.Request as Request

35−import Bun.Response as Bun.Response

14+import Bun.Response (Response)

15+import Bun.Response as Response

36import Control.Alternative (class Plus, empty)

16import Control.Alternative (class Plus, empty)

37−import Control.Monad.Except (ExceptT, runExceptT)

17+import Control.Monad.Except (ExceptT, runExceptT, throwError)

38−import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson)

18+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)

39import Data.Array as Array

19import Data.Array as Array

40−import Data.Either (Either(..), either)

20+import Data.Either (Either(..))

41−import Data.Int as Int

42−import Data.Map (Map)

43−import Data.Map as Map

44import Data.Maybe (Maybe(..))

21import Data.Maybe (Maybe(..))

45−import Data.Number as Number

46−import Data.String as String

47import Data.Symbol (class IsSymbol, reflectSymbol)

22import Data.Symbol (class IsSymbol, reflectSymbol)

48−import Data.Traversable (traverse)

49import Data.URL as URL

23import Data.URL as URL

24+import Effect (Effect)

50import Effect.Aff (Aff)

25import Effect.Aff (Aff)

51import Effect.Aff.Class (liftAff)

26import Effect.Aff.Class (liftAff)

52−import Foreign.Object (Object)

27+import Prim.Row (class Lacks)

53−import Foreign.Object as Object

54import Prim.Row as Row

28import Prim.Row as Row

55import Prim.RowList (class RowToList, RowList)

29import Prim.RowList (class RowToList, RowList)

56import Prim.RowList as RowList

30import Prim.RowList as RowList

57−import PureStack.Cookie (Cookie)

58−import PureStack.Cookie as Cookie

59import Record as Record

31import Record as Record

60−import Record.Builder (Builder)

61−import Record.Builder as Builder

62import Type.Proxy (Proxy(..))

32import Type.Proxy (Proxy(..))

64−type Route =

65− { path :: Array String

34+type Route = { path :: Array String, verb :: String }

66− , verb :: String

67− , query :: Map String (Array String)

68− , originalRequest :: Bun.Request

69− }

71routeFromRequest :: Request -> Route

36routeFromRequest :: Request -> Route

72routeFromRequest req =

37routeFromRequest req =

73− let

74− url = URL.fromString $ Request.url req

75− in

76− { verb: Request.method req

38+ { verb: Request.method req

77− , path: case url of

39+ , path: case URL.fromString (Request.url req) of

78− Nothing -> []

40+ Nothing -> []

79− Just u -> case URL.path u of

41+ Just url -> case URL.path url of

80− URL.PathEmpty -> []

42+ URL.PathEmpty -> []

81− URL.PathAbsolute p -> p

43+ URL.PathAbsolute p -> p

82− URL.PathRelative p -> p

44+ URL.PathRelative p -> p

83− , query: case url of

84− Nothing -> Map.empty

85− Just u -> URL.query u

86− , originalRequest: req

87− }

45+ }

89type Server a = ExceptT Response Aff a

47type Server a = ExceptT Response Aff a

91newtype Nt m = Nt (forall x. m x -> Server x)

49newtype Nt m = Nt (forall x. m x -> Server x)

93−class ServeRoute :: forall k. k -> Type -> Row Type -> (Type -> Type) -> Constraint

51+class ServeRoute :: forall k. k -> Type -> (Type -> Type) -> Constraint

94−class ServeRoute route handler middlewares m | route middlewares -> handler, handler -> m where

52+class ServeRoute route handler m | route -> handler, handler -> m where

95− serveRoute :: Route -> Maybe (Nt m -> handler -> Record middlewares -> Request -> Server Response)

53+ serveRoute :: Route -> Maybe (Nt m -> handler -> Request -> Server Response)

97−instance (ServeRoute rest handler middlewares m, IsSymbol path) => ServeRoute (path / rest) handler middlewares m where

55+instance (ServeRoute rest handler m, IsSymbol path) => ServeRoute (path / rest) handler m where

98− serveRoute route@{ path } = do

56+ serveRoute { path, verb } = do

99 { head: h, tail } <- Array.uncons path

57 { head: h, tail } <- Array.uncons path

100 assert $ h == (reflectSymbol @path Proxy)

58 assert $ h == (reflectSymbol @path Proxy)

101− serveRoute @rest route { path = tail }

59+ serveRoute @rest { path: tail, verb: verb }

102

103−else instance

104− ( ServeRoute rest handler middlewares m

105− , ServeQuery row list

106− , RowToList row list

107− ) =>

108− ServeRoute (Record row / rest) (Record row -> handler) middlewares m where

109− serveRoute route@{ query } = do

110− builder <- serveQuery @row @list query

111− serveRoute @rest route <#> (\f nt handler req -> f nt (handler $ Builder.buildFromScratch builder) req)

112−

113−else instance

114− ( ServeRoute rest handler middlewares m

115− , IsSymbol field

116− , Row.Cons field (Bun.Request -> m x) tail middlewares

117− ) =>

118− ServeRoute (Middleware field / rest) (x -> handler) middlewares m where

119− serveRoute route@{ originalRequest } = do

120− serveRoute @rest route <#>

121− ( \f nt@(Nt ntf) handler middlewares req -> do

122− x <- ntf $ Record.get (Proxy @field) middlewares originalRequest

123− f nt (handler x) middlewares req

124− )

125−

126−else instance (ServeRoute rest handler middlewares m, ParsePathPiece t) => ServeRoute (t / rest) (t -> handler) middlewares m where

61+else instance (ServeRoute rest handler m, ParsePathPiece t) => ServeRoute (t / rest) (t -> handler) m where

127− serveRoute route@{ path } = do

62+ serveRoute { path, verb } = do

128 { head: h, tail } <- Array.uncons path

63 { head: h, tail } <- Array.uncons path

129 t <- parsePathPiece @t h

64 t <- parsePathPiece @t h

130− serveRoute @rest route { path = tail } <#> (\f nt handler mws req -> f nt (handler t) mws req)

65+ serveRoute @rest { path: tail, verb } <#> (\f nt handler req -> f nt (handler t) req)

131

132−else instance MethodName (meth Unit Unit) => ServeRoute (meth Unit Unit) (m Unit) middlewares m where

133− serveRoute { path, verb } = do

134− assert $ verb == methodName @(meth Unit Unit)

135− assert $ path == []

136− pure $ \(Nt nt) handler _middlewares _req -> do

137− nt handler

138− pure $ ok

139−else instance (ToResponse resp, MethodName (meth Unit resp)) => ServeRoute (meth Unit resp) (m resp) middlewares m where

67+else instance ToResponse resp => ServeRoute (GET resp) (m resp) m where

140 serveRoute { path, verb } = do

68 serveRoute { path, verb } = do

141− assert $ verb == methodName @(meth Unit resp)

69+ assert $ verb == "GET"

142 assert $ path == []

70 assert $ path == []

143− pure $ \(Nt nt) handler _middlewares _req -> do

71+ pure $ \(Nt nt) handler _req -> do

144 resp <- nt handler

72 resp <- nt handler

145 pure $ toResponse resp

73 pure $ toResponse resp

74+

146−else instance (FromRequest req, MethodName (meth resp Unit)) => ServeRoute (meth resp Unit) (req -> m Unit) middlewares m where

75+else instance (ToResponse resp) => ServeRoute (POST Unit resp) (m resp) m where

147 serveRoute { path, verb } = do

76 serveRoute { path, verb } = do

148− assert $ verb == methodName @(meth resp Unit)

149 assert $ path == []

77 assert $ path == []

78+ assert $ verb == "POST"

150− pure $ \(Nt nt) handler _middlewares req -> do

79+ pure $ \(Nt nt) handler _req -> do

151− liftAff (fromRequest req) >>= case _ of

80+ resp <- nt handler

152− Nothing -> pure $ badRequest

81+ pure $ toResponse resp

153− Just r -> do

82+

154− nt $ handler r

155− pure $ ok

156−else instance (FromRequest req, ToResponse resp, MethodName (meth req resp)) => ServeRoute (meth req resp) (req -> m resp) middlewares m where

83+else instance (FromRequest req, ToResponse resp) => ServeRoute (POST req resp) (req -> m resp) m where

157 serveRoute { path, verb } = do

84 serveRoute { path, verb } = do

158− assert $ verb == methodName @(meth req resp)

159 assert $ path == []

85 assert $ path == []

86+ assert $ verb == "POST"

160− pure $ \(Nt nt) handler _middlewares req -> do

87+ pure $ \(Nt nt) handler req -> do

161 liftAff (fromRequest req) >>= case _ of

88 liftAff (fromRequest req) >>= case _ of

162 Nothing -> pure $ badRequest

89 Nothing -> pure $ badRequest

163 Just r -> do

90 Just r -> do

164 resp <- nt $ handler r

91 resp <- nt $ handler r

165 pure $ toResponse resp

92 pure $ toResponse resp

166

167−else instance

168− ( ServeAPI routes list handlers middlewares m

169− , RowToList routes list

170− ) =>

171− ServeRoute routes (Record handlers) middlewares m where

172− serveRoute route = pure $ \nt handlers middlewares req ->

173− serveAPI @routes @list nt handlers middlewares route req

174−

175−class ServeQuery :: Row Type -> RowList Type -> Constraint

176−class ServeQuery row list | list -> row where

177− serveQuery :: Map String (Array String) -> Maybe (Builder (Record ()) (Record row))

178−

179−instance ServeQuery () RowList.Nil where

180− serveQuery _ = Just $ identity

181−

182−instance

183− ( ParsePathPiece t

184− , ServeQuery tail rest

185− , IsSymbol field

186− , Row.Cons field (Array t) tail row

187− , Row.Lacks field tail

188− ) =>

189− ServeQuery row (RowList.Cons field (Array t) rest) where

190− serveQuery m = do

191− r <- serveQuery @tail @rest m

192− case Map.lookup (reflectSymbol @field Proxy) m of

193− Nothing -> pure $ Builder.insert (Proxy @field) [] <<< r

194− Just a -> do

195− v <- parsePathPiece @t `traverse` a

196− pure $ Builder.insert (Proxy @field) v <<< r

197−

198−else instance

199− ( ParsePathPiece t

200− , ServeQuery tail rest

201− , IsSymbol field

202− , Row.Cons field (Maybe t) tail row

203− , Row.Lacks field tail

204− ) =>

205− ServeQuery row (RowList.Cons field (Maybe t) rest) where

206− serveQuery m = do

207− r <- serveQuery @tail @rest m

208− case Map.lookup (reflectSymbol @field Proxy) m of

209− Nothing -> pure $ Builder.insert (Proxy @field) Nothing <<< r

210− Just a -> do

211− { head, tail } <- Array.uncons a

212− assert $ tail == []

213− v <- parsePathPiece @t head

214− pure $ Builder.insert (Proxy @field) (Just v) <<< r

215−

216−else instance

217− ( ParsePathPiece t

218− , ServeQuery tail rest

219− , IsSymbol field

220− , Row.Cons field t tail row

221− , Row.Lacks field tail

222− ) =>

223− ServeQuery row (RowList.Cons field t rest) where

224− serveQuery m = do

225− { head, tail } <- Map.lookup (reflectSymbol @field Proxy) m >>= Array.uncons

226− assert $ tail == []

227− v <- parsePathPiece @t head

228− r <- serveQuery @tail @rest m

229− pure $ Builder.insert (Proxy @field) v <<< r

230−

231−data ResponseBody

232− = JsonResponseBody Json

233− | EmptyResponseBody

234− | StringResponseBody String

235−

236−newtype Response = Response { body :: ResponseBody, status :: Int, statusText :: String, headers :: Object String }

237−

238class ToResponse r where

94class ToResponse r where

239 toResponse :: r -> Response

95 toResponse :: r -> Response

240

241instance EncodeJson (Record row) => ToResponse (Record row) where

97instance EncodeJson (Record row) => ToResponse (Record row) where

242− toResponse rec = Response { body: JsonResponseBody $ encodeJson rec, status: 200, statusText: "OK", headers: Object.empty }

98+ toResponse rec = Response.json (encodeJson rec) { status: 200, statusText: "OK", headers: [] }

243

244instance ToResponse Response where

100instance ToResponse Response where

245 toResponse resp = resp

101 toResponse resp = resp

@@ -255,156 +111,106 @@ instance DecodeJson (Record row) => FromRequest (Record row) where

255instance FromRequest Request where

111instance FromRequest Request where

256 fromRequest req = pure $ Just req

112 fromRequest req = pure $ Just req

257

113

258−instance FromRequest Unit where

259− fromRequest _ = pure $ Just unit

260−

261−instance

262− ( FromRequest req

263− , FromHeader header

264− ) =>

265− FromRequest (Headers (Object header) req) where

266− fromRequest req = do

267− r <- fromRequest req

268− pure $ do

269− headers <- traverse fromHeader (Request.headers req)

270− r' <- r

271− pure $ Headers headers r'

272−

273−instance

274− ( RowToList headers headersList

275− , FromRequest req

276− , FromHeaders headers headersList

277− ) =>

278− FromRequest (Headers (Record headers) req) where

279− fromRequest req = do

280− r <- fromRequest req

281− pure $ do

282− headers <- fromHeaders @headers @headersList (Request.headers req)

283− r' <- r

284− pure $ Headers (Builder.buildFromScratch headers) r'

285−

286−class FromHeader t where

287− fromHeader :: String -> Maybe t

288−

289−instance FromHeader Cookie where

290− fromHeader = Cookie.parse >>> case _ of

291− Left _ -> Nothing

292− Right x -> Just x

293−

294−instance FromHeader String where

295− fromHeader = Just

296−

297−instance FromHeader Int where

298− fromHeader = Int.fromString

299−

300−class FromHeaders :: Row Type -> RowList Type -> Constraint

301−class FromHeaders row list | list -> row where

302− fromHeaders :: Object String -> Maybe (Builder {} (Record row))

303−

304−instance FromHeaders () RowList.Nil where

305− fromHeaders _ = Just $ identity

306−

307−instance

308− ( FromHeader t

309− , IsSymbol field

310− , FromHeaders tail rest

311− , Row.Cons field (Maybe t) tail row

312− , Row.Lacks field tail

313− ) =>

314− FromHeaders row (RowList.Cons field (Maybe t) rest) where

315− fromHeaders headers = do

316− r <- fromHeaders @tail @rest headers

317− case Object.lookup (reflectSymbol @field Proxy) headers of

318− Nothing -> pure $ Builder.insert (Proxy @field) Nothing <<< r

319− Just t -> do

320− v <- fromHeader t

321− pure $ Builder.insert (Proxy @field) (Just v) <<< r

322−

323−else instance

324− ( FromHeader t

325− , IsSymbol field

326− , FromHeaders tail rest

327− , Row.Cons field t tail row

328− , Row.Lacks field tail

329− ) =>

330− FromHeaders row (RowList.Cons field t rest) where

331− fromHeaders headers = do

332− t <- Object.lookup (reflectSymbol @field Proxy) headers >>= fromHeader

333− r <- fromHeaders @tail @rest headers

334− pure $ Builder.insert (Proxy @field) t <<< r

335−

336class ParsePathPiece t where

114class ParsePathPiece t where

337 parsePathPiece :: String -> Maybe t

115 parsePathPiece :: String -> Maybe t

338

116

339−instance ParsePathPiece String where

340− parsePathPiece = Just

341−

342−instance ParsePathPiece Int where

343− parsePathPiece = Int.fromString

344−

345−instance ParsePathPiece Number where

346− parsePathPiece = Number.fromString

347−

348−instance ParsePathPiece Boolean where

349− parsePathPiece s = case String.toLower s of

350− "true" -> Just true

351− "1" -> Just true

352− "false" -> Just false

353− "0" -> Just false

354− _ -> Nothing

355−

356assert :: forall m. Applicative m => Plus m => Boolean -> m Unit

117assert :: forall m. Applicative m => Plus m => Boolean -> m Unit

357assert true = pure unit

118assert true = pure unit

358assert false = empty

119assert false = empty

359

120

360−class ServeAPI :: Row Type -> RowList Type -> Row Type -> Row Type -> (Type -> Type) -> Constraint

121+class ServeAPI :: Row Type -> RowList Type -> Row Type -> (Type -> Type) -> Constraint

361−class ServeAPI row list handlers middlewares m | row -> handlers, handlers -> m where

122+class ServeAPI row list handlers m | row -> handlers, handlers -> m where

362− serveAPI :: Nt m -> Record handlers -> Record middlewares -> Route -> Request -> Server Response

123+ serveAPI :: Nt m -> Record handlers -> Route -> Request -> Server Response

363

124

364−instance ServeAPI row RowList.Nil () middlewares m where

125+instance ServeAPI row RowList.Nil () m where

365− serveAPI _ _ _ _ _ = pure notFound

126+ serveAPI _ _ _ _ = pure notFound

366

127

367instance

128instance

368− ( ServeRoute t handler middlewares m

129+ ( ServeRoute t handler m

369 , Row.Cons field t tail row

130 , Row.Cons field t tail row

370− , ServeAPI row rest restHandlers middlewares m

131+ , ServeAPI row rest restHandlers m

371 , IsSymbol field

132 , IsSymbol field

372 , Row.Cons field handler restHandlers handlers

133 , Row.Cons field handler restHandlers handlers

373 , Row.Lacks field restHandlers

134 , Row.Lacks field restHandlers

374 ) =>

135 ) =>

375− ServeAPI row (RowList.Cons field t rest) handlers middlewares m where

136+ ServeAPI row (RowList.Cons field t rest) handlers m where

376− serveAPI nt handlers middlewares route req =

137+ serveAPI nt handlers route@{ path, verb } req =

377− case serveRoute @t route of

138+ case serveRoute @t { path, verb } of

378− Nothing -> serveAPI @row @rest @restHandlers @middlewares nt (Record.delete (Proxy @field) handlers) middlewares route req

139+ Nothing -> serveAPI @row @rest @restHandlers nt (Record.delete (Proxy @field) handlers) route req

379− Just f -> f nt (Record.get (Proxy @field) handlers) middlewares req

140+ Just f -> f nt (Record.get (Proxy @field) handlers) req

380

141

381notFound :: Response

142notFound :: Response

382−notFound = Response { body: EmptyResponseBody, status: 404, statusText: "Not Found", headers: Object.empty }

143+notFound = Response.string "" { status: 404, statusText: "Not Found", headers: [] }

383

144

384internalServerError :: Response

145internalServerError :: Response

385−internalServerError = Response { body: EmptyResponseBody, status: 500, statusText: "Internal Server Error", headers: Object.empty }

146+internalServerError = Response.string "" { status: 500, statusText: "Internal Server Error", headers: [] }

386

147

387badRequest :: Response

148badRequest :: Response

388−badRequest = Response { body: EmptyResponseBody, status: 400, statusText: "Bad Request", headers: Object.empty }

149+badRequest = Response.string "" { status: 400, statusText: "Bad Request", headers: [] }

389−

390−ok :: Response

391−ok = Response { body: EmptyResponseBody, status: 200, statusText: "OK", headers: Object.empty }

392

150

393−-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad

151+serve

394−-- | instead you can just pass `identity` as the first argument.

395−run

396− :: forall @row list handlers m middlewares

152+ :: forall @row list handlers m

397 . RowToList row list

153 . RowToList row list

398− => ServeAPI row list handlers middlewares m

154+ => ServeAPI row list handlers m

399 => (forall x. m x -> Server x)

155 => (forall x. m x -> Server x)

400− -> { handlers :: Record handlers, middlewares :: Record middlewares }

156+ -> Record handlers

401 -> Request

157 -> Request

402− -> Aff Bun.Response.Response

158+ -> Aff Response

403−run nt { handlers, middlewares } req = do

159+serve nt handlers req = do

404− Response { body, headers, status, statusText } <-

405− map (either identity identity) $ runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers middlewares (routeFromRequest req) req

160+ res <- runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers (routeFromRequest req) req

406− let opts = { headers, status, statusText }

407− pure $ case body of

161+ pure case res of

408− EmptyResponseBody -> Bun.Response.string "" opts

162+ Left resp -> resp

409− JsonResponseBody json -> Bun.Response.json json opts

163+ Right resp -> resp

410− StringResponseBody string -> Bun.Response.string string opts

164+

165+-- class RecordNaturalTransformation

166+-- :: forall k

167+-- . (k -> Type)

168+-- -> (k -> Type)

169+-- -> Row Type

170+-- -> RowList Type

171+-- -> Row Type

172+-- -> Constraint

173+-- class

174+-- RecordNaturalTransformation from to row list row'

175+-- | list from -> row

176+-- , list to -> row'

177+-- , row' from -> row

178+-- , row to -> row where

179+-- nt' :: (forall a. from a -> to a) -> Record row -> Record row'

180+

181+-- instance RecordNaturalTransformation from to () RowList.Nil () where

182+-- nt' _ rec = rec

183+

184+-- instance

185+-- ( IsSymbol field

186+-- , Row.Cons field t tail row

187+-- , Row.Cons field t' tail' row'

188+-- , FunctionNaturalTransformation from to t t'

189+-- , RecordNaturalTransformation from to tail rest tail'

190+-- , Lacks field tail

191+-- , Lacks field tail'

192+-- ) =>

193+-- RecordNaturalTransformation from to row (RowList.Cons field t rest) row' where

194+-- nt' f rec = Record.insert (Proxy @field) (ntFunction f $ Record.get (Proxy @field) rec)

195+-- $ nt' @from @to @tail @rest @tail' f (Record.delete (Proxy @field) rec)

196+

197+-- class FunctionNaturalTransformation :: forall k. (k -> Type) -> (k -> Type) -> Type -> Type -> Constraint

198+-- class FunctionNaturalTransformation from to func func' | to func -> func' where

199+-- ntFunction :: (forall a. from a -> to a) -> func -> func'

200+

201+-- instance FunctionNaturalTransformation from to (from x) (to x) where

202+-- ntFunction f g = f g

203+

204+-- else instance

205+-- FunctionNaturalTransformation from to func func' =>

206+-- FunctionNaturalTransformation from to (a -> func) (a -> func') where

207+-- ntFunction f g = \a -> ntFunction f (g a)

208+

209+-- nt

210+-- :: forall @from row row' list

211+-- . RowToList row list

212+-- => RecordNaturalTransformation from Aff row list row'

213+-- => (forall a. from a -> Aff a)

214+-- -> Record row

215+-- -> Record row'

216+-- nt f rec = nt' @from @Aff @row @list @row' f rec