git.iko.soy/rowtype-yoga/purescript-yoga-react-native
on main help sign in
commit033362369925c2971763423bb33018940490bcb2 authorMark <mark.eibes@gmail.com> dateSun 15 Feb 2026, 09:28 (8 months ago) parentf37dacc
6 files changed+464−199
example-macos/spago.yaml+3 example-macos/src/Main.js+4 example-macos/src/Main.purs+277−199 spago.lock+3 src/Yoga/React/Native/Matrix.js+75 src/Yoga/React/Native/Matrix.purs+102
example-macos/spago.yaml+3
@@ -4,12 +4,15 @@ package:
44 - arrays
55 - console
66 - effect
7+ - either
78 - foldable-traversable
9+ - foreign
810 - maybe
911 - nullable
1012 - prelude
1113 - react-basic
1214 - react-basic-hooks
15+ - strings
1316 - tuples
1417 - yoga-react
1518 - yoga-react-native
example-macos/src/Main.js+4
@@ -19,3 +19,7 @@ export const getFieldJSON = (key) => (obj) => {
1919 if (v === undefined || v === null) return "";
2020 return JSON.stringify(v);
2121};
22+export const charCodes = (str) => Array.from(str).map((c) => c.charCodeAt(0));
23+export const abs = (n) => Math.abs(n);
24+export const setInterval = (ms) => (fn) => () => globalThis.setInterval(fn, ms);
25+export const clearInterval = (id) => () => globalThis.clearInterval(id);
example-macos/src/Main.purs+277−199
@@ -2,14 +2,19 @@ module Main where
22
33import Prelude
44
5−import Data.Array (snoc, mapWithIndex, length, filter, null)
5+import Data.Array (mapWithIndex, length, filter, null, (!!))
66import Data.Nullable (toNullable)
7−import Data.Maybe (Maybe(..))
8−import Data.String (contains, Pattern(..))
7+import Data.Maybe (Maybe(..), fromMaybe)
8+import Data.String (take)
9+import Data.Foldable (for_, foldl)
10+import Data.Traversable (for)
911import Effect (Effect)
12+import Data.Either (Either(..))
13+import Effect.Aff (launchAff_, try)
14+import Effect.Class (liftEffect)
1015import React.Basic (JSX)
1116import React.Basic.Events (EventHandler, handler, handler_, unsafeEventFn)
12−import React.Basic.Hooks (useState', (/\))
17+import React.Basic.Hooks (useState, useState', useEffect, useRef, readRef, writeRef, (/\))
1318import React.Basic.Hooks as React
1419import Yoga.React (component)
1520import Yoga.React.Native (nativeEvent, registerComponent, safeAreaView, text, tw, view)
@@ -36,6 +41,7 @@ import Yoga.React.Native.MacOS.FilePicker (nativeFilePicker)
3641import Yoga.React.Native.MacOS.VideoPlayer (nativeVideoPlayer)
3742import Yoga.React.Native.MacOS.AnimatedImage (nativeAnimatedImage)
3843import Yoga.React.Native.MacOS.PatternBackground (nativePatternBackground)
44+import Yoga.React.Native.Matrix as Matrix
3945import Yoga.React.Native.Style as Style
4046
4147main :: Effect Unit
@@ -594,7 +600,7 @@ systemTab = component "SystemTab" \p -> React.do
594600 ]
595601 )
596602
597−-- Tab 5: Chat (Telegram-style)
603+-- Tab 5: Chat (Matrix)
598604type ChatProps =
599605 { fg :: String
600606 , dimFg :: String
@@ -607,112 +613,242 @@ type Message =
607613 { sender :: String
608614 , body :: String
609615 , kind :: String -- "text" | "sticker" | "gif" | "video"
616+ , eventId :: String
610617 }
611618
612−type Contact =
613− { name :: String
614− , initials :: String
615− , color :: String
616− , preview :: String
619+type Session =
620+ { homeserver :: String
621+ , accessToken :: String
622+ , userId :: String
617623 }
618624
619−contacts :: Array Contact
620−contacts =
621− [ { name: "Alice", initials: "A", color: "#5856D6", preview: "Check out this sticker!" }
622− , { name: "Bob", initials: "B", color: "#FF9500", preview: "Hey, how's the app going?" }
623− , { name: "Carol", initials: "C", color: "#34C759", preview: "Love the new UI" }
624− ]
625−
626−initialMessages :: String -> Array Message
627−initialMessages name = case name of
628− "Alice" ->
629− [ { sender: "Alice", body: "Hey! Have you seen the new Rive stickers?", kind: "text" }
630− , { sender: "You", body: "Not yet, show me!", kind: "text" }
631− , { sender: "Alice", body: "cat_following_mouse", kind: "sticker" }
632− , { sender: "You", body: "That's amazing! The cat follows your mouse!", kind: "text" }
633− , { sender: "You", body: "😍", kind: "text" }
634− , { sender: "Alice", body: "Right? Check out this one too", kind: "text" }
635− , { sender: "Alice", body: "rating_animation", kind: "sticker" }
636− , { sender: "Alice", body: "Look at this cute cat!", kind: "text" }
637− , { sender: "Alice", body: "https://media.giphy.com/media/JIX9t2j0ZTN9S/giphy.gif", kind: "gif" }
638− ]
639− "Bob" ->
640− [ { sender: "Bob", body: "Hey, how's the app going?", kind: "text" }
641− , { sender: "You", body: "Great! Just added native macOS controls", kind: "text" }
642− , { sender: "Bob", body: "Nice! Toolbar, sidebar, the works?", kind: "text" }
643− , { sender: "You", body: "Yep, plus visual effects and context menus", kind: "text" }
644− , { sender: "Bob", body: "🔥", kind: "text" }
645− , { sender: "Bob", body: "switch_event_example", kind: "sticker" }
646− , { sender: "Bob", body: "Check out this video", kind: "text" }
647− , { sender: "Bob", body: "https://commondatastorage.googleapis.com/gtv-videos-bucket/sample/BigBuckBunny.mp4", kind: "video" }
648− ]
649− "Carol" ->
650− [ { sender: "Carol", body: "Love the new UI", kind: "text" }
651− , { sender: "You", body: "Thanks! It's all PureScript + native macOS views", kind: "text" }
652− , { sender: "Carol", body: "The frosted glass sidebar is chef's kiss", kind: "text" }
653− , { sender: "Carol", body: "windy_tree", kind: "sticker" }
654− , { sender: "You", body: "https://media.giphy.com/media/13CoXDiaCcCoyk/giphy.gif", kind: "gif" }
655− , { sender: "Carol", body: "Haha love it!", kind: "text" }
656− ]
657− _ -> []
625+type Room =
626+ { roomId :: String
627+ , name :: String
628+ , lastMessage :: String
629+ }
630+
631+avatarColors :: Array String
632+avatarColors = [ "#5856D6", "#FF9500", "#34C759", "#FF2D55", "#5AC8FA", "#FF6B6B", "#4ECDC4", "#45B7D1" ]
633+
634+avatarColor :: String -> String
635+avatarColor roomId = fromMaybe "#5856D6" (avatarColors !! (mod (hashCode roomId) (length avatarColors)))
636+ where
637+ hashCode s = abs (foldl (\acc c -> acc * 31 + c) 0 (charCodes s))
638+
639+foreign import charCodes :: String -> Array Int
640+foreign import abs :: Int -> Int
658641
659642chatTab :: ChatProps -> JSX
660643chatTab = component "ChatTab" \p -> React.do
661− activeContact /\ setActiveContact <- useState' "Alice"
662− messages /\ setMessages <- useState' (initialMessages "Alice")
644+ session /\ setSession <- useState' (Nothing :: Maybe Session)
645+ rooms /\ setRooms <- useState' ([] :: Array Room)
646+ activeRoom /\ setActiveRoom <- useState' (Nothing :: Maybe String)
647+ messages /\ setMessages <- useState ([] :: Array Message)
663648 inputText /\ setInputText <- useState' ""
649+ loginError /\ setLoginError <- useState' ""
650+ loginServer /\ setLoginServer <- useState' "https://matrix.org"
651+ loginUser /\ setLoginUser <- useState' ""
652+ loginPass /\ setLoginPass <- useState' ""
653+ syncTokenRef <- useRef ""
654+ activeRoomRef <- useRef (Nothing :: Maybe String)
655+ sessionRef <- useRef (Nothing :: Maybe Session)
656+ seenIdsRef <- useRef ([] :: Array String)
657+
658+ -- Sync polling effect
659+ useEffect session do
660+ case session of
661+ Nothing -> pure mempty
662+ Just sess -> do
663+ writeRef sessionRef (Just sess)
664+ let
665+ doSync = launchAff_ do
666+ token <- readRef syncTokenRef # liftEffect
667+ result <- try (Matrix.sync sess.homeserver sess.accessToken token 5000)
668+ case result of
669+ Left _ -> pure unit
670+ Right resp -> liftEffect do
671+ let nextBatch = Matrix.getSyncNextBatch resp
672+ writeRef syncTokenRef nextBatch
673+ let roomIds = Matrix.getSyncJoinedRoomIds resp
674+ currentRoom <- readRef activeRoomRef
675+ for_ roomIds \rid -> do
676+ let events = Matrix.getSyncTimelineEvents resp rid
677+ let msgEvents = filter (\ev -> Matrix.getEventType ev == "m.room.message") events
678+ case currentRoom of
679+ Just cr | cr == rid -> do
680+ seen <- readRef seenIdsRef
681+ let newMsgs = filter (\ev -> not (Matrix.getEventId ev `elem` seen)) msgEvents
682+ let
683+ converted = newMsgs <#> \ev ->
684+ { sender: Matrix.getEventSender ev
685+ , body: Matrix.getEventBody ev
686+ , kind: eventKind ev
687+ , eventId: Matrix.getEventId ev
688+ }
689+ if null converted then pure unit
690+ else do
691+ let newIds = converted <#> _.eventId
692+ writeRef seenIdsRef (seen <> newIds)
693+ setMessages \msgs -> msgs <> converted
694+ _ -> pure unit
695+ timerId <- setInterval 3000 doSync
696+ doSync
697+ pure (clearInterval timerId)
698+
664699 let
665− sendMessage msg = do
700+ doLogin = launchAff_ do
701+ result <- try (Matrix.login loginServer loginUser loginPass)
702+ case result of
703+ Left _ -> liftEffect (setLoginError "Login failed. Check credentials.")
704+ Right resp -> do
705+ let sess = { homeserver: loginServer, accessToken: resp.access_token, userId: resp.user_id }
706+ roomIds <- try (Matrix.joinedRooms loginServer resp.access_token)
707+ case roomIds of
708+ Left _ -> liftEffect do
709+ setSession (Just sess)
710+ setLoginError ""
711+ Right rids -> do
712+ names <- for rids \rid -> do
713+ n <- try (Matrix.roomName loginServer resp.access_token rid)
714+ let
715+ name = case n of
716+ Left _ -> rid
717+ Right "" -> rid
718+ Right nm -> nm
719+ pure { roomId: rid, name, lastMessage: "" }
720+ liftEffect do
721+ setSession (Just sess)
722+ setRooms names
723+ setLoginError ""
724+
725+ selectRoom sess rid = do
726+ setActiveRoom (Just rid)
727+ writeRef activeRoomRef (Just rid)
728+ setMessages (const [])
729+ writeRef seenIdsRef []
730+ launchAff_ do
731+ result <- try (Matrix.sync sess.homeserver sess.accessToken "" 0)
732+ case result of
733+ Left _ -> pure unit
734+ Right resp -> liftEffect do
735+ let events = Matrix.getSyncTimelineEvents resp rid
736+ let msgEvents = filter (\ev -> Matrix.getEventType ev == "m.room.message") events
737+ let
738+ converted = msgEvents <#> \ev ->
739+ { sender: Matrix.getEventSender ev
740+ , body: Matrix.getEventBody ev
741+ , kind: eventKind ev
742+ , eventId: Matrix.getEventId ev
743+ }
744+ let ids = converted <#> _.eventId
745+ writeRef seenIdsRef ids
746+ setMessages (const converted)
747+
748+ sendMessage sess rid msg = do
666749 if msg == "" then pure unit
667750 else do
668− setMessages (snoc messages { sender: "You", body: msg, kind: "text" })
669751 setInputText ""
670− switchContact name = do
671− setActiveContact name
672− setMessages (initialMessages name)
673− setInputText ""
674− sendSticker stickerName = do
675− setMessages (snoc messages { sender: "You", body: stickerName, kind: "sticker" })
676− setInputText ""
677− allStickers = [ "cat_following_mouse", "rating_animation", "switch_event_example", "windy_tree" ]
678− query = colonQuery inputText
679− matchingStickers = if query == "" then [] else filter (contains (Pattern query)) allStickers
752+ launchAff_ do
753+ txnId <- Matrix.genTxnId # liftEffect
754+ _ <- try (Matrix.sendMessage sess.homeserver sess.accessToken rid txnId msg)
755+ pure unit
756+
680757 sentBubbleBg = if p.isDark then "#65B86A" else "#5CB85C"
681758 receivedBubbleBg = if p.isDark then "#3B3B3D" else "#FFFFFF"
682759 chatBg = if p.isDark then "#17212B" else "#E8DFD3"
683− sidebar = view { style: tw "pt-2" }
684− ( contacts <#> \c ->
760+
761+ loginForm = view
762+ { style: tw "flex-1 items-center justify-center"
763+ <> Style.style { backgroundColor: chatBg }
764+ }
765+ [ view { style: tw "rounded-xl p-6" <> Style.style { backgroundColor: p.cardBg, width: 340.0 } }
766+ [ text { style: tw "text-lg font-bold mb-4 text-center" <> Style.style { color: p.fg } } "Matrix Login"
767+ , text { style: tw "text-xs mb-1" <> Style.style { color: p.dimFg } } "Homeserver"
768+ , nativeTextField
769+ { text: loginServer
770+ , placeholder: "https://matrix.org"
771+ , search: false
772+ , rounded: true
773+ , onChangeText: extractString "text" setLoginServer
774+ , onSubmit: handler_ (pure unit)
775+ , style: tw "mb-3" <> Style.style { height: 28.0 }
776+ }
777+ , text { style: tw "text-xs mb-1" <> Style.style { color: p.dimFg } } "Username"
778+ , nativeTextField
779+ { text: loginUser
780+ , placeholder: "username"
781+ , search: false
782+ , rounded: true
783+ , onChangeText: extractString "text" setLoginUser
784+ , onSubmit: handler_ (pure unit)
785+ , style: tw "mb-3" <> Style.style { height: 28.0 }
786+ }
787+ , text { style: tw "text-xs mb-1" <> Style.style { color: p.dimFg } } "Password"
788+ , nativeTextField
789+ { text: loginPass
790+ , placeholder: "password"
791+ , search: false
792+ , rounded: true
793+ , onChangeText: extractString "text" setLoginPass
794+ , onSubmit: handler_ doLogin
795+ , style: tw "mb-4" <> Style.style { height: 28.0 }
796+ }
797+ , if loginError /= "" then
798+ text { style: tw "text-xs mb-2 text-center" <> Style.style { color: "#FF3B30" } } loginError
799+ else text { style: Style.style { height: 0.0 } } ""
800+ , nativeButton
801+ { title: "Sign In"
802+ , bezelStyle: "rounded"
803+ , sfSymbol: "arrow.right.circle.fill"
804+ , onPress: handler_ doLogin
805+ , style: Style.style { height: 32.0 }
806+ }
807+ ]
808+ ]
809+
810+ roomSidebar sess = view { style: tw "pt-2" }
811+ ( rooms <#> \r ->
685812 view
686813 { style: tw "flex-row items-center px-3 py-2 mx-2 rounded-lg"
687814 <> Style.style
688− { backgroundColor: if activeContact == c.name then (if p.isDark then "#2B5278" else "#419FD9") else "transparent" }
815+ { backgroundColor: if activeRoom == Just r.roomId then (if p.isDark then "#2B5278" else "#419FD9") else "transparent" }
689816 }
690817 [ view
691818 { style: tw "rounded-full items-center justify-center"
692− <> Style.style { width: 32.0, height: 32.0, backgroundColor: c.color }
819+ <> Style.style { width: 32.0, height: 32.0, backgroundColor: avatarColor r.roomId }
693820 }
694− [ text { style: tw "text-xs font-bold" <> Style.style { color: "#FFFFFF" } } c.initials ]
821+ [ text { style: tw "text-xs font-bold" <> Style.style { color: "#FFFFFF" } } (take 1 r.name) ]
695822 , view { style: tw "ml-2 flex-1" }
696− [ text { style: tw "text-sm font-semibold" <> Style.style { color: if activeContact == c.name then "#FFFFFF" else p.fg } } c.name
823+ [ text
824+ { style: tw "text-sm font-semibold"
825+ <> Style.style { color: if activeRoom == Just r.roomId then "#FFFFFF" else p.fg }
826+ }
827+ r.name
697828 , text
698829 { style: tw "text-xs"
699− <> Style.style { color: if activeContact == c.name then "#FFFFFFCC" else p.dimFg }
830+ <> Style.style { color: if activeRoom == Just r.roomId then "#FFFFFFCC" else p.dimFg }
700831 }
701− c.preview
832+ r.lastMessage
702833 ]
703834 , nativeButton
704835 { title: ""
705836 , bezelStyle: "toolbar"
706837 , sfSymbol: ""
707− , onPress: handler_ (switchContact c.name)
838+ , onPress: handler_ (selectRoom sess r.roomId)
708839 , style: Style.style { position: "absolute", top: 0.0, left: 0.0, right: 0.0, bottom: 0.0, opacity: 0.0 }
709840 }
710841 ]
711842 )
712− messageBubble _ msg = do
713− let isMine = msg.sender == "You"
843+
844+ messageBubble sess _ msg = do
845+ let
846+ isMine = case sess of
847+ Just s -> msg.sender == s.userId
848+ Nothing -> false
714849 let align = if isMine then "flex-end" else "flex-start"
715850 let bigEmoji = msg.kind == "text" && isSingleEmoji msg.body
851+ let senderLabel = if isMine then "" else msg.sender
716852 nativeContextMenu
717853 { items:
718854 [ { id: "copy", title: "Copy", sfSymbol: "doc.on.doc" }
@@ -723,117 +859,41 @@ chatTab = component "ChatTab" \p -> React.do
723859 , onSelectItem: handler_ (pure unit)
724860 , style: tw "px-3 mb-1"
725861 }
726− ( if msg.kind == "sticker" then
727− view
728− { style: tw "rounded-2xl overflow-hidden"
729− <> Style.style { alignSelf: align, width: 120.0, height: 120.0 }
730− }
731− [ nativeRiveView_
732− { resourceName: msg.body
733− , fit: "contain"
734− , autoplay: true
735− , style: Style.style { width: 120.0, height: 120.0 }
736− }
737− ]
738− else if msg.kind == "gif" then
739− view
740− { style: Style.style { alignSelf: align } }
741− [ nativeAnimatedImage
742− { source: msg.body
743− , animating: true
744− , cornerRadius: 16.0
745− , style: Style.style { width: 240.0, height: 180.0 }
746− }
747− ]
748− else if msg.kind == "video" then
749− view
750− { style: Style.style { alignSelf: align } }
751− [ nativeVideoPlayer
752− { source: msg.body
753− , playing: false
754− , looping: true
755− , muted: false
756− , cornerRadius: 16.0
757− , style: Style.style { width: 280.0, height: 180.0 }
758− }
759− ]
760− else if bigEmoji then
761− text
762− { style: Style.style { alignSelf: align, fontSize: 64.0, lineHeight: 72.0 } }
763− msg.body
764− else
765− view
766− { style: tw "rounded-2xl px-3 py-2"
767− <> Style.style
768− { alignSelf: align
769− , backgroundColor: if isMine then sentBubbleBg else receivedBubbleBg
770− , maxWidth: 320.0
771− }
772− }
773− [ text
774− { style: tw "text-sm"
775− <> Style.style { color: if isMine then "#FFFFFF" else (if p.isDark then "#FFFFFF" else "#000000") }
776− }
862+ ( view { style: Style.style { alignSelf: align, maxWidth: 320.0 } }
863+ [ if senderLabel == "" then text { style: Style.style { height: 0.0 } } ""
864+ else text { style: tw "text-xs mb-0.5" <> Style.style { color: p.dimFg } } senderLabel
865+ , if bigEmoji then
866+ text
867+ { style: Style.style { fontSize: 64.0, lineHeight: 72.0 } }
777868 msg.body
778− ]
779− )
780− stickerBar = view { style: tw "flex-row px-3 py-1" <> Style.style { backgroundColor: "transparent" } }
781− [ stickerButton "cat_following_mouse"
782− , stickerButton "rating_animation"
783− , stickerButton "switch_event_example"
784− , stickerButton "windy_tree"
785− ]
786− stickerButton name = view
787− { style: tw "mr-2 rounded-lg overflow-hidden" <> Style.style { backgroundColor: p.cardBg } }
788− [ nativeRiveView_
789− { resourceName: name
790− , fit: "contain"
791− , autoplay: true
792− , style: Style.style { width: 40.0, height: 40.0 }
793− }
794− , nativeButton
795− { title: ""
796− , bezelStyle: "toolbar"
797− , sfSymbol: ""
798− , onPress: handler_ (sendSticker name)
799− , style: Style.style { position: "absolute", top: 0.0, left: 0.0, right: 0.0, bottom: 0.0, opacity: 0.0 }
800− }
801− ]
802− stickerPicker stickers = view
803− { style: tw "flex-row px-3 py-2"
804− <> Style.style { backgroundColor: p.cardBg, borderTopWidth: 0.5, borderColor: p.dimFg }
805− }
806− ( stickers <#> \name ->
807− view
808− { style: tw "mr-2 rounded-lg overflow-hidden items-center"
809− <> Style.style { backgroundColor: if p.isDark then "#3A3A3A" else "#E0E0E0" }
810− }
811− [ nativeRiveView_
812− { resourceName: name
813− , fit: "contain"
814− , autoplay: true
815− , style: Style.style { width: 56.0, height: 56.0 }
816− }
817− , text { style: tw "text-xs pb-1" <> Style.style { color: p.dimFg } } (":" <> name)
818− , nativeButton
819− { title: ""
820− , bezelStyle: "toolbar"
821− , sfSymbol: ""
822− , onPress: handler_ (sendSticker name)
823− , style: Style.style { position: "absolute", top: 0.0, left: 0.0, right: 0.0, bottom: 0.0, opacity: 0.0 }
824− }
869+ else
870+ view
871+ { style: tw "rounded-2xl px-3 py-2"
872+ <> Style.style
873+ { backgroundColor: if isMine then sentBubbleBg else receivedBubbleBg }
874+ }
875+ [ text
876+ { style: tw "text-sm"
877+ <> Style.style { color: if isMine then "#FFFFFF" else (if p.isDark then "#FFFFFF" else "#000000") }
878+ }
879+ msg.body
880+ ]
825881 ]
826− )
827− pure do
828− sidebarLayout
829− { sidebar
830− , sidebarWidth: 200.0
882+ )
883+
884+ activeRoomName = case activeRoom of
885+ Nothing -> "Select a room"
886+ Just rid -> fromMaybe rid (map _.name (filter (\r -> r.roomId == rid) rooms !! 0))
887+
888+ chatView sess = sidebarLayout
889+ { sidebar: roomSidebar sess
890+ , sidebarWidth: 220.0
831891 , content: view { style: tw "flex-1" <> Style.style { backgroundColor: "transparent" } }
832892 [ view
833893 { style: tw "px-4 py-2 border-b"
834894 <> Style.style { borderBottomWidth: 0.5, borderColor: p.dimFg, backgroundColor: "transparent" }
835895 }
836− [ text { style: tw "text-base font-semibold" <> Style.style { color: p.fg } } activeContact ]
896+ [ text { style: tw "text-base font-semibold" <> Style.style { color: p.fg } } activeRoomName ]
837897 , nativePatternBackground
838898 { patternColor: if p.isDark then "#FFFFFF" else "#000000"
839899 , backgroundColor2: chatBg
@@ -843,35 +903,54 @@ chatTab = component "ChatTab" \p -> React.do
843903 }
844904 ( nativeScrollView { scrollToBottom: length messages, style: tw "flex-1" <> Style.style { backgroundColor: "transparent" } }
845905 ( view { style: tw "py-2 pr-3" }
846− (mapWithIndex messageBubble messages)
906+ (mapWithIndex (messageBubble session) messages)
847907 )
848908 )
849− , if null matchingStickers then stickerBar
850− else stickerPicker matchingStickers
851909 , view
852910 { style: tw "flex-row items-center px-3 py-2"
853911 <> Style.style { borderTopWidth: 0.5, borderColor: p.dimFg, backgroundColor: "transparent" }
854912 }
855− [ nativeTextField
856− { text: inputText
857− , placeholder: "Message..."
858− , search: false
859− , rounded: true
860− , onChangeText: extractString "text" setInputText
861− , onSubmit: extractString "text" \t -> sendMessage t
862− , style: tw "flex-1" <> Style.style { height: 28.0 }
863− }
864− , nativeButton
865− { title: ""
866− , sfSymbol: "paperplane.fill"
867− , bezelStyle: "toolbar"
868− , onPress: handler_ (sendMessage inputText)
869− , style: Style.style { height: 28.0, width: 36.0, marginLeft: 8.0 }
870− }
871− ]
913+ ( case activeRoom of
914+ Nothing ->
915+ [ text { style: tw "text-sm" <> Style.style { color: p.dimFg } } "Select a room to start chatting" ]
916+ Just rid ->
917+ [ nativeTextField
918+ { text: inputText
919+ , placeholder: "Message..."
920+ , search: false
921+ , rounded: true
922+ , onChangeText: extractString "text" setInputText
923+ , onSubmit: extractString "text" \t -> sendMessage sess rid t
924+ , style: tw "flex-1" <> Style.style { height: 28.0 }
925+ }
926+ , nativeButton
927+ { title: ""
928+ , sfSymbol: "paperplane.fill"
929+ , bezelStyle: "toolbar"
930+ , onPress: handler_ (sendMessage sess rid inputText)
931+ , style: Style.style { height: 28.0, width: 36.0, marginLeft: 8.0 }
932+ }
933+ ]
934+ )
872935 ]
873936 }
874937
938+ pure do
939+ case session of
940+ Nothing -> loginForm
941+ Just sess -> chatView sess
942+
943+eventKind :: Matrix.MatrixEvent -> String
944+eventKind ev = case Matrix.getEventMsgType ev of
945+ "m.image" -> "gif"
946+ _ -> "text"
947+
948+elem :: forall a. Eq a => a -> Array a -> Boolean
949+elem x xs = not (null (filter (_ == x) xs))
950+
951+foreign import setInterval :: Int -> Effect Unit -> Effect Int
952+foreign import clearInterval :: Int -> Effect Unit
953+
875954-- UI helpers
876955sectionTitle :: String -> String -> JSX
877956sectionTitle color title =
@@ -892,4 +971,3 @@ round n = unsafeRound n
892971foreign import unsafeRound :: Number -> Int
893972foreign import getFieldJSON :: String -> forall r. r -> String
894973foreign import isSingleEmoji :: String -> Boolean
895−foreign import colonQuery :: String -> String
spago.lock+3
@@ -30,12 +30,15 @@
3030 "arrays",
3131 "console",
3232 "effect",
33+ "either",
3334 "foldable-traversable",
35+ "foreign",
3436 "maybe",
3537 "nullable",
3638 "prelude",
3739 "react-basic",
3840 "react-basic-hooks",
41+ "strings",
3942 "tuples",
4043 "yoga-react",
4144 "yoga-react-native"
src/Yoga/React/Native/Matrix.jsnew file+75
@@ -0,0 +1,75 @@
1+const mkAff = (promise) => (onError, onSuccess) => {
2+ promise.then(onSuccess, onError);
3+ return (cancelError, onCancelerError, onCancelerSuccess) => onCancelerSuccess();
4+};
5+
6+const jsonPost = (url, body, token) =>
7+ fetch(url, {
8+ method: "POST",
9+ headers: { "Content-Type": "application/json", ...(token ? { Authorization: "Bearer " + token } : {}) },
10+ body: JSON.stringify(body),
11+ }).then((r) => r.json());
12+
13+const jsonPut = (url, body, token) =>
14+ fetch(url, {
15+ method: "PUT",
16+ headers: { "Content-Type": "application/json", Authorization: "Bearer " + token },
17+ body: JSON.stringify(body),
18+ }).then((r) => r.json());
19+
20+const jsonGet = (url, token) =>
21+ fetch(url, {
22+ method: "GET",
23+ headers: { Authorization: "Bearer " + token },
24+ }).then((r) => r.json());
25+
26+export const loginImpl = (homeserver) => (user) => (password) =>
27+ mkAff(jsonPost(homeserver + "/_matrix/client/v3/login", { type: "m.login.password", identifier: { type: "m.id.user", user }, password }));
28+
29+export const syncImpl = (homeserver) => (accessToken) => (since) => (timeout) =>
30+ mkAff(jsonGet(homeserver + "/_matrix/client/v3/sync?timeout=" + timeout + (since ? "&since=" + since : ""), accessToken));
31+
32+export const sendMessageImpl = (homeserver) => (accessToken) => (roomId) => (txnId) => (body) =>
33+ mkAff(jsonPut(homeserver + "/_matrix/client/v3/rooms/" + encodeURIComponent(roomId) + "/send/m.room.message/" + encodeURIComponent(txnId), { msgtype: "m.text", body }, accessToken));
34+
35+export const joinedRoomsImpl = (homeserver) => (accessToken) =>
36+ mkAff(jsonGet(homeserver + "/_matrix/client/v3/joined_rooms", accessToken));
37+
38+export const roomNameImpl = (homeserver) => (accessToken) => (roomId) =>
39+ mkAff(jsonGet(homeserver + "/_matrix/client/v3/rooms/" + encodeURIComponent(roomId) + "/state/m.room.name", accessToken).then((r) => r.name || "").catch(() => ""));
40+
41+export const roomMembersImpl = (homeserver) => (accessToken) => (roomId) =>
42+ mkAff(jsonGet(homeserver + "/_matrix/client/v3/rooms/" + encodeURIComponent(roomId) + "/joined_members", accessToken).then((r) => Object.entries(r.joined || {}).map(([uid, info]) => ({ user_id: uid, displayname: info.display_name || uid }))));
43+
44+export const genTxnId = () => "m" + Date.now() + "." + Math.random().toString(36).slice(2);
45+
46+export const getJoinedRoomIds = (resp) => resp.joined_rooms || [];
47+
48+export const getSyncNextBatch = (resp) => resp.next_batch || "";
49+
50+export const getSyncJoinedRoomIds = (resp) => {
51+ const join = resp.rooms && resp.rooms.join;
52+ return join ? Object.keys(join) : [];
53+};
54+
55+export const getSyncTimelineEvents = (resp) => (roomId) => {
56+ const join = resp.rooms && resp.rooms.join;
57+ const room = join && join[roomId];
58+ const timeline = room && room.timeline;
59+ return timeline && timeline.events ? timeline.events : [];
60+};
61+
62+export const getEventType = (ev) => ev.type || "";
63+export const getEventSender = (ev) => ev.sender || "";
64+export const getEventBody = (ev) => (ev.content && ev.content.body) || "";
65+export const getEventMsgType = (ev) => (ev.content && ev.content.msgtype) || "";
66+export const getEventId = (ev) => ev.event_id || "";
67+export const getEventTs = (ev) => ev.origin_server_ts || 0;
68+export const getEventImageUrl = (ev) => (ev.content && ev.content.url) || "";
69+
70+export const parseJsonImpl = (str) => {
71+ try { return JSON.parse(str); }
72+ catch (_) { return null; }
73+};
74+
75+export const stringifyJson = (obj) => JSON.stringify(obj);
src/Yoga/React/Native/Matrix.pursnew file+102
@@ -0,0 +1,102 @@
1+module Yoga.React.Native.Matrix
2+ ( LoginResponse
3+ , RoomInfo
4+ , MatrixEvent
5+ , login
6+ , sync
7+ , sendMessage
8+ , joinedRooms
9+ , roomName
10+ , roomMembers
11+ , genTxnId
12+ , getSyncNextBatch
13+ , getSyncJoinedRoomIds
14+ , getSyncTimelineEvents
15+ , getEventType
16+ , getEventSender
17+ , getEventBody
18+ , getEventMsgType
19+ , getEventId
20+ , getEventTs
21+ , getEventImageUrl
22+ , parseJson
23+ , stringifyJson
24+ ) where
25+
26+import Prelude
27+
28+import Data.Nullable (Nullable, toMaybe)
29+import Data.Maybe (Maybe)
30+import Effect (Effect)
31+import Effect.Aff (Aff)
32+import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
33+import Foreign (Foreign)
34+
35+type LoginResponse =
36+ { user_id :: String
37+ , access_token :: String
38+ , device_id :: String
39+ }
40+
41+type RoomInfo =
42+ { user_id :: String
43+ , displayname :: String
44+ }
45+
46+type MatrixEvent = Foreign
47+
48+foreign import loginImpl :: String -> String -> String -> EffectFnAff LoginResponse
49+
50+login :: String -> String -> String -> Aff LoginResponse
51+login homeserver user password = fromEffectFnAff (loginImpl homeserver user password)
52+
53+foreign import syncImpl :: String -> String -> String -> Int -> EffectFnAff Foreign
54+
55+sync :: String -> String -> String -> Int -> Aff Foreign
56+sync homeserver accessToken since timeout = fromEffectFnAff (syncImpl homeserver accessToken since timeout)
57+
58+foreign import sendMessageImpl :: String -> String -> String -> String -> String -> EffectFnAff { event_id :: String }
59+
60+sendMessage :: String -> String -> String -> String -> String -> Aff { event_id :: String }
61+sendMessage homeserver accessToken roomId txnId body = fromEffectFnAff (sendMessageImpl homeserver accessToken roomId txnId body)
62+
63+foreign import joinedRoomsImpl :: String -> String -> EffectFnAff Foreign
64+
65+joinedRooms :: String -> String -> Aff (Array String)
66+joinedRooms homeserver accessToken = do
67+ resp <- fromEffectFnAff (joinedRoomsImpl homeserver accessToken)
68+ pure (getJoinedRoomIds resp)
69+
70+foreign import roomNameImpl :: String -> String -> String -> EffectFnAff String
71+
72+roomName :: String -> String -> String -> Aff String
73+roomName homeserver accessToken roomId = fromEffectFnAff (roomNameImpl homeserver accessToken roomId)
74+
75+foreign import roomMembersImpl :: String -> String -> String -> EffectFnAff (Array RoomInfo)
76+
77+roomMembers :: String -> String -> String -> Aff (Array RoomInfo)
78+roomMembers homeserver accessToken roomId = fromEffectFnAff (roomMembersImpl homeserver accessToken roomId)
79+
80+foreign import genTxnId :: Effect String
81+
82+-- Sync response accessors
83+foreign import getJoinedRoomIds :: Foreign -> Array String
84+foreign import getSyncNextBatch :: Foreign -> String
85+foreign import getSyncJoinedRoomIds :: Foreign -> Array String
86+foreign import getSyncTimelineEvents :: Foreign -> String -> Array MatrixEvent
87+
88+-- Event accessors
89+foreign import getEventType :: MatrixEvent -> String
90+foreign import getEventSender :: MatrixEvent -> String
91+foreign import getEventBody :: MatrixEvent -> String
92+foreign import getEventMsgType :: MatrixEvent -> String
93+foreign import getEventId :: MatrixEvent -> String
94+foreign import getEventTs :: MatrixEvent -> Number
95+foreign import getEventImageUrl :: MatrixEvent -> String
96+
97+-- JSON helpers for session persistence
98+foreign import parseJsonImpl :: String -> Nullable Foreign
99+foreign import stringifyJson :: Foreign -> String
100+
101+parseJson :: String -> Maybe Foreign
102+parseJson = toMaybe <<< parseJsonImpl