{-# OPTIONS_GHC -XTemplateHaskell #-}
module Test.Framework.TH (
defaultMainGenerator,
defaultMainGenerator2,
testGroupGenerator
) where
import Language.Haskell.TH
import Language.Haskell.Exts.Parser
import Language.Haskell.Exts.Syntax
import Text.Regex.Posix
import Data.Maybe
import Language.Haskell.Exts.Extension
import Language.Haskell.Extract
import Test.Framework (defaultMain, testGroup)
defaultMainGenerator :: ExpQ
defaultMainGenerator :: ExpQ
defaultMainGenerator =
[| defaultMain [ testGroup $(locationModule) $ $(propListGenerator) ++ $(caseListGenerator) ++ $(testListGenerator) ] |]
defaultMainGenerator2 :: ExpQ
defaultMainGenerator2 :: ExpQ
defaultMainGenerator2 =
[| defaultMain [ testGroup $(locationModule) $ $(caseListGenerator) ++ $(propListGenerator) ++ $(testListGenerator) ] |]
testGroupGenerator :: ExpQ
testGroupGenerator :: ExpQ
testGroupGenerator =
[| testGroup $(locationModule) $ $(propListGenerator) ++ $(caseListGenerator) ++ $(testListGenerator) |]
listGenerator :: String -> String -> ExpQ
listGenerator :: String -> String -> ExpQ
listGenerator beginning :: String
beginning funcName :: String
funcName =
String -> ExpQ -> ExpQ
functionExtractorMap String
beginning (String -> ExpQ
applyNameFix String
funcName)
propListGenerator :: ExpQ
propListGenerator :: ExpQ
propListGenerator = String -> String -> ExpQ
listGenerator "^prop_" "testProperty"
caseListGenerator :: ExpQ
caseListGenerator :: ExpQ
caseListGenerator = String -> String -> ExpQ
listGenerator "^case_" "testCase"
testListGenerator :: ExpQ
testListGenerator :: ExpQ
testListGenerator = String -> String -> ExpQ
listGenerator "^test_" "testGroup"
applyNameFix :: String -> ExpQ
applyNameFix :: String -> ExpQ
applyNameFix n :: String
n =
do Exp
fn <- [|fixName|]
Exp -> ExpQ
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> ExpQ) -> Exp -> ExpQ
forall a b. (a -> b) -> a -> b
$ [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP (String -> Name
mkName "n")] (Exp -> Exp -> Exp
AppE (Name -> Exp
VarE (String -> Name
mkName String
n)) (Exp -> Exp -> Exp
AppE (Exp
fn) (Name -> Exp
VarE (String -> Name
mkName "n"))))
fixName :: String -> String
fixName :: String -> String
fixName name :: String
name = Char -> Char -> String -> String
forall a. Eq a => a -> a -> [a] -> [a]
replace '_' ' ' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop 5 String
name
replace :: Eq a => a -> a -> [a] -> [a]
replace :: a -> a -> [a] -> [a]
replace b :: a
b v :: a
v = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\i :: a
i -> if a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
i then a
v else a
i)