From c2c37e5260abd53a7cfe402df9de9a0d7b22cac2 Mon Sep 17 00:00:00 2001 From: Robert Steuck Date: Fri, 18 Jan 2019 23:05:43 +0100 Subject: [PATCH 1/4] do not traverse ignored directories this prevents crashed due to file permissions --- package.yaml | 3 +++ src/FilteredRecurseDir.hs | 24 ++++++++++++++++++++++++ src/Server.hs | 25 +++++++++++-------------- toodles.cabal | 10 ++++++++-- 4 files changed, 46 insertions(+), 16 deletions(-) create mode 100644 src/FilteredRecurseDir.hs diff --git a/package.yaml b/package.yaml index c604774..9179e1f 100644 --- a/package.yaml +++ b/package.yaml @@ -52,6 +52,7 @@ library: - blaze-html ==0.9.1.1 - cmdargs ==0.10.20 - directory ==1.3.1.5 + - filepath ==1.4.2 - megaparsec ==6.5.0 - regex-posix ==0.95.2 - servant ==0.14.1 @@ -83,6 +84,7 @@ executables: - blaze-html ==0.9.1.1 - cmdargs ==0.10.20 - directory ==1.3.1.5 + - filepath ==1.4.2 - megaparsec ==6.5.0 - regex-posix ==0.95.2 - servant ==0.14.1 @@ -114,6 +116,7 @@ tests: - blaze-html ==0.9.1.1 - cmdargs ==0.10.20 - directory ==1.3.1.5 + - filepath ==1.4.2 - megaparsec ==6.5.0 - regex-posix ==0.95.2 - servant ==0.14.1 diff --git a/src/FilteredRecurseDir.hs b/src/FilteredRecurseDir.hs new file mode 100644 index 0000000..86e61c5 --- /dev/null +++ b/src/FilteredRecurseDir.hs @@ -0,0 +1,24 @@ +module FilteredRecurseDir where + +import System.IO.HVFS +import System.IO.Unsafe +import System.FilePath (pathSeparator) + +recurseFilterDir :: HVFS a => a -> FilePath -> (FilePath -> IO Bool) -> IO [FilePath] +recurseFilterDir fs x pred = recurseFilterDirStat fs x pred >>= return . map fst + +recurseFilterDirStat :: HVFS a => a -> FilePath -> (FilePath -> IO Bool) -> IO [(FilePath, HVFSStatEncap)] +recurseFilterDirStat h fn pred = + do fs <- vGetSymbolicLinkStatus h fn + validFile <- pred fn + putStrLn ("path " ++ (show fn) ++ " is " ++ (if validFile then "valid" else "invalid" )) + if validFile + then if withStat fs vIsDirectory + then do + dirc <- vGetDirectoryContents h fn + let contents = map ((++) (fn ++ [pathSeparator])) $ + filter (\x -> x /= "." && x /= "..") dirc + subdirs <- unsafeInterleaveIO $ mapM (\fn -> recurseFilterDirStat h fn pred) contents + return $ (concat subdirs) ++ [(fn, fs)] + else return [(fn, fs)] + else return [] diff --git a/src/Server.hs b/src/Server.hs index ac947f1..1ce368c 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -10,6 +10,7 @@ import Config import Parse import ToodlesApi import Types +import FilteredRecurseDir import qualified Control.Exception as E import Control.Monad @@ -319,8 +320,8 @@ getAllFiles :: ToodlesConfig -> FilePath -> IO [SourceFile] getAllFiles (ToodlesConfig ignoredPaths _) basePath = E.catch (do putStrLn $ printf "Running toodles for path: %s" basePath - files <- recurseDir SystemFS basePath - let validFiles = filter isValidFile files + files <- recurseFilterDir SystemFS basePath (return . not . ignoreFile) + let validFiles = filter fileHasValidExtension files mapM (\f -> SourceFile f . (map T.pack . lines) <$> @@ -333,20 +334,16 @@ getAllFiles (ToodlesConfig ignoredPaths _) basePath = where - isValidFile :: FilePath -> Bool - isValidFile path = fileHasValidExtension && not ignoreFile + ignoreFile :: FilePath -> Bool + ignoreFile path = + let p = T.pack path + in T.isInfixOf "node_modules" p || T.isSuffixOf "pb.go" p || + T.isSuffixOf "_pb2.py" p || + any (\r -> path =~ r :: Bool) ignoredPaths - where - - fileHasValidExtension :: Bool - fileHasValidExtension = any (\ext -> ext `T.isSuffixOf` T.pack path) (map extension fileTypeToComment) + fileHasValidExtension :: FilePath -> Bool + fileHasValidExtension path = any (\ext -> ext `T.isSuffixOf` T.pack path) (map extension fileTypeToComment) - ignoreFile :: Bool - ignoreFile = - let p = T.pack path - in T.isInfixOf "node_modules" p || T.isSuffixOf "pb.go" p || - T.isSuffixOf "_pb2.py" p || - any (\r -> path =~ r :: Bool) ignoredPaths mapHead :: (a -> a) -> [a] -> [a] mapHead f (x:xs) = f x : xs diff --git a/toodles.cabal b/toodles.cabal index 5bf28e8..3c94308 100644 --- a/toodles.cabal +++ b/toodles.cabal @@ -1,10 +1,10 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.0. +-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack -- --- hash: eca068224b8e938feec8b371e63c8819e81e6d2030806c1f220e08823596b7f7 +-- hash: 3e491112d2297954f078aacab7b353d492a9606c6f58d268655910a4b48ecfce name: toodles version: 1.0.2 @@ -45,6 +45,7 @@ library ToodlesApi Server other-modules: + FilteredRecurseDir Paths_toodles hs-source-dirs: src @@ -56,6 +57,7 @@ library , blaze-html ==0.9.1.1 , cmdargs ==0.10.20 , directory ==1.3.1.5 + , filepath ==1.4.2 , hspec >=2.4.4 , hspec-expectations >=0.8.2 , megaparsec ==6.5.0 @@ -74,6 +76,7 @@ executable toodles main-is: Main.hs other-modules: Config + FilteredRecurseDir Parse Server ToodlesApi @@ -90,6 +93,7 @@ executable toodles , blaze-html ==0.9.1.1 , cmdargs ==0.10.20 , directory ==1.3.1.5 + , filepath ==1.4.2 , hspec >=2.4.4 , hspec-expectations >=0.8.2 , megaparsec ==6.5.0 @@ -109,6 +113,7 @@ test-suite toodles-test main-is: Spec.hs other-modules: Config + FilteredRecurseDir Parse Server ToodlesApi @@ -125,6 +130,7 @@ test-suite toodles-test , blaze-html ==0.9.1.1 , cmdargs ==0.10.20 , directory ==1.3.1.5 + , filepath ==1.4.2 , hspec >=2.4.4 , hspec-expectations >=0.8.2 , megaparsec ==6.5.0 From 5ffb9e1043c3f00466da938275d38e5330786f4d Mon Sep 17 00:00:00 2001 From: Robert Steuck Date: Mon, 21 Jan 2019 08:22:30 +0100 Subject: [PATCH 2/4] fix warnings --- src/FilteredRecurseDir.hs | 8 ++++---- src/Server.hs | 1 - 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/FilteredRecurseDir.hs b/src/FilteredRecurseDir.hs index 86e61c5..3285762 100644 --- a/src/FilteredRecurseDir.hs +++ b/src/FilteredRecurseDir.hs @@ -5,12 +5,12 @@ import System.IO.Unsafe import System.FilePath (pathSeparator) recurseFilterDir :: HVFS a => a -> FilePath -> (FilePath -> IO Bool) -> IO [FilePath] -recurseFilterDir fs x pred = recurseFilterDirStat fs x pred >>= return . map fst +recurseFilterDir fs x p = recurseFilterDirStat fs x p >>= return . map fst recurseFilterDirStat :: HVFS a => a -> FilePath -> (FilePath -> IO Bool) -> IO [(FilePath, HVFSStatEncap)] -recurseFilterDirStat h fn pred = +recurseFilterDirStat h fn p = do fs <- vGetSymbolicLinkStatus h fn - validFile <- pred fn + validFile <- p fn putStrLn ("path " ++ (show fn) ++ " is " ++ (if validFile then "valid" else "invalid" )) if validFile then if withStat fs vIsDirectory @@ -18,7 +18,7 @@ recurseFilterDirStat h fn pred = dirc <- vGetDirectoryContents h fn let contents = map ((++) (fn ++ [pathSeparator])) $ filter (\x -> x /= "." && x /= "..") dirc - subdirs <- unsafeInterleaveIO $ mapM (\fn -> recurseFilterDirStat h fn pred) contents + subdirs <- unsafeInterleaveIO $ mapM (\fn' -> recurseFilterDirStat h fn' p) contents return $ (concat subdirs) ++ [(fn, fs)] else return [(fn, fs)] else return [] diff --git a/src/Server.hs b/src/Server.hs index 1ce368c..e6ac293 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -29,7 +29,6 @@ import Servant import System.Directory import System.IO.HVFS import qualified System.IO.Strict as SIO -import System.Path import System.Path.NameManip import Text.Blaze.Html5 (Html) import qualified Text.Blaze.Html5 as BZ From c55152da32ad16f11c8cbb59a5e3ec2b0131a17b Mon Sep 17 00:00:00 2001 From: Robert Steuck Date: Mon, 21 Jan 2019 08:53:46 +0100 Subject: [PATCH 3/4] use library function instead of custom filter traverse dir --- package.yaml | 6 +++--- src/FilteredRecurseDir.hs | 24 ------------------------ src/Server.hs | 5 ++--- toodles.cabal | 11 ++++------- 4 files changed, 9 insertions(+), 37 deletions(-) delete mode 100644 src/FilteredRecurseDir.hs diff --git a/package.yaml b/package.yaml index 9179e1f..6b70620 100644 --- a/package.yaml +++ b/package.yaml @@ -52,7 +52,7 @@ library: - blaze-html ==0.9.1.1 - cmdargs ==0.10.20 - directory ==1.3.1.5 - - filepath ==1.4.2 + - extra ==1.6.13 - megaparsec ==6.5.0 - regex-posix ==0.95.2 - servant ==0.14.1 @@ -84,7 +84,7 @@ executables: - blaze-html ==0.9.1.1 - cmdargs ==0.10.20 - directory ==1.3.1.5 - - filepath ==1.4.2 + - extra ==1.6.13 - megaparsec ==6.5.0 - regex-posix ==0.95.2 - servant ==0.14.1 @@ -116,7 +116,7 @@ tests: - blaze-html ==0.9.1.1 - cmdargs ==0.10.20 - directory ==1.3.1.5 - - filepath ==1.4.2 + - extra ==1.6.13 - megaparsec ==6.5.0 - regex-posix ==0.95.2 - servant ==0.14.1 diff --git a/src/FilteredRecurseDir.hs b/src/FilteredRecurseDir.hs deleted file mode 100644 index 3285762..0000000 --- a/src/FilteredRecurseDir.hs +++ /dev/null @@ -1,24 +0,0 @@ -module FilteredRecurseDir where - -import System.IO.HVFS -import System.IO.Unsafe -import System.FilePath (pathSeparator) - -recurseFilterDir :: HVFS a => a -> FilePath -> (FilePath -> IO Bool) -> IO [FilePath] -recurseFilterDir fs x p = recurseFilterDirStat fs x p >>= return . map fst - -recurseFilterDirStat :: HVFS a => a -> FilePath -> (FilePath -> IO Bool) -> IO [(FilePath, HVFSStatEncap)] -recurseFilterDirStat h fn p = - do fs <- vGetSymbolicLinkStatus h fn - validFile <- p fn - putStrLn ("path " ++ (show fn) ++ " is " ++ (if validFile then "valid" else "invalid" )) - if validFile - then if withStat fs vIsDirectory - then do - dirc <- vGetDirectoryContents h fn - let contents = map ((++) (fn ++ [pathSeparator])) $ - filter (\x -> x /= "." && x /= "..") dirc - subdirs <- unsafeInterleaveIO $ mapM (\fn' -> recurseFilterDirStat h fn' p) contents - return $ (concat subdirs) ++ [(fn, fs)] - else return [(fn, fs)] - else return [] diff --git a/src/Server.hs b/src/Server.hs index e6ac293..cf80376 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -10,7 +10,6 @@ import Config import Parse import ToodlesApi import Types -import FilteredRecurseDir import qualified Control.Exception as E import Control.Monad @@ -27,7 +26,7 @@ import qualified Data.Text as T import qualified Data.Yaml as Y import Servant import System.Directory -import System.IO.HVFS +import System.Directory.Extra import qualified System.IO.Strict as SIO import System.Path.NameManip import Text.Blaze.Html5 (Html) @@ -319,7 +318,7 @@ getAllFiles :: ToodlesConfig -> FilePath -> IO [SourceFile] getAllFiles (ToodlesConfig ignoredPaths _) basePath = E.catch (do putStrLn $ printf "Running toodles for path: %s" basePath - files <- recurseFilterDir SystemFS basePath (return . not . ignoreFile) + files <- listFilesInside (return . not . ignoreFile) basePath let validFiles = filter fileHasValidExtension files mapM (\f -> diff --git a/toodles.cabal b/toodles.cabal index 3c94308..dd151e2 100644 --- a/toodles.cabal +++ b/toodles.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 3e491112d2297954f078aacab7b353d492a9606c6f58d268655910a4b48ecfce +-- hash: 1b4520f165439b7fb3fce7f9d4d7a56afe20ac9ae86140d2b337e14f0517cbb6 name: toodles version: 1.0.2 @@ -45,7 +45,6 @@ library ToodlesApi Server other-modules: - FilteredRecurseDir Paths_toodles hs-source-dirs: src @@ -57,7 +56,7 @@ library , blaze-html ==0.9.1.1 , cmdargs ==0.10.20 , directory ==1.3.1.5 - , filepath ==1.4.2 + , extra ==1.6.13 , hspec >=2.4.4 , hspec-expectations >=0.8.2 , megaparsec ==6.5.0 @@ -76,7 +75,6 @@ executable toodles main-is: Main.hs other-modules: Config - FilteredRecurseDir Parse Server ToodlesApi @@ -93,7 +91,7 @@ executable toodles , blaze-html ==0.9.1.1 , cmdargs ==0.10.20 , directory ==1.3.1.5 - , filepath ==1.4.2 + , extra ==1.6.13 , hspec >=2.4.4 , hspec-expectations >=0.8.2 , megaparsec ==6.5.0 @@ -113,7 +111,6 @@ test-suite toodles-test main-is: Spec.hs other-modules: Config - FilteredRecurseDir Parse Server ToodlesApi @@ -130,7 +127,7 @@ test-suite toodles-test , blaze-html ==0.9.1.1 , cmdargs ==0.10.20 , directory ==1.3.1.5 - , filepath ==1.4.2 + , extra ==1.6.13 , hspec >=2.4.4 , hspec-expectations >=0.8.2 , megaparsec ==6.5.0 From ba7f358c9f8c6a5f9dc9a16faf9d0c37586791c1 Mon Sep 17 00:00:00 2001 From: Robert Steuck Date: Tue, 22 Jan 2019 09:02:44 +0100 Subject: [PATCH 4/4] fix filter ignored files --- src/Server.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Server.hs b/src/Server.hs index cf80376..c0f188d 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -318,8 +318,8 @@ getAllFiles :: ToodlesConfig -> FilePath -> IO [SourceFile] getAllFiles (ToodlesConfig ignoredPaths _) basePath = E.catch (do putStrLn $ printf "Running toodles for path: %s" basePath - files <- listFilesInside (return . not . ignoreFile) basePath - let validFiles = filter fileHasValidExtension files + files <- listFilesInside (return . not . ignorePath) basePath + let validFiles = filter isValidFile files mapM (\f -> SourceFile f . (map T.pack . lines) <$> @@ -332,8 +332,8 @@ getAllFiles (ToodlesConfig ignoredPaths _) basePath = where - ignoreFile :: FilePath -> Bool - ignoreFile path = + ignorePath :: FilePath -> Bool + ignorePath path = let p = T.pack path in T.isInfixOf "node_modules" p || T.isSuffixOf "pb.go" p || T.isSuffixOf "_pb2.py" p || @@ -342,6 +342,9 @@ getAllFiles (ToodlesConfig ignoredPaths _) basePath = fileHasValidExtension :: FilePath -> Bool fileHasValidExtension path = any (\ext -> ext `T.isSuffixOf` T.pack path) (map extension fileTypeToComment) + isValidFile :: FilePath -> Bool + isValidFile path = (not $ ignorePath path) && fileHasValidExtension path + mapHead :: (a -> a) -> [a] -> [a] mapHead f (x:xs) = f x : xs