commit 90ac1a2fba7a2fe507056ae58e919f74737df402
parent b0fe62f13b4b19b7ada111b68521cb0bf262ff98
Author: mtmn <miro@haravara.org>
Date: Mon, 20 Apr 2026 11:45:21 +0200
chore: use Fn/runFn for multi-argument FFIs
https://github.com/purescript/documentation/blob/master/guides/FFI-Tips.md
Diffstat:
8 files changed, 97 insertions(+), 71 deletions(-)
diff --git a/src/Config.js b/src/Config.js
@@ -1,6 +1,6 @@
import { readFileSync } from "fs";
-export const loadConfigImpl = (path) => (onLeft) => (onRight) => () => {
+export const loadConfigImpl = (path, onLeft, onRight) => () => {
try {
const json = readFileSync(path, { encoding: "utf8" });
onRight(JSON.parse(json))();
diff --git a/src/Config.purs b/src/Config.purs
@@ -3,6 +3,7 @@ module Config where
import Prelude
import Data.Argonaut.Core (Json)
+import Data.Function.Uncurried (Fn3, runFn3)
import Data.Argonaut (decodeJson, (.:), (.:?))
import Data.Either (Either(..))
import Data.Int (fromString) as Data.Int
@@ -67,15 +68,12 @@ s3ConfigFromUser cfg =
}
foreign import loadConfigImpl
- :: String
- -> (String -> Effect Unit)
- -> (Json -> Effect Unit)
- -> Effect Unit
+ :: Fn3 String (String -> Effect Unit) (Json -> Effect Unit) (Effect Unit)
loadConfig :: String -> Aff AppConfig
loadConfig path = do
json <- makeAff \cb ->
- loadConfigImpl path
+ runFn3 loadConfigImpl path
(\msg -> cb (Left (error msg)))
(\j -> cb (Right j))
*> pure nonCanceler
diff --git a/src/Db.js b/src/Db.js
@@ -1,6 +1,6 @@
import duckdb from "duckdb";
-export const connectImpl = (path) => (cb) => () => {
+export const connectImpl = (path, cb) => () => {
const db = new duckdb.Database(path, (err) => {
if (err) {
cb(err)(null)();
@@ -15,13 +15,13 @@ export const connectImpl = (path) => (cb) => () => {
});
};
-export const runImpl = (conn) => (sql) => (params) => (cb) => () => {
+export const runImpl = (conn, sql, params, cb) => () => {
conn.run(sql, ...params, (err) => {
cb(err)();
});
};
-export const checkpointImpl = (conn) => (cb) => () => {
+export const checkpointImpl = (conn, cb) => () => {
conn.run("CHECKPOINT", (err) => {
cb(err)();
});
@@ -34,7 +34,7 @@ const convertBigInts = (row) =>
Object.entries(row).map(([k, v]) => [k, typeof v === "bigint" ? Number(v) : v]),
);
-export const allImpl = (conn) => (sql) => (params) => (cb) => () => {
+export const allImpl = (conn, sql, params, cb) => () => {
conn.all(sql, ...params, (err, rows) => {
cb(err)(rows ? rows.map(convertBigInts) : rows)();
});
diff --git a/src/Db.purs b/src/Db.purs
@@ -15,6 +15,7 @@ import Effect.Exception (Error, error, message)
import Control.Monad.Error.Class (throwError)
import Effect.Now (nowDateTime)
import Data.Formatter.DateTime (formatDateTime)
+import Data.Function.Uncurried (Fn2, Fn4, runFn2, runFn4)
import Foreign (Foreign)
import Unsafe.Coerce (unsafeCoerce)
import Types (Listen(..), TrackMetadata(..), MbidMapping(..), Stats(..), StatsEntry(..))
@@ -46,14 +47,14 @@ instance Show FilterField where
show FilterYear = "FilterYear"
show FilterGenre = "FilterGenre"
-foreign import connectImpl :: String -> (Nullable Error -> Nullable Connection -> Effect Unit) -> Effect Unit
-foreign import runImpl :: Connection -> String -> Array Foreign -> (Nullable Error -> Effect Unit) -> Effect Unit
-foreign import allImpl :: Connection -> String -> Array Foreign -> (Nullable Error -> Nullable (Array Json) -> Effect Unit) -> Effect Unit
-foreign import checkpointImpl :: Connection -> (Nullable Error -> Effect Unit) -> Effect Unit
+foreign import connectImpl :: Fn2 String (Nullable Error -> Nullable Connection -> Effect Unit) (Effect Unit)
+foreign import runImpl :: Fn4 Connection String (Array Foreign) (Nullable Error -> Effect Unit) (Effect Unit)
+foreign import allImpl :: Fn4 Connection String (Array Foreign) (Nullable Error -> Nullable (Array Json) -> Effect Unit) (Effect Unit)
+foreign import checkpointImpl :: Fn2 Connection (Nullable Error -> Effect Unit) (Effect Unit)
connect :: String -> Aff Connection
connect path = makeAff \cb -> do
- connectImpl path \err conn ->
+ runFn2 connectImpl path \err conn ->
case toMaybe err of
Just e ->
cb (Left e)
@@ -64,7 +65,7 @@ connect path = makeAff \cb -> do
run :: Connection -> String -> Array Foreign -> Aff Unit
run conn sql params = makeAff \cb -> do
- runImpl conn sql params \err ->
+ runFn4 runImpl conn sql params \err ->
case toMaybe err of
Just e -> cb (Left e)
Nothing -> cb (Right unit)
@@ -72,7 +73,7 @@ run conn sql params = makeAff \cb -> do
checkpoint :: Connection -> Aff Unit
checkpoint conn = makeAff \cb -> do
- checkpointImpl conn \err ->
+ runFn2 checkpointImpl conn \err ->
case toMaybe err of
Just e -> cb (Left e)
Nothing -> cb (Right unit)
@@ -135,7 +136,7 @@ withTransaction conn lock action = do
queryAll :: Connection -> String -> Array Foreign -> Aff (Array Json)
queryAll conn sql params = makeAff \cb -> do
- allImpl conn sql params \err rows ->
+ runFn4 allImpl conn sql params \err rows ->
case toMaybe err of
Just e -> cb (Left e)
Nothing -> cb (Right (fromMaybe [] (toMaybe rows)))
diff --git a/src/Metrics.js b/src/Metrics.js
@@ -135,7 +135,7 @@ const activeMetrics =
// Exports
// ---------------------------------------------------------------------------
-export const getMetricsImpl = (onSuccess) => (onError) => () => {
+export const getMetricsImpl = (onSuccess, onError) => () => {
activeMetrics.getMetrics().then(
(s) => onSuccess(s)(),
(err) => onError(err.message)(),
@@ -146,47 +146,46 @@ export const getContentType = () => activeMetrics.contentType;
// Attaches a 'finish' listener to record metrics and log the request.
// logFn: String -> Effect Unit — structured logger called on completion.
-export const wrapRequest =
- (method) => (path) => (logFn) => (_req) => (res) => (handler) => () => {
- const startMs = Date.now();
- res.once("finish", () => {
- const durationMs = Date.now() - startMs;
- const status = res.statusCode || 0;
- activeMetrics.recordHttpRequest(method, path, status, durationMs);
- logFn(`${method} ${path} ${status} ${durationMs}ms`)();
- });
- handler();
- };
+export const wrapRequestImpl = (method, path, logFn, _req, res, handler) => () => {
+ const startMs = Date.now();
+ res.once("finish", () => {
+ const durationMs = Date.now() - startMs;
+ const status = res.statusCode || 0;
+ activeMetrics.recordHttpRequest(method, path, status, durationMs);
+ logFn(`${method} ${path} ${status} ${durationMs}ms`)();
+ });
+ handler();
+};
-export const incSyncRuns = (user) => (source) => (result) => () => {
+export const incSyncRunsImpl = (user, source, result) => () => {
activeMetrics.incSyncRuns(user, source, result);
};
-export const incSyncScrobbles = (user) => (source) => (count) => () => {
+export const incSyncScrobblesImpl = (user, source, count) => () => {
activeMetrics.incSyncScrobbles(user, source, count);
};
-export const setSyncLastSuccess = (user) => (source) => () => {
+export const setSyncLastSuccessImpl = (user, source) => () => {
activeMetrics.setSyncLastSuccess(user, source);
};
-export const incEnrichmentFetch = (user) => (source) => (result) => () => {
+export const incEnrichmentFetchImpl = (user, source, result) => () => {
activeMetrics.incEnrichmentFetch(user, source, result);
};
-export const setEnrichmentQueueSize = (user) => (type) => (size) => () => {
+export const setEnrichmentQueueSizeImpl = (user, type, size) => () => {
activeMetrics.setEnrichmentQueueSize(user, type, size);
};
-export const incCoverRequest = (user) => (source) => (result) => () => {
+export const incCoverRequestImpl = (user, source, result) => () => {
activeMetrics.incCoverRequest(user, source, result);
};
-export const incCosineRequest = (user) => (result) => () => {
+export const incCosineRequestImpl = (user, result) => () => {
activeMetrics.incCosineRequest(user, result);
};
-export const incDbBackupRun = (user) => (result) => () => {
+export const incDbBackupRunImpl = (user, result) => () => {
activeMetrics.incDbBackupRun(user, result);
};
diff --git a/src/Metrics.purs b/src/Metrics.purs
@@ -3,42 +3,70 @@ module Metrics where
import Prelude
import Data.Either (Either(..))
+import Data.Function.Uncurried (Fn2, Fn3, Fn6, runFn2, runFn3, runFn6)
import Effect (Effect)
import Effect.Aff (Aff, makeAff, nonCanceler)
import Effect.Exception (error)
import Node.HTTP.Types (IMServer, IncomingMessage, ServerResponse)
-- | Async: serialises all registered metrics to Prometheus text format.
-foreign import getMetricsImpl :: (String -> Effect Unit) -> (String -> Effect Unit) -> Effect Unit
+foreign import getMetricsImpl :: Fn2 (String -> Effect Unit) (String -> Effect Unit) (Effect Unit)
-- | The MIME type to use for the /metrics response body.
foreign import getContentType :: Effect String
-- | Attaches a 'finish' listener to record metrics and log the request.
-foreign import wrapRequest :: String -> String -> (String -> Effect Unit) -> IncomingMessage IMServer -> ServerResponse -> Effect Unit -> Effect Unit
+foreign import wrapRequestImpl :: Fn6 String String (String -> Effect Unit) (IncomingMessage IMServer) ServerResponse (Effect Unit) (Effect Unit)
-- Sync
-foreign import incSyncRuns :: String -> String -> String -> Effect Unit
-foreign import incSyncScrobbles :: String -> String -> Int -> Effect Unit
-foreign import setSyncLastSuccess :: String -> String -> Effect Unit
+foreign import incSyncRunsImpl :: Fn3 String String String (Effect Unit)
+foreign import incSyncScrobblesImpl :: Fn3 String String Int (Effect Unit)
+foreign import setSyncLastSuccessImpl :: Fn2 String String (Effect Unit)
-- Metadata enrichment
-foreign import incEnrichmentFetch :: String -> String -> String -> Effect Unit
-foreign import setEnrichmentQueueSize :: String -> String -> Int -> Effect Unit
+foreign import incEnrichmentFetchImpl :: Fn3 String String String (Effect Unit)
+foreign import setEnrichmentQueueSizeImpl :: Fn3 String String Int (Effect Unit)
-- Cover art
-foreign import incCoverRequest :: String -> String -> String -> Effect Unit
+foreign import incCoverRequestImpl :: Fn3 String String String (Effect Unit)
-- Cosine Club
-foreign import incCosineRequest :: String -> String -> Effect Unit
+foreign import incCosineRequestImpl :: Fn2 String String (Effect Unit)
-- Database backup
-foreign import incDbBackupRun :: String -> String -> Effect Unit
+foreign import incDbBackupRunImpl :: Fn2 String String (Effect Unit)
foreign import setDbBackupLastSuccess :: String -> Effect Unit
getMetrics :: Aff String
getMetrics = makeAff \cb -> do
- getMetricsImpl
+ runFn2 getMetricsImpl
(\s -> cb (Right s))
(\e -> cb (Left (error e)))
pure nonCanceler
+
+wrapRequest :: String -> String -> (String -> Effect Unit) -> IncomingMessage IMServer -> ServerResponse -> Effect Unit -> Effect Unit
+wrapRequest method path logFn req res handler = runFn6 wrapRequestImpl method path logFn req res handler
+
+incSyncRuns :: String -> String -> String -> Effect Unit
+incSyncRuns u s r = runFn3 incSyncRunsImpl u s r
+
+incSyncScrobbles :: String -> String -> Int -> Effect Unit
+incSyncScrobbles u s c = runFn3 incSyncScrobblesImpl u s c
+
+setSyncLastSuccess :: String -> String -> Effect Unit
+setSyncLastSuccess u s = runFn2 setSyncLastSuccessImpl u s
+
+incEnrichmentFetch :: String -> String -> String -> Effect Unit
+incEnrichmentFetch u s r = runFn3 incEnrichmentFetchImpl u s r
+
+setEnrichmentQueueSize :: String -> String -> Int -> Effect Unit
+setEnrichmentQueueSize u t n = runFn3 setEnrichmentQueueSizeImpl u t n
+
+incCoverRequest :: String -> String -> String -> Effect Unit
+incCoverRequest u s r = runFn3 incCoverRequestImpl u s r
+
+incCosineRequest :: String -> String -> Effect Unit
+incCosineRequest u r = runFn2 incCosineRequestImpl u r
+
+incDbBackupRun :: String -> String -> Effect Unit
+incDbBackupRun u r = runFn2 incDbBackupRunImpl u r
diff --git a/src/S3.js b/src/S3.js
@@ -18,23 +18,22 @@ const makeClient = (cfg) =>
: undefined,
});
-export const uploadToS3Impl =
- (cfg) => (key) => (body) => (contentType) => (cb) => () => {
- const client = makeClient(cfg);
- const command = new PutObjectCommand({
- Bucket: cfg.bucket,
- Key: key,
- Body: body,
- ContentType: contentType,
- });
+export const uploadToS3Impl = (cfg, key, body, contentType, cb) => () => {
+ const client = makeClient(cfg);
+ const command = new PutObjectCommand({
+ Bucket: cfg.bucket,
+ Key: key,
+ Body: body,
+ ContentType: contentType,
+ });
- client
- .send(command)
- .then(() => cb(null)())
- .catch((err) => cb(err)());
- };
+ client
+ .send(command)
+ .then(() => cb(null)())
+ .catch((err) => cb(err)());
+};
-export const existsInS3Impl = (cfg) => (key) => (cb) => () => {
+export const existsInS3Impl = (cfg, key, cb) => () => {
const client = makeClient(cfg);
const command = new HeadObjectCommand({
Bucket: cfg.bucket,
@@ -53,7 +52,7 @@ export const existsInS3Impl = (cfg) => (key) => (cb) => () => {
});
};
-export const getS3UrlImpl = (cfg) => (key) => {
+export const getS3UrlImpl = (cfg, key) => {
const endpoint = cfg.endpointUrl || "";
const bucket = cfg.bucket || "";
if (cfg.addressingStyle === "path") {
diff --git a/src/S3.purs b/src/S3.purs
@@ -4,6 +4,7 @@ import Prelude
import Config (S3Config)
import Data.Either (Either(..))
+import Data.Function.Uncurried (Fn2, Fn3, Fn5, runFn2, runFn3, runFn5)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, toMaybe, toNullable)
import Effect (Effect)
@@ -31,16 +32,16 @@ toJs cfg =
}
foreign import uploadToS3Impl
- :: S3ConfigJs -> String -> Buffer -> String -> (Nullable Error -> Effect Unit) -> Effect Unit
+ :: Fn5 S3ConfigJs String Buffer String (Nullable Error -> Effect Unit) (Effect Unit)
foreign import existsInS3Impl
- :: S3ConfigJs -> String -> (Nullable Error -> Boolean -> Effect Unit) -> Effect Unit
+ :: Fn3 S3ConfigJs String (Nullable Error -> Boolean -> Effect Unit) (Effect Unit)
-foreign import getS3UrlImpl :: S3ConfigJs -> String -> String
+foreign import getS3UrlImpl :: Fn2 S3ConfigJs String String
uploadToS3 :: S3Config -> String -> Buffer -> String -> Aff Unit
uploadToS3 cfg key body contentType = makeAff \cb -> do
- uploadToS3Impl (toJs cfg) key body contentType \err ->
+ runFn5 uploadToS3Impl (toJs cfg) key body contentType \err ->
case toMaybe err of
Just e -> cb (Left e)
Nothing -> cb (Right unit)
@@ -48,11 +49,11 @@ uploadToS3 cfg key body contentType = makeAff \cb -> do
existsInS3 :: S3Config -> String -> Aff Boolean
existsInS3 cfg key = makeAff \cb -> do
- existsInS3Impl (toJs cfg) key \err exists ->
+ runFn3 existsInS3Impl (toJs cfg) key \err exists ->
case toMaybe err of
Just e -> cb (Left e)
Nothing -> cb (Right exists)
pure nonCanceler
getS3Url :: S3Config -> String -> String
-getS3Url cfg = getS3UrlImpl (toJs cfg)
+getS3Url cfg key = runFn2 getS3UrlImpl (toJs cfg) key
