The given code barely passes at the limit of 23, even with -O2
enabled on Preloaded. GHC actually does lots of GC during compilation, so I guess we can apply this article to reduce GC times. Unfortunately, +RTS
option is not available in OPTIONS_GHC
so I need kazk's help here.
module Kata.AdditionCommutes
( plusCommutes ) where
import Kata.AdditionCommutes.Definitions
( Z, S
, Natural(..), Equal(..)
, (:+:))
-- | x == x
refl :: Natural n -> Equal n n
refl NumZ = EqlZ
refl (NumS n) = EqlS (refl n)
-- | a == b -> b == a
sym :: Equal a b -> Equal b a
sym EqlZ = EqlZ
sym (EqlS p) = EqlS (sym p)
-- | a == b && b == c -> a == c
(<&>) :: Equal a b -> Equal b c -> Equal a c
(<&>) EqlZ EqlZ = EqlZ
(<&>) (EqlS a) (EqlS b) = EqlS (a <&> b)
-- | s(a) + b == a + s(b)
shove :: Natural a -> Natural b -> Equal (S a :+: b) (a :+: S b)
shove NumZ m = EqlS (refl m)
shove (NumS n) m = EqlS (shove n m)
-- | a + b == b + a
plusCommutes :: Natural a -> Natural b -> Equal (a :+: b) (b :+: a)
plusCommutes NumZ NumZ = EqlZ
plusCommutes a (NumS b) = sym (shove a b) <&> EqlS (plusCommutes a b)
plusCommutes (NumS a) b = EqlS (plusCommutes a b) <&> shove b a
module Kata.AdditionCommutesSpec (spec) where
import Kata.AdditionCommutes
import Kata.AdditionCommutes.Definitions
import Test.Hspec
import Test.Hspec.Codewars
-- | Verify that the functions' signature is correct:
solution :: Natural a -> Natural b -> Equal (a :+: b) (b :+: a)
solution = plusCommutes
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "Proof checking" $ do
it "Doesn't use any unsafe modules" $
solutionShouldHide $ Module "Unsafe.Coerce"
it "Simple tests" $ do
solution $(nat 0) $(nat 0) `shouldBe` $(proof 0)
solution $(nat 1) $(nat 0) `shouldBe` $(proof 1)
solution $(nat 5) $(nat 2) `shouldBe` $(proof 7)
solution $(nat 2) $(nat 7) `shouldBe` $(proof 9)
it "Methodical tests" $ $(makeTests [| solution |])
test.js
is a simple concatenation of preloaded, code and test cases. Other three files are components of cw-2
module, and they have a dependency on chai
.
Also, you can find all installed packages at ls node_modules
. Everything except cw-2
is publicly available.
const fs = require('fs') const cp = require('child_process') console.log(cp.execSync('pwd').toString()) console.log(cp.execSync('ls').toString()) console.log(cp.execSync('ls node_modules').toString()) console.log(cp.execSync('ls node_modules/cw-2').toString()) //console.log(this) const file1 = fs.readFileSync('/home/codewarrior/node/test.js') console.log(file1.toString()) const file2 = fs.readFileSync('/home/codewarrior/node/node_modules/cw-2/index.js') console.log(file2.toString()) const file3 = fs.readFileSync('/home/codewarrior/node/node_modules/cw-2/assertions.js') console.log(file3.toString()) const file4 = fs.readFileSync('/home/codewarrior/node/node_modules/cw-2/utils.js') console.log(file4.toString())
- const fs = require('fs')
- const cp = require('child_process')
- console.log(cp.execSync('pwd').toString())
- console.log(cp.execSync('ls').toString())
- console.log(cp.execSync('ls node_modules').toString())
- console.log(cp.execSync('ls node_modules/cw-2').toString())
- //console.log(this)
const file1 = fs.readFileSync('/home/codewarrior/index.js')- const file1 = fs.readFileSync('/home/codewarrior/node/test.js')
- console.log(file1.toString())
const file2 = fs.readFileSync('/runner/frameworks/javascript/cw-2.js')- const file2 = fs.readFileSync('/home/codewarrior/node/node_modules/cw-2/index.js')
- console.log(file2.toString())
const file3 = fs.readFileSync('/runner/frameworks/javascript/chai-display.js')- const file3 = fs.readFileSync('/home/codewarrior/node/node_modules/cw-2/assertions.js')
- console.log(file3.toString())
const file4 = fs.readFileSync('/runner/frameworks/javascript/display.js')- const file4 = fs.readFileSync('/home/codewarrior/node/node_modules/cw-2/utils.js')
- console.log(file4.toString())
index.js
is a combination of preloaded, code and test cases with a bit of error handling. Other three files are required modules to run the tests.
const fs = require('fs')
//console.log(this)
const file1 = fs.readFileSync('/home/codewarrior/index.js')
console.log(file1.toString())
const file2 = fs.readFileSync('/runner/frameworks/javascript/cw-2.js')
console.log(file2.toString())
const file3 = fs.readFileSync('/runner/frameworks/javascript/chai-display.js')
console.log(file3.toString())
const file4 = fs.readFileSync('/runner/frameworks/javascript/display.js')
console.log(file4.toString())
const assert = require('chai').assert
describe("Solution", function() {
it("should test for something", function() {
assert.strictEqual(1 + 1, 2);
});
});
Haskell optimization flags
Just a demo that passing -Ox
flags does work (GHC 8 only).
module Example where
factorial n = product [1..n]
module ExampleSpec where
import Test.Hspec
import Example
spec :: Spec
spec = do
describe "factorial" $ do
it "should work" $ do
factorial 200 `shouldBe` product [1..200]
main = hspec spec
Hspec Spec with Timing
A slightly hacky way to reproduce the timing information after the runner got the outermost "Test" group removed.
module Example where
add = (+)
module ExampleSpec where
import Test.Hspec
import Example
import Test.Hspec.Core.Spec
import System.CPUTime
import Text.Printf
timeIt :: IO () -> IO ()
timeIt ioa = do
t1 <- getCPUTime
ioa
t2 <- getCPUTime
printf "%.3f ms" $ (fromInteger (t2 - t1) / 10^9 :: Double)
timeBefore :: IO Integer
timeBefore = getCPUTime
timeAfter :: Integer -> IO ()
timeAfter t1 = do
t2 <- getCPUTime
printf "<COMPLETEDIN::>%.4f ms" $ (fromInteger (t2 - t1) / 10^9 :: Double)
spec :: Spec
--spec = around_ timeIt spec''
--spec = beforeAll timeBefore $ afterAll timeAfter spec'
spec = beforeAll timeBefore $ afterAll timeAfter $ aroundWith (\ioa _ -> ioa ()) spec''
spec' :: SpecWith Integer
spec' = mapSpecItem mapAction mapItem spec'' where
mapAction ioa _ = ioa ()
mapItem item@Item{..} = item{itemExample = itemExample' itemExample}
itemExample' ex params action callback
= ex params (mapExAction action) callback
mapExAction :: ((Integer -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
mapExAction action unitAction
= action (mapExAction' unitAction)
mapExAction' :: (() -> IO ()) -> Integer -> IO ()
mapExAction' action _ = action ()
spec'' :: Spec
spec'' = do
describe "add" $ do
it "adds Nums" $ do
(add 1 1) `shouldBe` (2 :: Integer)
it "foo" $ do
(add 1 1) `shouldBe` (2 :: Integer)
describe "add2" $ do
it "adds Nums" $ do
(add 1 1) `shouldBe` (2 :: Integer)
it "bar" $ do
(add 1 1) `shouldBe` (2 :: Integer)
main = hspec spec
//
const fs = require('fs')
let file = fs.readFileSync('/opt/runner/cw-2/assertions.js')
console.log(file.toString('ascii'))
const assert = require("chai").assert;
console.log(1n)
const util = require('util')
console.log(util.format('%o', {bignum:1n, str:'string', num:0.123}))
JSON.stringify = function(value, replacer, space) {
console.log(value, replacer, space)
//throw new Error();
return util.format('%o', value)
}
describe("Solution", function() {
it("should test for something", function() {
Test.assertDeepEquals(1 + 1, 3);
});
});
describe("Solution", function() {
it("should test for something", function() {
assert.deepEqual(1n + 1n, 3n, 'custom fail');
});
});
No raw randoms please.
module Example where
module ExampleSpec where
import Test.Hspec
import Example
import System.Random
import Control.Monad
-- `spec` of type `Spec` must exist
spec :: Spec
spec = do
describe "demo" $ do
it "using random" $ do
g <- newStdGen
let l1 = take 10 $ randoms g :: [Integer]
let l2 = take 10 $ randoms g :: [Integer]
print l1
print l2
l1 `shouldBe` l2
it "using random with two stdgen" $ do
g1 <- newStdGen
let l1 = take 10 $ randoms g1 :: [Integer]
g2 <- newStdGen
let l2 = take 10 $ randoms g2 :: [Integer]
print l1
print l2
l1 `shouldNotBe` l2
it "using random with splitAt" $ do
g <- newStdGen
let (l1, rest) = splitAt 10 $ randoms g
let l2 = take 10 rest :: [Integer]
print l1
print l2
l1 `shouldNotBe` l2
it "using randomIO" $ do
l1 <- replicateM 10 randomIO :: IO [Integer]
l2 <- replicateM 10 randomIO :: IO [Integer]
print l1
print l2
l1 `shouldNotBe` l2
-- the following line is optional for 8.2
main = hspec spec
The Preloaded section includes all Codewars-specific testing utilities to be added to Haskell 8 runner.
-
solutionShouldHide
,solutionShouldHideAll
replaces the legacyhidden
functionality. -
shouldBeApprox
,shouldBeApproxPrec
can be used for floating-point assertions.-
shouldBeApprox
has default absolute/relative margin of1e-6
.
-
module ExampleSpec where import Test.Hspec import Test.Hspec.Codewars import Example infix 1 `shouldBeApprox'` shouldBeApprox' = shouldBeApproxPrec 1e-9 spec :: Spec spec = do describe "add" $ do it "adds Nums" $ do ((+) 1 1) `shouldBe` (3 :: Integer) describe "approx" $ do it "approx tests" $ do sqrt 2.0 `shouldBeApprox` (1.4142135 :: Double) sqrt 3.0 `shouldBeApprox` (sqrt 2.0 :: Double) describe "approxNaN" $ do it "approx tests" $ do (0/0) `shouldBeApprox` (1.4142135 :: Double) describe "approxSmall" $ do it "approx tests" $ do sqrt 2e-8 `shouldBeApprox` (1.41e-4 :: Double) sqrt 3e-8 `shouldBeApprox` (1.7e-4 :: Double) describe "approxBig" $ do it "approx tests" $ do sqrt 2e18 `shouldBeApprox` (1.4142135e9 :: Double) sqrt 3e18 `shouldBeApprox` (1.7e9 :: Double) describe "approx2" $ do it "approx tests" $ do sqrt 2.0 `shouldBeApprox'` (1.414213562 :: Double) sqrt 2.0 `shouldBeApprox'` (1.4142135 :: Double) describe "hidden module" $ do it "hidden Prelude.head" $ do solutionShouldHide $ FromModule "Prelude" "head" describe "hidden module" $ do it "hidden Prelude.head and Data.Set" $ do solutionShouldHideAll [FromModule "Prelude" "head", Module "Data.Set"] main = hspec spec
- {-# LANGUAGE RecordWildCards #-}
- module ExampleSpec where
import Data.List (intercalate)- import Test.Hspec
import Test.HUnit (assertBool)- import Test.Hspec.Codewars
- import Example
import qualified Language.Haskell.Exts as QripParseOk :: Q.ParseResult a -> IO aripParseOk (Q.ParseOk x) = return xripParseOk _ = fail "Could not parse solution correctly"getImports :: Q.Module a -> IO [Q.ImportDecl a]getImports (Q.Module _ _ _ x _) = return xgetImports _ = fail "Unknown source type"getModuleName :: Q.ModuleName a -> StringgetModuleName (Q.ModuleName _ x) = xnameToStr :: Q.Name a -> StringnameToStr (Q.Ident _ x) = xnameToStr (Q.Symbol _ x) = xcnameToStr :: Q.CName a -> StringcnameToStr (Q.VarName _ x) = nameToStr xcnameToStr (Q.ConName _ x) = nameToStr xspecToStr :: Q.ImportSpec a -> [String]specToStr (Q.IVar _ x) = [nameToStr x]specToStr (Q.IAbs _ _ x) = [nameToStr x]specToStr (Q.IThingAll _ x) = [nameToStr x]specToStr (Q.IThingWith _ x cn) = nameToStr x : map cnameToStr cndata ImportDesc =ImportAll {mName :: String}| ImportSome {mName :: String, mSymbols :: [String]}| HideSome {mName :: String, mSymbols :: [String]}deriving (Eq, Show)declToDesc :: Q.ImportDecl a -> ImportDescdeclToDesc decl = case Q.importSpecs decl ofNothing -> ImportAll moduleNameJust (Q.ImportSpecList _ True xs) -> HideSome moduleName (concatMap specToStr xs)Just (Q.ImportSpecList _ False xs) -> ImportSome moduleName (concatMap specToStr xs)wheremoduleName = getModuleName $ Q.importModule decltreatPrelude :: [ImportDesc] -> [ImportDesc]treatPrelude xs = if any (\x -> mName x == "Prelude") xs then xs else ImportAll "Prelude" : xsdata Hidden = Module {moduleName :: String} | FromModule {moduleName :: String, symbolName :: String} deriving (Eq)instance Show Hidden whereshow (Module{..}) = moduleNameshow (FromModule{..}) = moduleName ++ "." ++ symbolNameshowList hiddens xs = intercalate ", " (map show hiddens) ++ xsexposed :: ImportDesc -> Hidden -> Boolexposed (ImportAll{..}) (Module{..}) = mName == moduleNameexposed (ImportAll{..}) (FromModule{..}) = mName == moduleNameexposed (ImportSome{..}) (Module{..}) = mName == moduleNameexposed (ImportSome{..}) (FromModule{..}) = mName == moduleName && symbolName `elem` mSymbolsexposed (HideSome{..}) (Module{..}) = mName == moduleNameexposed (HideSome{..}) (FromModule{..}) = mName == moduleName && symbolName `notElem` mSymbolshidden :: [Hidden] -> Expectationhidden hiddens = dosol <- Q.parseFile "solution.txt" >>= ripParseOk >>= getImportslet imports = treatPrelude $ map declToDesc sollet failures = [(desc, hide) | desc <- imports, hide <- hiddens, exposed desc hide]let message = "Import declarations must hide " ++ show hiddensassertBool message $ null failures- infix 1 `shouldBeApprox'`
- shouldBeApprox' = shouldBeApproxPrec 1e-9
- spec :: Spec
- spec = do
- describe "add" $ do
- it "adds Nums" $ do
((+) 1 1) `shouldBe` (2 :: Integer)- ((+) 1 1) `shouldBe` (3 :: Integer)
- describe "approx" $ do
- it "approx tests" $ do
- sqrt 2.0 `shouldBeApprox` (1.4142135 :: Double)
- sqrt 3.0 `shouldBeApprox` (sqrt 2.0 :: Double)
- describe "approxNaN" $ do
- it "approx tests" $ do
- (0/0) `shouldBeApprox` (1.4142135 :: Double)
- describe "approxSmall" $ do
- it "approx tests" $ do
- sqrt 2e-8 `shouldBeApprox` (1.41e-4 :: Double)
- sqrt 3e-8 `shouldBeApprox` (1.7e-4 :: Double)
- describe "approxBig" $ do
- it "approx tests" $ do
- sqrt 2e18 `shouldBeApprox` (1.4142135e9 :: Double)
- sqrt 3e18 `shouldBeApprox` (1.7e9 :: Double)
- describe "approx2" $ do
- it "approx tests" $ do
- sqrt 2.0 `shouldBeApprox'` (1.414213562 :: Double)
- sqrt 2.0 `shouldBeApprox'` (1.4142135 :: Double)
- describe "hidden module" $ do
- it "hidden Prelude.head" $ do
hidden [FromModule "Prelude" "head"]- solutionShouldHide $ FromModule "Prelude" "head"
- describe "hidden module" $ do
- it "hidden Prelude.head and Data.Set" $ do
hidden [FromModule "Prelude" "head", Module "Data.Set"]- solutionShouldHideAll [FromModule "Prelude" "head", Module "Data.Set"]
- main = hspec spec
Currently, the hiding
test that tests for hidden modules is only available in Haskell 7. Unfortunately, the original source is not compatible with Haskell 8 runner, so we have to write it from scratch.
Here is a small attempt to analyze the import statements from the source code.
module Example where
import Prelude hiding (Bool(..), head, (/))
import Data.Maybe
import qualified Data.Map as Map
import Data.Map (Map(..), fromList)
import Data.Set (Set)
import Data.Monoid (Dual(getDual))
module ExampleSpec where
import Data.List (intercalate)
import Test.Hspec
import Test.HUnit (assertBool)
import Example
import qualified Language.Haskell.Exts as Q
ripParseOk :: Q.ParseResult a -> IO a
ripParseOk (Q.ParseOk x) = return x
ripParseOk _ = fail "Could not parse solution correctly"
getImports :: Q.Module a -> IO [Q.ImportDecl a]
getImports (Q.Module _ _ _ x _) = return x
getImports _ = fail "Unknown source type"
getModuleName :: Q.ModuleName a -> String
getModuleName (Q.ModuleName _ x) = x
nameToStr :: Q.Name a -> String
nameToStr (Q.Ident _ x) = x
nameToStr (Q.Symbol _ x) = x
cnameToStr :: Q.CName a -> String
cnameToStr (Q.VarName _ x) = nameToStr x
cnameToStr (Q.ConName _ x) = nameToStr x
specToStr :: Q.ImportSpec a -> [String]
specToStr (Q.IVar _ x) = [nameToStr x]
specToStr (Q.IAbs _ _ x) = [nameToStr x]
specToStr (Q.IThingAll _ x) = [nameToStr x]
specToStr (Q.IThingWith _ x cn) = nameToStr x : map cnameToStr cn
data ImportDesc =
ImportAll {mName :: String}
| ImportSome {mName :: String, mSymbols :: [String]}
| HideSome {mName :: String, mSymbols :: [String]}
deriving (Eq, Show)
declToDesc :: Q.ImportDecl a -> ImportDesc
declToDesc decl = case Q.importSpecs decl of
Nothing -> ImportAll moduleName
Just (Q.ImportSpecList _ True xs) -> HideSome moduleName (concatMap specToStr xs)
Just (Q.ImportSpecList _ False xs) -> ImportSome moduleName (concatMap specToStr xs)
where
moduleName = getModuleName $ Q.importModule decl
treatPrelude :: [ImportDesc] -> [ImportDesc]
treatPrelude xs = if any (\x -> mName x == "Prelude") xs then xs else ImportAll "Prelude" : xs
data Hidden = Module {moduleName :: String} | FromModule {moduleName :: String, symbolName :: String} deriving (Eq)
instance Show Hidden where
show (Module{..}) = moduleName
show (FromModule{..}) = moduleName ++ "." ++ symbolName
showList hiddens xs = intercalate ", " (map show hiddens) ++ xs
exposed :: ImportDesc -> Hidden -> Bool
exposed (ImportAll{..}) (Module{..}) = mName == moduleName
exposed (ImportAll{..}) (FromModule{..}) = mName == moduleName
exposed (ImportSome{..}) (Module{..}) = mName == moduleName
exposed (ImportSome{..}) (FromModule{..}) = mName == moduleName && symbolName `elem` mSymbols
exposed (HideSome{..}) (Module{..}) = mName == moduleName
exposed (HideSome{..}) (FromModule{..}) = mName == moduleName && symbolName `notElem` mSymbols
hidden :: [Hidden] -> Expectation
hidden hiddens = do
sol <- Q.parseFile "solution.txt" >>= ripParseOk >>= getImports
let imports = treatPrelude $ map declToDesc sol
let failures = [(desc, hide) | desc <- imports, hide <- hiddens, exposed desc hide]
let message = "Import declarations must hide " ++ show hiddens
assertBool message $ null failures
spec :: Spec
spec = do
describe "add" $ do
it "adds Nums" $ do
((+) 1 1) `shouldBe` (2 :: Integer)
describe "hidden module" $ do
it "hidden Prelude.head" $ do
hidden [FromModule "Prelude" "head"]
describe "hidden module" $ do
it "hidden Prelude.head and Data.Set" $ do
hidden [FromModule "Prelude" "head", Module "Data.Set"]
main = hspec spec
Megaparsec test
List of packages tested
megaparsec
hspec-megaparsec
If you can build a working attoparsec
example, please post a kumite on it.
module Example where
import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Void
type Parser = Parsec Void String
singleX :: Parser Char
singleX = char 'x'
module ExampleSpec where
import Test.Hspec
import Test.Hspec.Megaparsec
import Text.Megaparsec
import Example
spec :: Spec
spec = do
describe "megaparsec" $ do
it "works as intended" $ do
parse singleX "" `shouldSucceedOn` "x"
-- the following line is optional for 8.2
main = hspec spec
Haskell packages sanity check
List of packages recently added
-
parsec
,attoparsec
,megaparsec
-
hspec-attoparsec
,hspec-megaparsec
-
regex-pcre
,regex-tdfa
,regex-posix
List of packages tested here
parsec
regex-*
module Example where
import qualified Text.Regex.Posix as Posix
import qualified Text.Regex.PCRE as PCRE
import qualified Text.Regex.TDFA as TDFA
import Text.Parsec
import Text.Parsec.Char
import Text.Parsec.String
-- The most basic functionalities of Regex modules
posixMatches :: String -> String -> Bool
posixMatches = (Posix.=~)
pcreMatches :: String -> String -> Bool
pcreMatches = (PCRE.=~)
tdfaMatches :: String -> String -> Bool
tdfaMatches = (TDFA.=~)
pcreVersion :: Maybe String
pcreVersion = PCRE.getVersion
-- The most basic functionalities of Parsec
number :: Parser Integer
number = (\a b -> read a) <$> many1 digit <*> eof
parseInt :: String -> Either ParseError Integer
parseInt = parse number ""
module ExampleSpec where
import Data.Maybe
import Data.Either
import Test.Hspec
import Example
-- `spec` of type `Spec` must exist
spec :: Spec
spec = do
describe "regex" $ do
it "PCRE version should be available" $ do
pcreVersion `shouldSatisfy` isJust
it "Each flavor should work as intended" $ do
posixMatches "baaab" "a+b" `shouldBe` True
posixMatches "aaacb" "a+b" `shouldBe` False
pcreMatches "baaab" "a+b" `shouldBe` True
pcreMatches "aaacb" "a+b" `shouldBe` False
tdfaMatches "baaab" "a+b" `shouldBe` True
tdfaMatches "aaacb" "a+b" `shouldBe` False
describe "parsec" $ do
it "Parsec should work as intended" $ do
parseInt "a" `shouldSatisfy` isLeft
parseInt "123456" `shouldBe` Right 123456
parseInt "123456 " `shouldSatisfy` isLeft
-- the following line is optional for 8.2
main = hspec spec