Merge pull request #89 from GetShopTV/levels

Enhancements

.changelogged.template.yaml

@@ -14,6 +14,10 @@ changelogs:
       # version in package.yaml should be updated
       - path: package.yaml
         version_pattern: "version:"
+
+    # Apply common options like --level when is not target changelog or not.
+    # false by default.
+    default: true
 
   # HTTP API changelog
   - changelog: API_ChangeLog.md

.changelogged.yaml

@@ -0,0 +1,13 @@
+changelogs:
+  - changelog: ChangeLog.md
+
+    ignore_files:
+      - ChangeLog.md
+
+    version_files:
+      - path: package.yaml
+        version_pattern: "version:"
+      - path: src/Changelogged/Pure.hs
+        version_pattern: "changeloggedVersion ="
+
+    default: true

package.yaml

@@ -40,6 +40,7 @@ library:
     - mtl
     - exceptions
     - system-filepath
+    - string-conversions
     - foldl
     - vector
     - either

src/Changelogged/Bump/Common.hs

@@ -36,7 +36,7 @@ bumpAny VersionFile{..} version = do
   output versionFilePath (select $ generateVersionedFile file changed matched)
 
 -- |Replace given lines in the file.
--- Here is used and called to write new lines wih versions.
+-- Here is used and called to write new lines with versions.
 generateVersionedFile
   -- template file
   :: [Line]

src/Changelogged/Bump/Local.hs

@@ -27,11 +27,11 @@ currentLocalVersion VersionFile{..} = do
     Just realVer -> fromMaybe
       (throw (PatternMatchFail $ "cannot get local version. Given variable " <> show versionFileVersionPattern <> " doesn't store version. Check config.\n"))
       (versionMatch . lineToText $ realVer)
-    Nothing -> throw (PatternMatchFail $ "cannot get local version. Cannot find given variable " <> show versionFileVersionPattern <> " in file " <> encodeString versionFilePath <> ". Check config.\n")
+    Nothing -> throw (PatternMatchFail $ "cannot get local version. Cannot match given pattern " <> show versionFileVersionPattern <> " in file " <> encodeString versionFilePath <> ". Check config.\n")
 
 -- |Generate new local version.
-generateLocalVersion :: Level -> VersionFile -> IO Text
-generateLocalVersion lev indicator = do
+generateLocalVersionForFile :: Level -> VersionFile -> IO Text
+generateLocalVersionForFile lev indicator = do
   current <- currentLocalVersion indicator
   -- This print must not be here but I think it's better than throw current vrsion to main.
   printf ("Version: "%s%" -> ") current
@@ -40,17 +40,21 @@ generateLocalVersion lev indicator = do
   where
     new current = bump (delimited current) lev
 
+-- |Set new local version.
+generateLocalVersion :: Level -> ChangelogConfig -> IO (Maybe Text)
+generateLocalVersion lev ChangelogConfig{..} = do
+  case changelogVersionFiles of
+    Nothing -> error "No file version files specified for changelog."
+    Just versionFiles -> do
+      localVersions <- mapM (generateLocalVersionForFile lev) versionFiles
+      return (listToMaybe localVersions) -- FIXME: don't ignore other version files
+
 -- |Infer new local version.
 generateLocalVersionByChangelog :: ChangelogConfig -> IO (Maybe Text)
-generateLocalVersionByChangelog ChangelogConfig{..} = do
+generateLocalVersionByChangelog logConfig@ChangelogConfig{..} = do
   versionedChanges <- getChangelogEntries changelogChangelog
   case versionedChanges of
-    Just lev -> do
-      case changelogVersionFiles of
-        Nothing -> error "No file version files specified for changelog."
-        Just versionFiles -> do
-          localVersions <- mapM (generateLocalVersion lev) versionFiles
-          return (listToMaybe localVersions) -- FIXME: don't ignore other version files
+    Just lev -> generateLocalVersion lev logConfig
     Nothing -> do
       warning $ "keeping current version since " <> showPath changelogChangelog <> " apparently does not contain any new entries"
       return Nothing

src/Changelogged/CheckLog/Check.hs

@@ -58,7 +58,7 @@ checkLocalChangelogF fmt writeLog GitInfo{..} ChangelogConfig{..} = do
             message <- commitMessage PR commit
             changelogIsUp fmt writeLog gitRemoteUrl pnum PR message changelogChangelog
 
--- |This is actually part if '@Main@'
+-- |This is actually part of '@Main@'
 -- Check given changelog regarding options.
 checkChangelogWrap :: Options -> GitInfo -> ChangelogConfig -> IO Bool
 checkChangelogWrap Options{..} git config@ChangelogConfig{..} = do

src/Changelogged/CheckLog/Common.hs

@@ -28,18 +28,6 @@ changelogIsUp fmt writeSug link item mode message changelog = do
       return False
     _ -> return True
 
--- |Ignore commits which only affect '.md' files
-noMarkdown :: Text -> IO Bool
-noMarkdown commit = do
-  statCommit <- fold (inproc "git" ["show", "--stat", commit] empty) Fold.list
-  chLogUpdated <- fold
-    (grep (has $ text ".md ")
-      (select statCommit)) countLines
-  onlyChLogUpdated <- fold
-    (grep (has $ text "|")
-      (select statCommit)) countLines
-  return $ chLogUpdated /= onlyChLogUpdated
-
 -- |
 warnMissing :: Text -> Mode -> Text -> IO ()
 warnMissing item mode message = do

src/Changelogged/Config.hs

@@ -3,6 +3,7 @@
 module Changelogged.Config where
 
 import Data.Aeson
+import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>))
 import Data.String (fromString)
 import Data.Text (Text)
@@ -15,19 +16,21 @@ data Config = Config
   { configChangelogs    :: [ChangelogConfig]
   , configIgnoreCommits :: Maybe [Text]
   , configBranch        :: Maybe Text
-  }
+  } deriving Eq
 
 data ChangelogConfig = ChangelogConfig
   { changelogChangelog    :: Turtle.FilePath
   , changelogWatchFiles   :: Maybe [Turtle.FilePath]
   , changelogIgnoreFiles  :: Maybe [Turtle.FilePath]
   , changelogVersionFiles :: Maybe [VersionFile]
-  }
+    -- If changelog is marked as default it's version files will be bumped with explicit level from options.
+  , changelogDefault      :: Bool
+  } deriving Eq
 
 data VersionFile = VersionFile
   { versionFilePath :: Turtle.FilePath
   , versionFileVersionPattern :: Text
-  }
+  } deriving (Show, Eq)
 
 instance FromJSON Config where
   parseJSON = withObject "Config" $ \o -> Config
@@ -41,6 +44,7 @@ instance FromJSON ChangelogConfig where
     <*> (fmap (map fromString) <$> o .:? "watch_files")
     <*> (fmap (map fromString) <$> o .:? "ignore_files")
     <*> o .:? "version_files"
+    <*> (fromMaybe False <$> o .:? "default")
 
 instance FromJSON VersionFile where
   parseJSON = withObject "VersionFile" $ \o -> VersionFile
@@ -54,6 +58,7 @@ defaultConfig = Config
       , changelogWatchFiles   = Nothing  -- watch everything
       , changelogIgnoreFiles  = Nothing  -- ignore nothing
       , changelogVersionFiles = Just [VersionFile "package.yaml" "version:"]
+      , changelogDefault      = True
       }
   , configIgnoreCommits = Nothing
   , configBranch = Nothing

src/Changelogged/Main.hs

@@ -2,10 +2,12 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Changelogged.Main where
 
-import Turtle hiding (FilePath)
+import Data.List (find)
+import Turtle hiding (FilePath, find)
 
 import Control.Exception
 import Data.Maybe (fromMaybe)
+import Data.Text (unpack, pack)
 
 import System.Console.ANSI (Color(..))
 
@@ -15,28 +17,45 @@ import Changelogged.Bump.Common
 import Changelogged.Git
 import Changelogged.Options
 import Changelogged.Utils
-import Changelogged.Pure (showText)
+import Changelogged.Types (Level)
+import Changelogged.Pure (showText, showPath, changeloggedVersion)
 import Changelogged.Config
 
 defaultMain :: IO ()
 defaultMain = do
   -- parse command line options
   opts@Options{..} <- parseOptions
-  -- load config file (or default config)
-  config@Config{..} <- fromMaybe defaultConfig <$> loadConfig ".changelogged.yaml"
-  -- load git info
-  gitInfo <- loadGitInfo optFromBC configBranch
-  coloredPrint Blue (ppConfig  config)
-  coloredPrint Blue (ppGitInfo gitInfo)
-  -- process changelogs
-  processChangelogs config opts gitInfo
+
+  if optVersion
+    then versionP changeloggedVersion
+    else do
+      -- load config file (or default config)
+      let configPath = fromMaybe ".changelogged.yaml" (unpack . showPath <$> optConfigPath)
+      config@Config{..} <- fromMaybe defaultConfig <$> loadConfig configPath
+      -- load git info
+      gitInfo <- loadGitInfo optFromBC configBranch
+      if config == defaultConfig
+        then coloredPrint Blue "Using default config.\n"
+        else coloredPrint Blue ("Configuration file: " <> pack configPath <> "\n")
+      coloredPrint Blue (ppConfig  config)
+      coloredPrint Blue (ppGitInfo gitInfo)
+      -- process changelogs
+      processChangelogs config opts gitInfo
 
 processChangelogs :: Config -> Options -> GitInfo -> IO ()
-processChangelogs config opts gitInfo = do
-  mapM_ (processChangelog opts gitInfo) (configChangelogs config)
+processChangelogs config opts@Options{..} gitInfo = case optTargetChangelog of
+  Nothing -> do
+    mapM_ (processChangelog opts gitInfo optChangeLevel) (filter (\entry -> changelogDefault entry == True) $ configChangelogs config)
+    mapM_ (processChangelog opts gitInfo Nothing) (filter (\entry -> changelogDefault entry /= True) $ configChangelogs config)
+  Just changelogPath -> do
+    case lookupChangelog changelogPath of
+      Just changelog -> processChangelog opts gitInfo optChangeLevel changelog
+      Nothing -> failure $ "Given target changelog " <> format fp changelogPath <> " is missed in config or mistyped."
+    where
+      lookupChangelog path = find (\entry -> changelogChangelog entry == path) (configChangelogs config)
 
-processChangelog :: Options -> GitInfo -> ChangelogConfig -> IO ()
-processChangelog opts@Options{..} gitInfo config@ChangelogConfig{..} = do
+processChangelog :: Options -> GitInfo -> Maybe Level -> ChangelogConfig -> IO ()
+processChangelog opts@Options{..} gitInfo level config@ChangelogConfig{..} = do
   putStrLn ""
   info $ "processing " <> format fp changelogChangelog
   changelogExists <- testfile changelogChangelog
@@ -57,12 +76,12 @@ processChangelog opts@Options{..} gitInfo config@ChangelogConfig{..} = do
     | not upToDate && optForce ->
         warning $ format fp changelogChangelog <> " is out of date. Bumping versions anyway due to --force."
     | otherwise -> (do
-        newVersion <- if optNoCheck
-          then do
+        newVersion <- case (optNoCheck, level) of
+          (_, Just lev) -> generateLocalVersion lev config
+          (True, Nothing) ->  do
             failure "cannot infer new version from changelog because of --no-check.\nUse explicit --level CHANGE_LEVEL."
             return Nothing
-          else do
-            generateLocalVersionByChangelog config
+          (False, Nothing) -> generateLocalVersionByChangelog config
 
         case newVersion of
           Nothing -> return ()
@@ -72,4 +91,3 @@ processChangelog opts@Options{..} gitInfo config@ChangelogConfig{..} = do
               headChangelog version changelogChangelog
             Nothing -> warning "no files specified to bump versions in"
         ) `catch` (\(ex :: PatternMatchFail) -> failure (showText ex))
-

src/Changelogged/Options.hs

@@ -1,12 +1,16 @@
+{-# LANGUAGE FlexibleContexts #-}
 module Changelogged.Options where
 
 import Data.Char (toLower)
 import Data.List (intercalate)
 import Data.Monoid ((<>))
+import Data.String.Conversions (cs)
 
 import Options.Applicative
 import qualified Turtle
 
+import Filesystem.Path.CurrentOS (valid, fromText)
+
 import Changelogged.Types
 
 -- |
@@ -62,6 +66,13 @@ readLevel = eitherReader (r . map toLower)
          "Unknown level of changes: " <> show lvl <> ".\n"
       <> "Should be " <> availableLevelsStr <> ".\n"
 
+readFilePath :: ReadM Turtle.FilePath
+readFilePath = eitherReader r
+  where
+    r filePathString = if valid $ fromText $ cs filePathString
+      then Right (fromText $ cs filePathString)
+      else Left ("Invalid file path " <> filePathString <> ".\n")
+
 parser :: Parser Options
 parser = Options
   <$> warningFormat
@@ -73,6 +84,9 @@ parser = Options
         "Look for missing changelog entries from the start of the project."
   <*> hiddenSwitch "force" "Bump versions ignoring possibly outdated changelogs."
   <*> hiddenSwitch "no-check" "Do not check if changelogs have any missing entries."
+  <*> optional targetChangelog
+  <*> optional configPath
+  <*> hiddenSwitch "version" "Print version."
   where
     longSwitch name description = switch $
          long name
@@ -87,7 +101,7 @@ parser = Options
          long "level"
       <> metavar "CHANGE_LEVEL"
       <> help (unlines
-           [ "Level of changes (to override one inferred from changelogs)."
+           [ "Level of changes (to override one inferred from changelog)."
            , "CHANGE_LEVEL can be " <> availableLevelsStr <> "."
            ])
       <> hidden
@@ -97,6 +111,13 @@ parser = Options
       <> help ("Format for missing changelog entry warnings. FORMAT can be " <> availableWarningFormatsStr <> ".")
       <> value WarnSimple
       <> showDefault
+    targetChangelog = argument readFilePath $
+         metavar "TARGET_CHANGELOG"
+      <> help ("Path to target changelog.")
+    configPath = option readFilePath $
+         long "config"
+      <> metavar "changelogged.yaml config file location"
+      <> help ("Path to config file.")
 
 welcome :: Turtle.Description
 welcome = Turtle.Description "changelogged - Changelog Manager for Git Projects"
@@ -117,6 +138,12 @@ data Options = Options
   , optForce           :: Bool
     -- | Do not check if changelogs have any missing entries.
   , optNoCheck         :: Bool
+    -- | Check exactly one target changelog.
+  , optTargetChangelog :: Maybe Turtle.FilePath
+    -- | Use specified config file.
+  , optConfigPath      :: Maybe Turtle.FilePath
+    -- | Print version
+  , optVersion         :: Bool
   }
 
 -- | Parse command line options.

src/Changelogged/Pattern.hs

@@ -46,13 +46,6 @@ versionMatch str = maxByLen $ match (has versionExactRegex) str
 hashRegex :: Pattern Text
 hashRegex = prefix $ between (within 0 chars) spaces1 (plus (digit <|> lower))
 
--- >>> match hashGrepExclude "ee17741 Merge pull request #38 from GetShopTV/redesign-strategies"
--- []
--- >>> match hashGrepExclude "ee17741 Reference pull request #38 from GetShopTV/redesign-strategies"
--- [()]
-hashGrepExclude :: Pattern ()
-hashGrepExclude = invert (hashRegex <> spaces <> text "Merge")
-
 -- >>> hashMatch "f4875f4 Update changelog"
 -- Just "f4875f4"
 -- >>> hashMatch "Update changelog"

src/Changelogged/Pure.hs

@@ -1,24 +1,21 @@
 module Changelogged.Pure where
 
 import Prelude hiding (FilePath)
-import qualified Data.HashMap.Strict as HM
-import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as Text
 
 import Filesystem.Path.CurrentOS (encodeString, FilePath)
 
 import Changelogged.Types
 
+changeloggedVersion :: Text
+changeloggedVersion = "0.2.0"
+
 -- | Maximum in list ordered by length.
 maxByLen :: [Text] -> Maybe Text
 maxByLen [] = Nothing
 maxByLen hs = Just $ foldl1 (\left right -> if Text.length left > Text.length right then left else right) hs
 
--- 
-defaultedEmpty :: Maybe (HM.HashMap k v) -> HM.HashMap k v
-defaultedEmpty = fromMaybe HM.empty
-
 -- |'@fromJust@' function with custom error message.
 fromJustCustom :: String -> Maybe a -> a
 fromJustCustom msg Nothing = error msg

src/Changelogged/Utils.hs

@@ -25,3 +25,7 @@ failure msg = coloredPrint Red $
 info :: Text -> IO ()
 info msg = coloredPrint Cyan $
   "INFO: " <> msg <> "\n"
+
+versionP :: Text -> IO ()
+versionP ver = coloredPrint Green $
+  "VERSION: " <> ver <> "\n"