Look for test name to task id mapping in manifest

.gitignore

@@ -4,3 +4,4 @@ results.json
 stack.yaml.lock
 bin/setup-tests
 tests/**/HspecFormatter.hs
+**/dist-newstyle/

bin/run.sh

@@ -98,6 +98,6 @@ fi
 echo "$stack_yml_file_contents" > "${input_dir}/stack.yaml"
 echo "$package_yml_file_contents" > "${input_dir}/package.yaml"
 echo "$tests_file_contents" > "${input_dir}/test/Tests.hs"
-rm -f "${input_dir}/test/HspecFormatter.hs"
+rm -f "${input_dir}"/test/{HspecFormatter,Manifest}.hs
 
 echo "${slug}: done"

pre-compiled/package.yaml

@@ -4,10 +4,11 @@ version: 1.6.0.10
 dependencies:
   - base
 
+ghc-options: -Wall
+
 library:
   exposed-modules: LeapYear
   source-dirs: src
-  ghc-options: -Wall
   dependencies:
     - QuickCheck
     - lens
@@ -30,10 +31,14 @@ tests:
     main: Tests.hs
     source-dirs: test
     dependencies:
-      - leap
       - aeson
       - aeson-pretty
       - bytestring
+      - containers
+      - directory
+      - filepath
       - hspec
       - hspec-core
+      - leap
       - stm
+      - text

pre-compiled/src/LeapYear.hs

@@ -1,4 +1,4 @@
 module LeapYear (isLeapYear) where
 
 isLeapYear :: Integer -> Bool
-isLeapYear year = error "You need to implement this function."
+isLeapYear _year = error "You need to implement this function."

pre-compiled/test/HspecFormatter.hs

@@ -3,20 +3,20 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE LambdaCase #-}
 
 module HspecFormatter (formatter) where
 
-import Data.Aeson (ToJSON, toJSON, object, encode, (.=))
+import Data.Aeson (ToJSON, toJSON, object, (.=))
 import Data.Aeson.Encode.Pretty (encodePretty)
 import qualified Data.ByteString.Lazy as BS
-import Data.Maybe (fromMaybe)
-import Control.Monad (forM_)
 import Control.Concurrent.STM
-import GHC.IO.Unsafe (unsafePerformIO)
-import Test.Hspec
 import Test.Hspec.Core.Formatters.V2
-import Test.Hspec.Core.Format (Format, FormatConfig, Path, Event(ItemDone, Done), FailureReason(..))
+import Test.Hspec.Core.Format (Format, FormatConfig, Path, Event(ItemDone, Done))
 import GHC.Generics (Generic)
+import qualified Manifest
+import qualified System.IO as IO
 
 data TestResultStatus = Pass | Fail | Err deriving (Eq, Show)
 
@@ -28,10 +28,17 @@ instance ToJSON TestResultStatus where
 data TestResult = TestResult {
   name :: String,
   status :: TestResultStatus,
-  message :: Maybe String
+  message :: Maybe String,
+  taskId :: Maybe Int
 } deriving (Generic, Show)
 
 instance ToJSON TestResult where
+  toJSON t = object [
+      "name" .= t.name
+      , "status" .= t.status
+      , "message" .= t.message
+      , "task_id" .= t.taskId
+    ]
 
 data TestResults = TestResults {
   resultsStatus :: TestResultStatus,
@@ -48,25 +55,21 @@ instance ToJSON TestResults where
       , "tests" .= t.tests
     ]
 
-results :: TVar TestResults
-{-# NOINLINE results #-}
-results = unsafePerformIO $ newTVarIO (TestResults Fail [] Nothing 2)
-
-format :: Format
-format event = case event of
+format :: TVar TestResults -> (String -> Maybe Int) -> Format
+format results getTaskId event = case event of
   ItemDone path item -> handleItemDone path item
   Done _ -> handleDone
   _ -> return ()
   where
     handleItemDone :: Path -> Item -> IO ()
-    handleItemDone (_, requirement) item =
+    handleItemDone (_, requirement) item = do
+        let taskId = getTaskId requirement
         case itemResult item of
-          Success ->
-            addTestResult TestResult { name = requirement, status = Pass, message = Nothing }
+          Success -> addTestResult TestResult { name = requirement, status = Pass, message = Nothing, taskId }
           -- NOTE: We don't expect pending tests in Exercism exercises
           Pending _ _ -> return ()
           Failure _ failureReason ->
-            let baseResult = TestResult { name = requirement, status = Fail, message = Just "" }
+            let baseResult = TestResult { name = requirement, status = Fail, message = Just "", taskId }
                 result = case failureReason of
                   NoReason -> baseResult { message = Just "No reason" }
                   Reason reason -> baseResult { message = Just reason }
@@ -86,6 +89,11 @@ format event = case event of
       BS.writeFile "results.json" (encodePretty finalResults)
       return ()
 
-
 formatter :: FormatConfig -> IO Format
-formatter _config = return format
+formatter _config = do
+  getTaskId <- Manifest.getManifest >>= \case
+    Left e -> do
+      IO.hPutStrLn IO.stderr e
+      pure $ \_ -> Nothing
+    Right m -> pure $ Manifest.getTaskId m
+  format <$> newTVarIO (TestResults Fail [] Nothing 2) <*> pure getTaskId

pre-compiled/test/Manifest.hs

@@ -0,0 +1,45 @@
+{-# language OverloadedStrings #-}
+{-# language LambdaCase #-}
+module Manifest ( Manifest, getTaskId, getManifest ) where
+
+import Data.Aeson ( FromJSON (parseJSON), (.:))
+import qualified Data.Aeson as Aeson
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Text (Text)
+import qualified Data.Text as Text
+import System.Directory
+import System.FilePath ((</>))
+import Text.Printf (printf)
+import Data.Bifunctor (first)
+
+newtype Test = Test
+  { taskId :: Maybe Int
+  }
+
+instance FromJSON Test where
+  parseJSON = Aeson.withObject "test" $ \v -> Test <$> v .: "task_id"
+
+newtype Manifest = Manifest
+  { _tests :: Map Text Test
+  }
+
+instance FromJSON Manifest where
+  parseJSON = Aeson.withObject "manifest" $ \v -> Manifest <$> v .: "tests"
+
+-- | Map test description to task ID based on a manifest.
+getTaskId :: Manifest -> String -> Maybe Int
+getTaskId (Manifest m) name = Map.lookup (Text.pack name) m >>= taskId
+
+findManifest :: IO (Either String FilePath)
+findManifest = do
+  d <- getCurrentDirectory
+  let p = d </> ".exercism/metadata.json"
+  doesFileExist p >>= \case
+    False -> pure $ Left $ printf "Could not find manifest: %s" p
+    True  -> pure $ Right p
+
+getManifest :: IO (Either String Manifest)
+getManifest = findManifest >>= \case
+  Right p -> first (printf "Could not decode manifest: %s") <$> Aeson.eitherDecodeFileStrict p
+  Left e -> pure $ Left e

test-setup/src/Main.hs

@@ -6,6 +6,7 @@ import System.Environment (getArgs)
 import Control.Arrow ((>>>))
 import Control.Monad (when)
 import System.Directory (copyFile)
+import Data.Foldable (traverse_)
 
 main :: IO ()
 main = do
@@ -14,8 +15,9 @@ main = do
     [] -> error "setup-tests expects one argument - the project directory whose code should be modified"
     xs -> modifyTests (head xs)
 
-hspecFormatterPath :: String
-hspecFormatterPath = "pre-compiled/test/HspecFormatter.hs"
+(|>) :: a -> b -> (a, b)
+(|>) = (,)
+infixl 4 |>
 
 modifyTests :: String -> IO ()
 modifyTests inputDir = do
@@ -37,10 +39,21 @@ modifyTests inputDir = do
   -- Add aeson, aeson-pretty, bytestring, hspec-core, stm and text packages to `tests` section of 
   -- package.yaml.
   -- (assumes that the tests.test.dependencies is the last item in package.yaml!)
-  appendFile packageFile "      - aeson\n      - aeson-pretty\n      - bytestring\n      - hspec-core\n      - stm\n      - text\n"
-
+  appendFile packageFile $ unlines
+    [ "      - aeson"
+    , "      - aeson-pretty"
+    , "      - bytestring"
+    , "      - hspec-core"
+    , "      - stm"
+    , "      - text"
+    , "      - containers"
+    , "      - directory"
+    , "      - filepath"
+    ]
   -- Copy our custom hspec formatter into the input code directory so it can be used
-  copyFile hspecFormatterPath (inputDir ++ "/test/HspecFormatter.hs")
+  traverse_ (uncurry copyFile)
+    [ "pre-compiled/test/HspecFormatter.hs" |> inputDir ++ "/test/HspecFormatter.hs"
+    , "pre-compiled/test/Manifest.hs"       |> inputDir ++ "/test/Manifest.hs" ]
 
   where
     -- Update Test.Hspec.Runner import to add the `configFormat` import that we need

tests/example-all-fail/expected_results.json

@@ -5,47 +5,56 @@
         {
             "message": "Expected 'False' but got 'True'",
             "name": "2015 - year not divisible by 4 in common year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": "Expected 'False' but got 'True'",
             "name": "1970 - year divisible by 2, not divisible by 4 in common year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": "Expected 'True' but got 'False'",
             "name": "1996 - year divisible by 4, not divisible by 100 in leap year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": "Expected 'True' but got 'False'",
             "name": "1960 - year divisible by 4 and 5 is still a leap year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": "Expected 'False' but got 'True'",
             "name": "2100 - year divisible by 100, not divisible by 400 in common year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": "Expected 'False' but got 'True'",
             "name": "1900 - year divisible by 100 but not by 3 is still not a leap year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": "Expected 'True' but got 'False'",
             "name": "2000 - year divisible by 400 in leap year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": "Expected 'True' but got 'False'",
             "name": "2400 - year divisible by 400 but not by 125 is still a leap year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": "Expected 'False' but got 'True'",
             "name": "1800 - year divisible by 200, not divisible by 400 in common year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         }
     ],
     "version": 2

tests/example-partial-fail/expected_results.json

@@ -5,47 +5,56 @@
         {
             "message": null,
             "name": "2015 - year not divisible by 4 in common year",
-            "status": "pass"
+            "status": "pass",
+            "task_id": null
         },
         {
             "message": null,
             "name": "1970 - year divisible by 2, not divisible by 4 in common year",
-            "status": "pass"
+            "status": "pass",
+            "task_id": null
         },
         {
             "message": null,
             "name": "1996 - year divisible by 4, not divisible by 100 in leap year",
-            "status": "pass"
+            "status": "pass",
+            "task_id": null
         },
         {
             "message": null,
             "name": "1960 - year divisible by 4 and 5 is still a leap year",
-            "status": "pass"
+            "status": "pass",
+            "task_id": null
         },
         {
             "message": null,
             "name": "2100 - year divisible by 100, not divisible by 400 in common year",
-            "status": "pass"
+            "status": "pass",
+            "task_id": null
         },
         {
             "message": null,
             "name": "1900 - year divisible by 100 but not by 3 is still not a leap year",
-            "status": "pass"
+            "status": "pass",
+            "task_id": null
         },
         {
             "message": "Expected 'True' but got 'False'",
             "name": "2000 - year divisible by 400 in leap year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": "Expected 'True' but got 'False'",
             "name": "2400 - year divisible by 400 but not by 125 is still a leap year",
-            "status": "fail"
+            "status": "fail",
+            "task_id": null
         },
         {
             "message": null,
             "name": "1800 - year divisible by 200, not divisible by 400 in common year",
-            "status": "pass"
+            "status": "pass",
+            "task_id": null
         }
     ],
     "version": 2

tests/example-success/.exercism/metadata.json

@@ -0,0 +1,13 @@
+{
+  "tests": {
+    "2015 - year not divisible by 4 in common year": { "task_id": 1 },
+    "1970 - year divisible by 2, not divisible by 4 in common year": { "task_id": 1 },
+    "1996 - year divisible by 4, not divisible by 100 in leap year": { "task_id": 1 },
+    "1960 - year divisible by 4 and 5 is still a leap year": { "task_id": 1 },
+    "2100 - year divisible by 100, not divisible by 400 in common year": { "task_id": 1 },
+    "1900 - year divisible by 100 but not by 3 is still not a leap year": { "task_id": 1 },
+    "2000 - year divisible by 400 in leap year": { "task_id": 1 },
+    "2400 - year divisible by 400 but not by 125 is still a leap year": { "task_id": 1 },
+    "1800 - year divisible by 200, not divisible by 400 in common year": { "task_id": 1 }
+  }
+}