shaker 0.2 → 0.2.1

raw patch · 7 files changed

+272/−2 lines, 7 files

Files

• shaker.cabal +8/−2
• src/Shaker/Reflexivite.hs +60/−0
• src/Shaker/SourceHelper.hs +97/−0
• src/Shaker/TestTH.hs +28/−0
• testsuite/tests/RunTestTH.hs +25/−0
• testsuite/tests/Shaker/CommonTest.hs +24/−0
• testsuite/tests/Shaker/ReflexiviteTest.hs +30/−0

@@ -1,5 +1,5 @@ name: shaker-version: 0.2+version: 0.2.1 cabal-version: >= 1.8 build-type: Custom license: BSD3@@ -73,7 +73,7 @@ source-repository this   type:     git   location: git://github.com/bonnefoa/Shaker.git -  tag:      0.2+  tag:      0.2.1  Executable shaker   Main-Is: Shaker.hs@@ -87,10 +87,13 @@     Shaker.Action.Compile     Shaker.Conductor     Shaker.Config+    Shaker.TestTH     Shaker.PluginConfig+    Shaker.Reflexivite     Shaker.Regex     Shaker.Cli     Shaker.Io+    Shaker.SourceHelper     Shaker.Cabal.CabalInfo     Shaker.Type     Shaker.Listener@@ -118,14 +121,17 @@   main-is:         RunTest.hs   ghc-options: -Wall -fno-warn-orphans   other-modules: +    RunTestTH     Shaker.RegexTest     Shaker.Properties     Shaker.Action.CompileTest     Shaker.IoTest     Shaker.CliTest+    Shaker.CommonTest     Shaker.ParserTest     Shaker.Cabal.CabalInfoTest     Shaker.ListenerTest+    Shaker.ReflexiviteTest     Shaker.ConductorTest   build-depends: base >= 4.1,                  Cabal >= 1.8.0.2,

@@ -0,0 +1,60 @@+module Shaker.Reflexivite+ where++import OccName (occNameString)+import Name (nameOccName)+import Var (varName)+import Data.List+import Data.Maybe+import GHC+import GHC.Paths+import Shaker.Type +import Shaker.Action.Compile+import Shaker.SourceHelper+import Control.Monad.Reader++-- ^ Mapping between module name (to import) and test to execute+data ModuleMapping = ModuleMapping {+  cfModuleName :: String -- ^ Complete name of the module +  ,cfHunitName :: [String] -- ^ Hunit test function names+  ,cfPropName :: [String] -- ^ QuickCheck test function names+ }+ deriving Show++-- | Collect all non-main modules with their test function associated+runReflexivite :: Shaker IO [ModuleMapping]+runReflexivite = do+  cpList <- asks compileInputs +  let cpIn = mergeCompileInputsSources cpList+  cfFlList <- lift $ constructCompileFileList cpIn+  modMaps <- lift $ runGhc (Just libdir) $ do +            _ <- ghcCompile $ runReader (removeFileWithTemplateHaskell cpIn >>= removeFileWithMain >>= setAllHsFilesAsTargets ) cfFlList+            modSummaries <- getModuleGraph+            mapM getModuleMapping modSummaries +  return modMaps++-- | Collect module name and tests name for the given module+getModuleMapping :: (GhcMonad m) => ModSummary -> m ModuleMapping+getModuleMapping  modSum = do +  mayModuleInfo <- getModuleInfo $  ms_mod modSum+  props <- return $ getQuickcheckFunction mayModuleInfo+  hunits <- return $ getHunitFunctions mayModuleInfo+  return $ ModuleMapping modName hunits props+  where modName = (moduleNameString . moduleName . ms_mod) modSum        +       +getQuickcheckFunction :: Maybe ModuleInfo -> [String]+getQuickcheckFunction = getFunctionWithPredicate ("prop_" `isPrefixOf`) ++getHunitFunctions :: Maybe ModuleInfo -> [String]+getHunitFunctions = getFunctionWithPredicate ("test" `isPrefixOf`) ++getFunctionWithPredicate :: (String -> Bool) -> Maybe ModuleInfo -> [String]+getFunctionWithPredicate _ Nothing = []+getFunctionWithPredicate predicat (Just modInfo) = filter predicat nameList+   where idList = catMaybes $ map tyThingToId $ modInfoTyThings modInfo+         nameList = map (occNameString . nameOccName . varName) idList ++tyThingToId :: TyThing -> Maybe Id+tyThingToId (AnId tyId) = Just tyId+tyThingToId _ = Nothing+

@@ -0,0 +1,97 @@+module Shaker.SourceHelper+ where++import GHC+import Data.List+import Shaker.Io+import Shaker.Type+import Control.Monad.Reader++type CompileR = Reader [CompileFile]++data CompileFile = CompileFile {+  cfFp :: FilePath +  ,cfHasMain :: Bool +  ,cfHasTH :: Bool+ } deriving Show++-- * Compile input management++-- | Build the list of haskell source files located in +-- CompileInput source dirs+constructCompileFileList :: CompileInput -> IO [CompileFile] +constructCompileFileList cpIn = do+  files <- recurseMultipleListFiles fli+  mapM constructCompileFile files+  where fli = getFileListenInfoForCompileInput cpIn+  +constructCompileFile :: FilePath -> IO CompileFile      +constructCompileFile fp = do+  hasMain <- isFileContainingMain fp+  hasTH <- isFileContainingTH fp+  return $ CompileFile fp hasMain hasTH++-- | Merge source dirs informations from the CompileInput list to +-- create a single CompileInput+mergeCompileInputsSources :: [CompileInput] -> CompileInput+mergeCompileInputsSources [] = defaultCompileInput +mergeCompileInputsSources cplInps@(cpIn:_) = do +  let srcDirs = nub $ concatMap cfSourceDirs cplInps+  cpIn {cfSourceDirs = srcDirs, cfDescription ="Full compilation"  } ++-- | Fill the target files to all files in listenerInput if empty+fillTargetIfEmpty ::CompileInput -> CompileR CompileInput+fillTargetIfEmpty cpIn = do+  if null (cfTargetFiles cpIn) +     then setAllHsFilesAsTargets cpIn+     else return cpIn++-- | Configure the CompileInput with all haskell files configured as targets+setAllHsFilesAsTargets :: CompileInput -> CompileR CompileInput+setAllHsFilesAsTargets cpIn = do+  files <- ask+  return cpIn {cfTargetFiles = map cfFp files }++-- | Change the dynflags with information from the CompileInput like importPaths +-- and .o and .hi directory+configureDynFlagsWithCompileInput :: CompileInput -> DynFlags -> DynFlags +configureDynFlagsWithCompileInput cpIn dflags = do +  dflags{+    importPaths = sourceDirs+    ,objectDir = Just compileTarget+    ,hiDir = Just compileTarget+  }+  where compileTarget = cfCompileTarget cpIn+        sourceDirs = cfSourceDirs cpIn++getFileListenInfoForCompileInput :: CompileInput -> [FileListenInfo] +getFileListenInfoForCompileInput cpIn =+  map (\a -> FileListenInfo a defaultExclude defaultHaskellPatterns) (cfSourceDirs cpIn)++-- * Target files filtering++removeFileWithTemplateHaskell :: CompileInput ->CompileR CompileInput+removeFileWithTemplateHaskell = removeFileWithPredicate cfHasTH++removeFileWithMain :: CompileInput -> CompileR CompileInput+removeFileWithMain = removeFileWithPredicate cfHasMain++removeFileWithPredicate :: (CompileFile -> Bool) -> CompileInput -> CompileR CompileInput+removeFileWithPredicate predicate cpIn = do +  cpFl <- ask +  let toRemove = map cfFp $ filter predicate cpFl+  return $ cpIn {cfTargetFiles =  targets \\ toRemove}+  where targets = cfTargetFiles cpIn++-- * GHC Compile management++ghcCompile :: GhcMonad m => CompileInput -> m SuccessFlag+ghcCompile cpIn@(CompileInput _ _ _ procFlags strflags targetFiles) = do   +     dflags <- getSessionDynFlags+     (newFlags,_,_) <- parseDynamicFlags dflags (map noLoc strflags)+     let chgdFlags = configureDynFlagsWithCompileInput cpIn newFlags+     _ <- setSessionDynFlags $ procFlags chgdFlags+     target <- mapM (`guessTarget` Nothing) targetFiles+     setTargets target+     load LoadAllTargets+

@@ -0,0 +1,28 @@+{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-}++module Shaker.TestTH+ where++import Shaker.Reflexivite+import Language.Haskell.TH+import Control.Monad.Reader+import Shaker.Cabal.CabalInfo++importModules :: ExpQ+importModules = undefined++listProperties :: ExpQ +listProperties = do+  modMaps <- runIO $ defaultCabalInput >>= runReaderT runReflexivite+  return $ ListE $ getQuickCheckProperty modMaps++getQuickCheckProperty :: [ModuleMapping] -> [Exp]+getQuickCheckProperty = concat . (map getQuickCheckProperty')++getQuickCheckProperty' :: ModuleMapping -> [Exp]+getQuickCheckProperty' modMap = map (\pName -> +  AppE (VarE (mkName "quickCheck") ) (VarE (mkName pName) ) ) $ cfPropName modMap++listHunit :: ExpQ +listHunit = undefined+

@@ -0,0 +1,25 @@+{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-}+module RunTestTH+ where++import Test.HUnit+import Control.Monad.Trans+-- import Shaker.TestTH+-- import Test.QuickCheck++runAll :: IO()+runAll = do +  mapM_ liftIO propLists+  mapM_ liftIO testLists++propLists :: [IO()]+propLists = []+--propLists = $(listProperties)+  --  putStrLn "prop_completeWord ">> quickCheck prop_completeWord,+  ++testLists :: [IO Counts]+testLists = [+  -- putStrLn "testRunCompileProject" >> runTestTT testRunCompileProject,+  ]+

@@ -0,0 +1,24 @@+module Shaker.CommonTest+ where ++import System.Directory+import Test.HUnit+import Control.Exception+import Shaker.Type++runTestOnDirectory :: FilePath -> Assertion -> Assertion+runTestOnDirectory fp fun = do+  oldDir <- getCurrentDirectory +  setCurrentDirectory fp+  finally fun (setCurrentDirectory oldDir)++initializeEmptyCompileInput :: CompileInput +initializeEmptyCompileInput = CompileInput {+  cfSourceDirs = []+  ,cfDescription = ""+  ,cfCompileTarget = ""+  ,cfDynFlags = id+  ,cfCommandLineFlags =[]+  ,cfTargetFiles = []+}+

@@ -0,0 +1,30 @@+module Shaker.ReflexiviteTest+ where++import Shaker.Reflexivite+import Test.HUnit+import Data.List+import Shaker.Config +import Control.Monad.Reader+import Shaker.Type++testRunReflexivite ::Test+testRunReflexivite = TestCase $ do+  modMapLst <- runReaderT runReflexivite testInputShaker +  length modMapLst > 1 @? "Should have more than one module, got : "++ show (length modMapLst)+  any ( \(ModuleMapping nm _ _) -> nm == "Shaker.Action.ReflexiviteTest") modMapLst @? +    "Should have module Shaker.Action.ReflexiviteTest, got " ++ show modMapLst+  let (Just regexpModMap)  = find (\(ModuleMapping nm _ _) -> nm == "Shaker.RegexTest" ) modMapLst+  any (== "prop_filterListAll") (cfPropName regexpModMap) @? "Should contain regexp module with quickechck properties prop_filterListAll, got "+    ++ show (cfPropName regexpModMap)+  let (Just reflexiviteModMap)  = find (\(ModuleMapping nm _ _) -> nm == "Shaker.Action.ReflexiviteTest" ) modMapLst+  any (== "testRunReflexivite") (cfHunitName reflexiviteModMap) @? "Should contain reflexivite test module with hunit test testRunReflexivite, got "+    ++ show (cfHunitName reflexiviteModMap)+    +testInputShaker :: ShakerInput+testInputShaker = defaultInput {+  compileInputs = [defaultCompileInput {+       cfCommandLineFlags = ["-package ghc"]+     }]+}+