Add current formatter with license

Author: kazk

LICENSE.md

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2020 Qualified Inc.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

README.md

@@ -0,0 +1,25 @@
+# Test.Hspec.Formatters.Codewars
+
+Hspec formatter for [Qualified](https://www.qualified.io/) and [Codewars](https://www.codewars.com).
+
+## Usage
+
+Specify `codewars` formatter:
+
+```haskell
+-- test/Main.hs
+module Main where
+
+import Test.Hspec.Runner
+import Test.Hspec.Formatters.Codewars (codewars)
+
+import qualified Spec
+
+main :: IO ()
+main = hspecWith defaultConfig {configFormatter = Just codewars} Spec.spec
+```
+
+```haskell
+-- test/Spec.hs
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
+```

src/Test/Hspec/Formatters/Codewars.hs

@@ -0,0 +1,100 @@
+module Test.Hspec.Formatters.Codewars
+    (
+      codewars
+    ) where
+
+import System.IO (Handle)
+import Control.Exception (SomeException)
+import Control.Monad (unless, join, forM_)
+import Text.Printf (printf)
+import Data.List (intercalate)
+
+import Data.List.Split (splitOn)
+
+import Test.Hspec.Core.Spec (Progress)
+import Test.Hspec.Runner (Path)
+import Test.Hspec.Formatters (Formatter (..), FormatM,
+                              FailureRecord (..), FailureReason (..),
+                              getRealTime,
+                              formatException,
+                              write, writeLine)
+
+codewars :: Formatter
+codewars = Formatter
+    { headerFormatter = headerFormatter'
+    , footerFormatter = footerFormatter'
+    , exampleGroupStarted = exampleGroupStarted'
+    , exampleGroupDone = exampleGroupDone'
+    , examplePending = examplePending'
+    , exampleSucceeded = exampleSucceeded'
+    , exampleFailed = exampleFailed'
+    , exampleProgress = exampleProgress'
+    , failedFormatter = failedFormatter'
+    }
+
+-- https://hackage.haskell.org/package/hspec-core-2.4.4/docs/Test-Hspec-Core-Formatters.html
+
+headerFormatter' :: FormatM ()
+headerFormatter' = return ()
+
+footerFormatter' :: FormatM ()
+footerFormatter' = return ()
+
+-- evaluated before each test group
+exampleGroupStarted' :: [String] -> String -> FormatM ()
+exampleGroupStarted' = \nesting name -> do
+    writeLine ""
+    writeLine' $ join $ ["<DESCRIBE::>", name]
+
+-- evaluated after each test group
+exampleGroupDone' :: FormatM ()
+exampleGroupDone' = writeLine "\n<COMPLETEDIN::>"
+
+-- evaluated after each successful example
+exampleSucceeded' :: Path -> FormatM ()
+exampleSucceeded' = \(_, requirement) -> do
+    writeLine ""
+    writeLine' $ join ["<IT::>", requirement]
+    writeLine "\n<PASSED::>Test Passed"
+    writeLine "\n<COMPLETEDIN::>"
+
+-- evaluated after each failed example
+exampleFailed' :: Path -> Either SomeException FailureReason -> FormatM ()
+exampleFailed' = \(_, requirement) reason -> do
+    writeLine ""
+    writeLine' $ join ["<IT::>", requirement]
+    writeLine ""
+    formatFailure reason
+    writeLine "\n<COMPLETEDIN::>"
+
+-- evaluated after each pending example
+examplePending' :: Path -> Maybe String -> FormatM ()
+examplePending' = \_ _ -> return ()
+
+-- Failed test summary
+-- evaluated after a test run
+failedFormatter' :: FormatM ()
+failedFormatter' = return ()
+
+-- used to notify the progress of the currently evaluated example
+-- Only called when interactive/color mode.
+exampleProgress' :: Handle -> Path -> Progress -> IO ()
+exampleProgress' = \_ _ _ -> return ()
+
+writeLine' :: String -> FormatM ()
+writeLine' s = writeLine $ intercalate "<:LF:>" $ splitOn "\n" s
+
+formatFailure :: Either SomeException FailureReason -> FormatM ()
+formatFailure (Left e) = do
+    writeLine ""
+    writeLine' $ ((printf "<ERROR::>%s") . formatException) e
+formatFailure (Right NoReason) = do
+    writeLine ""
+    writeLine "<FAILED::>Test Failed"
+formatFailure (Right (Reason err)) = do
+    writeLine ""
+    writeLine' $ (printf "<FAILED::>%s" err)
+formatFailure (Right (ExpectedButGot preface expected actual)) = do
+    writeLine ""
+    mapM_ writeLine preface
+    writeLine' $ "<FAILED::>Test Failed\nexpected: " ++ expected ++ "\n but got: " ++ actual