module Shaker.TestTH
where
import Control.Arrow
import Language.Haskell.TH
import Shaker.ModuleData
import Shaker.Type
listAllTestFrameworkGroupList :: ShakerInput -> ExpQ
listAllTestFrameworkGroupList = shakerModuleData >>> removeNonTestModules >>> listTestFrameworkGroupList
listTestFrameworkGroupList :: [ModuleData] -> ExpQ
listTestFrameworkGroupList = return . ListE . map getSingleTestFrameworkGroup
getSingleTestFrameworkGroup :: ModuleData -> Exp
getSingleTestFrameworkGroup moduleData = foldl1 AppE [process_to_group_exp, test_case_tuple_list, list_assertion, list_prop]
where process_to_group_exp = AppE (VarE .mkName $ "processToTestGroup") (LitE (StringL $ moduleDataName moduleData))
list_prop = ListE $ map getSingleFrameworkQuickCheck $ moduleDataProperties moduleData
list_assertion = ListE $ map getSingleFrameworkHunit $ moduleDataAssertions moduleData
test_case_tuple_list = convertHunitTestCaseToTuples (moduleDataTestCase moduleData)
convertHunitTestCaseToTuples :: [String] -> Exp
convertHunitTestCaseToTuples = ListE . map convertToTuple
where convertToTuple name = TupE [LitE (StringL name), VarE $ mkName name ]
getSingleFrameworkHunit :: String -> Exp
getSingleFrameworkHunit hunitName = AppE testcase_with_name_exp assertion_exp
where testcase_with_name_exp = AppE ( VarE $ mkName "testCase") (LitE $ StringL hunitName)
assertion_exp = VarE . mkName $ hunitName
getSingleFrameworkQuickCheck :: String -> Exp
getSingleFrameworkQuickCheck propName = AppE testproperty_with_name_exp property_exp
where canonical_name = tail . dropWhile (/= '_') $ propName
testproperty_with_name_exp = AppE ( VarE $ mkName "testProperty") (LitE $ StringL canonical_name)
property_exp = VarE . mkName $ propName