<commit_before>#!/usr/bin/env runhaskell
-- Run this script from the root of the exercism checkout!
module Main where
import System.Exit (ExitCode(..), exitFailure)
import System.Posix.Temp (mkdtemp)
import System.Directory
  ( removeDirectoryRecursive, getTemporaryDirectory
  , getCurrentDirectory, setCurrentDirectory, copyFile
  , getDirectoryContents, removeFile )
import System.Posix.Files ( isDirectory, getFileStatus )
import Control.Exception (bracket, finally)
import System.FilePath ((</>))
import System.Process (rawSystem)
import Data.List (isPrefixOf, intercalate)
import Data.Maybe (catMaybes)
import Control.Monad (filterM)
import Control.Applicative

withTemporaryDirectory_ :: FilePath -> IO a -> IO a
withTemporaryDirectory_ fp f =
     do sysTmpDir <- getTemporaryDirectory
        curDir <- getCurrentDirectory
        bracket (mkdtemp (sysTmpDir </> fp))
                (\path -> setCurrentDirectory curDir >>
                          removeDirectoryRecursive path)
                (\path -> setCurrentDirectory path >> f)

assignmentsDir :: FilePath
assignmentsDir = "."

parseModule :: [String] -> String
parseModule = (!!1) . words . head . filter (isPrefixOf "module ")

testAssignment :: FilePath -> FilePath -> IO (Maybe String)
testAssignment dir fn = do
  let d = dir </> fn
      example = d </> "example.hs"
      testFile = d </> (fn ++ "_test.hs")
      opts = ["-Wall", "-Werror", testFile]
  putStrLn $ "-- " ++ fn
  modFile <- (++ ".hs") . parseModule . lines <$> readFile example
  copyFile example modFile
  exitCode <- finally (rawSystem "runhaskell" opts) (removeFile modFile)
  return $ case exitCode of
    ExitSuccess -> Nothing
    _           -> Just fn

getAssignments :: FilePath -> IO [FilePath]
getAssignments dir = getDirectoryContents dir >>= filterM isAssignmentDir
  where
    isAssignmentDir path = case path of
      '.':_ -> return False
      '_':_ -> return False
      "bin" -> return False
      _     -> isDirectory <$> getFileStatus (dir </> path)

main :: IO ()
main = do
  dir <- (</> assignmentsDir) <$> getCurrentDirectory
  withTemporaryDirectory_ "exercism-haskell" $ do
    failures <- catMaybes <$> (getAssignments dir >>= mapM (testAssignment dir))
    case failures of
      [] -> putStrLn "SUCCESS!"
      xs -> putStrLn ("Failures: " ++ intercalate ", " xs) >> exitFailure<commit_msg>allow individual tests to be run more easily<commit_after>#!/usr/bin/env runhaskell
-- Run this script from the root of the exercism checkout!
module Main where
import System.Exit (ExitCode(..), exitFailure)
import System.Posix.Temp (mkdtemp)
import System.Environment (getArgs)
import System.Directory
  ( removeDirectoryRecursive, getTemporaryDirectory
  , getCurrentDirectory, setCurrentDirectory, copyFile
  , getDirectoryContents, removeFile )
import System.Posix.Files ( isDirectory, getFileStatus )
import Control.Exception (bracket, finally)
import System.FilePath ((</>))
import System.Process (rawSystem)
import Data.List (isPrefixOf, intercalate)
import Data.Maybe (catMaybes)
import Control.Monad (filterM)
import Control.Applicative

withTemporaryDirectory_ :: FilePath -> IO a -> IO a
withTemporaryDirectory_ fp f =
     do sysTmpDir <- getTemporaryDirectory
        curDir <- getCurrentDirectory
        bracket (mkdtemp (sysTmpDir </> fp))
                (\path -> setCurrentDirectory curDir >>
                          removeDirectoryRecursive path)
                (\path -> setCurrentDirectory path >> f)

assignmentsDir :: FilePath
assignmentsDir = "."

parseModule :: [String] -> String
parseModule = (!!1) . words . head . filter (isPrefixOf "module ")

testAssignment :: FilePath -> FilePath -> IO (Maybe String)
testAssignment dir fn = do
  let d = dir </> fn
      example = d </> "example.hs"
      testFile = d </> (fn ++ "_test.hs")
      opts = ["-Wall", "-Werror", testFile]
  putStrLn $ "-- " ++ fn
  modFile <- (++ ".hs") . parseModule . lines <$> readFile example
  copyFile example modFile
  exitCode <- finally (rawSystem "runhaskell" opts) (removeFile modFile)
  return $ case exitCode of
    ExitSuccess -> Nothing
    _           -> Just fn

getAssignments :: FilePath -> [FilePath] -> IO [FilePath]
getAssignments dir = filterM isAssignmentDir
  where
    isAssignmentDir path = case path of
      '.':_ -> return False
      '_':_ -> return False
      "bin" -> return False
      _     -> isDirectory <$> getFileStatus (dir </> path)

main :: IO ()
main = do
  dir <- (</> assignmentsDir) <$> getCurrentDirectory
  dirs <- getArgs >>= \args -> case args of
    [] -> getDirectoryContents dir
    _  -> return args
  withTemporaryDirectory_ "exercism-haskell" $ do
    failures <- catMaybes <$>
      (getAssignments dir dirs >>= mapM (testAssignment dir))
    case failures of
      [] -> putStrLn "SUCCESS!"
      xs -> putStrLn ("Failures: " ++ intercalate ", " xs) >> exitFailure
{'fraction_non_alphanumeric': 0.11952517396643471, 'fraction_numerical': 0.00040933278755628325, 'mean_word_length': 3.234835355285962, 'pattern_counts': {'":': 0, '<': 38, '<?xml version=': 0, '>': 81, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2231333', 'n_tokens_mistral': 1444, 'n_tokens_neox': 1416, 'n_words': 423}