git.iko.soy/rowtype-yoga/purescript-opencode
on main help sign in
Add OpenCode and OpenTUI PureScript bindings
commitcddee7ea67e48e19436af926b941c91f7aead9bb authorMark <mark.eibes@gmail.com> dateThu 8 Oct 2026, 23:00 (5 days ago)
13 files changed+879
.gitignore+3 LICENSE+21 package.json+15 spago.yaml+25 src/OpenCode/RPC.js+50 src/OpenCode/RPC.purs+90 src/OpenCode/Server.js+49 src/OpenCode/Server.purs+62 src/OpenCode/TUI.js+83 src/OpenCode/TUI.purs+85 src/OpenTUI.js+117 src/OpenTUI.purs+119 src/OpenTUI/Kitty.purs+160
.gitignorenew file+3
@@ -0,0 +1,3 @@
1+.spago/
2+output/
3+node_modules/
LICENSEnew file+21
@@ -0,0 +1,21 @@
1+MIT License
2+
3+Copyright (c) 2026 Mark Eibes
4+
5+Permission is hereby granted, free of charge, to any person obtaining a copy
6+of this software and associated documentation files (the "Software"), to deal
7+in the Software without restriction, including without limitation the rights
8+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9+copies of the Software, and to permit persons to whom the Software is
10+furnished to do so, subject to the following conditions:
11+
12+The above copyright notice and this permission notice shall be included in all
13+copies or substantial portions of the Software.
14+
15+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21+SOFTWARE.
package.jsonnew file+15
@@ -0,0 +1,15 @@
1+{
2+ "name": "purescript-opencode",
3+ "version": "0.0.1",
4+ "description": "PureScript bindings for OpenCode terminal plugins and OpenTUI",
5+ "license": "MIT",
6+ "repository": "github:rowtype-yoga/purescript-opencode",
7+ "private": true,
8+ "type": "module",
9+ "peerDependencies": {
10+ "@opencode/plugin": "2.0.26",
11+ "@opentui/core": "0.5.17",
12+ "@opentui/solid": "0.5.17",
13+ "solid-js": "^1.9.15"
14+ }
15+}
spago.yamlnew file+25
@@ -0,0 +1,25 @@
1+package:
2+ name: opencode
3+ dependencies:
4+ - aff: ">=8.0.0 <9.0.0"
5+ - arrays: ">=7.3.0 <8.0.0"
6+ - effect: ">=4.0.0 <5.0.0"
7+ - foreign: ">=7.0.0 <8.0.0"
8+ - integers: ">=6.0.0 <7.0.0"
9+ - js-promise: ">=1.0.0 <2.0.0"
10+ - maybe: ">=6.0.0 <7.0.0"
11+ - nullable: ">=6.0.0 <7.0.0"
12+ - prelude: ">=6.0.2 <7.0.0"
13+ - strings: ">=6.0.1 <7.0.0"
14+ publish:
15+ version: 0.0.1
16+ license: MIT
17+ include:
18+ - package.json
19+ - LICENSE
20+ location:
21+ githubOwner: rowtype-yoga
22+ githubRepo: purescript-opencode
23+workspace:
24+ packageSet:
25+ registry: 73.2.0
src/OpenCode/RPC.jsnew file+50
@@ -0,0 +1,50 @@
1+import { Rpc } from "@opencode/plugin";
2+
3+export const define = (definition) =>
4+ Rpc.define({
5+ id: definition.id,
6+ methods: Object.fromEntries(
7+ definition.methods.map((method) => [
8+ method.name,
9+ { input: method.inputSchema, output: method.outputSchema },
10+ ]),
11+ ),
12+ events: Object.fromEntries(
13+ definition.events.map((event) => [event.name, { schema: event.schema }]),
14+ ),
15+ });
16+
17+export const client = (context) => (contract) => () => ({
18+ rpc: context.client.rpc(contract),
19+ location: context.location ?? context.data.location.default(),
20+});
21+
22+export const register = (context) => (contract) => (handlers) => () =>
23+ context.rpc.register(
24+ contract,
25+ Object.fromEntries(
26+ handlers.map((handler) => [
27+ handler.name,
28+ (input, context) => handler.handler(input)(context)(),
29+ ]),
30+ ),
31+ );
32+
33+export const emit = (registration) => (name) => (data) => () =>
34+ registration.events.emit(name, data);
35+
36+export const dispose = (registration) => () => registration.dispose();
37+
38+export const callImpl = (client) => (name) => (input) => () => {
39+ const controller = new AbortController();
40+ return {
41+ promise: client.rpc[name](input, {
42+ location: client.location,
43+ signal: controller.signal,
44+ }),
45+ cancel: () => controller.abort(),
46+ };
47+};
48+
49+export const listen = (rpc) => (name) => (handler) => () =>
50+ rpc.rpc.events.on(name, (event) => handler(event.data)());
src/OpenCode/RPC.pursnew file+90
@@ -0,0 +1,90 @@
1+module OpenCode.RPC
2+ ( Client
3+ , Contract
4+ , CallContext
5+ , Registration
6+ , Method
7+ , Event
8+ , Handler
9+ , define
10+ , client
11+ , register
12+ , emit
13+ , dispose
14+ , call
15+ , listen
16+ ) where
17+
18+import Prelude
19+
20+import Effect (Effect)
21+import Effect.Aff (Aff, bracket)
22+import Effect.Class (liftEffect)
23+import Foreign (Foreign)
24+import OpenCode.Server (Context)
25+import OpenCode.TUI (Context) as TUI
26+import Promise (Promise)
27+import Promise.Aff as Promise
28+
29+type Handler = Foreign -> CallContext -> Effect (Promise Foreign)
30+
31+type Method =
32+ { name :: String
33+ , inputSchema :: Foreign
34+ , outputSchema :: Foreign
35+ }
36+
37+type Event =
38+ { name :: String
39+ , schema :: Foreign
40+ }
41+
42+call :: Client -> String -> Foreign -> Aff Foreign
43+call connection name input =
44+ bracket (liftEffect (callImpl connection name input))
45+ (liftEffect <<< _.cancel)
46+ (Promise.toAff <<< _.promise)
47+
48+foreign import data Client :: Type
49+
50+foreign import data Contract :: Type
51+
52+foreign import data CallContext :: Type
53+
54+foreign import data Registration :: Type
55+
56+-- | Definitions contain only portable Standard Schema/JSON Schema values.
57+foreign import define
58+ :: { id :: String
59+ , methods :: Array Method
60+ , events :: Array Event
61+ }
62+ -> Contract
63+
64+foreign import client :: TUI.Context -> Contract -> Effect Client
65+
66+foreign import register
67+ :: Context
68+ -> Contract
69+ -> Array { name :: String, handler :: Handler }
70+ -> Effect (Promise Registration)
71+
72+foreign import emit
73+ :: Registration
74+ -> String
75+ -> Foreign
76+ -> Effect (Promise Unit)
77+
78+foreign import dispose :: Registration -> Effect (Promise Unit)
79+
80+foreign import listen
81+ :: Client
82+ -> String
83+ -> (Foreign -> Effect Unit)
84+ -> Effect (Effect Unit)
85+
86+foreign import callImpl
87+ :: Client
88+ -> String
89+ -> Foreign
90+ -> Effect { promise :: Promise Foreign, cancel :: Effect Unit }
src/OpenCode/Server.jsnew file+49
@@ -0,0 +1,49 @@
1+import { Plugin } from "@opencode/plugin";
2+
3+export const define = (definition) =>
4+ Plugin.define({
5+ id: definition.id,
6+ setup: (context) =>
7+ definition.setup(context)().then((cleanup) => async () => {
8+ await cleanup();
9+ }),
10+ });
11+
12+export const locationDirectory = (context) => () => context.location.directory;
13+
14+export const registerTool = (context) => (tool) => () =>
15+ context.tool
16+ .transform((editor) => {
17+ editor.add({
18+ name: tool.name,
19+ description: tool.description,
20+ input: tool.inputSchema,
21+ execute: (input, execution) => tool.execute(input)(execution)(),
22+ });
23+ })
24+ .then((registration) => async () => {
25+ await registration.dispose();
26+ });
27+
28+export const sessionId = (context) => context.sessionID;
29+
30+export const onAbort = (context) => (callback) => () => {
31+ const signal = context.signal;
32+ let removed = false;
33+ const remove = () => {
34+ if (!removed) {
35+ removed = true;
36+ signal.removeEventListener("abort", listener);
37+ }
38+ };
39+ const listener = () => {
40+ remove();
41+ callback();
42+ };
43+
44+ if (signal.aborted) listener();
45+ else signal.addEventListener("abort", listener, { once: true });
46+ return remove;
47+};
48+
49+export const success = (message) => ({ content: message });
src/OpenCode/Server.pursnew file+62
@@ -0,0 +1,62 @@
1+module OpenCode.Server
2+ ( Context
3+ , Plugin
4+ , ToolContext
5+ , ToolResult
6+ , Tool
7+ , define
8+ , locationDirectory
9+ , registerTool
10+ , sessionId
11+ , onAbort
12+ , success
13+ ) where
14+
15+import Effect (Effect)
16+import Foreign (Foreign)
17+import Promise (Promise)
18+import Prelude (Unit)
19+
20+-- | Schemas are Standard Schema or JSON Schema values supplied by the caller.
21+-- | Keeping them Foreign lets applications choose their JSON codec without
22+-- | making this SDK binding own application schemas.
23+type Tool =
24+ { name :: String
25+ , description :: String
26+ , inputSchema :: Foreign
27+ , execute :: Foreign -> ToolContext -> Effect (Promise ToolResult)
28+ }
29+
30+foreign import data Context :: Type
31+
32+foreign import data Plugin :: Type
33+
34+foreign import data ToolContext :: Type
35+
36+foreign import data ToolResult :: Type
37+
38+-- | The cleanup returned from setup is asynchronous because OpenCode tool and
39+-- | RPC registrations have asynchronous disposal.
40+foreign import define
41+ :: { id :: String
42+ , setup :: Context -> Effect (Promise (Effect (Promise Unit)))
43+ }
44+ -> Plugin
45+
46+-- | The location is the server plugin instance's location, not process.cwd().
47+foreign import locationDirectory :: Context -> Effect String
48+
49+foreign import registerTool
50+ :: Context
51+ -> Tool
52+ -> Effect (Promise (Effect (Promise Unit)))
53+
54+foreign import sessionId :: ToolContext -> String
55+
56+-- | Registers one AbortSignal listener and returns its idempotent removal.
57+foreign import onAbort
58+ :: ToolContext
59+ -> Effect Unit
60+ -> Effect (Effect Unit)
61+
62+foreign import success :: String -> ToolResult
src/OpenCode/TUI.jsnew file+83
@@ -0,0 +1,83 @@
1+import { Plugin } from "@opencode/plugin/tui";
2+import { jsx } from "@opentui/solid/jsx-runtime";
3+import { createEffect, createRoot } from "solid-js";
4+
5+export const define = (definition) =>
6+ Plugin.define({
7+ id: definition.id,
8+ setup: (context) => definition.setup(context)(),
9+ });
10+
11+export const renderer = (context) => context.renderer;
12+
13+export const cwd = (context) => () =>
14+ (context.location ?? context.data.location.default()).directory;
15+
16+export const themeMode = (context) => () => context.themeMode;
17+
18+export const mutedColor = (context) => () => context.theme.text.muted;
19+
20+export const backgroundColor = (context) => () => context.theme.background.base;
21+
22+export const route = (context) => () => {
23+ const current = context.ui.router.current();
24+ return {
25+ kind: current.type,
26+ sessionID: current.type === "session" ? current.sessionID : null,
27+ };
28+};
29+
30+export const observeRoute = (context) => (callback) => () =>
31+ createRoot((dispose) => {
32+ createEffect(() => {
33+ context.ui.router.current();
34+ callback();
35+ });
36+ return dispose;
37+ });
38+
39+export const registerCommand = (context) => (command) => (run) => () => {
40+ context.keymap.layer(() => ({
41+ mode: "global",
42+ commands: [
43+ {
44+ id: command.id,
45+ title: command.title,
46+ description: command.description,
47+ group: command.group,
48+ palette: true,
49+ slash: { name: command.name, arguments: true },
50+ run: (input) => run(input ?? null)(),
51+ },
52+ ],
53+ }));
54+};
55+
56+export const mountSlot = (context) => (path) => (factory) => () =>
57+ context.ui.slot({
58+ append: path,
59+ render: (input) => jsx(() => factory(input.sessionID ?? null)()),
60+ });
61+
62+export const pushMode = (context) => (mode) => () => context.keymap.mode.push(mode);
63+
64+export const registerKeys = (context) => (renderable) => (mode) => (commands) => () => {
65+ context.keymap.layer(() => ({
66+ mode,
67+ target: () => renderable,
68+ priority: 100,
69+ commands: commands.map((command) => ({
70+ id: command.id,
71+ bind: command.bind,
72+ run: (_input, event) => {
73+ event?.preventDefault();
74+ event?.stopPropagation();
75+ command.run();
76+ },
77+ })),
78+ }));
79+};
80+
81+export const notifyError = (context) => (message) => () => {
82+ context.ui.toast.show({ message, variant: "error" });
83+};
src/OpenCode/TUI.pursnew file+85
@@ -0,0 +1,85 @@
1+module OpenCode.TUI
2+ ( Context
3+ , Plugin
4+ , Route
5+ , define
6+ , renderer
7+ , cwd
8+ , themeMode
9+ , mutedColor
10+ , backgroundColor
11+ , route
12+ , observeRoute
13+ , registerCommand
14+ , mountSlot
15+ , pushMode
16+ , registerKeys
17+ , notifyError
18+ ) where
19+
20+import Data.Nullable (Nullable)
21+import Effect (Effect)
22+import Promise (Promise)
23+import OpenTUI (Color, Renderable, Renderer)
24+import Prelude (Unit)
25+
26+type Route =
27+ { kind :: String
28+ , sessionID :: Nullable String
29+ }
30+
31+foreign import data Context :: Type
32+
33+foreign import data Plugin :: Type
34+
35+-- The host owns setup invocation and calls the cleanup effect returned by setup.
36+foreign import define
37+ :: { id :: String, setup :: Context -> Effect (Effect Unit) }
38+ -> Plugin
39+
40+foreign import renderer :: Context -> Renderer
41+
42+foreign import cwd :: Context -> Effect String
43+
44+foreign import themeMode :: Context -> Effect String
45+
46+foreign import mutedColor :: Context -> Effect Color
47+
48+foreign import backgroundColor :: Context -> Effect Color
49+
50+foreign import route :: Context -> Effect Route
51+
52+-- The callback runs immediately and on later route changes. Run the returned cleanup
53+-- to dispose its Solid root.
54+foreign import observeRoute :: Context -> Effect Unit -> Effect (Effect Unit)
55+
56+foreign import registerCommand
57+ :: Context
58+ -> { id :: String
59+ , title :: String
60+ , description :: String
61+ , group :: String
62+ , name :: String
63+ }
64+ -> (Nullable String -> Effect (Promise Unit))
65+ -> Effect Unit
66+
67+-- The returned cleanup unregisters the host slot claim. The slot callback creates
68+-- the renderable and owns resources associated with it.
69+foreign import mountSlot
70+ :: Context
71+ -> String
72+ -> (Nullable String -> Effect (Nullable Renderable))
73+ -> Effect (Effect Unit)
74+
75+-- Run the returned cleanup to pop precisely this mode stack entry.
76+foreign import pushMode :: Context -> String -> Effect (Effect Unit)
77+
78+foreign import registerKeys
79+ :: Context
80+ -> Renderable
81+ -> String
82+ -> Array { id :: String, bind :: String, run :: Effect Unit }
83+ -> Effect Unit
84+
85+foreign import notifyError :: Context -> String -> Effect Unit
src/OpenTUI.jsnew file+117
@@ -0,0 +1,117 @@
1+let nativeRenderLibrary;
2+const textEncoder = new TextEncoder();
3+
4+const renderLibrary = () => {
5+ nativeRenderLibrary ??= resolveRenderLib();
6+ return nativeRenderLibrary;
7+};
8+
9+const subscribe = (target, event, callback) => () => {
10+ const listener = () => callback();
11+ target.on(event, listener);
12+ return () => target.off(event, listener);
13+};
14+
15+export const createBox = renderer => options => renderAfter => () => {
16+ const renderable = new BoxRenderable(renderer, {
17+ width: options.width,
18+ height: options.height,
19+ flexShrink: options.flexShrink,
20+ backgroundColor: options.backgroundColor,
21+ renderAfter(buffer) {
22+ renderAfter(this)(buffer)();
23+ },
24+ });
25+ renderable.focusable = options.focusable;
26+ return renderable;
27+};
28+
29+export const metrics = renderer => () => {
30+ const resolution = renderer.resolution;
31+ return {
32+ columns: renderer.terminalWidth,
33+ rows: renderer.terminalHeight,
34+ width: renderer.width,
35+ height: renderer.height,
36+ resolution: resolution === null ? null : {
37+ width: resolution.width,
38+ height: resolution.height,
39+ },
40+ };
41+};
42+
43+export const bounds = renderable => () => ({
44+ x: renderable.screenX,
45+ y: renderable.screenY,
46+ width: renderable.width,
47+ height: renderable.height,
48+ visible: renderable.visible,
49+ destroyed: renderable.isDestroyed,
50+ focused: renderable.focused,
51+});
52+
53+export const capabilities = renderer => () => {
54+ const terminalCapabilities = renderer.capabilities;
55+ return terminalCapabilities === null ? null : {
56+ kittyGraphics: terminalCapabilities.kitty_graphics,
57+ rgb: terminalCapabilities.rgb,
58+ remote: terminalCapabilities.remote,
59+ multiplexer: terminalCapabilities.multiplexer !== "none",
60+ };
61+};
62+
63+export const controlState = renderer => () => renderer.controlState;
64+
65+export const isDestroyed = renderer => () => renderer.isDestroyed;
66+
67+export const focused = renderer => () => renderer.currentFocusedRenderable;
68+
69+export const focus = renderable => () => {
70+ renderable.focus();
71+};
72+
73+export const blur = renderable => () => {
74+ renderable.blur();
75+};
76+
77+export const setHeight = renderable => height => () => {
78+ renderable.height = height;
79+};
80+
81+export const requestRender = renderer => () => {
82+ renderer.requestRender();
83+};
84+
85+export const writeControl = renderer => control => () => {
86+ renderLibrary().writeOut(renderer.rendererPtr, textEncoder.encode(control));
87+};
88+
89+export const prependInputHandler = renderer => callback => () => {
90+ const handler = sequence => callback(sequence)();
91+ renderer.prependInputHandler(handler);
92+ return () => renderer.removeInputHandler(handler);
93+};
94+
95+export const onFrame = renderer => callback => subscribe(renderer, "frame", callback);
96+
97+export const onResize = renderer => callback => subscribe(renderer, "resize", callback);
98+
99+export const onRendererDestroy = renderer => callback => subscribe(renderer, "destroy", callback);
100+
101+export const onDestroyed = renderable => callback => subscribe(renderable, "destroyed", callback);
102+
103+export const rgba = red => green => blue => alpha => RGBA.fromInts(red, green, blue, alpha);
104+
105+export const drawText = buffer => text => x => y => foreground => background => () => {
106+ buffer.drawText(text, x, y, foreground, background, 0);
107+};
108+
109+export const pushScissor = buffer => rect => () => {
110+ buffer.pushScissorRect(rect.x, rect.y, rect.width, rect.height);
111+};
112+
113+export const popScissor = buffer => () => {
114+ buffer.popScissorRect();
115+};
116+
117+import { BoxRenderable, RGBA, resolveRenderLib } from "@opentui/core";
src/OpenTUI.pursnew file+119
@@ -0,0 +1,119 @@
1+module OpenTUI
2+ ( Renderer
3+ , Renderable
4+ , Buffer
5+ , Color
6+ , Metrics
7+ , Bounds
8+ , Capabilities
9+ , BoxOptions
10+ , createBox
11+ , metrics
12+ , bounds
13+ , capabilities
14+ , controlState
15+ , isDestroyed
16+ , focused
17+ , focus
18+ , blur
19+ , setHeight
20+ , requestRender
21+ , writeControl
22+ , prependInputHandler
23+ , onFrame
24+ , onResize
25+ , onRendererDestroy
26+ , onDestroyed
27+ , rgba
28+ , drawText
29+ , pushScissor
30+ , popScissor
31+ ) where
32+
33+import Prelude
34+
35+import Data.Nullable (Nullable)
36+import Effect (Effect)
37+
38+type Metrics =
39+ { columns :: Int
40+ , rows :: Int
41+ , width :: Int
42+ , height :: Int
43+ , resolution :: Nullable { width :: Number, height :: Number }
44+ }
45+
46+type Bounds =
47+ { x :: Int
48+ , y :: Int
49+ , width :: Int
50+ , height :: Int
51+ , visible :: Boolean
52+ , destroyed :: Boolean
53+ , focused :: Boolean
54+ }
55+
56+type Capabilities =
57+ { kittyGraphics :: Boolean
58+ , rgb :: Boolean
59+ , remote :: Boolean
60+ , multiplexer :: Boolean
61+ }
62+
63+type BoxOptions =
64+ { width :: String
65+ , height :: Int
66+ , flexShrink :: Int
67+ , backgroundColor :: String
68+ , focusable :: Boolean
69+ }
70+
71+foreign import data Renderer :: Type
72+
73+foreign import data Renderable :: Type
74+
75+foreign import data Buffer :: Type
76+
77+foreign import data Color :: Type
78+
79+foreign import createBox :: Renderer -> BoxOptions -> (Renderable -> Buffer -> Effect Unit) -> Effect Renderable
80+
81+foreign import metrics :: Renderer -> Effect Metrics
82+
83+foreign import bounds :: Renderable -> Effect Bounds
84+
85+foreign import capabilities :: Renderer -> Effect (Nullable Capabilities)
86+
87+foreign import controlState :: Renderer -> Effect String
88+
89+foreign import isDestroyed :: Renderer -> Effect Boolean
90+
91+foreign import focused :: Renderer -> Effect (Nullable Renderable)
92+
93+foreign import focus :: Renderable -> Effect Unit
94+
95+foreign import blur :: Renderable -> Effect Unit
96+
97+foreign import setHeight :: Renderable -> Int -> Effect Unit
98+
99+foreign import requestRender :: Renderer -> Effect Unit
100+
101+foreign import writeControl :: Renderer -> String -> Effect Unit
102+
103+foreign import prependInputHandler :: Renderer -> (String -> Effect Boolean) -> Effect (Effect Unit)
104+
105+foreign import onFrame :: Renderer -> Effect Unit -> Effect (Effect Unit)
106+
107+foreign import onResize :: Renderer -> Effect Unit -> Effect (Effect Unit)
108+
109+foreign import onRendererDestroy :: Renderer -> Effect Unit -> Effect (Effect Unit)
110+
111+foreign import onDestroyed :: Renderable -> Effect Unit -> Effect (Effect Unit)
112+
113+foreign import rgba :: Int -> Int -> Int -> Int -> Color
114+
115+foreign import drawText :: Buffer -> String -> Int -> Int -> Color -> Color -> Effect Unit
116+
117+foreign import pushScissor :: Buffer -> { x :: Int, y :: Int, width :: Int, height :: Int } -> Effect Unit
118+
119+foreign import popScissor :: Buffer -> Effect Unit
src/OpenTUI/Kitty.pursnew file+160
@@ -0,0 +1,160 @@
1+module OpenTUI.Kitty
2+ ( SharedImage
3+ , Reply
4+ , transmit
5+ , placement
6+ , deleteImage
7+ , placeholderRows
8+ , reply
9+ ) where
10+
11+import Prelude
12+
13+import Data.Array as Array
14+import Data.Int as Int
15+import Data.Maybe (Maybe(..))
16+import Data.String as String
17+import Data.String.CodePoints as CodePoints
18+
19+type SharedImage =
20+ { width :: Int
21+ , height :: Int
22+ , byteLength :: Int
23+ , encodedName :: String
24+ }
25+
26+type Reply =
27+ { imageId :: Int
28+ , placementId :: Maybe Int
29+ , message :: String
30+ }
31+
32+apcPrefix :: String
33+apcPrefix = "\x1b_G"
34+
35+apcSuffix :: String
36+apcSuffix = "\x1b\\"
37+
38+placeholderCharacter :: String
39+placeholderCharacter = "􎻮"
40+
41+maximumImageId :: Int
42+maximumImageId = 2147483647
43+
44+maximumGeometry :: Int
45+maximumGeometry = 297
46+
47+highByteDivisor :: Int
48+highByteDivisor = 16777216
49+
50+-- Source: kitty's normative rowcolumn-diacritics.txt table,
51+-- https://sw.kovidgoyal.net/kitty/_downloads/f0a0de9ec8d9ff4456206db8e0814937/rowcolumn-diacritics.txt
52+-- The table has 297 entries; it is converted once when this module initializes.
53+diacritics :: Array String
54+diacritics = map CodePoints.singleton (CodePoints.toCodePointArray "̅̍̎̐̒̽̾̿͆͊͋͌͐͑͒͗͛ͣͤͥͦͧͨͩͪͫͬͭͮͯ҃҄҅҆҇֒֓֔֕֗֘֙֜֝֞֟֠֡֨֩֫֬֯ׄؐؑؒؓؔؕؖؗٗ٘ٙٚٛٝٞۖۗۘۙۚۛۜ۟۠ۡۢۤۧۨ۫۬ܰܲܳܵܶܺܽܿ݀݁݃݅݇݉݊߫߬߭߮߯߰߱߳ࠖࠗ࠘࠙ࠛࠜࠝࠞࠟࠠࠡࠢࠣࠥࠦࠧࠩࠪࠫࠬ࠭॑॓॔ྂྃ྆྇፝፞፟៝᤺ᨗ᩵᩶᩷᩸᩹᩺᩻᩼᭫᭭᭮᭯᭰᭱᭲᭳᳐᳑᳒᳚᳛᳠᷀᷁᷃᷄᷅᷆᷇᷈᷉᷋᷌᷑᷒ᷓᷔᷕᷖᷗᷘᷙᷚᷛᷜᷝᷞᷟᷠᷡᷢᷣᷤᷥᷦ᷾⃐⃑⃔⃕⃖⃗⃛⃜⃡⃧⃩⃰⳯⳰⳱ⷠⷡⷢⷣⷤⷥⷦⷧⷨⷩⷪⷫⷬⷭⷮⷯⷰⷱⷲⷳⷴⷵⷶⷷⷸⷹⷺⷻⷼⷽⷾⷿ꙯꙼꙽꛰꛱꣠꣡꣢꣣꣤꣥꣦꣧꣨꣩꣪꣫꣬꣭꣮꣯꣰꣱ꪰꪲꪳꪷꪸꪾ꪿꫁︠︡︢︣︤︥︦𐨏𐨸𝆅𝆆𝆇𝆈𝆉𝆪𝆫𝆬𝆭𝉂𝉃𝉄")
55+
56+apc :: String -> String -> String
57+apc controlData payload = apcPrefix <> controlData <> ";" <> payload <> apcSuffix
58+
59+validImageId :: Int -> Boolean
60+validImageId imageId = imageId > 0 && imageId <= maximumImageId
61+
62+validSharedImage :: SharedImage -> Boolean
63+validSharedImage image =
64+ image.width > 0
65+ && image.height > 0
66+ && image.byteLength > 0
67+
68+cappedGeometry :: Int -> Int
69+cappedGeometry count = min maximumGeometry count
70+
71+transmit :: Int -> Int -> Int -> SharedImage -> String
72+transmit imageId columns rows image
73+ | validImageId imageId && columns > 0 && rows > 0 && validSharedImage image =
74+ apc
75+ ( "a=t,f=32,t=s,q=0,i=" <> show imageId
76+ <> ",s="
77+ <> show image.width
78+ <> ",v="
79+ <> show image.height
80+ <> ",S="
81+ <> show image.byteLength
82+ )
83+ image.encodedName
84+ <> apc
85+ ( "a=p,U=1,q=2,i=" <> show imageId
86+ <> ",p=1,c="
87+ <> show (cappedGeometry columns)
88+ <> ",r="
89+ <> show (cappedGeometry rows)
90+ )
91+ ""
92+ | otherwise = ""
93+
94+placement :: Int -> Int -> Int -> String
95+placement imageId columns rows
96+ | validImageId imageId && columns > 0 && rows > 0 =
97+ apc
98+ ( "a=p,U=1,q=0,i=" <> show imageId
99+ <> ",p=1,c="
100+ <> show (cappedGeometry columns)
101+ <> ",r="
102+ <> show (cappedGeometry rows)
103+ )
104+ ""
105+ | otherwise = ""
106+
107+deleteImage :: Int -> String
108+deleteImage imageId
109+ | validImageId imageId = apc ("a=d,d=I,i=" <> show imageId <> ",q=2") ""
110+ | otherwise = ""
111+
112+diacritic :: Int -> String
113+diacritic index = case Array.index diacritics index of
114+ Just mark -> mark
115+ Nothing -> ""
116+
117+placeholderCell :: Int -> Int -> Int -> String
118+placeholderCell row column highByte =
119+ placeholderCharacter
120+ <> diacritic row
121+ <> diacritic column
122+ <> diacritic highByte
123+
124+placeholderRows :: Int -> Int -> Int -> Array String
125+placeholderRows imageId columns rows
126+ | not (validImageId imageId) = []
127+ | columns <= 0 || rows <= 0 = []
128+ | otherwise =
129+ let
130+ columnCount = cappedGeometry columns
131+ rowCount = cappedGeometry rows
132+ highByte = imageId / highByteDivisor
133+ rowString row = Array.foldMap (\column -> placeholderCell row column highByte) (Array.range 0 (columnCount - 1))
134+ in
135+ map rowString (Array.range 0 (rowCount - 1))
136+
137+controlValue :: String -> String -> Maybe String
138+controlValue key =
139+ Array.findMap (String.stripPrefix (String.Pattern (key <> "=")))
140+ <<< String.split (String.Pattern ",")
141+
142+positiveInt :: String -> Maybe Int
143+positiveInt value = case Int.fromString value of
144+ Just number | number > 0 -> Just number
145+ _ -> Nothing
146+
147+reply :: String -> Maybe Reply
148+reply input = do
149+ withoutPrefix <- String.stripPrefix (String.Pattern apcPrefix) input
150+ body <- String.stripSuffix (String.Pattern apcSuffix) withoutPrefix
151+ if String.contains (String.Pattern apcPrefix) body || String.contains (String.Pattern apcSuffix) body then Nothing
152+ else do
153+ separator <- String.indexOf (String.Pattern ";") body
154+ let controlData = String.take separator body
155+ let message = String.drop (separator + 1) body
156+ imageId <- controlValue "i" controlData >>= positiveInt
157+ placementId <- case controlValue "p" controlData of
158+ Nothing -> Just Nothing
159+ Just value -> Just <$> Int.fromString value
160+ pure { imageId, placementId, message }