2021-11-23 20:49:57 +03:00
|
|
|
{- ORMOLU_DISABLE -} -- Remove this when the file is ready to be auto-formatted
|
2018-12-22 09:53:50 +03:00
|
|
|
{- For every file foo.u in the current directory write the parse error to foo.message.txt -}
|
|
|
|
module GenerateErrors where
|
|
|
|
import qualified Data.Text as Text
|
2022-02-25 00:15:56 +03:00
|
|
|
import Prelude
|
2018-12-22 09:53:50 +03:00
|
|
|
import System.Directory ( listDirectory, getCurrentDirectory )
|
|
|
|
import System.FilePath ( takeExtension, dropExtension )
|
|
|
|
import System.IO ( putStrLn )
|
|
|
|
import qualified Unison.Builtin as B
|
|
|
|
import Unison.Parser ( Err )
|
|
|
|
import qualified Unison.Parsers as P
|
2018-12-23 07:49:02 +03:00
|
|
|
import Unison.PrintError ( prettyParseError )
|
2018-12-22 09:53:50 +03:00
|
|
|
import Unison.Symbol ( Symbol )
|
2018-12-23 07:49:02 +03:00
|
|
|
import qualified Unison.Util.ColorText as Color
|
|
|
|
import Unison.Var ( Var )
|
2018-12-22 09:53:50 +03:00
|
|
|
|
|
|
|
|
|
|
|
unisonFilesInDir :: FilePath -> IO [String]
|
|
|
|
unisonFilesInDir p = do
|
|
|
|
files <- listDirectory p
|
|
|
|
pure $ filter ((==) ".u" . takeExtension) files
|
|
|
|
|
|
|
|
unisonFilesInCurrDir :: IO [String]
|
|
|
|
unisonFilesInCurrDir = getCurrentDirectory >>= unisonFilesInDir
|
|
|
|
|
|
|
|
errorFileName :: String -> String
|
|
|
|
errorFileName n = dropExtension n ++ ".message.txt"
|
|
|
|
|
2018-12-23 07:49:02 +03:00
|
|
|
emitAsPlainTextTo :: Var v => String -> Err v -> FilePath -> IO ()
|
|
|
|
emitAsPlainTextTo src e f = writeFile f plainErr
|
|
|
|
where plainErr = Color.toPlain $ prettyParseError src e
|
|
|
|
|
|
|
|
printError :: Var v => String -> Err v -> IO ()
|
|
|
|
printError src e = putStrLn $ B.showParseError src e
|
|
|
|
|
2018-12-22 09:53:50 +03:00
|
|
|
processFile :: FilePath -> IO ()
|
|
|
|
processFile f = do
|
2022-02-25 00:15:56 +03:00
|
|
|
content <- Text.unpack <$> readUtf8 f
|
2018-12-22 09:53:50 +03:00
|
|
|
let res = P.parseFile f content B.names
|
|
|
|
case res of
|
2018-12-23 07:49:02 +03:00
|
|
|
Left err -> do
|
|
|
|
emitAsPlainTextTo content (err :: Err Symbol) (errorFileName f)
|
|
|
|
printError content err
|
2018-12-23 07:17:57 +03:00
|
|
|
Right _ -> putStrLn $
|
2018-12-22 09:53:50 +03:00
|
|
|
"Error: " ++ f ++ " parses successfully but none of the files in this directory should parse"
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
main = unisonFilesInCurrDir >>= mapM_ processFile
|