Async, HasIO, and get aoc examples working in web
This commit is contained in:
@@ -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"
|
|
||||||
|
|||||||
@@ -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"
|
||||||
|
)
|
||||||
|
|||||||
7
playground/samples/Node.newt
Normal file
7
playground/samples/Node.newt
Normal 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)`
|
||||||
@@ -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
|
||||||
|
|||||||
26
playground/samples/Web.newt
Normal file
26
playground/samples/Web.newt
Normal 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
|
||||||
@@ -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')
|
||||||
|
|||||||
@@ -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",
|
||||||
|
|||||||
@@ -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",
|
||||||
]
|
]
|
||||||
|
|||||||
Reference in New Issue
Block a user