From a6127929954805604d0a8442bdb44a8c556e76da Mon Sep 17 00:00:00 2001
From: Pascal Hartig <realpassy@fb.com>
Date: Wed, 28 Aug 2019 14:29:54 -0700
Subject: [PATCH] Add script to watch for TSC strict mode regressions

Summary:
This is a simple script that runs `tsc --strict` twice: on the current revision and the previous one, compares the number of errors and if there are more, prints them out and raises a failure exit code.

This should help us ensure that while we clean up the 500-odd errors we don't land more in the process.

Reviewed By: danielbuechele

Differential Revision: D17093671

fbshipit-source-id: 6c5d1424c729d15d66a32ae17f15b17c3b76fc68
---
 scripts/stricter/.gitignore   |   3 +
 scripts/stricter/package.yaml |  16 +++++
 scripts/stricter/stack.yaml   |   4 ++
 scripts/stricter/stricter.hs  | 109 ++++++++++++++++++++++++++++++++++
 4 files changed, 132 insertions(+)
 create mode 100644 scripts/stricter/.gitignore
 create mode 100644 scripts/stricter/package.yaml
 create mode 100644 scripts/stricter/stack.yaml
 create mode 100755 scripts/stricter/stricter.hs

diff --git a/scripts/stricter/.gitignore b/scripts/stricter/.gitignore
new file mode 100644
index 000000000..01bafa9a7
--- /dev/null
+++ b/scripts/stricter/.gitignore
@@ -0,0 +1,3 @@
+.stack-work
+Setup.hs
+*.cabal
diff --git a/scripts/stricter/package.yaml b/scripts/stricter/package.yaml
new file mode 100644
index 000000000..62d8c95ef
--- /dev/null
+++ b/scripts/stricter/package.yaml
@@ -0,0 +1,16 @@
+name:                stricter
+version:             0.0.1
+
+dependencies:
+  - base >= 4.7 && < 5
+  - turtle
+  - typed-process
+  - system-filepath
+  - foldl
+  - text
+  - bytestring
+
+executables:
+  stricter:
+    source-dirs:      .
+    main:             stricter.hs
diff --git a/scripts/stricter/stack.yaml b/scripts/stricter/stack.yaml
new file mode 100644
index 000000000..b7bed1818
--- /dev/null
+++ b/scripts/stricter/stack.yaml
@@ -0,0 +1,4 @@
+packages:
+- .
+resolver: lts-14.3
+
diff --git a/scripts/stricter/stricter.hs b/scripts/stricter/stricter.hs
new file mode 100755
index 000000000..5ace82181
--- /dev/null
+++ b/scripts/stricter/stricter.hs
@@ -0,0 +1,109 @@
+#!/usr/bin/env stack
+-- stack --resolver lts-14.3 --install-ghc runghc --package turtle --package system-filepath --package foldl --package typed-process --package bytestring
+{-
+Copyright (c) Facebook, Inc. and its affiliates.
+
+This source code is licensed under the MIT license found in the LICENSE file
+in the root directory of this source tree.
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+import Prelude hiding (FilePath)
+import Turtle
+
+import Data.Maybe (catMaybes)
+import Control.Monad (forM_)
+import Data.List ((\\))
+
+import qualified Filesystem.Path.CurrentOS as Path
+import qualified System.Process.Typed as Proc
+import qualified Data.Text as T
+import qualified Control.Foldl as F
+import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+
+-- * Global settings
+
+flipperPath :: FilePath -> FilePath
+flipperPath basePath =
+  basePath </> "xplat" </> "sonar"
+
+-- * Application logic
+
+-- | Find the root of the project, indicated by the presence of a ".hg" folder.
+findProjectRoot :: FilePath -> IO (Maybe FilePath)
+findProjectRoot dir = go $ Path.splitDirectories dir
+  where
+        go :: forall (m :: * -> *).
+              MonadIO m =>
+              [FilePath] -> m (Maybe FilePath)
+        go []     = return Nothing
+        go ds     = do
+          let ds'  = init ds
+              dir' = Path.concat ds'
+              hg   = dir' </> ".hg"
+          hgExists <- testdir hg
+          if hgExists then
+            return $ Just dir'
+          else
+            go ds'
+
+data TSCResult = TSCResult
+  { numErrors :: Int
+  , errors    :: [BS.ByteString]
+  } deriving (Show, Eq)
+
+runTSC :: FilePath -> Shell TSCResult
+runTSC root = do
+  cd root
+  (exitCode, stdout, stderr) <- liftIO $ Proc.readProcess (Proc.proc "yarn" ["run", "tsc", "--strict"])
+  let errors = C.split '\n' (BSL.toStrict stdout) & filter (BS.isInfixOf ": error TS")
+  pure $ TSCResult { numErrors = length errors
+                   , errors = errors
+                   }
+
+hgPrev :: Shell ()
+hgPrev = procs "hg" ["prev"] mempty
+
+hgNext :: Shell ()
+hgNext = procs "hg" ["next"] mempty
+
+handleErr :: IO ExitCode
+handleErr = err "Failed to run hg/tsc. Check above output." >> (pure $ ExitFailure 2)
+
+handleRes :: TSCResult -> TSCResult -> IO ExitCode
+handleRes cur prev = do
+  let delta = numErrors cur - numErrors prev
+  if delta > 0 then do
+    eprintf ("TSC Strict Mode regression. "%d%" new violations introduced:\n") delta
+    forM_ (errors cur \\ errors prev) $ eprintf ("- "%w%"\n")
+    return $ ExitFailure 1
+  else do
+    printf ("TSC Strict Mode test passed. Delta: "%d%"\n") delta
+    return ExitSuccess
+
+main :: IO ()
+main = do
+  projectRoot <- findProjectRoot =<< pwd
+  let flipperDir = flipperPath <$> projectRoot
+  flipperDir_ <- case flipperDir of
+        Just f -> realpath f
+        Nothing -> die "Couldn't determine Flipper project location."
+
+  printf "Running tsc --strict against current revision.\n"
+  currentRes <- fold (runTSC flipperDir_) F.head
+  printf "Checking out hg prev.\n"
+  _ <- sh hgPrev
+  printf "Running tsc --strict against previous revision.\n"
+  prevRes <- fold (runTSC flipperDir_) F.head
+  printf "Checking out hg next.\n"
+  _ <- sh hgNext
+
+  exit =<< case (currentRes, prevRes) of
+    (Just cur, Just prev) -> handleRes cur prev
+    _ -> handleErr
\ No newline at end of file