79023ee190
Reviewed By: bhamodi Differential Revision: D33331422 fbshipit-source-id: 016e8dcc0c0c7f1fc353a348b54fda0d5e2ddc01
112 lines
3.4 KiB
Haskell
Executable File
112 lines
3.4 KiB
Haskell
Executable File
#!/usr/bin/env stack
|
|
{-
|
|
Copyright (c) Meta Platforms, Inc. and affiliates.
|
|
|
|
This source code is licensed under the MIT license found in the
|
|
LICENSE file in the root directory of this source tree.
|
|
-}
|
|
|
|
-- stack --resolver lts-14.3 --install-ghc runghc --package turtle --package system-filepath --package foldl --package typed-process --package bytestring
|
|
|
|
{-# 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")
|
|
eprintf "Please visit https://fburl.com/strictflipper for more information.\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
|