Update demos and adds <|

test/Spec.hs

@@ -111,6 +111,21 @@ lexer = testGroup "Lexer Tests"
         case (runParser tricuLexer "" "!result = 5") of
           Left _ -> return ()
           Right _ -> assertFailure "Expected failure when trying to assign the value of !result"
+
+  , testCase "Lex <| as arrow-left token" $ do
+      let input = "f <| g"
+          expect = Right [LIdentifier "f", LArrowLeft, LIdentifier "g"]
+      runParser tricuLexer "" input @?= expect
+
+  , testCase "Lex <| without surrounding spaces" $ do
+      let input = "a<|b"
+          expect = Right [LIdentifier "a", LArrowLeft, LIdentifier "b"]
+      runParser tricuLexer "" input @?= expect
+
+  , testCase "Lex $ remains legal identifier char" $ do
+      let input = "foo$bar = 1"
+          expect = Right [LIdentifier "foo$bar", LAssign, LIntegerLiteral 1]
+      runParser tricuLexer "" input @?= expect
   ]
 
 parser :: TestTree
@@ -212,6 +227,30 @@ parser = testGroup "Parser Tests"
       let input = "(t) -- (t) -- (t)"
           expect = [TLeaf]
       parseTricu input @?= expect
+
+  , testCase "Parse <| as low-precedence application" $ do
+      let input = "f x <| g y"
+          expect = SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
+                        (SApp (SVar "g" Nothing) (SVar "y" Nothing))
+      parseSingle input @?= expect
+
+  , testCase "Parse chained <| as right-associative" $ do
+      let input = "f <| g <| h"
+          expect = SApp (SVar "f" Nothing)
+                        (SApp (SVar "g" Nothing) (SVar "h" Nothing))
+      parseSingle input @?= expect
+
+  , testCase "Parse <| after newline inside parens" $ do
+      let input = "(f x <|\n  g y)"
+          expect = SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
+                        (SApp (SVar "g" Nothing) (SVar "y" Nothing))
+      parseSingle input @?= expect
+
+  , testCase "Parse <| in lambda body" $ do
+      let input = "(x : f x <| g)"
+          expect = SLambda ["x"] (SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
+                                      (SVar "g" Nothing))
+      parseSingle input @?= expect
   ]
 
 simpleEvaluation :: TestTree
@@ -1571,32 +1610,32 @@ ioDriverTests = testGroup "IO driver tests"
           ]
       final @?= Fork (ofString "root-local") (ofString "root")
 
-	, testCase "local does not affect outer bind continuation" $ do
-	    final <- runIOSourceWithEnv unsafePerms (ofString "root") $
-	      unlines
-	        [ "main = io (bind"
-	        , "  (local (env : append env \"-local\") (pure \"x\"))"
-	        , "  (_ : bind ask (env : pure env)))"
-	        ]
-	    final @?= ofString "root"
+  , testCase "local does not affect outer bind continuation" $ do
+      final <- runIOSourceWithEnv unsafePerms (ofString "root") $
+        unlines
+          [ "main = io (bind"
+          , "  (local (env : append env \"-local\") (pure \"x\"))"
+          , "  (_ : bind ask (env : pure env)))"
+          ]
+      final @?= ofString "root"
 
-	, testCase "local environment persists across inner binds" $ do
-	    final <- runIOSourceWithEnv unsafePerms (ofString "root") $
-	      unlines
-	        [ "main = io (local (env : append env \"-local\")"
-	        , "  (bind (pure t) (_ :"
-	        , "  bind ask (env : pure env))))"
-	        ]
-	    final @?= ofString "root-local"
+  , testCase "local environment persists across inner binds" $ do
+      final <- runIOSourceWithEnv unsafePerms (ofString "root") $
+        unlines
+          [ "main = io (local (env : append env \"-local\")"
+          , "  (bind (pure t) (_ :"
+          , "  bind ask (env : pure env))))"
+          ]
+      final @?= ofString "root-local"
 
-	, testCase "local restores environment when scoped action returns error value" $ do
-	    final <- runIOSourceWithEnv defaultPerms (ofString "root") $
-	      unlines
-	        [ "main = io (bind"
-	        , "  (local (env : append env \"-local\") (readFile \"definitely-missing.txt\"))"
-	        , "  (_ : bind ask (env : pure env)))"
-	        ]
-	    final @?= ofString "root"
+  , testCase "local restores environment when scoped action returns error value" $ do
+      final <- runIOSourceWithEnv defaultPerms (ofString "root") $
+        unlines
+          [ "main = io (bind"
+          , "  (local (env : append env \"-local\") (readFile \"definitely-missing.txt\"))"
+          , "  (_ : bind ask (env : pure env)))"
+          ]
+      final @?= ofString "root"
 
     -- State tests
   , testCase "get returns initial state" $ do
@@ -1745,22 +1784,22 @@ ioDriverTests = testGroup "IO driver tests"
           ]
       final @?= ofString "awake"
 
-	, testCase "await waits for sleeping child and returns child value" $ do
-		  (final, st) <- runIOSourceWith unsafePerms Leaf Leaf $
-		    unlines
-		      [ "main = io (bind (fork (bind (sleep 1) (_ : pure \"child done\"))) (h :"
-		      , "  await h))"
-		      ]
-		  final @?= ofString "child done"
-		  st @?= Leaf
+  , testCase "await waits for sleeping child and returns child value" $ do
+      (final, st) <- runIOSourceWith unsafePerms Leaf Leaf $
+        unlines
+          [ "main = io (bind (fork (bind (sleep 1) (_ : pure \"child done\"))) (h :"
+          , "  await h))"
+          ]
+      final @?= ofString "child done"
+      st @?= Leaf
 
-	, testCase "sleep inside bind resumes as unit" $ do
-		  (final, st) <- runIOSourceWith unsafePerms Leaf Leaf $
-		    unlines
-		      [ "main = io (bind (sleep 1) (_ : pure \"awake\"))"
-		      ]
-		  final @?= ofString "awake"
-		  st @?= Leaf
+  , testCase "sleep inside bind resumes as unit" $ do
+      (final, st) <- runIOSourceWith unsafePerms Leaf Leaf $
+        unlines
+          [ "main = io (bind (sleep 1) (_ : pure \"awake\"))"
+          ]
+      final @?= ofString "awake"
+      st @?= Leaf
 
   , testCase "fork await returns child value" $ do
       (final, st) <- runIOSourceWith unsafePerms Leaf Leaf $