Make be stack safe partially

.travis.yml

@@ -4,7 +4,7 @@ sudo: required
 node_js: stable
 install:
   - npm install -g yarn
-  - yarn global add purescript@^0.12.0 pulp@^12.3.0 bower purescript-psa@^0.6.0
+  - yarn global add purescript@^0.13.8 pulp@^15.0.0 bower purescript-psa@^0.7.3
   - export PATH="$PATH:`yarn global bin`"
   - bower install
 script:

bower.json

@@ -12,15 +12,19 @@
     "output"
   ],
   "dependencies": {
-    "purescript-prelude": "^4.0.0",
-    "purescript-console": "^4.0.0",
-    "purescript-lists": "^5.0.0",
-    "purescript-tuples": "^5.0.0"
+    "purescript-prelude": "^4.1.1",
+    "purescript-console": "^4.4.0",
+    "purescript-lists": "^5.4.1",
+    "purescript-tuples": "^5.1.0",
+    "purescript-tailrec": "^4.1.1"
   },
   "devDependencies": {
-    "purescript-quickcheck": "^5.0.0",
-    "purescript-psci-support": "^4.0.0",
-    "purescript-spec": "^3.0.0",
-    "purescript-spec-discovery": "owickstrom/purescript-spec-discovery#a1a8dfd5fadb3f00199d68d20af4bbf56a048c6e"
+    "purescript-quickcheck": "^6.1.0",
+    "purescript-psci-support": "4.0.0",
+    "purescript-spec": "^4.0.1",
+    "purescript-spec-discovery": "^4.0.0"
+  },
+  "resolutions": {
+    "purescript-spec": "^4.0.1"
   }
 }

src/Prettier/Printer.purs

@@ -34,6 +34,7 @@ module Prettier.Printer
 
 import Prelude
 
+import Control.Monad.Rec.Class (Step(..), tailRec)
 import Data.Array as Array
 import Data.Foldable (intercalate)
 import Data.List (List(Cons), (:))
@@ -98,16 +99,32 @@ copy i x = intercalate "" $ Array.replicate i x
 best :: Int -> Int -> DOC -> Doc
 best w k x = be w k $ List.singleton (Tuple 0 x)
 
+type Rec
+  = { acc :: Doc -> Doc
+    , rem :: List (Tuple Int DOC)
+    , k :: Int
+    }
+
 be :: Int -> Int -> List (Tuple Int DOC) -> Doc
-be w k List.Nil = Nil
-be w k (Cons (Tuple i NIL) z) = be w k z
-be w k (Cons (Tuple i (APPEND x y)) z) = be w k $ (Tuple i x) : (Tuple i y) : z
-be w k (Cons (Tuple i (NEST j x)) z) = be w k  $ (Tuple (i + j) x) : z
-be w k (Cons (Tuple i (TEXT s)) z) = Text s $ be w (k + String.length s) z
-be w k (Cons (Tuple i LINE) z) = Line i $ be w i z
-be w k (Cons (Tuple i (UNION x y)) z) =
-  let x' = be w k $ (Tuple i x) : z
-  in if fits (w - k) x' then x' else be w k $ (Tuple i y) : z
+be w k0 rem0 = tailRec go { acc: identity, rem: rem0, k: k0 } $ Nil
+  where
+  go :: Rec -> Step Rec (Doc -> Doc)
+  go { acc, rem, k } = case rem of
+    List.Nil -> Done acc
+    Cons (Tuple i doc) z -> case doc of
+      NIL -> Loop { acc, rem: z, k }
+      APPEND x y -> Loop { acc, rem: (Tuple i x) : (Tuple i y) : z, k }
+      NEST j x -> Loop { acc, rem: (Tuple (i + j) x) : z, k }
+      TEXT s -> Loop { acc: acc <<< Text s, rem: z, k: k + String.length s }
+      LINE -> Loop { acc: acc <<< Line i, rem: z, k: i }
+      UNION x y -> Loop { acc, rem: rem', k }
+        where
+        -- TODO: `be w k remx` is not stack-safe
+        rem' 
+          | fits (w - k) (be w k remx) = remx
+          | otherwise = remy
+        remx = (Tuple i x) : z
+        remy = (Tuple i y) : z
 
 fits :: Int -> Doc -> Boolean
 fits w x | w < 0 = false

test/Main.purs

@@ -3,9 +3,13 @@ module Test.Main where
 import Prelude
 
 import Effect (Effect)
+import Effect.Aff (launchAff_)
 import Test.Spec.Discovery (discover)
 import Test.Spec.Reporter.Console (consoleReporter)
-import Test.Spec.Runner (run)
+import Test.Spec.Runner (runSpec)
 
 main :: Effect Unit
-main = discover "Test\\.Prettier.Printer\\.*" >>= run [consoleReporter]
+main = do
+  launchAff_ do
+    specs <- discover "Test\\.Prettier.Printer\\.*"
+    runSpec [ consoleReporter ] specs

test/Prettier/Printer.purs

@@ -3,11 +3,13 @@ module Test.Prettier.Printer where
 import Prelude
 
 import Control.Monad.Gen (oneOf)
+import Data.Array (foldr, (..))
 import Data.NonEmpty ((:|))
 import Effect.Class (liftEffect)
-import Prettier.Printer (DOC, line, nest, nil, pretty, text)
+import Prettier.Printer (DOC, nest, line, nil, pretty, text)
 import Test.QuickCheck (class Arbitrary, arbitrary, quickCheck, (===))
 import Test.Spec (Spec, describe, it)
+import Test.Spec.Console (write)
 
 newtype DOC' = DOC' DOC
 
@@ -20,6 +22,19 @@ instance arbDOC' :: Arbitrary DOC' where
 
 spec :: Spec Unit
 spec = describe "Prettier.Printer" do
+  describe "overflow" do
+    it "stack safety nest" do
+      let
+        large = foldr (\_ -> nest 0) nil $ 0 .. 1_000_000
+        _ = pretty 0 large
+      pure unit
+    it "stack safety append" do
+      let
+        large = foldr (\_ -> (<>) nil) nil $ 0 .. 1_000_000
+        _ = pretty 0 large
+      pure unit
+    it "stack safety union" do
+      liftEffect $ write "TODO"
   describe "text" do
     it "is a homomorphism from string concatenation to document concatenation" do
       liftEffect $ quickCheck \w s t ->