Skip to content

Instantly share code, notes, and snippets.

@moodmosaic moodmosaic/TH.hs
Last active Apr 30, 2018

Embed
What would you like to do?
Parametrised unit tests and Template Haskell
@@ -1,11 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+
module Main (main) where
import Data.Fixed (Pico)
import Data.Time (LocalTime(..), TimeOfDay(..), ZonedTime(..),
fromGregorian, hoursToTimeZone)
-import Test.Framework (defaultMain)
+import Discordia.TH
import Test.Framework.Providers.HUnit (hUnitTestToTests)
import Test.HUnit (Test(..), (~:), (~=?))
newtype ZonedTimeEq =
ZT ZonedTime deriving (Show)
@@ -22,12 +24,12 @@ zt (y, mth, d) (h, m, s) tz =
(hoursToTimeZone tz)
adjustToBusinessHours :: a -> a
adjustToBusinessHours = id
-adjustToBusinessHoursReturnsCorrectResult :: [Test]
-adjustToBusinessHoursReturnsCorrectResult = do
+case_adjustToBusinessHoursReturnsCorrectResult :: [Test]
+case_adjustToBusinessHoursReturnsCorrectResult = do
(dt, expected) <-
[
(zt (2017, 10, 2) (6, 59, 4) 0, zt (2017, 10, 2) (9, 0, 0) 0),
(zt (2017, 10, 2) (9, 42, 41) 0, zt (2017, 10, 2) (9, 42, 41) 0),
(zt (2017, 10, 2) (19, 1, 32) 0, zt (2017, 10, 3) (9, 0, 0) 0)
@@ -35,10 +37,6 @@ adjustToBusinessHoursReturnsCorrectResult = do
let actual = adjustToBusinessHours dt
return $ ZT expected ~=? ZT actual
main :: IO ()
main =
- defaultMain
- $ hUnitTestToTests
- $ TestList [
- "adjustToBusinessHours returns correct result" ~: adjustToBusinessHoursReturnsCorrectResult
- ]
+ $(discover)
{-# LANGUAGE TemplateHaskell #-}
module Discordia.TH where
import Language.Haskell.Extract (functionExtractorMap)
import Language.Haskell.TH
import Test.Framework (defaultMain)
import Test.HUnit (Test(..))
discover :: ExpQ
discover = [|
defaultMain
$ hUnitTestToTests
$ TestList $(createTest "^case_" "~:")
|]
createTest :: String -> String -> ExpQ
createTest beginning funcName =
functionExtractorMap beginning $ applyNameFix funcName
applyNameFix :: String -> ExpQ
applyNameFix n =
do fn <- [|fixName|]
return $
LamE
[VarP (mkName "n")]
(AppE (VarE (mkName n)) (AppE (fn) (VarE (mkName "n"))))
fixName :: String -> String
fixName name =
replace '_' ' ' $ drop 5 name
replace :: Eq a => a -> a -> [a] -> [a]
replace b v =
map (\i -> if b == i then v else i)
@moodmosaic

This comment has been minimized.

Copy link
Owner Author

commented Apr 30, 2018

Make sure to include these in your .cabal file:

build-depends:
    language-haskell-extract
  , template-haskell
  , HUnit
  , test-framework

other-modules:
  Discordia.TH
@moodmosaic

This comment has been minimized.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.