<commit_before>{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Unison.Prelude
import           EasyTest
import           Shellmet                       (($|))
import           System.Directory
import           System.FilePath                ( (</>)
                                                , splitFileName
                                                , takeExtensions
                                                , takeBaseName
                                                )
import           System.Process                 ( readProcessWithExitCode )

import           Data.Text                      ( pack
                                                , unpack
                                                )
import           Data.List

import System.Environment (getArgs)

type TestBuilder = FilePath -> FilePath -> [String] -> String -> Test ()

testBuilder
  :: Bool -> FilePath -> FilePath -> [String] -> String -> Test ()
testBuilder new ucm dir prelude transcript = scope transcript $ do
  io $ fromString ucm args
  ok
  where
    files = fmap (pack . (dir </>)) (prelude ++ [transcript])
    args | new = ["--new-runtime", "transcript"] ++ files
         | otherwise = ["transcript"] ++ files

testBuilder'
  :: Bool -> FilePath -> FilePath -> [String] -> String -> Test ()
testBuilder' new ucm dir prelude transcript = scope transcript $ do
  let output = dir </> takeBaseName transcript <> ".output.md"
  io $ runAndCaptureError ucm args output
  ok
  where
    files = fmap (pack . (dir </>)) (prelude ++ [transcript])
    args | new = ["--new-runtime", "transcript"] ++ files
         | otherwise = ["transcript"] ++ files
    -- Given a command and arguments, run it and capture the standard error to a file
    -- regardless of success or failure.
    runAndCaptureError :: FilePath -> [Text] -> FilePath -> IO ()
    runAndCaptureError cmd args outfile = do
      t <- readProcessWithExitCode cmd (map unpack args) ""
      let output = (\(_, _, stderr) -> stderr) t
      writeUtf8 outfile $ (pack . dropRunMessage) output

    -- Given the standard error, drops the part in the end that changes each run
    dropRunMessage :: String -> String
    dropRunMessage = unlines . reverse . drop 3 . reverse . lines


buildTests :: TestBuilder -> FilePath -> Test ()
buildTests testBuilder dir = do
  io
     . putStrLn
     . unlines
     $ [ ""
       , "Searching for transcripts to run in: " ++ dir
       ]
  files <- io $ listDirectory dir
  let 
    -- Any files that start with _ are treated as prelude
    (prelude, transcripts) =
      partition ((isPrefixOf "_") . snd . splitFileName)
      . sort
      . filter (\f -> takeExtensions f == ".md") $ files

  ucm <- io $ unpack <$> "cabal" $| ["exec", "--", "which", "unison"] -- todo: what is it in windows?
  tests (testBuilder ucm dir prelude <$> transcripts)

-- Transcripts that exit successfully get cleaned-up by the transcript parser.
-- Any remaining folders matching "transcript-.*" are output directories
-- of failed transcripts and should be moved under the "test-output" folder
cleanup :: Test ()
cleanup = do
  files' <- io $ listDirectory "."
  let dirs = filter ("transcript-" `isPrefixOf`) files'

  -- if any such codebases remain they are moved under test-output
  unless (null dirs) $ do
    io $ createDirectoryIfMissing True "test-output"
    io $ for_ dirs (\d -> renameDirectory d ("test-output" </> d))
    io
      . putStrLn
      . unlines
      $ [ ""
        , "NOTE: All transcript codebases have been moved into"
        , "the `test-output` directory. Feel free to delete it."
        ]

test :: Bool -> Test ()
test new = do
  buildTests (testBuilder new) $ "unison-src" </> "transcripts"
  buildTests (testBuilder True)
    $ "unison-src" </> "new-runtime-transcripts"
  buildTests (testBuilder' new)
    $ "unison-src" </> "transcripts" </> "errors"
  cleanup

main :: IO ()
main =
  getArgs >>= \case
    "--new-runtime" : _ -> run (test True)
    _ -> run (test False)
<commit_msg>Run transcripts in the old-runtime-transcripts directory<commit_after>{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Unison.Prelude
import           EasyTest
import           Shellmet                       (($|))
import           System.Directory
import           System.FilePath                ( (</>)
                                                , splitFileName
                                                , takeExtensions
                                                , takeBaseName
                                                )
import           System.Process                 ( readProcessWithExitCode )

import           Data.Text                      ( pack
                                                , unpack
                                                )
import           Data.List

import System.Environment (getArgs)

type TestBuilder = FilePath -> FilePath -> [String] -> String -> Test ()

testBuilder
  :: Bool -> FilePath -> FilePath -> [String] -> String -> Test ()
testBuilder new ucm dir prelude transcript = scope transcript $ do
  io $ fromString ucm args
  ok
  where
    files = fmap (pack . (dir </>)) (prelude ++ [transcript])
    args | new = ["--new-runtime", "transcript"] ++ files
         | otherwise = ["transcript"] ++ files

testBuilder'
  :: Bool -> FilePath -> FilePath -> [String] -> String -> Test ()
testBuilder' new ucm dir prelude transcript = scope transcript $ do
  let output = dir </> takeBaseName transcript <> ".output.md"
  io $ runAndCaptureError ucm args output
  ok
  where
    files = fmap (pack . (dir </>)) (prelude ++ [transcript])
    args | new = ["--new-runtime", "transcript"] ++ files
         | otherwise = ["transcript"] ++ files
    -- Given a command and arguments, run it and capture the standard error to a file
    -- regardless of success or failure.
    runAndCaptureError :: FilePath -> [Text] -> FilePath -> IO ()
    runAndCaptureError cmd args outfile = do
      t <- readProcessWithExitCode cmd (map unpack args) ""
      let output = (\(_, _, stderr) -> stderr) t
      writeUtf8 outfile $ (pack . dropRunMessage) output

    -- Given the standard error, drops the part in the end that changes each run
    dropRunMessage :: String -> String
    dropRunMessage = unlines . reverse . drop 3 . reverse . lines


buildTests :: TestBuilder -> FilePath -> Test ()
buildTests testBuilder dir = do
  io
     . putStrLn
     . unlines
     $ [ ""
       , "Searching for transcripts to run in: " ++ dir
       ]
  files <- io $ listDirectory dir
  let 
    -- Any files that start with _ are treated as prelude
    (prelude, transcripts) =
      partition ((isPrefixOf "_") . snd . splitFileName)
      . sort
      . filter (\f -> takeExtensions f == ".md") $ files

  ucm <- io $ unpack <$> "cabal" $| ["exec", "--", "which", "unison"] -- todo: what is it in windows?
  tests (testBuilder ucm dir prelude <$> transcripts)

-- Transcripts that exit successfully get cleaned-up by the transcript parser.
-- Any remaining folders matching "transcript-.*" are output directories
-- of failed transcripts and should be moved under the "test-output" folder
cleanup :: Test ()
cleanup = do
  files' <- io $ listDirectory "."
  let dirs = filter ("transcript-" `isPrefixOf`) files'

  -- if any such codebases remain they are moved under test-output
  unless (null dirs) $ do
    io $ createDirectoryIfMissing True "test-output"
    io $ for_ dirs (\d -> renameDirectory d ("test-output" </> d))
    io
      . putStrLn
      . unlines
      $ [ ""
        , "NOTE: All transcript codebases have been moved into"
        , "the `test-output` directory. Feel free to delete it."
        ]

test :: Bool -> Test ()
test new = do
  buildTests (testBuilder new) $ "unison-src" </> "transcripts"
  buildTests (testBuilder True)
    $ "unison-src" </> "new-runtime-transcripts"
  buildTests (testBuilder False)
    $ "unison-src" </> "old-runtime-transcripts"
  buildTests (testBuilder' new)
    $ "unison-src" </> "transcripts" </> "errors"
  cleanup

main :: IO ()
main =
  getArgs >>= \case
    "--new-runtime" : _ -> run (test True)
    _ -> run (test False)

{'fraction_non_alphanumeric': 0.11504208856898865, 'fraction_numerical': 0.0004879834085641088, 'mean_word_length': 1.9778423537958592, 'pattern_counts': {'":': 0, '<': 36, '<?xml version=': 0, '>': 84, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 24, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3008620', 'n_tokens_mistral': 2265, 'n_tokens_neox': 2154, 'n_words': 756}