Async, HasIO, and get aoc examples working in web

This commit is contained in:
2024-11-26 20:05:25 -08:00
parent e2db5a77df
commit a8363c7a45
8 changed files with 103 additions and 43 deletions

View File

@@ -1,7 +1,12 @@
-- Doesn't run in playground because it's using the node `fs` module
module Day1 module Day1
/-
I ported a couple of Advent of Code 2023 solutions from Lean4
as an early test case. Here I've adapted them to the web playground
by replacing `readFile` with an async `fetchText`.
-/
import Prelude
import Web
digits1 : List Char -> List Int digits1 : List Char -> List Int
digits1 Nil = Nil digits1 Nil = Nil
@@ -51,21 +56,20 @@ part1 text digits =
#check digits1 unpack : String -> List Int #check digits1 unpack : String -> List Int
-- readFile not in browser / playground runFile : String -> Async Unit
runFile fn = do
text <- fetchText fn
putStrLn fn
putStrLn "part1"
putStrLn $ show (part1 text (digits1 unpack))
putStrLn "part2"
putStrLn $ show (part1 text (digits2 unpack))
putStrLn ""
-- runFile : String -> IO Unit -- Argument is a hack to keep it from running at startup. Need to add IO
-- runFile fn = do main : IO Unit
-- text <- readFile fn main = runAsync (do
-- putStrLn fn runFile "aoc2023/day1/eg.txt"
-- putStrLn "part1" runFile "aoc2023/day1/eg2.txt"
-- putStrLn $ show (part1 text (digits1 ∘ unpack)) -- runFile "aoc2023/day1/input.txt"
-- putStrLn "part2" )
-- putStrLn $ show (part1 text (digits2 ∘ unpack))
-- putStrLn ""
-- -- Argument is a hack to keep it from running at startup. Need to add IO
-- main : IO Unit
-- main = do
-- runFile "aoc2023/day1/eg.txt"
-- runFile "aoc2023/day1/eg2.txt"
-- runFile "aoc2023/day1/input.txt"

View File

@@ -1,6 +1,12 @@
module Day2 module Day2
import Prelude /-
I ported a couple of Advent of Code 2023 solutions from Lean4
as an early test case. Here I've adapted them to the web playground
by replacing `readFile` with an async `fetchText`.
-/
import Web
Draw : U Draw : U
Draw = Int × Int × Int Draw = Int × Int × Int
@@ -84,18 +90,19 @@ part2 (MkGame n parts :: rest) =
-- readFile not in browser / playground -- readFile not in browser / playground
-- run : String -> IO Unit run : String -> Async Unit
-- run fn = do run fn = do
-- text <- readFile fn text <- fetchText fn
-- case mapM parseGame (split (trim text) "\n") of case mapM parseGame (split (trim text) "\n") of
-- Left err => putStrLn $ "fail " ++ err Left err => putStrLn $ "fail " ++ err
-- Right games => do Right games => do
-- putStrLn "part1" putStrLn "part1"
-- printLn (part1 games) printLn (part1 games)
-- putStrLn "part2" putStrLn "part2"
-- printLn (part2 games) printLn (part2 games)
-- main : IO Unit main : IO Unit
-- main = do main = runAsync (do
-- run "aoc2023/day2/eg.txt" run "aoc2023/day2/eg.txt"
-- run "aoc2023/day2/input.txt" run "aoc2023/day2/input.txt"
)

View File

@@ -0,0 +1,7 @@
module Node
import Prelude
pfunc fs : JSObject := `require('fs')`
pfunc getArgs : List String := `arrayToList(String, process.argv)`
pfunc readFile uses (fs) : (fn : String) -> IO String := `(fn) => (w) => MkIORes(Unit, fs.readFileSync(fn, 'utf8'), w)`

View File

@@ -266,11 +266,20 @@ instance Monad IO where
MkIORes a w => mab a w MkIORes a w => mab a w
pure a = \ w => MkIORes a w pure a = \ w => MkIORes a w
pfunc putStrLn uses (MkIORes MkUnit) : String -> IO Unit := `(s) => (w) => { class HasIO (m : U -> U) where
liftIO : a. IO a m a
instance HasIO IO where
liftIO a = a
pfunc primPutStrLn uses (MkIORes MkUnit) : String -> IO Unit := `(s) => (w) => {
console.log(s) console.log(s)
return MkIORes(undefined,MkUnit,w) return MkIORes(undefined,MkUnit,w)
}` }`
putStrLn : io. {{HasIO io}} -> String -> io Unit
putStrLn s = liftIO (primPutStrLn s)
pfunc showInt : Int -> String := `(i) => String(i)` pfunc showInt : Int -> String := `(i) => String(i)`
class Show a where class Show a where
@@ -322,8 +331,8 @@ instance Sub Int where
instance Ord Int where instance Ord Int where
x < y = ltInt x y x < y = ltInt x y
printLn : {a} {{Show a}} a IO Unit printLn : {m} {{HasIO m}} {a} {{Show a}} a m Unit
printLn a = putStrLn $ show a printLn a = putStrLn (show a)
-- opaque JSObject -- opaque JSObject
ptype JSObject ptype JSObject

View File

@@ -0,0 +1,26 @@
module Web
import Prelude
ptype Async : U -> U
pfunc resolve : a. a -> Async a := `(_, a) => Promise.resolve(a)`
pfunc andThen : a b. Async a -> (a -> Async b) -> Async b := `(A,B,a,ab) => a.then(ab)`
pfunc reject : a. String -> Async a := `(_, msg) => Promise.reject(msg)`
instance Monad Async where
bind = andThen
pure = resolve
-- It'd be nice to be able to declare operators and JS "projections"
pfunc fetchText : String -> Async String := `async (url) => {
let response = await fetch(url)
return response.text()
}`
pfunc liftAsync : a. IO a -> Async a := `(_, a) => Promise.resolve(a(undefined).h0)`
instance HasIO Async where
liftIO = liftAsync
runAsync : a. Async a -> IO Unit
runAsync foo = pure MkUnit

View File

@@ -4,7 +4,8 @@
realLog = console.log realLog = console.log
messages = [] messages = []
console.log = (...args) => { console.log = (...args) => {
messages.push(args.join(' ')) window.parent.postMessage({message: args.join(' ')}, '*')
// messages.push(args.join(' '))
realLog(...args) realLog(...args)
} }
window.addEventListener('message', (ev) => { window.addEventListener('message', (ev) => {
@@ -12,12 +13,13 @@ window.addEventListener('message', (ev) => {
let {cmd, src} = ev.data let {cmd, src} = ev.data
if (cmd === 'exec') { if (cmd === 'exec') {
try { try {
eval(src) window.parent.postMessage({messages: []}, '*')
eval(src)
} catch (e) { } catch (e) {
console.log(e) console.log(e)
} }
} }
window.parent.postMessage({messages}, '*') // window.parent.postMessage({messages}, '*')
messages = [] messages = []
}) })
realLog('IFRAME INITIALIZED') realLog('IFRAME INITIALIZED')

View File

@@ -32,6 +32,9 @@ function runOutput() {
window.onmessage = (ev) => { window.onmessage = (ev) => {
console.log("window got", ev.data); console.log("window got", ev.data);
if (ev.data.messages) state.messages.value = ev.data.messages; if (ev.data.messages) state.messages.value = ev.data.messages;
if (ev.data.message) {
state.messages.value = [...state.messages.value, ev.data.message]
}
}; };
newtWorker.onmessage = (ev) => { newtWorker.onmessage = (ev) => {
@@ -213,6 +216,7 @@ const SAMPLES = [
"Lists.newt", "Lists.newt",
"Day1.newt", "Day1.newt",
"Day2.newt", "Day2.newt",
"Node.newt",
"Prelude.newt", "Prelude.newt",
"TypeClass.newt", "TypeClass.newt",
"Combinatory.newt", "Combinatory.newt",

View File

@@ -119,6 +119,7 @@ process.stdout.write = (s) => {
// hack for now // hack for now
const preload = [ const preload = [
"Prelude.newt", "Prelude.newt",
"Web.newt",
"aoc2023/day1/eg.txt", "aoc2023/day1/eg.txt",
"aoc2023/day1/eg2.txt", "aoc2023/day1/eg2.txt",
] ]