arion 0.1.0.0 → 0.1.0.1

raw patch · 6 files changed

+196/−1 lines, 6 files

Files

• arion.cabal +6/−1
• src/Arion/EventProcessor.hs +31/−0
• src/Arion/Help.hs +6/−0
• src/Arion/Runner.hs +52/−0
• src/Arion/Types.hs +80/−0
• src/Arion/Utilities.hs +21/−0

@@ -1,5 +1,5 @@ name:                arion-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Watcher and runner for Hspec description:         Watcher and runner for Hspec license:             PublicDomain@@ -30,6 +30,11 @@                        process >= 1.2.0.0,                        directory,                        transformers+  other-modules:       Arion.Runner,+                       Arion.Types,+                       Arion.EventProcessor,+                       Arion.Help,+                       Arion.Utilities   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -threaded

@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+module Arion.EventProcessor (+    processEvent+) where++import Arion.Types+import System.FSNotify+import Filesystem.Path.CurrentOS (encodeString)+import Data.List (isSuffixOf)+import qualified Data.Map as M+import Arion.Help++processEvent :: SourceTestMap -> Event -> [Command]+processEvent sourceToTestFileMap (Modified filePath _) = commands sourceToTestFileMap (encodeString filePath)+processEvent sourceToTestFileMap (Added filePath _) = commands sourceToTestFileMap (encodeString filePath)+processEvent _ _ = []++commands :: SourceTestMap -> FilePath -> [Command]+commands sourceToTestFileMap 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 RunHaskell commandCandidates+        | otherwise = []++toCommandCandidates :: Maybe [TestFile] -> [String]+toCommandCandidates (Just testFiles) = map testFilePath testFiles+toCommandCandidates Nothing = [""]+

@@ -0,0 +1,6 @@+module Arion.Help (+    usage+) where++usage :: String+usage = "Usage: arion <folder to watch> <folder with source files> <folder with test files>"

@@ -0,0 +1,52 @@+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 ((<$>), liftA2, (<*>))+import Control.Monad ((=<<), liftM2)++import Arion.Types+import Arion.EventProcessor+import Arion.Utilities+import Arion.Help++run :: [String] -> IO ()+run args+    | "--help" `elem` args = putStrLn usage+    | length args >= 3 = let (path:sourceFolder:testFolder:_) = args+                         in withManager (startWatching path sourceFolder testFolder)+    | otherwise = putStrLn "Try arion --help for more information"++startWatching :: String -> String -> String -> WatchManager -> IO ()+startWatching path sourceFolder testFolder manager = let sourceFiles = map (uncurry toSourceFile) <$> (mapM filePathAndContent =<< findHaskellFiles sourceFolder)+                                                         testFiles = map (uncurry toTestFile) <$> (mapM filePathAndContent =<< findHaskellFiles testFolder)+                                                         sourceToTestFileMap = associate <$> sourceFiles <*> testFiles+                                                         watchTreeWithHandler = watchTree manager (fromText $ pack path) (const True)+                                                     in (watchTreeWithHandler =<< (eventHandler <$> sourceToTestFileMap)) >> (forever $ threadDelay maxBound)++filePathAndContent :: String -> IO (FilePath, FileContent)+filePathAndContent relativePath = let canonicalizedPath = canonicalizePath relativePath+                                      content = readFile =<< canonicalizedPath+                                  in liftM2 (,) canonicalizedPath content++findHaskellFiles :: String -> IO [String]+findHaskellFiles = find always (extension ==? ".hs" ||? extension ==? ".lhs")++eventHandler :: SourceTestMap -> Event -> IO ()+eventHandler sourceToTestFileMap event = let commands = processEvent sourceToTestFileMap event+                                         in mapM_ executeCommand commands++executeCommand :: Command -> IO ()+executeCommand command = let process = (try . callCommand) (show command) :: IO (Either SomeException ())+                         in void $ forkIO $ process >> return ()

@@ -0,0 +1,80 @@+module Arion.Types (+    Command(..),+    FileContent,+    SourceTestMap,+    SourceFile(..),+    TestFile(..),+    FileType(..),+    toSourceFile,+    toTestFile,+    typeOf+) where++import Data.List (isInfixOf)+import Data.List.Split (splitOn)+import Text.Regex.Posix+import Data.Map (Map)++data Command = RunHaskell { commandString :: String } | Echo String deriving (Eq)++instance Show Command where+    show (RunHaskell commandString) = "runhaskell -isrc " ++ commandString+    show (Echo stringToEcho) = "echo " ++ stringToEcho++type FileContent = String++type SourceTestMap = Map FilePath [TestFile]++data SourceFile = SourceFile { +    sourceFilePath :: String,+    moduleName :: String,+    importedModules :: [String]+} deriving (Eq, Ord)++data TestFile = TestFile { +    testFilePath :: String,+    imports :: [String]+} deriving (Eq, Ord)++instance Show SourceFile where+    show sourceFile = moduleName sourceFile++instance Show TestFile where+    show testFile = testFilePath testFile++data FileType = Source | Test++typeOf :: String -> FileType+typeOf filePath+       | isInfixOf "Spec" filePath == True = Test+       | otherwise = Source++toSourceFile :: FilePath -> FileContent -> SourceFile+toSourceFile filePath content = let theModuleName = getModuleName content+                                    theImportedModules = getImports content+                                in SourceFile {+                                      sourceFilePath = filePath,+                                      moduleName = theModuleName,+                                      importedModules = theImportedModules+                                   }++toTestFile :: FilePath -> FileContent -> TestFile+toTestFile filePath content = let importLines = getImports content+                                  in TestFile {+                                      testFilePath = filePath,+                                      imports = importLines+                                  }++getImports :: FileContent -> [String]+getImports fileContent = let importLines = getAllTextMatches $ fileContent =~ "import.*" :: [String]+                             imports = map (importedModule . splitOn " ") importLines+                         in imports++importedModule :: [String] -> String+importedModule [_, moduleName] = moduleName+importedModule _ = ""++getModuleName :: FileContent -> String+getModuleName fileContent = let moduleLine = fileContent =~ "(module\\s+.*\\s+where)" :: String+                                [_, moduleName, _] = splitOn " " moduleLine+                            in moduleName

@@ -0,0 +1,21 @@+module Arion.Utilities (+    associate+) where++import Arion.Types+import Data.Map (Map, fromList)+import Data.List++associate :: [SourceFile] -> [TestFile] -> Map FilePath [TestFile]+associate sourceFiles testFiles = let preTransitive = map (createAssociations testFiles) sourceFiles+                                      transitive = map (\(sourceFile, testsAssociatedWithSource) -> let imports = importedModules sourceFile+                                                                                                        testsAssociatedWithImports =+                                                                                                            concatMap snd $ concatMap (\imp -> filter (\(source, tests) -> moduleName source == imp) preTransitive) imports+                                                                                                    in (sourceFilePath sourceFile, testsAssociatedWithSource `union` testsAssociatedWithImports)+                                                       ) preTransitive+                                  in fromList transitive++createAssociations :: [TestFile] -> SourceFile -> (SourceFile, [TestFile])+createAssociations testFiles sourceFile = let associatedTestFiles = filter (\testFile -> moduleName sourceFile `elem` imports testFile) testFiles+                                          in (sourceFile, associatedTestFiles)+