arion 0.1.0.7 → 0.1.0.8
raw patch · 5 files changed
+133/−82 lines, 5 files
Files
- arion.cabal +1/−1
- src/Arion/EventProcessor.hs +27/−23
- src/Arion/Runner.hs +65/−31
- src/Arion/Types.hs +22/−15
- src/Arion/Utilities.hs +18/−12
arion.cabal view
@@ -1,5 +1,5 @@ name: arion-version: 0.1.0.7+version: 0.1.0.8 synopsis: Watcher and runner for Hspec description: Watcher and runner for Hspec license: MIT
src/Arion/EventProcessor.hs view
@@ -1,31 +1,35 @@ {-# LANGUAGE OverloadedStrings #-} module Arion.EventProcessor (- processEvent+ processEvent, respondToEvent ) where -import Arion.Types-import System.FSNotify (Event(..))-import Filesystem.Path.CurrentOS (encodeString)-import Data.List (isSuffixOf)-import qualified Data.Map as M-import Arion.Help+import Arion.Types+import Control.Applicative ((<$>))+import Data.List (isSuffixOf)+import Data.List (nub)+import qualified Data.Map as M+import Data.Maybe (fromMaybe)+import Filesystem.Path (FilePath)+import Filesystem.Path.CurrentOS (encodeString)+import Prelude hiding (FilePath)+import System.FSNotify (Event (..)) -processEvent :: SourceTestMap -> String -> String -> Event -> [Command]-processEvent sourceToTestFileMap sourceFolder testFolder (Modified filePath _) = commands sourceToTestFileMap sourceFolder testFolder (encodeString filePath)-processEvent sourceToTestFileMap sourceFolder testFolder (Added filePath _) = commands sourceToTestFileMap sourceFolder testFolder (encodeString filePath)-processEvent _ _ _ _ = [] -commands :: SourceTestMap -> String -> String -> FilePath -> [Command]-commands sourceToTestFileMap sourceFolder testFolder filePath- | isSuffixOf "hs" filePath = let fileType = typeOf filePath- commandCandidates = case fileType of- Source -> let testFiles = M.lookup filePath sourceToTestFileMap- in toCommandCandidates testFiles- Test -> [filePath]- in Echo (filePath ++ " changed") : map (CabalExec . RunHaskell sourceFolder testFolder ) commandCandidates- | otherwise = [] -toCommandCandidates :: Maybe [TestFile] -> [String]-toCommandCandidates (Just testFiles) = map testFilePath testFiles-toCommandCandidates Nothing = [""]+respondToEvent (Modified filePath time) = Just (filePath,time)+respondToEvent (Added filePath time) = Just (filePath,time)+respondToEvent _ = Nothing +-- commands :: SourceTestMap -> String -> String -> (FilePath,a) -> [Command]+processEvent :: M.Map String [TestFile] -> String -> String -> (FilePath, t) -> [Command]+processEvent sourceToTestFileMap sourceFolder testFolder (filePath,_)+ | isSuffixOf "hs" encodedFilePath =+ let fileType = typeOf encodedFilePath+ commandCandidates = case fileType of+ Source -> nub . map testFilePath . fromMaybe []+ $ M.lookup encodedFilePath sourceToTestFileMap+ Test -> [encodedFilePath]+ in Echo (encodedFilePath ++ " changed") :+ map (RunHaskell sourceFolder testFolder ) commandCandidates+ | otherwise = []+ where encodedFilePath = encodeString filePath
src/Arion/Runner.hs view
@@ -1,25 +1,29 @@+{-# LANGUAGE ScopedTypeVariables, TupleSections #-} module Arion.Runner( run ) where -import System.FSNotify (watchTree, withManager, WatchManager, Event)-import Data.Text (pack)-import Filesystem.Path.CurrentOS (fromText)-import System.Process (callCommand)-import Control.Monad (mapM_)-import System.FilePath.Find (find, always, extension, (==?), (||?))-import Control.Concurrent (threadDelay)-import Control.Monad (forever, void)-import Control.Exception (try, SomeException)-import Control.Concurrent (forkIO)-import System.Directory (canonicalizePath)-import Control.Applicative ((<$>))-import Control.Monad ((=<<))--import Arion.Types-import Arion.EventProcessor-import Arion.Utilities-import Arion.Help+import Arion.EventProcessor+import Arion.Help+import Arion.Types+import Arion.Utilities+import Control.Applicative ((<$>))+import Control.Concurrent (MVar, newEmptyMVar, putMVar,+ takeMVar, threadDelay)+import Control.Exception (SomeException, bracket_, try)+import Control.Monad (forever, void)+import Control.Monad (join)+import Data.IORef (IORef, atomicModifyIORef', newIORef)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Text (pack)+import Filesystem.Path.CurrentOS (fromText)+import System.Directory (canonicalizePath)+import System.FilePath.Find (always, extension, find, (==?),+ (||?))+import System.FSNotify (WatchManager, watchTree,+ withManager)+import System.Process (callCommand) run :: [String] -> IO () run args@@ -30,14 +34,19 @@ startWatching :: String -> String -> String -> WatchManager -> IO () startWatching path sourceFolder testFolder manager = do- sourceFilePathAndContent <- mapM filePathAndContent =<< findHaskellFiles sourceFolder- testFilePathAndContent <- mapM filePathAndContent =<< findHaskellFiles testFolder- let sourceFiles = map (uncurry toSourceFile) sourceFilePathAndContent- let testFiles = map (uncurry toTestFile) testFilePathAndContent- let sourceToTestFileMap = associate sourceFiles testFiles- _ <- watchTree manager (fromText $ pack path) (const True) (eventHandler sourceToTestFileMap sourceFolder testFolder)- forever $ threadDelay maxBound+ sourceFiles <- mapM (\x -> uncurry toSourceFile <$> filePathAndContent x)+ =<< findHaskellFiles sourceFolder+ testFiles <- mapM (\x -> uncurry toTestFile <$> filePathAndContent x)+ =<< findHaskellFiles testFolder + let sourceToTestFileMap = associate sourceFiles testFiles++ lock <- newEmptyMVar+ inProgress <- newIORef Map.empty+ _ <- watchTree manager (fromText $ pack path) (const True)+ (eventHandler lock inProgress (processEvent sourceToTestFileMap sourceFolder testFolder) . respondToEvent)+ forever $ threadDelay maxBound+ filePathAndContent :: String -> IO (FilePath, FileContent) filePathAndContent relativePath = do canonicalizedPath <- canonicalizePath relativePath@@ -47,10 +56,35 @@ findHaskellFiles :: String -> IO [String] findHaskellFiles = find always (extension ==? ".hs" ||? extension ==? ".lhs") -eventHandler :: SourceTestMap -> String -> String -> Event -> IO ()-eventHandler sourceToTestFileMap sourceFolder testFolder event = let commands = processEvent sourceToTestFileMap sourceFolder testFolder event- in mapM_ executeCommand commands+-- 10th of a sec? seems ok.+dELAY = 100000 -executeCommand :: Command -> IO ()-executeCommand command = let process = (try . callCommand) (show command) :: IO (Either SomeException ())- in void $ forkIO $ process >> return ()+-- eventHandler :: Show a => MVar () -> IORef (Map Command ()) -> (a+ -- -> [Command]) -> a -> IO ()+eventHandler lock inProgress handler Nothing = return ()+eventHandler lock inProgress handler (Just (fp,time)) = do+ commands <- join $ atomicModifyIORef' inProgress+ (\running -> case Map.lookup fp running of+ Just _ -> (running,return [])+ Nothing -> (Map.insert fp () running,+ do threadDelay dELAY+ atomicModifyIORef' inProgress+ (\hash -> (Map.delete fp hash,+ ()))+ return $ handler (fp,time)+ ))++ mapM_ (runCommand lock) commands++runCommand :: Show a => MVar () -> a -> IO ()+runCommand lock command = do+ bracket_ (putMVar lock ())+ (takeMVar lock)+ (noisyTry (callCommand $ show command))++noisyTry :: IO () -> IO ()+noisyTry f = do+ (x :: Either SomeException ()) <- try f+ case x of+ Left y -> print ("error", y)+ _ -> return ()
src/Arion/Types.hs view
@@ -10,33 +10,34 @@ typeOf ) where -import Data.List (isInfixOf)-import Data.List.Split (splitOn)-import Text.Regex.Posix ((=~), getAllTextMatches)-import Data.Map (Map)+import Data.List (isInfixOf)+import Data.List.Split (splitOn)+import Data.Map (Map)+import Data.Maybe (mapMaybe)+import Text.Regex.Posix (getAllTextMatches, (=~)) data Command = RunHaskell { sourceFolder :: String, testFolder :: String, commandString :: String } |- Echo String |- CabalExec { command :: Command } deriving (Eq)+ Echo String+ deriving (Eq,Ord) instance Show Command where- show (RunHaskell sourceFolder testFolder commandString) = "runhaskell -- -i" ++ sourceFolder ++ " -i" ++ testFolder ++ " " ++ commandString+ show (RunHaskell sourceFolder testFolder commandString) = "cabal exec runhaskell -- -i" ++ sourceFolder ++ " -i" ++ testFolder ++ " " ++ commandString show (Echo stringToEcho) = "echo " ++ stringToEcho- show (CabalExec command) = "cabal exec " ++ show command + type FileContent = String type SourceTestMap = Map FilePath [TestFile] -data SourceFile = SourceFile { - sourceFilePath :: String,- moduleName :: String,+data SourceFile = SourceFile {+ sourceFilePath :: String,+ moduleName :: String, importedModules :: [String] } deriving (Eq, Ord, Show) -data TestFile = TestFile { +data TestFile = TestFile { testFilePath :: String,- imports :: [String]+ imports :: [String] } deriving (Eq, Ord, Show) data FileType = Source | Test@@ -63,10 +64,16 @@ } getImports :: FileContent -> [String]-getImports fileContent = let importLines = getAllTextMatches $ fileContent =~ "import.*" :: [String]- imports = map ((\(_:x:_) -> x) . filter (not . (`elem` ["","qualified"])) . splitOn " ") importLines+getImports fileContent = let importLines = getAllTextMatches $ fileContent =~ "^import .*" :: [String]+ imports = mapMaybe (getSecond . filter (not . (`elem` ["","qualified"])) . splitOn " ") importLines in imports ++getSecond (_:x:_) = Just x+getSecond _ = Nothing++-- this is just wrong - we can't always find a module in a file.+-- need to rework to propagate Maybe up through toSourceFile etc. getModuleName :: FileContent -> String getModuleName fileContent = let moduleLine = fileContent =~ "(module\\s+.*\\s+.*)" :: String (_:moduleName:_)= splitOn " " moduleLine
src/Arion/Utilities.hs view
@@ -3,29 +3,35 @@ dependencies ) where -import Arion.Types-import Data.Map (Map, fromList)-import Data.List (union)+import Arion.Types+import Data.List (nub, sort, union)+import Data.Map (Map, fromList) associate :: [SourceFile] -> [TestFile] -> Map FilePath [TestFile] associate sourceFiles testFiles = let sourcesAndDependencies = dependencies sourceFiles in fromList $ map (\(source, dependencies) ->- let testFilesFor source = filter (\testFile -> moduleName source `elem` imports testFile) testFiles + let testFilesFor source = filter (\testFile -> moduleName source `elem` imports testFile) testFiles testFilesForSource = testFilesFor source testFilesForDependencies = concatMap testFilesFor dependencies in (sourceFilePath source, testFilesForSource ++ testFilesForDependencies) ) sourcesAndDependencies dependencies :: [SourceFile] -> [(SourceFile, [SourceFile])]-dependencies [] = []-dependencies sourceFiles = map (\file -> let dependencies = transitiveDependencies sourceFiles (importedModules file)- in (file, dependencies)- ) sourceFiles+dependencies sourceFiles = map (\file -> let dependencies = transitiveDependencies sourceFiles [] file+ in (file, nub $ (filter ((/=) file) dependencies))+ ) sourceFiles -transitiveDependencies :: [SourceFile] -> [String] -> [SourceFile]-transitiveDependencies sourceFiles [] = []-transitiveDependencies sourceFiles imports = let sourcesForImports = concatMap (findSourcesByModule sourceFiles) imports- in sourcesForImports ++ concatMap (transitiveDependencies sourceFiles) (map importedModules sourcesForImports)+transitiveDependencies :: [SourceFile] -> [SourceFile] -> SourceFile -> [SourceFile]+transitiveDependencies allSourceFiles sourcesThatIHaveSeenSoFar theSourceFile =+ let sourcesThatImportMe = sourcesThatImport allSourceFiles (moduleName theSourceFile)+ in case any (\source -> source `elem` sourcesThatIHaveSeenSoFar) sourcesThatImportMe of+ True -> sourcesThatImportMe+ False -> let soFar = sourcesThatIHaveSeenSoFar ++ [theSourceFile]+ in sourcesThatImportMe ++ concatMap (transitiveDependencies allSourceFiles soFar) sourcesThatImportMe + findSourcesByModule :: [SourceFile] -> String -> [SourceFile] findSourcesByModule sourceFiles theModuleName = filter (\file -> moduleName file == theModuleName) sourceFiles++sourcesThatImport :: [SourceFile] -> String -> [SourceFile]+sourcesThatImport sourceFiles theModuleName = filter (\file -> theModuleName `elem` (importedModules file)) sourceFiles