diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,14 @@ # Changelog All notable changes to this project will be documented in this file. -## 0.2.0.0 (not released yet) +## 0.2.1.0 (released 2020-04-29) +- [#41] Add `--dry-run` option to allow test run without changing files. +- [#44] Don't touch files whose contents have not changed. +- [#46] Add `-e|--excluded-path=REGEX` option to exclude source paths. +- Bump _LTS Haskell_ to `15.10`. +- Remove unused dependencies. + +## 0.2.0.0 (released 2020-04-25) - [#28] Allow license headers to be anywhere in the file, not only at the very beginning. - [#31] Render templates for each source file instead of once (blocker for [#25]) - [#32] Allow custom user configuration for license headers. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -13,7 +13,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} - +{-# LANGUAGE RecordWildCards #-} module Main where import Headroom.Command ( commandParser ) @@ -46,9 +46,8 @@ bootstrap :: Command -> IO () bootstrap = \case c@(Gen _ _) -> do - genMode <- parseGenMode c - commandGen (CommandGenOptions genMode) - Init licenseType sourcePaths -> - commandInit (CommandInitOptions sourcePaths licenseType) - Run sourcePaths templatePaths variables runMode debug -> commandRun - (CommandRunOptions runMode sourcePaths templatePaths variables debug) + cgoGenMode <- parseGenMode c + commandGen CommandGenOptions { .. } + Init cioLicenseType cioSourcePaths -> commandInit CommandInitOptions { .. } + Run croSourcePaths croExcludedPaths croTemplatePaths croVariables croRunMode croDebug croDryRun + -> commandRun CommandRunOptions { .. } diff --git a/embedded/default-config.yaml b/embedded/default-config.yaml --- a/embedded/default-config.yaml +++ b/embedded/default-config.yaml @@ -19,6 +19,12 @@ ## the user. # source-paths: [] +## Allows to define list of regular expressions that will be matched against +## 'source-paths' and such paths will be excluded from processing. Same as +## '-e|--excluded-path=REGEX' command line argument (can be used multiple times +## for more than one path). +excluded-paths: [] + ## Paths to template files (either files or directories), ## same as '-t|--template-path=PATH' command line argument (can be used multiple ## times for more than one path). diff --git a/headroom.cabal b/headroom.cabal --- a/headroom.cabal +++ b/headroom.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: headroom -version: 0.2.0.0 +version: 0.2.1.0 license: BSD3 license-file: LICENSE copyright: Copyright (c) 2019-2020 Vaclav Svejcar @@ -123,6 +123,7 @@ Headroom.FileSystem Headroom.FileType Headroom.Meta + Headroom.Regex Headroom.Serialization Headroom.Template Headroom.Template.Mustache @@ -143,16 +144,13 @@ base >=4.7 && <5, either >=5.0.1.1 && <5.1, file-embed >=0.0.11.2 && <0.1, - lens >=4.18.1 && <4.19, mustache >=2.3.1 && <2.4, optparse-applicative >=0.15.1.0 && <0.16, - pcre-heavy >=1.0.0.2 && <1.1, pcre-light >=0.4.1.0 && <0.5, rio >=0.1.15.0 && <0.2, template-haskell >=2.15.0.0 && <2.16, text >=1.2.4.0 && <1.3, time >=1.9.3 && <1.10, - validation ==1.1.*, yaml >=0.11.3.0 && <0.12 executable headroom @@ -199,6 +197,7 @@ Headroom.FileSupportSpec Headroom.FileSystemSpec Headroom.FileTypeSpec + Headroom.RegexSpec Headroom.SerializationSpec Headroom.Template.MustacheSpec Headroom.Types.EnumExtraSpec @@ -217,6 +216,5 @@ headroom -any, hspec >=2.7.1 && <2.8, optparse-applicative >=0.15.1.0 && <0.16, - pcre-heavy >=1.0.0.2 && <1.1, pcre-light >=0.4.1.0 && <0.5, rio >=0.1.15.0 && <0.2 diff --git a/src/Headroom/Command.hs b/src/Headroom/Command.hs --- a/src/Headroom/Command.hs +++ b/src/Headroom/Command.hs @@ -68,6 +68,12 @@ ) <*> many (strOption + (long "excluded-path" <> short 'e' <> metavar "REGEX" <> help + "path to exclude from source code file paths" + ) + ) + <*> many + (strOption (long "template-path" <> short 't' <> metavar "PATH" <> help "path to header template file/directory" ) @@ -96,6 +102,7 @@ ) ) <*> switch (long "debug" <> help "produce more verbose output") + <*> switch (long "dry-run" <> help "execute dry run (no changes to files)") genOptions :: Parser Command genOptions = diff --git a/src/Headroom/Command/Run.hs b/src/Headroom/Command/Run.hs --- a/src/Headroom/Command/Run.hs +++ b/src/Headroom/Command/Run.hs @@ -33,7 +33,8 @@ , extractFileInfo , replaceHeader ) -import Headroom.FileSystem ( fileExtension +import Headroom.FileSystem ( excludePaths + , fileExtension , findFilesByExts , findFilesByTypes , loadFile @@ -119,6 +120,7 @@ -> IO () -- ^ execution result commandRun opts = bootstrap (env' opts) (croDebug opts) $ do logInfo $ display productInfo + warnOnDryRun startTS <- liftIO getPOSIXTime templates <- loadTemplates sourceFiles <- findSourceFiles (M.keys templates) @@ -134,21 +136,28 @@ , displayShow (endTS - startTS) , " second(s)." ] + warnOnDryRun +warnOnDryRun :: (HasLogFunc env, HasRunOptions env) => RIO env () +warnOnDryRun = do + CommandRunOptions {..} <- view runOptionsL + when croDryRun $ logWarn "[!] Running with '--dry-run', no files are changed!" + findSourceFiles :: (HasConfiguration env, HasLogFunc env) => [FileType] -> RIO env [FilePath] findSourceFiles fileTypes = do Configuration {..} <- view configurationL logDebug $ "Using source paths: " <> displayShow cSourcePaths - files <- - mconcat <$> mapM (findFilesByTypes cLicenseHeaders fileTypes) cSourcePaths - logInfo $ mconcat ["Found ", display $ L.length files, " source file(s)"] - pure files + files <- mconcat <$> mapM (findFiles' cLicenseHeaders) cSourcePaths + let files' = excludePaths cExcludedPaths files + logInfo $ mconcat ["Found ", display $ L.length files', " source file(s)"] + pure files' + where findFiles' licenseHeaders = findFilesByTypes licenseHeaders fileTypes -processSourceFiles :: (HasConfiguration env, HasLogFunc env) +processSourceFiles :: (HasConfiguration env, HasLogFunc env, HasRunOptions env) => Map FileType TemplateType -> [FilePath] -> RIO env (Int, Int) @@ -166,26 +175,29 @@ process (pr, (tt, ft, p)) = processSourceFile pr tt ft p -processSourceFile :: (HasConfiguration env, HasLogFunc env) +processSourceFile :: (HasConfiguration env, HasLogFunc env, HasRunOptions env) => Progress -> TemplateType -> FileType -> FilePath -> RIO env Bool processSourceFile progress template fileType path = do - Configuration {..} <- view configurationL - fileContent <- readFileUtf8 path + Configuration {..} <- view configurationL + CommandRunOptions {..} <- view runOptionsL + fileContent <- readFileUtf8 path let fileInfo = extractFileInfo fileType (configByFileType cLicenseHeaders fileType) fileContent variables = cVariables <> fiVariables fileInfo header <- renderTemplate variables template (processed, action, message') <- chooseAction fileInfo header - let message = if processed then message' else "Skipping file: " + let result = action fileContent + changed = processed && (fileContent /= result) + message = if changed then message' else "Skipping file: " logDebug $ "File info: " <> displayShow fileInfo logInfo $ mconcat [display progress, " ", display message, fromString path] - writeFileUtf8 path (action fileContent) - pure processed + when (not croDryRun && changed) (writeFileUtf8 path result) + pure changed chooseAction :: (HasConfiguration env) @@ -252,6 +264,7 @@ pure PartialConfiguration { pcRunMode = maybe mempty pure (croRunMode runOptions) , pcSourcePaths = ifNot null (croSourcePaths runOptions) + , pcExcludedPaths = ifNot null (croExcludedPaths runOptions) , pcTemplatePaths = ifNot null (croTemplatePaths runOptions) , pcVariables = ifNot null variables , pcLicenseHeaders = mempty diff --git a/src/Headroom/Configuration.hs b/src/Headroom/Configuration.hs --- a/src/Headroom/Configuration.hs +++ b/src/Headroom/Configuration.hs @@ -82,6 +82,7 @@ makeConfiguration PartialConfiguration {..} = do cRunMode <- lastOrError NoRunMode pcRunMode cSourcePaths <- lastOrError NoSourcePaths pcSourcePaths + cExcludedPaths <- lastOrError NoExcludedPaths pcExcludedPaths cTemplatePaths <- lastOrError NoTemplatePaths pcTemplatePaths cVariables <- lastOrError NoVariables pcVariables cLicenseHeaders <- makeHeadersConfig pcLicenseHeaders diff --git a/src/Headroom/FileSupport.hs b/src/Headroom/FileSupport.hs --- a/src/Headroom/FileSupport.hs +++ b/src/Headroom/FileSupport.hs @@ -13,7 +13,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} module Headroom.FileSupport ( -- * File info extraction extractFileInfo @@ -31,7 +30,10 @@ ) where -import Control.Lens.TH ( makeLensesFor ) +import Headroom.Regex ( compile' + , joinPatterns + , match' + ) import Headroom.Types ( FileInfo(..) , FileType(..) , HeaderConfig(..) @@ -41,16 +43,10 @@ import qualified RIO.HashMap as HM import qualified RIO.List as L import qualified RIO.Text as T -import Text.Regex.PCRE.Light ( Regex - , compile - , match - ) -import Text.Regex.PCRE.Light.Char8 ( utf8 ) +import Text.Regex.PCRE.Light ( Regex ) -makeLensesFor [("fiHeaderPos", "fiHeaderPosL")] ''FileInfo - -- | Extracts info about the processed file to be later used by the header -- detection/manipulation functions. extractFileInfo :: FileType -- ^ type of the detected file @@ -175,14 +171,14 @@ -- | Finds very first line that matches the given /regex/ (numbered from zero). -- --- >>> firstMatching (compile "^foo" [utf8]) ["some text", "foo bar", "foo baz", "last"] +-- >>> firstMatching (compile' "^foo") ["some text", "foo bar", "foo baz", "last"] -- Just 1 firstMatching :: Regex -- /regex/ used for matching -> [Text] -- input lines -> Maybe Int -- matching line number firstMatching regex input = go input 0 where - cond x = isJust $ match regex (encodeUtf8 x) [] + cond x = isJust $ match' regex x go (x : _) i | cond x = Just i go (_ : xs) i = go xs (i + 1) go [] _ = Nothing @@ -190,14 +186,14 @@ -- | Finds very last line that matches the given /regex/ (numbered from zero). -- --- >>> lastMatching (compile "^foo" [utf8]) ["some text", "foo bar", "foo baz", "last"] +-- >>> lastMatching (compile' "^foo") ["some text", "foo bar", "foo baz", "last"] -- Just 2 lastMatching :: Regex -- /regex/ used for matching -> [Text] -- input lines -> Maybe Int -- matching line number lastMatching regex input = go input 0 Nothing where - cond x = isJust $ match regex (encodeUtf8 x) [] + cond x = isJust $ match' regex x go (x : xs) i _ | cond x = go xs (i + 1) (Just i) go (_ : xs) i pos = go xs (i + 1) pos go [] _ pos = pos @@ -232,9 +228,7 @@ sndSplitAt = fromMaybe len (findSplit firstMatching sndSplit inLines) inLines = T.lines input len = L.length inLines - findSplit f r i = compile' r >>= (`f` i) - compile' [] = Nothing - compile' ps = Just $ compile (encodeUtf8 $ T.intercalate "|" ps) [utf8] + findSplit f ps i = compile' <$> joinPatterns ps >>= (`f` i) -- TODO: https://github.com/vaclavsvejcar/headroom/issues/25 @@ -248,3 +242,6 @@ stripLinesStart :: [Text] -> [Text] stripLinesStart = dropWhile (T.null . T.strip) + +fiHeaderPosL :: Lens' FileInfo (Maybe (Int, Int)) +fiHeaderPosL = lens fiHeaderPos (\x y -> x { fiHeaderPos = y }) diff --git a/src/Headroom/FileSystem.hs b/src/Headroom/FileSystem.hs --- a/src/Headroom/FileSystem.hs +++ b/src/Headroom/FileSystem.hs @@ -24,10 +24,16 @@ , createDirectory -- * Working with Files Metadata , fileExtension + -- * Other + , excludePaths ) where import Headroom.FileType ( listExtensions ) +import Headroom.Regex ( compile' + , joinPatterns + , match' + ) import Headroom.Types ( FileType , HeadersConfig(..) ) @@ -42,20 +48,11 @@ , takeExtension , () ) +import qualified RIO.List as L import qualified RIO.Text as T --- | Returns file extension for given path (if file), or nothing otherwise. --- --- >>> fileExtension "path/to/some/file.txt" --- Just "txt" -fileExtension :: FilePath -> Maybe Text -fileExtension path = case takeExtension path of - '.' : xs -> Just $ T.pack xs - _ -> Nothing - - -- | Recursively finds files on given path whose filename matches the predicate. findFiles :: MonadIO m => FilePath -- ^ path to search @@ -102,8 +99,34 @@ pure $ concat paths +-- | Returns file extension for given path (if file), or nothing otherwise. +-- +-- >>> fileExtension "path/to/some/file.txt" +-- Just "txt" +fileExtension :: FilePath -> Maybe Text +fileExtension path = case takeExtension path of + '.' : xs -> Just $ T.pack xs + _ -> Nothing + + -- | Loads file content in UTF8 encoding. loadFile :: MonadIO m => FilePath -- ^ file path -> m Text -- ^ file content loadFile = readFileUtf8 + + +-- | Takes list of patterns and file paths and returns list of file paths where +-- those matching the given patterns are excluded. +-- +-- >>> excludePaths ["\\.hidden", "zzz"] ["foo/.hidden", "test/bar", "x/zzz/e"] +-- ["test/bar"] +excludePaths :: [Text] -- ^ patterns describing paths to exclude + -> [FilePath] -- ^ list of file paths + -> [FilePath] -- ^ resulting list of file paths +excludePaths _ [] = [] +excludePaths [] paths = paths +excludePaths patterns paths = go $ compile' <$> joinPatterns patterns + where + go Nothing = paths + go (Just regex) = L.filter (isNothing . match' regex . T.pack) paths diff --git a/src/Headroom/Regex.hs b/src/Headroom/Regex.hs new file mode 100644 --- /dev/null +++ b/src/Headroom/Regex.hs @@ -0,0 +1,55 @@ +{-| +Module : Headroom.Regex +Description : Helper functions for regular expressions +Copyright : (c) 2019-2020 Vaclav Svejcar +License : BSD-3 +Maintainer : vaclav.svejcar@gmail.com +Stability : experimental +Portability : POSIX + +Provides wrappers mainly around functions from "Text.Regex.PCRE.Light" that more +suits the needs of this application. +-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Headroom.Regex + ( compile' + , joinPatterns + , match' + ) +where + +import RIO +import qualified RIO.Text as T +import Text.Regex.PCRE.Light ( Regex + , compile + ) +import Text.Regex.PCRE.Light.Char8 ( match + , utf8 + ) + + + +-- | Same as 'compile', but takes 'Text' on input and enables 'utf8' option +-- by default. +compile' :: Text -- ^ regular expression to be compiled + -> Regex -- ^ compiled regular expression +compile' regex = compile (encodeUtf8 regex) [utf8] + + +-- | Joins list of patterns into single regex string. If the input list is +-- empty, 'Nothing' is returned. +-- +-- >>> joinPatterns ["^foo", "^bar"] +-- Just "^foo|^bar" +joinPatterns :: [Text] -- ^ list of patterns to join + -> Maybe Text -- ^ joined patterns +joinPatterns [] = Nothing +joinPatterns ps = Just $ T.intercalate "|" ps + + +-- | Same as 'match', but works with 'Text' and uses no additional options. +match' :: Regex -- ^ a PCRE regular expression value produced by compile + -> Text -- ^ the subject text to match against + -> Maybe [Text] -- ^ the result value +match' regex subject = fmap T.pack <$> match regex (T.unpack subject) [] diff --git a/src/Headroom/Types.hs b/src/Headroom/Types.hs --- a/src/Headroom/Types.hs +++ b/src/Headroom/Types.hs @@ -123,6 +123,7 @@ | NoPutBefore !FileType -- ^ no configuration for @put-before@ | NoRunMode -- ^ no configuration for @run-mode@ | NoSourcePaths -- ^ no configuration for @source-paths@ + | NoExcludedPaths -- ^ no configuration for @excluded-paths@ | NoTemplatePaths -- ^ no configuration for @template-paths@ | NoVariables -- ^ no configuration for @variables@ deriving (Eq, Show) @@ -137,9 +138,9 @@ -- | Application command. data Command - = Run [FilePath] [FilePath] [Text] (Maybe RunMode) Bool -- ^ @run@ command - | Gen Bool (Maybe (LicenseType, FileType)) -- ^ @gen@ command - | Init LicenseType [FilePath] -- ^ @init@ command + = Run [FilePath] [Text] [FilePath] [Text] (Maybe RunMode) Bool Bool -- ^ @run@ command + | Gen Bool (Maybe (LicenseType, FileType)) -- ^ @gen@ command + | Init LicenseType [FilePath] -- ^ @init@ command deriving (Show) -------------------------------------------------------------------------------- @@ -161,9 +162,11 @@ data CommandRunOptions = CommandRunOptions { croRunMode :: !(Maybe RunMode) -- ^ used /Run/ command mode , croSourcePaths :: ![FilePath] -- ^ source code file paths + , croExcludedPaths :: ![Text] -- ^ source paths to exclude , croTemplatePaths :: ![FilePath] -- ^ template file paths , croVariables :: ![Text] -- ^ raw variables , croDebug :: !Bool -- ^ whether to run in debug mode + , croDryRun :: !Bool -- ^ whether to perform dry run } deriving (Eq, Show) @@ -218,6 +221,7 @@ data Configuration = Configuration { cRunMode :: !RunMode -- ^ mode of the @run@ command , cSourcePaths :: ![FilePath] -- ^ paths to source code files + , cExcludedPaths :: ![Text] -- ^ excluded source paths , cTemplatePaths :: ![FilePath] -- ^ paths to template files , cVariables :: !(HashMap Text Text) -- ^ variable values for templates , cLicenseHeaders :: !HeadersConfig -- ^ configuration of license headers @@ -269,6 +273,7 @@ data PartialConfiguration = PartialConfiguration { pcRunMode :: !(Last RunMode) -- ^ mode of the @run@ command , pcSourcePaths :: !(Last [FilePath]) -- ^ paths to source code files + , pcExcludedPaths :: !(Last [Text]) -- ^ excluded source paths , pcTemplatePaths :: !(Last [FilePath]) -- ^ paths to template files , pcVariables :: !(Last (HashMap Text Text)) -- ^ variable values for templates , pcLicenseHeaders :: !PartialHeadersConfig -- ^ configuration of license headers @@ -311,6 +316,7 @@ parseJSON = withObject "PartialConfiguration" $ \obj -> do pcRunMode <- Last <$> obj .:? "run-mode" pcSourcePaths <- Last <$> obj .:? "source-paths" + pcExcludedPaths <- Last <$> obj .:? "excluded-paths" pcTemplatePaths <- Last <$> obj .:? "template-paths" pcVariables <- Last <$> obj .:? "variables" pcLicenseHeaders <- obj .:? "license-headers" .!= mempty @@ -352,6 +358,7 @@ x <> y = PartialConfiguration { pcRunMode = pcRunMode x <> pcRunMode y , pcSourcePaths = pcSourcePaths x <> pcSourcePaths y + , pcExcludedPaths = pcExcludedPaths x <> pcExcludedPaths y , pcTemplatePaths = pcTemplatePaths x <> pcTemplatePaths y , pcVariables = pcVariables x <> pcVariables y , pcLicenseHeaders = pcLicenseHeaders x <> pcLicenseHeaders y @@ -381,7 +388,7 @@ } instance Monoid PartialConfiguration where - mempty = PartialConfiguration mempty mempty mempty mempty mempty + mempty = PartialConfiguration mempty mempty mempty mempty mempty mempty instance Monoid PartialHeaderConfig where mempty = PartialHeaderConfig mempty mempty mempty mempty mempty mempty @@ -432,6 +439,7 @@ NoPutBefore fileType -> noProp "put-before" fileType NoRunMode -> noFlag "run-mode" NoSourcePaths -> noFlag "source-paths" + NoExcludedPaths -> noFlag "excluded-paths" NoTemplatePaths -> noFlag "template-paths" NoVariables -> noFlag "variables" where diff --git a/test/Headroom/FileSystemSpec.hs b/test/Headroom/FileSystemSpec.hs --- a/test/Headroom/FileSystemSpec.hs +++ b/test/Headroom/FileSystemSpec.hs @@ -47,3 +47,15 @@ filePaths <- listFiles "test-data/test-traverse/a.html" let expected = ["test-data/test-traverse/a.html"] sort filePaths `shouldBe` sort expected + + describe "excludePaths" $ do + it "excludes paths matching selected pattern from input list" $ do + let patterns = ["\\.stack-work", "remove\\.txt"] + sample = + [ "/foo/bar/.stack-work/xx" + , "/hello/world" + , "foo/bar/remove.txt" + , "xx/yy" + ] + expected = ["/hello/world", "xx/yy"] + excludePaths patterns sample `shouldBe` expected diff --git a/test/Headroom/RegexSpec.hs b/test/Headroom/RegexSpec.hs new file mode 100644 --- /dev/null +++ b/test/Headroom/RegexSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Headroom.RegexSpec + ( spec + ) +where + +import Headroom.Regex +import RIO +import Test.Hspec + + +spec :: Spec +spec = do + describe "joinPatterns" $ do + it "returns Nothing for empty input" $ do + joinPatterns [] `shouldBe` Nothing + + it "handles single item list input" $ do + joinPatterns ["foo"] `shouldBe` Just "foo" + + it "handles multiple item list input" $ do + joinPatterns ["^foo", "^bar"] `shouldBe` Just "^foo|^bar" + + + describe "match'" $ do + it "matches regular expression against given sample" $ do + let regex = compile' <$> joinPatterns ["foo", "bar"] + (regex >>= (`match'` "xxx")) `shouldSatisfy` isNothing + (regex >>= (`match'` "foz")) `shouldSatisfy` isNothing + (regex >>= (`match'` "foosdas")) `shouldSatisfy` isJust + (regex >>= (`match'` "barfoo")) `shouldSatisfy` isJust