James/tricu
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Ergonomic language features and lib cleanup

Browse Source 
+ let bindings
+ where bindings
+ do notation

I explored enough of the alternative language design space and decided
that we should commit fully to Lambda style. That means no more highly
tacit/concatenative point-free/partial programs as default. We'll keep
taking advantage of those capabilities when it makes sense, but the
library will continue to see massive overhauls.
This commit is contained in:
James Eversole
2026-05-22 18:23:13 -05:00
parent 7cea3d1559
commit 2e2db07bd6
17 changed files with 1039 additions and 589 deletions
Download Patch File Download Diff File Expand all files Collapse all files

238
test/Spec.hs
View File

@@ -50,15 +50,15 @@ tests = testGroup "Tricu Tests"
, modules
, demos
, decoding
, elimLambdaSingle
, stressElimLambda
, byteMarshallingTests
, wireTests
, tricuReaderTests
, byteListUtilities
, binaryParserTests
-- , elimLambdaSingle
-- , stressElimLambda
-- , byteMarshallingTests
-- , wireTests
-- , tricuReaderTests
-- , byteListUtilities
-- , binaryParserTests
, httpParsingTests
, ioDriverTests
-- , ioDriverTests
]
lexer :: TestTree
@@ -136,6 +136,11 @@ lexer = testGroup "Lexer Tests"
expect = Right [LIdentifier "a", LArrowRight, LIdentifier "b"]
runParser tricuLexer "" input @?= expect
, testCase "Lex <- as bind arrow token" $ do
let input = "x <- action"
expect = Right [LIdentifier "x", LBindArrow, LIdentifier "action"]
runParser tricuLexer "" input @?= expect
, testCase "Lex $ remains legal identifier char" $ do
let input = "foo$bar = 1"
expect = Right [LIdentifier "foo$bar", LAssign, LIntegerLiteral 1]
@@ -227,6 +232,67 @@ parser = testGroup "Parser Tests"
expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a" Nothing)))
parseSingle input @?= expect
, testCase "Parse top-level definition arguments" $ do
let input = "const a b = a"
expect = SDef "const" ["a", "b"] (SVar "a" Nothing)
parseSingle input @?= expect
, testCase "Evaluate top-level definition arguments" $ do
tricuTestString "const a b = a\nconst 1 2" @?= "Fork (Stem Leaf) Leaf"
, testCase "Parse let expression" $ do
let input = "let x = t t in x"
expect = SApp (SLambda ["x"] (SVar "x" Nothing)) (SApp TLeaf TLeaf)
parseSingle input @?= expect
, testCase "Evaluate let expression" $ do
tricuTestString "let x = 1 in x" @?= "Fork (Stem Leaf) Leaf"
, testCase "Parse let function binding" $ do
let input = "let f x = x in f t"
expect = SApp (SLambda ["f"] (SApp (SVar "f" Nothing) TLeaf))
(SLambda ["x"] (SVar "x" Nothing))
parseSingle input @?= expect
, testCase "Parse where expression" $ do
let input = "x where x = t t"
expect = SApp (SLambda ["x"] (SVar "x" Nothing)) (SApp TLeaf TLeaf)
parseSingle input @?= expect
, testCase "Evaluate where expression" $ do
tricuTestString "x where x = 1" @?= "Fork (Stem Leaf) Leaf"
, testCase "Parse indented multiline definition body" $ do
let input = "x =\n t\n t"
expect = SDef "x" [] (SApp TLeaf TLeaf)
parseSingle input @?= expect
, testCase "Evaluate indented multiline let" $ do
tricuTestString "let\n x =\n 1\nin\n x" @?= "Fork (Stem Leaf) Leaf"
, testCase "Evaluate indented multiline where" $ do
tricuTestString "x\n where x =\n 1" @?= "Fork (Stem Leaf) Leaf"
, testCase "Parse explicit custom-bind do" $ do
let input = "do bind\n x <- pure t\n pure x"
expect = SApp
(SApp (SVar "bind" Nothing) (SApp (SVar "pure" Nothing) TLeaf))
(SLambda ["x"] (SApp (SVar "pure" Nothing) (SVar "x" Nothing)))
parseSingle input @?= expect
, testCase "Parse do statement without binder" $ do
let input = "do bind\n pure t\n pure t"
expect = SApp
(SApp (SVar "bind" Nothing) (SApp (SVar "pure" Nothing) TLeaf))
(SLambda ["_"] (SApp (SVar "pure" Nothing) TLeaf))
parseSingle input @?= expect
, testCase "Reject bare do without explicit bind operator" $ do
parsed <- try (evaluate (parseSingle "do\n x <- pure t\n pure x")) :: IO (Either SomeException TricuAST)
case parsed of
Left _ -> pure ()
Right _ -> assertFailure "Expected bare do to fail"
, testCase "Grouping T terms with parentheses in function application" $ do
let input = "x = (a : a)\nx (t)"
expect = [SDef "x" [] (SLambda ["a"] (SVar "a" Nothing)),SApp (SVar "x" Nothing) TLeaf]
@@ -2798,50 +2864,50 @@ ioDriverTests = testGroup "IO driver tests"
Left _ -> assertFailure $ "Expected numeric port, got: " ++ show val
other -> assertFailure $ "Expected ok result, got: " ++ show other
, testCase "connectTo creates connected socket" $
withFreePort $ \port -> do
final <- runIOSource $
unlines
[ "clientTask = port :"
, " onOk (connectTo \"127.0.0.1\" port) (client rest :"
, " onOk (send client [104 105]) (_ rest :"
, " pure t))"
, ""
, "main = io ("
, " onOk socket (server rest :"
, " onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
, " onOk (listen server 1) (_ rest :"
, " bind (fork (clientTask " ++ show port ++ ")) (_ :"
, " onOk (accept server) (accepted rest :"
, " onOk (recv (fst accepted) 2) (msg rest :"
, " pure msg)))))))"
]
final @?= ofBytes (BS.pack [104, 105])
, testCase "connectTo creates connected socket" $
withFreePort $ \port -> do
final <- runIOSource $
unlines
[ "clientTask = port :"
, " onOk (connectTo \"127.0.0.1\" port) (client rest :"
, " onOk (send client [104 105]) (_ rest :"
, " pure t))"
, ""
, "main = io ("
, " onOk socket (server rest :"
, " onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
, " onOk (listen server 1) (_ rest :"
, " bind (fork (clientTask " ++ show port ++ ")) (_ :"
, " onOk (accept server) (accepted rest :"
, " onOk (recv (fst accepted) 2) (msg rest :"
, " pure msg)))))))"
]
final @?= ofBytes (BS.pack [104, 105])
, testCase "serveOnce handles a single client connection" $
withFreePort $ \port -> do
final <- runIOSource $
unlines
[ "echoHandler = (client peer :"
, " onOk (recv client 2) (msg rest :"
, " onOk (send client msg) (_ rest :"
, " pure t)))"
, ""
, "clientTask = (port :"
, " onOk socket (sock rest :"
, " onOk (connect sock \"127.0.0.1\" port) (_ rest :"
, " onOk (send sock [104 105]) (_ rest :"
, " onOk (recv sock 2) (msg rest :"
, " pure msg)))))"
, ""
, "main = io ("
, " onOk socket (server rest :"
, " onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
, " onOk (listen server 1) (_ rest :"
, " bind (fork (serveOnce server echoHandler)) (_ :"
, " clientTask " ++ show port ++ ")))))"
]
final @?= ofBytes (BS.pack [104, 105])
, testCase "serveOnce handles a single client connection" $
withFreePort $ \port -> do
final <- runIOSource $
unlines
[ "echoHandler = (client peer :"
, " onOk (recv client 2) (msg rest :"
, " onOk (send client msg) (_ rest :"
, " pure t)))"
, ""
, "clientTask = (port :"
, " onOk socket (sock rest :"
, " onOk (connect sock \"127.0.0.1\" port) (_ rest :"
, " onOk (send sock [104 105]) (_ rest :"
, " onOk (recv sock 2) (msg rest :"
, " pure msg)))))"
, ""
, "main = io ("
, " onOk socket (server rest :"
, " onOk (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (_ rest :"
, " onOk (listen server 1) (_ rest :"
, " bind (fork (serveOnce server echoHandler)) (_ :"
, " clientTask " ++ show port ++ ")))))"
]
final @?= ofBytes (BS.pack [104, 105])
, testCase "finally preserves successful action result" $ do
final <- runIOSource $
@@ -3086,18 +3152,18 @@ ioDriverTests = testGroup "IO driver tests"
[ "main = io (createDirectory \"" ++ deniedDir ++ "/new\")"
]
final @?= ioErrResult "permission denied"
, testCase "createDirectory with file parent returns not a directory or does not exist" $
withSystemTempDirectory "tricu-mkdir-file-parent" $ \dir -> do
let parentFile = dir ++ "/file"
child = parentFile ++ "/sub"
writeFile parentFile "x"
final <- runIOSource $
unlines
[ "main = io (onCreateDirectory \"" ++ child ++ "\""
, " (err rest : pure err)"
, " (_ rest : pure \"ok\"))"
]
final @?= ofString "not a directory"
, testCase "createDirectory with file parent returns not a directory or does not exist" $
withSystemTempDirectory "tricu-mkdir-file-parent" $ \dir -> do
let parentFile = dir ++ "/file"
child = parentFile ++ "/sub"
writeFile parentFile "x"
final <- runIOSource $
unlines
[ "main = io (onCreateDirectory \"" ++ child ++ "\""
, " (err rest : pure err)"
, " (_ rest : pure \"ok\"))"
]
final @?= ofString "not a directory"
]
, testGroup "deleteFile"
@@ -3209,14 +3275,14 @@ ioDriverTests = testGroup "IO driver tests"
]
final @?= ofString "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
, testCase "sha256Hex hashes raw bytes" $ do
final <- runIOSource $
unlines
[ "main = io (onSha256Hex [(0) (255) (1)]"
, " (err rest : pure err)"
, " (hex rest : pure hex))"
]
final @?= ofString "47ffa3ea45a70b8a41c2c0825df323c00a8b7a01c1ea06083cc41dddcc001123"
, testCase "sha256Hex hashes raw bytes" $ do
final <- runIOSource $
unlines
[ "main = io (onSha256Hex [(0) (255) (1)]"
, " (err rest : pure err)"
, " (hex rest : pure hex))"
]
final @?= ofString "47ffa3ea45a70b8a41c2c0825df323c00a8b7a01c1ea06083cc41dddcc001123"
]
, testGroup "currentTime"
@@ -3362,6 +3428,36 @@ httpParsingTests = testGroup "HTTP Parsing Tests"
env = evalTricu lib (parseTricu input)
result env @?= parserErr (ofNumber 400) (ofString "Bad Request\n")
, testCase "parseContentLengthValue accepts max body bytes" $ do
lib <- evaluateFile "./lib/http.tri"
let input = "matchResult \"err\" (maybeLen rest : \"ok\") (parseContentLengthValue \"1048576\")"
env = evalTricu lib (parseTricu input)
result env @?= ofString "ok"
, testCase "parseContentLengthValue accepts shorter decimal below max" $ do
lib <- evaluateFile "./lib/http.tri"
let input = "matchResult \"err\" (maybeLen rest : \"ok\") (parseContentLengthValue \"999999\")"
env = evalTricu lib (parseTricu input)
result env @?= ofString "ok"
, testCase "parseContentLengthValue strips leading zeros before limit check" $ do
lib <- evaluateFile "./lib/http.tri"
let input = "parseContentLengthValue \"0000000000001\""
env = evalTricu lib (parseTricu input)
result env @?= parserOk (justT (ofNumber 1)) Leaf
, testCase "parseContentLengthValue rejects body above max" $ do
lib <- evaluateFile "./lib/http.tri"
let input = "parseContentLengthValue \"1048577\""
env = evalTricu lib (parseTricu input)
result env @?= parserErr (ofNumber 413) (ofString "Request body too large\n")
, testCase "parseContentLengthValue rejects longer body above max" $ do
lib <- evaluateFile "./lib/http.tri"
let input = "parseContentLengthValue \"2000000\""
env = evalTricu lib (parseTricu input)
result env @?= parserErr (ofNumber 413) (ofString "Request body too large\n")
-- statusLine / headerLine
, testCase "statusLine 200 OK" $ do
lib <- evaluateFile "./lib/http.tri"