braced block tests passing, layout block test is failing

parser-typechecker/src/Unison/TermParser.hs

@@ -36,12 +36,12 @@ pTrace s = pt <|> return ()
                  trace (s++": " ++x) $ attempt $ char 'z'
                  fail x
 
--- traced s p = p
-traced s p = do
-  pTrace s
-  a <- p <|> trace (s ++ " backtracked") (fail s)
-  let !x = trace (s ++ " succeeded") ()
-  pure a
+traced s p = p
+--traced s p = do
+--  pTrace s
+--  a <- p <|> trace (s ++ " backtracked") (fail s)
+--  let !x = trace (s ++ " succeeded") ()
+--  pure a
 
 {-
 Precedence of language constructs is identical to Haskell, except that all
@@ -84,7 +84,7 @@ term4 = traced "apply-chain" $ f <$> some termLeaf
     f [] = error "'some' shouldn't produce an empty list"
 
 termLeaf :: Var v => TermP v
-termLeaf =
+termLeaf = traced "leaf" $
   asum [hashLit, prefixTerm, text, number, tupleOrParenthesized term, blank, vector term, bracedBlock]
 
 ifthen :: Var v => TermP v
@@ -114,7 +114,7 @@ text :: Ord v => Parser s (Term v)
 text = Term.text <$> text'
 
 number :: Ord v => Parser s (Term v)
-number = traced "number" . token $ do
+number = token $ do
   let digits = takeWhile1 "number" isDigit
   sign <- optional (char '+' <|> char '-')
   ds <- digits
@@ -207,16 +207,16 @@ keywords =
 block'
   :: Var v
   => (forall a. Parser (S v) [a] -> Parser (S v) [a])
+  -> Parser (S v) x
   -> TermP v
-block' braced = go =<< braced statements
+block' braced semi = go =<< braced (traced "statements" statements)
   where
-  statements = traced "statements" $ do
+  statements = do
     s <- statement
     o <- optional semi
     case o of
       Nothing -> pure [s]
       Just _ -> (s:) . join . toList <$> optional statements
-  semi = L.spaced L.semi
   statement = traced "statement" $ (Right <$> binding) <|> (Left <$> blockTerm)
   toBinding (Right (v, e)) = (v,e)
   toBinding (Left e) = (Var.named "_", e)
@@ -230,10 +230,12 @@ block' braced = go =<< braced statements
     [] -> fail "empty block"
 
 block :: Var v => TermP v
-block = traced "block" $ block' L.block
+block = traced "block" $ bracedBlock <|> traced "unbraced-block" (block' L.vblock L.vsemi)
 
 bracedBlock :: Var v => TermP v
-bracedBlock = traced "braced-block" $ block' (\body -> token (string "{") *> body <* token (string "}"))
+bracedBlock = traced "braced-block" $
+  block' (\body -> token (string "{") *> body <* token (string "}")) semi
+  where semi = L.spaced L.semi
 
 -- We disallow type annotations and lambdas,
 -- just function application and operators
@@ -270,8 +272,8 @@ alias = do
       n = length params
   set (TypeParser.Aliases (s':s))
 
-bindings :: Var v => Parser (S v) [(v, Term v)]
-bindings = do s0 <- get; L.laidout (many alias *> binding) <* set s0 where
+-- bindings :: Var v => Parser (S v) [(v, Term v)]
+-- bindings = do s0 <- get; L.laidout (many alias *> binding) <* set s0 where
 
-moduleBindings :: Var v => Parser (S v) [(v, Term v)]
-moduleBindings = root bindings
+-- moduleBindings :: Var v => Parser (S v) [(v, Term v)]
+-- moduleBindings = root bindings

parser-typechecker/tests/Unison/Test/TermParser.hs

@@ -7,28 +7,33 @@ import Unison.Symbol (Symbol)
 import Unison.Parsers (unsafeParseTerm)
 
 test = scope "termparser" . tests . map parses $
-  [ -- "1"
-  --, "1.0"
-  --, "+1"
-  --, "-1"
-  --, "-1.0"
-  --, "4th"
-  --, "forty"
-  --, "forty two"
-  --, "\"forty two\""
-  --, "{ one }"
-  --, "{ one ; two }"
-  --, "{ one ; two ; }"
-  --, "{ one ; two ; three }"
-  --, "{ one ; two ; 42 }"
-  --, "{ one ; two ; three; }"
-  --, "x + 1"
-  --, "{ x + 1 }"
-  --, "{ x + 1; }"
-  "{ y = x; 24 }"
-  -- , "{ y = x + 1; 24 }"
-  -- , "{ x = 42 ; y = x + 1 ; 24 }"
-  -- , "foo 42"
+  [ "1"
+  , "1.0"
+  , "+1"
+  , "-1"
+  , "-1.0"
+  , "4th"
+  , "forty"
+  , "forty two"
+  , "\"forty two\""
+  , "{ one }"
+  , "{ one ; two }"
+  , "{ one ; two ; }"
+  , "{ one ; two ; three }"
+  , "{ one ; two ; 42 }"
+  , "{ one ; two ; three; }"
+  , "x + 1"
+  , "{ x + 1 }"
+  , "{ x + 1; }"
+  , "{ y = x; 24; }"
+  , "{ y = x + 1; 24 }"
+  , "{ x = 42 ; y = x + 1 ; 24 }"
+  , "{ x = \n" ++
+    "   z = 13 \n" ++
+    "   z + 1 \n" ++
+    "  91.0 \n" ++
+    "}"
+  , "foo 42"
   ]
 
 parses s = do

yaks/parsec-layout/src/Text/Parsec/Layout.hs

@@ -13,8 +13,9 @@
 
 module Text.Parsec.Layout
     ( block
-    , laidout
+    , vblock
     , semi
+    , vsemi
     , space
     , spaced
     , LayoutEnv
@@ -196,7 +197,7 @@ virtual_lbrace = do
   when allow pushCurrentContext
 
 virtual_rbrace :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m ()
-virtual_rbrace = do
+virtual_rbrace = try (void $ lookAhead semi) <|> do
   allow <- inLayout
   when allow $ eof <|> try (layoutSatisfies (VBrace ==) <?> "outdent")
 
@@ -207,6 +208,15 @@ space = do
     return " "
   <?> "space"
 
+vsemi :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m String
+vsemi = do
+    try $ layoutSatisfies p
+    return ";"
+  <?> "semicolon"
+  where
+    p VSemi = True
+    p _ = False
+
 -- | Recognize a semicolon including a virtual semicolon in layout.
 semi :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m String
 semi = do
@@ -214,9 +224,8 @@ semi = do
     return ";"
   <?> "semicolon"
   where
-        p VSemi = True
-        p (Other ';') = True
-        p _ = False
+    p (Other ';') = True
+    p _ = False
 
 lbrace :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m String
 lbrace = do
@@ -230,6 +239,15 @@ rbrace = do
     popContext "a right brace"
     return "}"
 
+vblock :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m a -> ParsecT s u m a
+vblock p = between (spaced virtual_lbrace) (spaced virtual_rbrace) p
+  where
+  -- NB: virtual_lbrace here doesn't use current column for offside calc, instead
+  -- uses 1 column greater than whatever column is at top of layout stack
+  virtual_lbrace = do
+    allow <- inLayout
+    when allow pushIncrementedContext
+
 block :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m a -> ParsecT s u m a
 block p = braced p <|> vbraced p where
   braced s = between (try (spaced lbrace)) (spaced rbrace) s
@@ -239,11 +257,3 @@ block p = braced p <|> vbraced p where
   virtual_lbrace = do
     allow <- inLayout
     when allow pushIncrementedContext
-
--- | Repeat a parser in layout, separated by (virtual) semicolons.
-laidout :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m a -> ParsecT s u m [a]
-laidout p = braced statements <|> vbraced statements where
-    braced s = between (try (spaced lbrace)) (spaced rbrace) s
-    vbraced s = between (spaced virtual_lbrace) (spaced virtual_rbrace) s
-    statements = p `sepBy` spaced semi
-