Handle hindent freaking out on bad input in a more useful way

Author: supermario

extra/Lamdera.hs

@@ -150,7 +150,7 @@ import qualified Data.Text.IO
 import qualified Data.Char as Char
 import qualified Data.List as List
 
-import System.Exit (exitFailure)
+import qualified System.Exit (ExitCode(..))
 
 import Prelude hiding (lookup)
 import qualified Data.ByteString as BS
@@ -510,67 +510,21 @@ formatHaskellValue label v =
 
 hindentPrintLabelled :: Show a => Text -> a -> IO a
 hindentPrintLabelled label v = do
-  let
-    input = Text.Show.Unicode.ushow v
-
-  -- if Prelude.length input > 10000
-  --   then
-  --     atomicPutStrLn $ "❌SKIPPED display, value show > 10,000 chars, here's a clip:\n" <> Prelude.take 1000 input
-  --   else do
-
-  pathM <- Dir.findExecutable "hindent"
-  case pathM of
-    Just _ -> do
-      (exit, stdout, stderr) <- System.Process.readProcessWithExitCode "hindent" ["--line-length","150"] input
-      if Prelude.length stderr > 0
-        then
-          atomicPutStrLn $
-            "\n🔶 "
-              <> T.unpack label
-              <> "\n->"
-              <> stderr
-              <> "\n📥 for input: \n"
-              <> input
-
-        else
-          atomicPutStrLn $
-            "\n🔶 "
-              <> T.unpack label
-              <> "\n->"
-              <> stdout
-    Nothing -> do
-      debug_ "hindent missing, formatting without"
-      atomicPutStrLn $ show v
-
+  let input = Text.Show.Unicode.ushow v
+  formatted <- hindent_ input
+  atomicPutStrLn $
+    "\n🔶 "
+      <> T.unpack label
+      <> "\n->"
+      <> T.unpack formatted
   pure v
 
 
 hindentPrint :: Show a => a -> IO a
 hindentPrint v = do
-  let
-    input = Text.Show.Unicode.ushow v
-
-  pathM <- Dir.findExecutable "hindent"
-  case pathM of
-    Just _ -> do
-      (exit, stdout, stderr) <- System.Process.readProcessWithExitCode "hindent" ["--line-length","150"] input
-      if Prelude.length stderr > 0
-        then
-          atomicPutStrLn $
-            "\nerrors: \n"
-              <> stderr
-              <> "\n📥 for input: \n"
-              <> input
-              <> "\nwith output: \n"
-              <> stdout
-
-        else
-          atomicPutStrLn stdout
-
-    Nothing -> do
-      debug_ "hindent missing, formatting without"
-      atomicPutStrLn $ show v
-
+  let input = Text.Show.Unicode.ushow v
+  formatted <- hindent_ input
+  Ext.Common.atomicPutStrLn_ formatted
   pure v
 
 
@@ -581,15 +535,33 @@ hindent v =
 
 hindent_ :: String -> IO Text
 hindent_ s = do
-  -- pure $ T.pack s
-  (exit, stdout, stderr) <-
-    System.Process.readProcessWithExitCode "hindent" ["--line-length","150"] s
-    `catchError` (\err -> pure (error "no exit code on failure", s, "hindent failed"))
-  if Prelude.length stderr > 0
-    then
-      pure $ T.pack stderr
-    else
-      pure $ T.pack stdout
+  pathM <- Dir.findExecutable "hindent"
+  case pathM of
+    Just _ -> do
+      (exit, stdout, stderr) <-
+        System.Process.readProcessWithExitCode "hindent" ["--line-length","150"] s
+        `catchError` (\err -> pure (error "no exit code on failure", s, "hindent failed on input"))
+
+      if exit /= System.Exit.ExitSuccess
+        then
+          pure $ T.pack stderr
+        else
+          if Prelude.length stderr > 0
+            then
+              pure $ T.pack $
+                "\nerrors: \n"
+                  <> stderr
+                  <> "\n📥 for input: \n"
+                  <> s
+                  <> "\nwith output: \n"
+                  <> stdout
+
+            else
+              pure $ T.pack stdout
+
+    Nothing -> do
+      debug_ "🔥  hindent missing, returning without formatting"
+      pure $ T.pack s
 
 
 hindentFormatValue :: Show a => a -> Text

extra/readme.md

@@ -33,8 +33,10 @@ The test framework is a very lightweight vendored copy of `EasyTest.hs`, defined
 The easiest way to run is from the project root:
 
 ```
-$ stack ghci
+$ TOKEN="..." LDEBUG=1 LOVR=~/lamdera/overrides stack ghci
 λ: Test.all
+...
+✅  38 tests passed, no failures!
 ```
 
 ### Developing

test/Test.hs

@@ -98,7 +98,7 @@ For more information on how to use the GHCi debugger, see the GHC User's Guide.
 -- Current target for ghci :rr command. See ~/.ghci config file, which should contain
 -- something like `:def rr const $ return $ unlines [":r","Test.target"]`
 
--- target = Test.all
+target = Test.all
 -- target = checkProject
 
 
@@ -128,7 +128,7 @@ previewProject = do
 
 -- target = buildTestHarnessToProductionJs
 -- target = checkProjectCompiles
-target = previewProject
+-- target = previewProject
 -- target = liveReloadLive
 -- target = Test.Wire.all
 -- target = checkUserConfig
@@ -139,6 +139,7 @@ target = previewProject
 -- target = Lamdera.ReverseProxy.start
 -- target = Test.Check.mockBuildSh "/Users/mario/lamdera-deploys/test-local-v1" "test-local"
 -- target = Test.Check.mockBuildSh "/Users/mario/dev/test/lamdera-init" "test-local"
+-- target = Test.Caching.all
 
 -- target = do
 --   let p = "/Users/mario/dev/projects/elm-pages/examples/end-to-end"
@@ -220,16 +221,16 @@ buildTestHarnessToProductionJs = do
 liveReloadLive = do
 
   -- setEnv "LOVR" "/Users/mario/dev/projects/lamdera/overrides"
-  -- setEnv "LDEBUG" "1"
-  -- setEnv "EXPERIMENTAL" "1"
+  setEnv "LDEBUG" "1"
+  setEnv "EXPERIMENTAL" "1"
 
   -- let p = "/Users/mario/lamdera/test/v1"
   -- let p = "/Users/mario/dev/projects/bento-life"
-  -- let p = "/Users/mario/dev/projects/lamdera-dashboard"
+  let p = "/Users/mario/dev/projects/lamdera-dashboard"
 
   -- let p = "/Users/mario/dev/test/lamdera-init"
   -- let p = "/Users/mario/dev/test/nu-ashworld-lamdera"
-  let p = "/Users/mario/dev/test/town-collab"
+  -- let p = "/Users/mario/dev/test/town-collab"
 
   -- let p = "/Users/mario/dev/projects/otstats"
   -- let p = "/Users/mario/work/codespecs"

test/Test/Helpers.hs

@@ -76,7 +76,8 @@ catchOutput :: IO () -> EasyTest.Test Text
 catchOutput action = do
   -- https://hackage.haskell.org/package/main-tester-0.2.0.1/docs/Test-Main.html
   pr <- EasyTest.io $ captureProcessResult action
-  EasyTest.io $ hindent pr
+  -- EasyTest.io $ hindent pr
+  pure $ T.pack $ show pr
 
 
 catchOutputStdErr :: IO () -> EasyTest.Test Text
@@ -89,4 +90,6 @@ catchOutputStdErr action = do
 
 captureProcessOutput action = do
     pr <- captureProcessResult action
-    hindent pr
+    -- hindent pr
+    pure $ T.pack $ show pr
+