packages feed

shaker 0.2.1 → 0.3

raw patch · 31 files changed

+525/−322 lines, 31 filesdep +template-haskelldep ~haskeline

Dependencies added: template-haskell

Dependency ranges changed: haskeline

Files

shaker.cabal view
@@ -1,5 +1,5 @@ name: shaker-version: 0.2.1+version: 0.3 cabal-version: >= 1.8 build-type: Custom license: BSD3@@ -43,6 +43,10 @@   .   [@Clean@] Clean the directory containing .o and .hi files.   .+  [@QuickCheck@] Launch all QuickCheck properties of the project.+  .+  [@HUnit@] Launch all HUnit tests of the project.+  .   [@Quit@] Exit the application.   .    /Examples/@@ -73,17 +77,56 @@ source-repository this   type:     git   location: git://github.com/bonnefoa/Shaker.git -  tag:      0.2.1+  tag:      0.3 +Library +  ghc-options: -Wall -fno-warn-orphans +  hs-source-dirs:  src, testsuite/tests +  exposed-modules:+    Shaker.Parser+    Shaker.Action.Standard+    Shaker.Action.Test+    Shaker.Action.Execute+    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+  build-depends: base >= 4.1,+                 Cabal >= 1.8.0.2,+                 containers >= 0.3,+                 haskeline >= 0.6.2.2 +                 ,directory >= 1.0.1.0,+                 filepath >= 1.1,+                 ghc >= 6,+                 ghc-paths >= 0.1,+                 haskell98 >= 1.0,+                 mtl >= 1.0,+                 parsec >= 3.0,+                 regex-posix >= 0.94.1,+                 old-time >= 1.0.0+                 ,bytestring >= 0.9.1.5+                 ,HUnit >= 1.2.2.1+                 ,QuickCheck >= 2.1.1.1+                 ,template-haskell >= 2.4.0.0+ Executable shaker   Main-Is: Shaker.hs-  ghc-options: -Wall -fno-warn-orphans+  ghc-options: -Wall -fno-warn-orphans    hs-source-dirs: src    other-modules:      Shaker.Parser-    Shaker.Action.Clean     Shaker.Action.Standard-    Shaker.Action.Quickcheck+    Shaker.Action.Test+    Shaker.Action.Execute     Shaker.Action.Compile     Shaker.Conductor     Shaker.Config@@ -100,7 +143,7 @@   build-depends: base >= 4.1 && < 5 ,                  Cabal >= 1.8.0.2,                  containers >= 0.3,-                 haskeline >= 0.6.0.0 +                 haskeline >= 0.6.2.2                   ,directory >= 1.0.1.0,                  filepath >= 1.1,                  ghc >= 6,@@ -111,6 +154,7 @@                  regex-posix >= 0.94.1,                  old-time >= 1.0.0                  ,bytestring >= 0.9.1.5+                 ,template-haskell >= 2.4.0.0  flag test   description: Build test program.@@ -118,7 +162,7 @@  Executable test   hs-source-dirs:  src, testsuite/tests -  main-is:         RunTest.hs+  main-is:         RunTestTH.hs   ghc-options: -Wall -fno-warn-orphans   other-modules:      RunTestTH@@ -129,6 +173,7 @@     Shaker.CliTest     Shaker.CommonTest     Shaker.ParserTest+    Shaker.SourceHelperTest     Shaker.Cabal.CabalInfoTest     Shaker.ListenerTest     Shaker.ReflexiviteTest@@ -136,7 +181,7 @@   build-depends: base >= 4.1,                  Cabal >= 1.8.0.2,                  containers >= 0.3,-                 haskeline >= 0.6.0.0 +                 haskeline >= 0.6.2.2                   ,directory >= 1.0.1.0,                  filepath >= 1.1,                  ghc >= 6,@@ -149,5 +194,6 @@                  ,bytestring >= 0.9.1.5                  ,HUnit >= 1.2.2.1                  ,QuickCheck >= 2.1.1.1+                 ,template-haskell >= 2.4.0.0   if !flag(test)     buildable:     False
src/Shaker.hs view
@@ -3,13 +3,18 @@  import Shaker.Conductor import Shaker.Config+import Shaker.Parser import Shaker.Cabal.CabalInfo import Control.Monad.Reader+import System( getArgs ) + main :: IO() main = do+  args <- getArgs   inputState <- defaultInputState   cab <- defaultCabalInput -  runReaderT (initThread inputState) cab--    +  if null args +    then runReaderT (initThread inputState) cab+    else runReaderT ( executeCommand . parseCommand cab $ concat args)  cab +
− src/Shaker/Action/Clean.hs 
@@ -1,17 +0,0 @@--- | Clean action is responsible to delete directory containing temporary .o and .hi files -module Shaker.Action.Clean- where--import Shaker.Type-import System.Directory-import Control.Monad.Trans -import Control.Monad.Reader--runClean :: Plugin -runClean = do-       toClean <- asks $ map cfCompileTarget . compileInputs-       lift$  mapM_ action toClean -    where action toClean = do-                   ex <- doesDirectoryExist toClean-                   if ex then removeDirectoryRecursive toClean  -                         else putStrLn ""
src/Shaker/Action/Compile.hs view
@@ -22,7 +22,7 @@   cpList <- asks compileInputs    let cpIn = mergeCompileInputsSources cpList   cfFlList <- lift $ constructCompileFileList cpIn-  let newInp = runReader (setAllHsFilesAsTargets cpIn >>= removeFileWithMain)  cfFlList+  let newInp = runReader (setAllHsFilesAsTargets cpIn >>= removeFileWithMain )  cfFlList   lift $ runSingleCompileInput newInp  runSingleCompileInput :: CompileInput -> IO()
+ src/Shaker/Action/Execute.hs view
@@ -0,0 +1,28 @@+module Shaker.Action.Execute+ where+  +import Shaker.Type+import Shaker.Reflexivite+import Control.Monad.Reader+import Control.Arrow+import Data.List++runExecute :: Plugin+runExecute = do+  arg <- asks argument+  launchFunction arg++launchFunction :: Maybe String -> Plugin +launchFunction Nothing = lift $ putStrLn "No action to execute. Give an argument of ModuleName.functionName. The function should be of type IO()"+launchFunction (Just actStr) = runFunction runnableFunction+  where runnableFunction = parseModuleAndAction actStr++parseModuleAndAction :: String -> RunnableFunction+parseModuleAndAction actStr +  | '>' `elem` actStr = RunnableFunction (split ',' moduleStr)  functionStr+  | otherwise = RunnableFunction [""] actStr+  where (functionStr, moduleStr) =  first reverse . second ( reverse . tail )  . span (/= '>') . reverse $ actStr++split :: Char -> String -> [String]+split sep = takeWhile (not . null) . unfoldr (Just . span (/= sep) . dropWhile (== sep))+
− src/Shaker/Action/Quickcheck.hs 
@@ -1,98 +0,0 @@-module Shaker.Action.Quickcheck- where--{--import OccName (occNameString)-import Name (nameOccName)-import Var (varName)-import Data.List-import Data.Maybe-import           Data.Dynamic                           (fromDynamic)-import GHC-import DynFlags -import GHC.Paths-import Shaker.Io-import Shaker.Type-import Control.Monad.Trans -import Control.Monad.Reader-import Unsafe.Coerce---runQuickcheck :: Plugin-runQuickcheck = do-        (CompileInput sourceDir targetInput procFlags strflags) <-  asks compileInputs-        (ListenerInput fli _) <- asks listenerInput -        targetFiles <-  lift $ recurseMultipleListFiles fli-        lift $ defaultErrorHandler defaultDynFlags $ -                       runGhc (Just libdir) $ do-                       dflags <- getSessionDynFlags-                       (newFlags,_,_) <- parseDynamicFlags dflags (map noLoc strflags)-	               _ <- setSessionDynFlags $ procFlags $ setSourceAndTarget sourceDir targetInput newFlags-                       target <- mapM (`guessTarget` Nothing) targetFiles-                       setTargets target-        	       _ <- load LoadAllTargets-                       return()-runTest :: IO()-runTest = do -  _ <- getTestFunc-  return()---getTestFunc :: IO()-getTestFunc = -            defaultErrorHandler defaultDynFlags $ do-            runGhc (Just libdir) $ do-            dflags <- getSessionDynFlags-            (newFlags,_,_) <- parseDynamicFlags dflags (map noLoc ["-itestsuite/tests","-isrc/","-package ghc"])-            _ <- setSessionDynFlags newFlags-            target <- guessTarget "Shaker.RunTest" Nothing-            setTargets [target]-            _ <- load LoadAllTargets-            m <- findModule (mkModuleName "Shaker.RunTest") Nothing-            setContext [] [m]-            dynCompileExpr("runAll")--            --compileExpr ("runAll")-            --(unsafeCoerce value) --example :: IO[String]-example = defaultErrorHandler defaultDynFlags $ do-    runGhc (Just libdir) $ do-    dflags <- getSessionDynFlags-    (newFlags,_,_) <- parseDynamicFlags dflags (map noLoc ["-itestsuite/tests","-isrc/","-package ghc"])-    _ <- setSessionDynFlags newFlags-    target <- guessTarget "Shaker.CliTest" Nothing-    setTargets [target]-    _ <- load LoadAllTargets-    modulesList <- getModuleGraph-    tyThingsList <- getTyThingsFromModuleSummary modulesList---    return $ showPpr gra-    return $ getQuickcheckFunction tyThingsList- -getTyThingsFromModuleSummary :: (GhcMonad  m) => [ModSummary] -> m [TyThing]-getTyThingsFromModuleSummary modSummaries = do-        modulesInfo <- mapM getModuleInfo modules-        return $ concat $ map modInfoTyThings $ catMaybes modulesInfo-   where modules = map ms_mod modSummaries-         --getQuickcheckFunction :: [TyThing] -> [String]-getQuickcheckFunction tyMap = filter ("prop_" `isPrefixOf`) nameList-   where idList = catMaybes $ map tyThingToId tyMap-         varList = map varName idList-         occList = map nameOccName varList-         nameList = map occNameString occList--tyThingToId :: TyThing -> Maybe Id-tyThingToId (AnId tyId) = Just tyId-tyThingToId _ = Nothing--setSourceAndTarget :: [String] -> String ->DynFlags -> DynFlags-setSourceAndTarget sources target dflags = dflags{-    importPaths = sources-    ,objectDir = Just target-    ,hiDir = Just target-  }----}
src/Shaker/Action/Standard.hs view
@@ -1,3 +1,4 @@+-- | Standard and simple actions module Shaker.Action.Standard  where @@ -5,7 +6,9 @@ import qualified Data.Map as M import Control.Monad.Trans import Control.Monad.Reader+import System.Directory +-- | Print the list of available actions runHelp ::  Plugin runHelp = do    commands <- asks commandMap @@ -14,14 +17,26 @@   print $ M.keys commands   putStrLn "use ~[actionName] for continuous launch"  +-- | Print exit. The real exit management is made in conductor runExit :: Plugin runExit = lift $ putStrLn "Exiting" +-- | Print a begin action notification runStartAction :: Plugin runStartAction = lift $    putStrLn "---------- Begin action -------------------------" +-- | Print an end action notification runEndAction :: Plugin runEndAction = lift $    putStrLn "---------- End action ---------------------------" +-- | Clean action is responsible to delete directory containing temporary .o and .hi files +runClean :: Plugin +runClean = do+     toClean <- asks $ map cfCompileTarget . compileInputs+     lift$  mapM_ action toClean +  where action toClean = do+                 ex <- doesDirectoryExist toClean+                 if ex then removeDirectoryRecursive toClean  +                       else putStrLn ""
+ src/Shaker/Action/Test.hs view
@@ -0,0 +1,34 @@+module Shaker.Action.Test+ where++import Shaker.Type+import Shaker.Reflexivite+import Control.Monad.Trans+import Control.Monad.Reader+import Language.Haskell.TH++-- | Discover all quickcheck properties in the project +-- and execute them+runQuickCheck :: Plugin+runQuickCheck = do +  modMap <- runReflexivite +  let filteredModMap = filter (not . null . cfPropName ) modMap+  let modules = ["Test.QuickCheck","Prelude" ] ++ map cfModuleName filteredModMap +  expression <- asks listProperties +  resolvedExp <- lift $ runQ expression+  let function =  filter (/= '\n') $ pprint resolvedExp+  lift $ putStrLn function+  runFunction $ RunnableFunction modules ("sequence_ " ++ function ++ " >> return () ") ++-- | Discover all Hunit test in the project and execute them+runHUnit :: Plugin+runHUnit = do +  modMap <- runReflexivite +  let filteredModMap = filter (not . null . cfHunitName) modMap+  let modules = ["Test.HUnit","Prelude" ] ++ map cfModuleName filteredModMap +  expression <- asks listHunit+  resolvedExp <- lift $ runQ expression+  let function =  filter (/= '\n') $ pprint resolvedExp+  lift $ putStrLn function+  runFunction $ RunnableFunction modules ("runTestTT  $ TestList $ " ++ function) +
src/Shaker/Cabal/CabalInfo.hs view
@@ -1,6 +1,8 @@ -- | Allow to use cabal configuration (generated via the configure action of cabal). -- Source directories and compilation options will be reused by Shaker.-module Shaker.Cabal.CabalInfo+module Shaker.Cabal.CabalInfo(+    defaultCabalInput+  )    where  import Shaker.Type
src/Shaker/Conductor.hs view
@@ -1,7 +1,8 @@ -- | Conductor is responsible to control the command-line listener,  -- the listener manager and the action to execute module Shaker.Conductor(- initThread+ initThread,+ executeCommand )   where @@ -13,6 +14,7 @@ import qualified Data.Map as M import Control.Monad.Reader import Data.Maybe+import qualified Control.Exception as C   -- | Initialize the master thread  -- Once the master thread is finished, all input threads are killed@@ -31,29 +33,54 @@   cmd <- lift $ takeMVar inputMv   executeCommand cmd     case cmd of-       Command _ [Quit] -> return ()+       Command _ [Action Quit] -> return ()        _ ->  mainThread st +data ConductorData = ConductorData {+  coKillChannel :: MVar [ThreadId]+  ,coEndToken :: MVar Char+  ,coEndProcess :: MVar Int+  ,coListenState :: ListenState+  ,coFun :: IO ()+ }+ -- | Continuously execute the given action until a keyboard input is done listenManager :: Shaker IO() -> Shaker IO() listenManager fun = do-  shIn <- ask -  lift $ action shIn -  where action shIn = do-          -- Setup keyboard listener-          endToken <- newEmptyMVar -          procCharListener <- forkIO $ getChar >>= putMVar endToken-          -- Setup source listener-          listenState <- initialize (listenerInput shIn)-          -- Run the action-          procId <-  forkIO $ forever $ threadExecutor listenState (runReaderT fun shIn)-          _ <- readMVar endToken -          mapM_ killThread  $  [procId,procCharListener] ++ threadIds listenState+  conductorData <- initializeConductorData fun +  lift $ action conductorData+  where action conductorData = do+         -- Setup keyboard listener+         forkIO (getChar >>= putMVar (coEndToken conductorData) ) >>= addThreadIdToMVar conductorData+         -- Run the action+         forkIO (forever $ threadExecutor conductorData) >>= addThreadIdToMVar conductorData+         _ <- readMVar (coEndToken conductorData)+         cleanThreads conductorData++initializeConductorData :: Shaker IO () -> Shaker IO ConductorData +initializeConductorData fun = do+  shIn <- ask+  lstState <- initializeListener +  killChannel <- lift $ newMVar [] +  endToken <- lift newEmptyMVar +  endProcess <- lift ( newMVar 42 :: IO ( MVar Int ) )+  return $ ConductorData killChannel endToken endProcess lstState (runReaderT fun shIn)   --- | Execute the given action when the modified MVar is filled-threadExecutor :: ListenState -> IO() -> IO ThreadId-threadExecutor listenState fun = takeMVar (modifiedFiles listenState) >> forkIO fun +cleanThreads :: ConductorData -> IO()+cleanThreads (ConductorData chan _ _ lsState _) = do +  lstChan <- readMVar chan+  mapM_ killThread $ lstChan ++ threadIds lsState +addThreadIdToMVar :: ConductorData -> ThreadId -> IO ()+addThreadIdToMVar conductorData thrId = modifyMVar_ (coKillChannel conductorData) (\b -> return $ thrId:b) ++-- | Execute the given action when the modified MVar is filled+threadExecutor :: ConductorData -> IO ()+threadExecutor cdtData@(ConductorData _ _ endProcess listenState fun) = do +  _ <- takeMVar (modifiedFiles listenState)+  _ <- takeMVar endProcess+  forkIO (fun `C.finally` putMVar endProcess 42) >>= addThreadIdToMVar cdtData+   -- | Execute Given Command in a new thread executeCommand :: Command -> Shaker IO() executeCommand (Command OneShot act) = executeAction act @@ -62,5 +89,14 @@ -- | Execute given action executeAction :: [Action] -> Shaker IO() executeAction acts = do-   thePluginMap <- asks pluginMap-   sequence_ $ mapMaybe (`M.lookup` thePluginMap) acts +   mapM_ executeAction' acts +   return () ++executeAction' :: Action -> Shaker IO()+executeAction' (ActionWithArg act arg) = do +  plMap<- asks pluginMap +  local (\shIn -> shIn {argument = Just arg} ) $ fromJust $ act `M.lookup` plMap+executeAction' (Action act) = do+  plMap <- asks pluginMap +  fromJust $ act `M.lookup` plMap+
src/Shaker/Config.hs view
@@ -13,6 +13,7 @@   listenerInput = defaultListenerInput,   pluginMap = defaultPluginMap,   commandMap = defaultCommandMap+  ,argument = Nothing   }  defaultInputState :: IO InputState
src/Shaker/Io.hs view
@@ -1,3 +1,5 @@+-- | Manage all file operations like listing files with includes and exclude patterns+-- and file filtering module Shaker.Io(   listModifiedAndCreatedFiles   ,getCurrentFpCl@@ -6,7 +8,6 @@   ,recurseListFiles    ,FileInfo(FileInfo)   ,FileListenInfo(..)-  ,isFileContaining   ,isFileContainingMain   ,isFileContainingTH   ,defaultHaskellPatterns@@ -67,7 +68,7 @@ isFileContainingTH fp = isFileContaining fp (L.pack "$(" `L.isInfixOf`)  isFileContainingMain :: FilePath -> IO Bool-isFileContainingMain fp = isFileContaining fp (L.pack "main" `L.isPrefixOf`)+isFileContainingMain fp = isFileContaining fp (\a -> L.pack "main " `L.isPrefixOf` a || L.pack "main:" `L.isPrefixOf` a)  isFileContaining :: FilePath -> (L.ByteString -> Bool) -> IO Bool isFileContaining fp pat = do
src/Shaker/Listener.hs view
@@ -1,6 +1,8 @@+-- | Manage file listener operation for continuous mode.+-- All communication are made via MVars module Shaker.Listener(   listen-  ,initialize+  ,initializeListener   ,schedule   ,updateFileStat   ,ListenState(ListenState,threadIds,modifiedFiles,currentFiles)@@ -8,6 +10,7 @@ where  import Control.Monad+import Control.Monad.Reader import Control.Concurrent.MVar import Control.Concurrent import Shaker.Type@@ -27,6 +30,11 @@   ,threadIds :: [ThreadId] -- ^ List of all forks id initialized } +initializeListener :: Shaker IO ListenState+initializeListener =do+  lstInput <- asks listenerInput +  lift $ initialize lstInput+ -- | initialize the mvar and launch forks initialize :: ListenerInput -> IO ListenState initialize lstInput = do@@ -58,8 +66,6 @@ updateFileStat _ _ _ [] = return () updateFileStat mC mM curFiles curMod = do   _ <- swapMVar mC curFiles -  putMVar mM curMod +  _ <- tryPutMVar mM curMod    return()  --
src/Shaker/Parser.hs view
@@ -1,3 +1,4 @@+-- | Module responsible to parse a String into a Command module Shaker.Parser(   parseCommand )@@ -11,7 +12,7 @@ parseCommand :: ShakerInput -> String -> Command parseCommand shIn str =    case (parse (typeCommand $ commandMap shIn) "parseCommand" str) of-    Left _ -> Command OneShot [Help]+    Left _ -> Command OneShot [Action Help]      Right val -> val  -- | Parse a Command@@ -20,17 +21,36 @@   typeMultipleAction cmMap >>= \acts ->   return (Command dur acts) - typeMultipleAction :: CommandMap -> GenParser Char st [Action] typeMultipleAction cmMap = many (typeAction cmMap) >>= \res ->   case res of -       [] -> return [Help]+       [] -> return [Action Help]        _ -> return res  -- | Parse to an action typeAction :: CommandMap -> GenParser Char st Action typeAction cmMap = skipMany (char ' ') >>+  typeShakerAction cmMap >>= \shAct -> +  optionMaybe (parseArgument cmMap) >>= \arg ->+  skipMany (char ' ') >> +  case arg of+       Nothing -> return $ Action shAct+       Just str -> return $ ActionWithArg shAct str++parseArgument :: CommandMap -> GenParser Char st String+parseArgument cmMap = +  skipMany (char ' ') >>+  mapM_ (\a -> notFollowedBy $ string (a++" ") ) (M.keys cmMap) >>  +  mapM_ (\a -> notFollowedBy $ string (a++"\n") ) (M.keys cmMap) >>  +  many1 (noneOf " \n") >>= \str ->+  skipMany (char ' ') >>+  return str ++-- | Parse a ShakerAction +typeShakerAction :: CommandMap -> GenParser Char st ShakerAction+typeShakerAction cmMap = skipMany (char ' ') >>   choice (parseMapAction cmMap)  >>= \res ->+  notFollowedBy (noneOf " \n") >>    skipMany (char ' ') >> return res  -- | Parse the continuous tag (~)@@ -38,6 +58,6 @@ typeDuration = skipMany (char ' ') >>   option OneShot (char '~' >> return Continuous) -parseMapAction :: CommandMap -> [GenParser Char st Action]+parseMapAction :: CommandMap -> [GenParser Char st ShakerAction] parseMapAction cmMap = map (\(k,v) -> try (string k) >> return v) (M.toList cmMap)
src/Shaker/PluginConfig.hs view
@@ -4,8 +4,8 @@  import qualified Data.Map as M (fromList) import Shaker.Type+import Shaker.Action.Test import Shaker.Action.Compile-import Shaker.Action.Clean import Shaker.Action.Standard  -- | The default plugin map contains mapping for compile, help and exit action @@ -15,6 +15,9 @@                 (Compile,runCompile ),                 (FullCompile,runFullCompile ),                 (Help,runHelp),+--                (Execute,runExecute),+                (QuickCheck,runQuickCheck),+                (HUnit,runHUnit),                 (Clean,runClean),                 (Quit,runExit)               ]@@ -25,7 +28,9 @@             ("Compile",Compile),             ("FullCompile",FullCompile),             ("Help", Help),---            ("QuickCheck",QuickCheck),+--            ("Execute", Execute),+            ("QuickCheck",QuickCheck),+            ("HUnit",HUnit),             ("Clean",Clean),             ("q",Quit),             ("Quit",Quit)
src/Shaker/Reflexivite.hs view
@@ -1,4 +1,12 @@-module Shaker.Reflexivite+module Shaker.Reflexivite(+  ModuleMapping(..)+  ,RunnableFunction(..)+  ,runReflexivite+  ,runFunction+  -- * Template haskell generator+  ,listHunit+  ,listProperties+)  where  import OccName (occNameString)@@ -8,12 +16,16 @@ import Data.Maybe import GHC import GHC.Paths+import Outputable import Shaker.Type  import Shaker.Action.Compile import Shaker.SourceHelper+import Unsafe.Coerce import Control.Monad.Reader+import Control.Arrow+import Language.Haskell.TH --- ^ Mapping between module name (to import) and test to execute+-- | 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@@ -21,40 +33,107 @@  }  deriving Show +data RunnableFunction = RunnableFunction {+  cfModule :: [String]+  ,cfFunctionName :: String -- The function name. Should have IO() as signature+}+ 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+  lift $ runGhc (Just libdir) $ do +            _ <- ghcCompile $ runReader (setAllHsFilesAsTargets cpIn >>= removeFileWithMain >>=removeFileWithTemplateHaskell) cfFlList             modSummaries <- getModuleGraph             mapM getModuleMapping modSummaries -  return modMaps +-- | Compile, load and run the given function+runFunction :: RunnableFunction -> Shaker IO()+runFunction (RunnableFunction funModuleName fun) = do+  cpList <- asks compileInputs +  let cpIn = mergeCompileInputsSources cpList+  cfFlList <- lift $ constructCompileFileList cpIn+  dynFun <- lift $ runGhc (Just libdir) $ do+         _ <- ghcCompile $ runReader (setAllHsFilesAsTargets cpIn >>= removeFileWithMain ) cfFlList+         configureContext funModuleName+         value <- compileExpr fun+         do let value' = unsafeCoerce value :: a+            return value'+  _ <- lift dynFun+  return () +  where +        configureContext [] = getModuleGraph >>= \mGraph ->  setContext [] $ map ms_mod mGraph+        configureContext imports = mapM (\a -> findModule (mkModuleName a)  Nothing ) imports >>= \m -> setContext [] m+ -- | 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+  let props = getQuickCheckFunction mayModuleInfo+  let hunits = getHunitFunctions mayModuleInfo   return $ ModuleMapping modName hunits props   where modName = (moduleNameString . moduleName . ms_mod) modSum                -getQuickcheckFunction :: Maybe ModuleInfo -> [String]-getQuickcheckFunction = getFunctionWithPredicate ("prop_" `isPrefixOf`) +getQuickCheckFunction :: Maybe ModuleInfo -> [String]+getQuickCheckFunction = getFunctionNameWithPredicate ("prop_" `isPrefixOf`)   getHunitFunctions :: Maybe ModuleInfo -> [String]-getHunitFunctions = getFunctionWithPredicate ("test" `isPrefixOf`) +getHunitFunctions = getFunctionTypeWithPredicate (== "Test.HUnit.Base.Test")  -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 +getFunctionTypeWithPredicate :: (String -> Bool) -> Maybe ModuleInfo -> [String]+getFunctionTypeWithPredicate _ Nothing = []+getFunctionTypeWithPredicate predicat (Just modInfo) = map snd $ filter ( predicat . fst)  typeList+   where idList = getIdList modInfo+         typeList = map ((showPpr . idType) &&& getFunctionNameFromId ) idList  +getFunctionNameWithPredicate :: (String -> Bool) -> Maybe ModuleInfo -> [String]+getFunctionNameWithPredicate _ Nothing = []+getFunctionNameWithPredicate predicat (Just modInfo) = filter predicat nameList+   where idList = getIdList modInfo+         nameList = map getFunctionNameFromId idList ++getFunctionNameFromId :: Id -> String+getFunctionNameFromId = occNameString . nameOccName . varName++getIdList :: ModuleInfo -> [Id]+getIdList modInfo = mapMaybe tyThingToId $ modInfoTyThings modInfo+ tyThingToId :: TyThing -> Maybe Id tyThingToId (AnId tyId) = Just tyId tyThingToId _ = Nothing+ ++getQuickCheckProperty :: [ModuleMapping] -> [Exp]+getQuickCheckProperty = concatMap getQuickCheckProperty'++getQuickCheckProperty' :: ModuleMapping -> [Exp]+getQuickCheckProperty' modMap = map getSingleQuickCheck $ cfPropName modMap++getSingleQuickCheck :: String -> Exp+getSingleQuickCheck propName = InfixE (Just printName) (VarE $ mkName ">>") (Just quickCall)+  where quickCall = (AppE (VarE $ mkName "quickCheck" ) . VarE . mkName) propName+        printName = AppE (VarE $ mkName "putStrLn") (LitE (StringL propName)) ++getHunit :: [ModuleMapping] -> [Exp]+getHunit = concatMap getHunit'++getHunit' :: ModuleMapping -> [Exp]+getHunit' modMap = map (VarE . mkName) $ cfHunitName modMap++-- | List the quickeck properties of the project.+-- see "Shaker.TestTH"+listProperties :: ShakerInput -> ExpQ+listProperties shIn = do+  modMaps <- runIO $ runReaderT runReflexivite shIn+  return $ ListE $ getQuickCheckProperty modMaps++-- | List all test case of the project.+-- see "Shaker.TestTH"+listHunit :: ShakerInput -> ExpQ+listHunit shIn = do +  modMaps <- runIO $ runReaderT runReflexivite shIn+  return $ ListE $ getHunit modMaps
src/Shaker/Regex.hs view
@@ -1,10 +1,22 @@-module Shaker.Regex-where+-- | Allow to filter a list of string with include and exclude patterns+module Shaker.Regex(+  processListWithRegexp+) where  import Text.Regex.Posix import Data.List -processListWithRegexp :: [String] -> [String] -> [String] -> [String]+-- | Filter all elements matching include patterns and +-- remove all elements matching exclude patterns to the result.+-- +-- If no include pattern is given, all elements are accepted minus those matching exclude patterns.+--+-- If no exclude pattern is given, all elements matching include patterns are taken.+processListWithRegexp :: +  [String] -- ^ Initial list to filter+  -> [String] -- ^ include patterns (regex)+  -> [String] -- ^ exclude patterns (regex)+  -> [String] -- ^ List with all elements matching include patterns minus all elements matching exclude patterns processListWithRegexp list [] [] = list processListWithRegexp list ignore [] = nub $ list \\ getExcluded list ignore  processListWithRegexp list [] include = nub $ getIncluded list include
src/Shaker/SourceHelper.hs view
@@ -1,4 +1,16 @@-module Shaker.SourceHelper+-- | Utilities function for compilation and haskell file management+module Shaker.SourceHelper(+  -- * Compile input management+  CompileFile(..)+  ,mergeCompileInputsSources+  ,constructCompileFileList+  -- * Target files filtering+  ,setAllHsFilesAsTargets+  ,removeFileWithMain+  ,removeFileWithTemplateHaskell+  -- * GHC Compile management+  ,ghcCompile+)  where  import GHC@@ -15,7 +27,6 @@   ,cfHasTH :: Bool  } deriving Show --- * Compile input management  -- | Build the list of haskell source files located in  -- CompileInput source dirs@@ -39,13 +50,6 @@   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@@ -55,8 +59,7 @@ -- | Change the dynflags with information from the CompileInput like importPaths  -- and .o and .hi directory configureDynFlagsWithCompileInput :: CompileInput -> DynFlags -> DynFlags -configureDynFlagsWithCompileInput cpIn dflags = do -  dflags{+configureDynFlagsWithCompileInput cpIn dflags = dflags{     importPaths = sourceDirs     ,objectDir = Just compileTarget     ,hiDir = Just compileTarget@@ -68,7 +71,6 @@ getFileListenInfoForCompileInput cpIn =   map (\a -> FileListenInfo a defaultExclude defaultHaskellPatterns) (cfSourceDirs cpIn) --- * Target files filtering  removeFileWithTemplateHaskell :: CompileInput ->CompileR CompileInput removeFileWithTemplateHaskell = removeFileWithPredicate cfHasTH@@ -83,8 +85,9 @@   return $ cpIn {cfTargetFiles =  targets \\ toRemove}   where targets = cfTargetFiles cpIn --- * GHC Compile management +-- | Configure and load targets of compilation. +-- It is possible to exploit the compilation result after this step. ghcCompile :: GhcMonad m => CompileInput -> m SuccessFlag ghcCompile cpIn@(CompileInput _ _ _ procFlags strflags targetFiles) = do         dflags <- getSessionDynFlags
src/Shaker/TestTH.hs view
@@ -1,28 +1,27 @@-{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-}-+-- | Allow to dynamically construct a list of +-- quickcheck properties and Hunit test with template haskell 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+-- | Template for the list of quickcheck properties.+-- Currently generate a list of type [IO()] containing+--+-- /[putStrLn "prop_1" >> quickCheck prop_1, ...]/+thListProperties :: ExpQ +thListProperties = do+  shIn <-runIO defaultCabalInput+  listProperties shIn -listHunit :: ExpQ -listHunit = undefined+-- | Template for the list of hunit tests.+-- Currently generate a list of type [Test] containing+--+-- /[test1, test2]/+thListHunit :: ExpQ +thListHunit = do +  shIn <-runIO defaultCabalInput+  listHunit shIn
src/Shaker/Type.hs view
@@ -1,3 +1,4 @@+-- | Aggregate all types and data used through shaker module Shaker.Type  where @@ -6,7 +7,12 @@ import Control.Monad.Reader import System.Time(ClockTime) +-- | Environnement containing the project configuration.+-- It is generated at startup and won't change type Shaker  = ReaderT ShakerInput +-- | Environnement for the project compilation+-- This environnement can change depending on the compile +-- action called type CompileM = Reader CompileInput  -- | Duration define the life span of an action@@ -15,18 +21,26 @@ 	| Continuous-- ^Execute the action when a source file modification is done until it is stopped 	deriving (Show,Eq) --- | Action represents the differents actions realisable by shaker+-- | Action represents the differents action with arguments data Action = +  Action ShakerAction+  | ActionWithArg ShakerAction String+  deriving (Show,Eq,Ord)++-- | ShakerAction represents the differents actions realisable by shaker+data ShakerAction =  	Compile -- ^ Compile sources with ghc 	| FullCompile -- ^ Compile all hs sources with ghc 	| QuickCheck -- ^ Execute quickcheck properties+	| HUnit -- ^ Execute hunit tests 	| Help -- ^ Display the help+        | Execute -- ^ Execute a command 	| Quit -- ^ Exit shaker 	| Clean -- ^ Delete generated    deriving (Show,Eq,Ord)  -- | Command agregate a duration with an action-data Command = Command Duration [Action]+data Command = Command Duration [Action]    deriving (Show,Eq)  -- | Represents the global configuration of the system@@ -35,6 +49,7 @@   ,listenerInput :: ListenerInput   ,pluginMap :: PluginMap   ,commandMap :: CommandMap+  ,argument :: Maybe String }    -- | Configuration flags to pass to the ghc compiler@@ -70,9 +85,9 @@   deriving (Show,Eq)    -- | Represents the mapping beetween an action and the function to execute-type PluginMap = M.Map Action Plugin+type PluginMap = M.Map ShakerAction Plugin -- | Represents the mapping between the command-line input and the action-type CommandMap = M.Map String Action +type CommandMap = M.Map String ShakerAction  -- | Represents an action of shaker type Plugin = Shaker IO() @@ -110,8 +125,10 @@     ,delay = 2000000     } +-- | Default haskell file pattern : *.hs defaultHaskellPatterns :: [String] defaultHaskellPatterns = [".*\\.hs$"] +-- | Default exclude pattern : Setup.hs defaultExclude :: [String] defaultExclude =  [".*Setup\\.hs$"]
− testsuite/tests/RunTest.hs 
@@ -1,58 +0,0 @@-module Main- where-import Shaker.Cabal.CabalInfoTest-import Shaker.Action.CompileTest-import Shaker.CliTest-import Shaker.ListenerTest-import Shaker.ParserTest-import Shaker.RegexTest-import Shaker.IoTest-import Test.QuickCheck-import Test.HUnit-import Control.Monad.Trans--main :: IO()-main = do -  mapM_ liftIO propLists-  mapM_ liftIO testLists--propLists :: [IO()]-propLists =[ -    putStrLn "prop_completeWord ">> quickCheck prop_completeWord,-    putStrLn "prop_partialWords ">> quickCheck prop_partialWords,-    putStrLn "prop_completeMultipleWords ">> quickCheck prop_completeMultipleWords,-    putStrLn "prop_partialMultipleWords ">> quickCheck prop_partialMultipleWords,-    putStrLn "prop_listFiles ">> quickCheck prop_listFiles,-    putStrLn "prop_listFilesWithIgnoreAll ">> quickCheck prop_listFilesWithIgnoreAll,-    putStrLn "prop_listFilesWithIgnore ">> quickCheck prop_listFilesWithIgnore,-    putStrLn "prop_listFilesWithIncludeAll ">> quickCheck prop_listFilesWithIncludeAll,-    putStrLn "prop_listModifiedFiles ">> quickCheck prop_listModifiedFiles,-    putStrLn "prop_listCreatedFiles ">> quickCheck prop_listCreatedFiles,-    putStrLn "prop_listModifiedAndCreatedFiles ">> quickCheck prop_listModifiedAndCreatedFiles,-    putStrLn "prop_updateFileStat ">> quickCheck prop_updateFileStat,-    putStrLn "prop_schedule ">> quickCheck prop_schedule,-    putStrLn "prop_listen ">> quickCheck prop_listen,-    putStrLn "prop_parseDefaultAction ">> quickCheck prop_parseDefaultAction,-    putStrLn "prop_parseCommand ">> quickCheck prop_parseCommand,-    putStrLn "prop_filterListAll ">> quickCheck prop_filterListAll,-    putStrLn "prop_filterListNone ">> quickCheck prop_filterListNone,-    putStrLn "prop_filterListPartial ">> quickCheck prop_filterListPartial,-    putStrLn "prop_includeAll ">> quickCheck prop_includeAll,-    putStrLn "prop_getIncludedAll_all ">> quickCheck prop_getIncludedAll_all,-    putStrLn "prop_getIncludedAll_none ">> quickCheck prop_getIncludedAll_none-  ]--testLists :: [IO Counts]-testLists = [-   putStrLn "testRunCompileProject" >> runTestTT testRunCompileProject,-   putStrLn "testParseCabalConfig " >> runTestTT testParseCabalConfig ,-   putStrLn "testInvalidMainShouldBeExcluded " >> runTestTT testInvalidMainShouldBeExcluded ,-   putStrLn "testCompileWithLocalSource " >> runTestTT testCompileWithLocalSource ,-   putStrLn "testProjectCabalContentWithLocalSource " >> runTestTT testProjectCabalContentWithLocalSource ,-   putStrLn "testRecurseListFiles " >> runTestTT testRecurseListFiles ,-   putStrLn "testListFiles " >> runTestTT testListFiles ,-   putStrLn "testListHsFiles " >> runTestTT testListHsFiles ,-   putStrLn "testIsFileContainingMain " >> runTestTT testIsFileContainingMain ,-   putStrLn "testIsFileNotContainingMain " >> runTestTT testIsFileNotContainingMain -  ]-
testsuite/tests/RunTestTH.hs view
@@ -1,25 +1,31 @@-{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-}-module RunTestTH+{-# LANGUAGE TemplateHaskell #-}+module Main  where  import Test.HUnit import Control.Monad.Trans--- import Shaker.TestTH--- import Test.QuickCheck+import Shaker.TestTH+import Test.QuickCheck+import Shaker.Cabal.CabalInfoTest+import Shaker.Action.CompileTest+import Shaker.CliTest+import Shaker.ListenerTest+import Shaker.ParserTest+import Shaker.RegexTest+import Shaker.IoTest+import Shaker.ReflexiviteTest+import Shaker.SourceHelperTest -runAll :: IO()-runAll = do +main :: IO()+main = do    mapM_ liftIO propLists-  mapM_ liftIO testLists+  _ <- testLists+  return ()   propLists :: [IO()]-propLists = []---propLists = $(listProperties)-  --  putStrLn "prop_completeWord ">> quickCheck prop_completeWord,-  +propLists = $(thListProperties) -testLists :: [IO Counts]-testLists = [-  -- putStrLn "testRunCompileProject" >> runTestTT testRunCompileProject,-  ]+testLists :: IO Counts+testLists = runTestTT  $ TestList $(thListHunit)+
testsuite/tests/Shaker/Action/CompileTest.hs view
@@ -4,23 +4,21 @@ import Shaker.Action.Compile import Test.HUnit import System.Directory-import Shaker.Config  import Control.Monad.Reader-import Shaker.Type+import Shaker.CommonTest     testRunCompileProject :: Test testRunCompileProject = TestCase $ -  runReaderT runCompile  testInputShaker  >> +  runReaderT runCompile  testShakerInput >>    getDirectoryContents "target/Shaker" >>= \cont ->   doesFileExist "target/Shaker/Action/CompileTest.o" >>= \ex ->   doesFileExist "target/Shaker/Action/CompileTest.hi" >>= \ex2 ->   assertBool ("File .o and hi should exists "++ show cont) (ex && ex2) -testInputShaker :: ShakerInput-testInputShaker = defaultInput {-  compileInputs = [defaultCompileInput {-       cfCommandLineFlags = ["-package ghc"]-     }]-}+testRunFullCompile :: Test +testRunFullCompile = TestCase $ do+  runReaderT runFullCompile testShakerInput+  cont <- getDirectoryContents "target/Shaker" +  ex <- doesFileExist "target/Shaker/Conductor.o" +  assertBool ("Conductor.o should exist, got "++show cont) ex -
testsuite/tests/Shaker/Cabal/CabalInfoTest.hs view
@@ -4,7 +4,7 @@ import Control.Monad.Reader import System.Directory import Shaker.Action.Compile-import Shaker.Action.Clean+import Shaker.Action.Standard import Shaker.Type import Shaker.CommonTest import Test.HUnit
testsuite/tests/Shaker/CliTest.hs view
@@ -10,10 +10,13 @@ import Shaker.Properties() import System.Console.Haskeline.Completion -instance Arbitrary Action where+instance Arbitrary ShakerAction where   arbitrary = elements [Compile,Quit,Help] -data ActionInt = ActionInt Action Int+instance Arbitrary Action where+  arbitrary = Action `liftM` arbitrary++data ActionInt = ActionInt ShakerAction Int   deriving (Show) instance Arbitrary ActionInt where   arbitrary = ActionInt `liftM` arbitrary
testsuite/tests/Shaker/CommonTest.hs view
@@ -5,6 +5,7 @@ import Test.HUnit import Control.Exception import Shaker.Type+import Shaker.Config  runTestOnDirectory :: FilePath -> Assertion -> Assertion runTestOnDirectory fp fun = do@@ -21,4 +22,12 @@   ,cfCommandLineFlags =[]   ,cfTargetFiles = [] }++testShakerInput :: ShakerInput+testShakerInput = defaultInput {+  compileInputs = [defaultCompileInput {+       cfCommandLineFlags = ["-package ghc"]+     }]+}+
testsuite/tests/Shaker/IoTest.hs view
@@ -18,7 +18,7 @@ abstractTestListFiles fli predicat = monadicIO action   where action = do                lstFile <- run $ listFiles fli{ignore= []}-               r <- run $listFiles fli+               r <- run $ listFiles fli                assert $ predicat lstFile r   prop_listFiles :: FileListenInfo -> Property@@ -80,5 +80,8 @@   res <- isFileContainingMain "src/Shaker/Config.hs"   assertBool "File Config.hs should not contain main methods" $ not res -+testIsFileConductorNotContainingMain :: Test+testIsFileConductorNotContainingMain = TestCase $ do+  res <- isFileContainingMain "src/Shaker/Conductor.hs"+  assertBool "File Config.hs should not contain main methods" $ not res
testsuite/tests/Shaker/ParserTest.hs view
@@ -7,9 +7,10 @@ import Shaker.Config import Shaker.PluginConfig import Data.Map (toList)+import Data.Char   prop_parseDefaultAction :: String -> Bool-prop_parseDefaultAction act = res == Command OneShot [Help]+prop_parseDefaultAction act = res == Command OneShot [Action Help]   where res = parseCommand defaultInput ('x' :act )  prop_parseCommand :: CommandString -> Bool@@ -23,6 +24,7 @@         comStr :: String          ,command::Command  } deriving (Show)+ -- | Action paired with expected string to be parsed data ActionString = ActionString {        cfActionStr :: String @@ -30,7 +32,14 @@ } deriving (Show)  instance Arbitrary ActionString where-  arbitrary = elements $ map (uncurry ActionString) (toList defaultCommandMap)+  arbitrary = do +        str <- listOf $ elements ['a'..'p'] +        proc str +        where proc "" = elements $ map (\(key,value) -> ActionString key (Action value)) (toList defaultCommandMap)+              proc str = elements $ map (\(key,value) -> ActionString (key ++ " " ++ trim str) (ActionWithArg value str)  ) (toList defaultCommandMap)++trim :: String -> String+trim = reverse . dropWhile isSpace . reverse  instance Arbitrary CommandString where   arbitrary = do
testsuite/tests/Shaker/ReflexiviteTest.hs view
@@ -4,27 +4,43 @@ import Shaker.Reflexivite import Test.HUnit import Data.List-import Shaker.Config  import Control.Monad.Reader-import Shaker.Type+import Shaker.CommonTest+import System.Directory  testRunReflexivite ::Test testRunReflexivite = TestCase $ do-  modMapLst <- runReaderT runReflexivite testInputShaker +  modMapLst <- runReaderT runReflexivite testShakerInput   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+  any ( \(ModuleMapping nm _ _) -> nm == "Shaker.ReflexiviteTest") modMapLst @? +    "Should have module Shaker.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+  let (Just reflexiviteModMap)  = find (\(ModuleMapping nm _ _) -> nm == "Shaker.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"]-     }]-}+  not ( any (== "testShakerInput") (cfHunitName reflexiviteModMap) ) @? "Should not contain function testShakerInput, got "+    ++ show (cfHunitName reflexiviteModMap)+  not (any (\a ->cfModuleName a == "Shaker.RunTestTH") modMapLst) @? "Should have excluded RunTestTH, got " ++ show modMapLst++aFun :: String -> IO ()+aFun tempFp = do+  exist <- doesDirectoryExist tempFp+  proc exist tempFp            +  where proc True fp = removeDirectory fp >> createDirectory fp+        proc _ fp = createDirectory fp++testRunFunction :: Test+testRunFunction = templateTestRunFunction ["Shaker.ReflexiviteTest"]++testRunFunctionWithEmptyModule :: Test+testRunFunctionWithEmptyModule = templateTestRunFunction [] ++templateTestRunFunction :: [String] -> Test +templateTestRunFunction modules= TestCase $ do +  tempFp <- getTemporaryDirectory >>= \a -> return $ a++"/testSha"+  let run = RunnableFunction modules $ "aFun " ++ show tempFp+  runReaderT (runFunction run) testShakerInput +  doesDirectoryExist tempFp @? "Directory /tmp/testSha should have been created"
testsuite/tests/Shaker/RegexTest.hs view
@@ -16,9 +16,3 @@ prop_includeAll :: [String] -> Bool prop_includeAll list = processListWithRegexp list [] [".*"] == nub list -prop_getIncludedAll_all :: [String] -> Bool-prop_getIncludedAll_all list = getIncluded list [".*"] == list--prop_getIncludedAll_none :: [String] -> Bool-prop_getIncludedAll_none list = getIncluded list [] == []-
+ testsuite/tests/Shaker/SourceHelperTest.hs view
@@ -0,0 +1,29 @@+module Shaker.SourceHelperTest+ where++import Test.HUnit+import Shaker.SourceHelper+import Shaker.Type+import Shaker.CommonTest+import Data.List+import Control.Monad.Reader++testConstructCompileFileList :: Test+testConstructCompileFileList = TestCase $ runTestOnDirectory "testsuite/tests/resources/cabalTest" $ do +  let cpIn = initializeEmptyCompileInput {cfSourceDirs = ["src"]}+  fileList <- constructCompileFileList cpIn +  any (\cpFl -> "Main.hs" `isSuffixOf` cfFp cpFl && cfHasMain cpFl) fileList @? "Should have one main file, got " ++ show fileList+  any (\cpFl -> "CabalTest.hs" `isSuffixOf` cfFp cpFl && (not . cfHasMain) cpFl) fileList @? "Should have one main file, got " ++ show fileList++testConstructConductorCompileFileList :: Test+testConstructConductorCompileFileList = TestCase $ do+  list <- constructCompileFileList defaultCompileInput +  let (Just cpFile) = find (\a ->  "Conductor.hs" `isSuffixOf` cfFp a ) list+  not (cfHasMain cpFile) && not (cfHasTH cpFile) @? "Should have conductor in list, got " ++ show cpFile++testCompileInputConstruction :: Test+testCompileInputConstruction = TestCase $ do+  list <- constructCompileFileList defaultCompileInput +  let newCpIn = runReader (setAllHsFilesAsTargets defaultCompileInput >>= removeFileWithMain >>= removeFileWithTemplateHaskell ) list+  any (\a -> "Conductor.hs" `isSuffixOf` a) (cfTargetFiles newCpIn) @?"Should have conductor in list, got " ++ show (cfTargetFiles newCpIn)+