changelogged 0.1.0 → 0.2.0

raw patch · 26 files changed

+471/−527 lines, 26 filesbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +22/−2
• README.md +35/−35
• app/Main.hs +2/−112
• changelogged.cabal +15/−6
• images/bump.png binary
• images/chlog_diff.png binary
• images/common_run.png binary
• images/force.png binary
• images/no_bump.png binary
• images/no_check.png binary
• images/no_force.png binary
• images/release.png binary
• images/suggest.png binary
• src/Changelogged/Bump/Common.hs +11/−15
• src/Changelogged/Bump/General.hs +0/−30
• src/Changelogged/Bump/Local.hs +18/−20
• src/Changelogged/CheckLog/Check.hs +50/−60
• src/Changelogged/CheckLog/Common.hs +3/−3
• src/Changelogged/Config.hs +84/−0
• src/Changelogged/Git.hs +73/−28
• src/Changelogged/Main.hs +75/−0
• src/Changelogged/Options.hs +68/−51
• src/Changelogged/Pattern.hs +0/−72
• src/Changelogged/Settings.hs +0/−67
• src/Changelogged/Types.hs +2/−26
• src/Changelogged/Utils.hs +13/−0

@@ -1,5 +1,25 @@-# Changelog for changelogged+0.2.0+--- -## Unreleased changes+* Major changes+  - Redesign configuration format (see [#76](https://github.com/GetShopTV/changelogged/pull/76));+    - universal changelog configuration;+    - separate version files from watched files (those can be different);+    - ignored files;+    - add optional version `branch` config (for Git Flow projects where development and feature branches might not have version tags associated with them);+    - pretty printing config and git info summary on start;+    - fix PR and commit links for projects with `git@github.com:` remote url;+  - Improve CLI (see [#64](https://github.com/GetShopTV/changelogged/pull/64)); +* Minor changes+  - Enable Travis CI (see [#65](https://github.com/GetShopTV/changelogged/pull/65));+  - Move code from Main to Changelogged.Main (see [`1194b20`](https://github.com/GetShopTV/changelogged/commit/1194b20));+  - Ignore tag at `HEAD` (see [`35cae7c`](https://github.com/GetShopTV/changelogged/commit/35cae7c)); +* Fixes+  - Remove orphan instances (see [`c9ffce3`](https://github.com/GetShopTV/changelogged/commit/c9ffce3));+  - Add images to `extra-source-files` and improve description (see [`b4a2efb`](https://github.com/GetShopTV/changelogged/commit/b4a2efb));+  - Fix image paths in README (see [`6028f57`](https://github.com/GetShopTV/changelogged/commit/6028f57));+  - Track changes for `HEAD` instead of origin/master (see [`0f5c839`](https://github.com/GetShopTV/changelogged/commit/0f5c839));+  - Use `--abbrev=0` to get clear tag name (see [`4f50f22`](https://github.com/GetShopTV/changelogged/commit/4f50f22));+  - Fix version bump to just use `version_pattern` (see [`976633f`](https://github.com/GetShopTV/changelogged/commit/976633f));

@@ -1,5 +1,8 @@-# Changelogged+# changelogged +[![Hackage](https://img.shields.io/hackage/v/changelogged.svg)](http://hackage.haskell.org/package/changelogged)+[![Build Status](https://travis-ci.org/GetShopTV/changelogged.svg?branch=master)](https://travis-ci.org/GetShopTV/changelogged)+ ## What and how to?  ### Purpose@@ -52,35 +55,32 @@  ### Features reference -#### Text of help message:+#### Help message+ ```-This tool can check your changelogs and bump versions in project.-It assumes to be run in root directory of project and that changelog is here.-You can specify these levels of changes: app, major, minor, fix, doc.-It can infer version from changelog.-But it will refuse to do it if it's not sure changelogs are up to date.+changelogged --help+``` -Usage: changelogged [-l|--level ARG] [-a|--api-level ARG] [--format ARG]-                    [-W|--with-api] [-m|--multiple] [-c|--no-check]-                    [-C|--no-bump] [-e|--from-bc] [-f|--force] [-y|--write]+```+changelogged - Changelog Manager for Git Projects +Usage: changelogged [--format FORMAT] [--update-changelog] [--bump-versions]+ Available options:   -h,--help                Show this help text-  -l,--level ARG           Level of changes (for packages). One of (app major-                           minor fix doc)-  -a,--api-level ARG       Level of changes (for API). One of (app major minor-                           fix doc)-  --format ARG             Warning format. One of (simple-                           suggest) (default: simple)-  -W,--with-api            Assume there is changelog for API.-  -m,--multiple            Assume there is more than one changelog.-  -c,--no-check            Do not check changelogs.-  -C,--no-bump             Do not bump versions. Only check changelogs.-  -e,--from-bc             Check changelogs from start of project.-  -f,--force               Bump version even if changelogs are outdated. Cannot-                           be mixed with -c.-  -y,--write               Write changelog suggestions to changelog directly.-                           Available with --format suggest.+  --format FORMAT          Missing entries report format. FORMAT can be 'simple'+                           or 'suggest'. (default: simple)+  --update-changelog       Prepend missing entries to changelogs. Available with+                           --format=suggest.+  --bump-versions          Bump versions according to change level.+  --level CHANGE_LEVEL     Level of changes (for packages). CHANGE_LEVEL can be+                           'app', 'major', 'minor', 'fix' or 'doc'.+  --api-level CHANGE_LEVEL Level of changes (for API). CHANGE_LEVEL can be+                           'app', 'major', 'minor', 'fix' or 'doc'.+  --from-bc                Check changelogs for the entire history of the+                           project.+  --force                  Bump versions even when changelogs are outdated.+  --no-check               Do not check changelogs. ```  See examples [below](#guiding-examples)@@ -119,58 +119,58 @@ ``` changelogged (master):$ changelogged ```-![image1](example_images/common_run.png)+![image1](images/common_run.png)  #### Suggest changelog entries: ``` changelogged (master):$ changelogged --format suggest ```-![image2](example_images/suggest.png)+![image2](images/suggest.png)  Force with no entries in changelog: ``` changelogged (master):$ changelogged --format suggest -f ```-![image3](example_images/no_force.png)+![image3](images/no_force.png)  Force with explicit version: ``` changelogged (master):$ changelogged -f -l major ```-![image4](example_images/force.png)+![image4](images/force.png)  #### Write suggested entries to changelog (works only with `--format suggest`) ``` changelogged (master):$ changelogged --format suggest -y ```-![image5](example_images/suggest.png)+![image5](images/suggest.png) ``` changelogged (master):$ git diff ChangeLog.md ```-![image6](example_images/chlog_diff.png)+![image6](images/chlog_diff.png) It requires some manual editing after. And it will not bump version immediately.  #### Bump version infering it from changelog: ``` changelogged (master):$ changelogged --format suggest -y ```-![image7](example_images/bump.png)+![image7](images/bump.png) ``` changelogged (master):$ git diff ChangeLog.md ```-![image8](example_images/release.png)+![image8](images/release.png)  Do not bump even if changelogs are up to date ``` changelogged -C ```-![image9](example_images/no_bump.png)+![image9](images/no_bump.png)  Try to bump without checking changelogs. Seems that `-f` option is always preferrable. But it waits for use cases. ``` chagelogged -c ```-![image10](example_images/no_check.png)+![image10](images/no_check.png)  ### Typical daily workflow to keep project and API changelogs up to date (assuming existing changelogged.yaml): See missing entries:

@@ -1,117 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Main where -import Prelude hiding (FilePath)-import Turtle--import Control.Exception-import qualified Data.HashMap.Strict as HM-import Data.Maybe (fromMaybe)--import System.Console.ANSI (Color(..))--import Changelogged.CheckLog.Check-import Changelogged.Bump.Local-import Changelogged.Bump.Common-import Changelogged.Bump.General-import Changelogged.Types-import Changelogged.Git-import Changelogged.Options-import Changelogged.Utils-import Changelogged.Pure (showPath, fromJustCustom, defaultedEmpty, showText)-import Changelogged.Settings--commonMain :: Paths -> Options -> Git -> IO ()-commonMain paths opts@Options{..} git = do-  coloredPrint Green ("Checking " <> showPath (taggedLogPath $ chLog paths) <> " and creating it if missing.\n")-  touch $ taggedLogPath (chLog paths)--  bump <- checkChangelogWrap opts git optNoCheck (chLog paths)--  (when (bump && not optNoBump) $ do-    newVersion <- case optPackagesLevel of-      Nothing -> generateVersionByChangelog optNoCheck (taggedLogPath $ chLog paths) (gitRevision git)-      Just lev -> Just <$> generateVersion lev (gitRevision git)-  -    case newVersion of-      Nothing -> return ()-      Just version -> case HM.lookup "main" (defaultedEmpty (versioned paths)) of-        Just files -> do-          printf ("Version: "%s%" -> ") (gitRevision git)-          coloredPrint Yellow (version <> "\n")-          mapM_ (bumpPart version) files-          headChangelog version (taggedLogPath $ chLog paths)-        Nothing -> coloredPrint Yellow "WARNING: no files to bump project version in specified.\n"-    ) `catch` (\(ex :: PatternMatchFail) -> coloredPrint Red (showText ex))-  where-    chLog cfg = HM.lookupDefault (TaggedLog "ChangeLog.md" Nothing) "main"-      (fromMaybe (HM.singleton "main" (TaggedLog "ChangeLog.md" Nothing)) (changelogs cfg))--apiMain :: Paths -> Options -> Git -> IO ()-apiMain paths opts@Options{..} git = do-  coloredPrint Green ("Checking " <> showPath (taggedLogPath $ chLog paths)-                                  <> " and creating it if missing.\nIf no indicator exists it will be checked as global changelog.\n")-  touch $ taggedLogPath (chLog paths)--  bump <- checkChangelogWrap opts git optNoCheck (chLog paths)--  (when (bump && not optNoBump) $ do-    newVersion <- case optApiLevel of-      Nothing -> generateLocalVersionByChangelog optNoCheck (chLog paths)-      Just lev -> Just <$> generateLocalVersion lev (fromJustCustom "No file with current API version specified." (taggedLogIndicator (chLog paths)))-  -    case newVersion of-      Nothing -> return ()-      Just version -> case HM.lookup "api" (defaultedEmpty (versioned paths)) of-        Just files -> do-          mapM_ (bumpPart version) files-          headChangelog version (taggedLogPath $ chLog paths)-        Nothing -> coloredPrint Yellow "WARNING: no files to bump API version in specified.\n"-    ) `catch` (\(ex :: PatternMatchFail) -> coloredPrint Red (showText ex))-  where-    chLog cfg = HM.lookupDefault (TaggedLog "ApiChangeLog.md" Nothing) "api"-      (fromMaybe (HM.singleton "api" (TaggedLog "ApiChangeLog.md" Nothing)) (changelogs cfg))--otherMain :: Paths -> Options -> Git -> IO ()-otherMain paths opts@Options{..} git = do-  mapM_ act (entries (changelogs paths))-  where-    entries :: Maybe (HM.HashMap Text TaggedLog) -> [(Text, TaggedLog)]-    entries (Just a) = HM.toList $ HM.delete "main" $ HM.delete "api" a-    entries Nothing = []-    -    act (key, changelog) = do-      coloredPrint Green ("Checking " <> showPath (taggedLogPath changelog) <> " and creating it if missing.\n")-      touch (taggedLogPath changelog)-    -      bump <- checkChangelogWrap opts git optNoCheck changelog-    -      (when (bump && not optNoBump) $ do-        newVersion <- generateLocalVersionByChangelog optNoCheck changelog-      -        case newVersion of-          Nothing -> return ()-          Just version -> case HM.lookup key (defaultedEmpty (versioned paths)) of-            Just files -> do-              mapM_ (bumpPart version) files-              headChangelog version (taggedLogPath changelog)-            Nothing -> coloredPrint Yellow "WARNING: no files to bump version in specified.\n"-        ) `catch` (\(ex :: PatternMatchFail) -> coloredPrint Red (showText ex))+import Changelogged.Main (defaultMain)  main :: IO ()-main = do-  opts@Options{..} <- options welcome parser--  defaultPaths <- makeDefaultPaths--  paths <- fromMaybe defaultPaths <$> loadPaths--  git <- gitData optFromBC--  commonMain paths opts git--  when optWithAPI $ apiMain paths opts git--  when optDifferentChlogs $ otherMain paths opts git-  -  sh $ rm $ gitHistory git+main = defaultMain

@@ -2,12 +2,12 @@ -- -- see: https://github.com/sol/hpack ----- hash: 603efc893dd29ab0891f45438ea57f2caee1d8d76eb24a1e2aa0677b19bf8c3b+-- hash: 63b26bc7b50ff0f7b1366ef7b0b032521ddaa86e14dd4465421a16d7471a953c  name:           changelogged-version:        0.1.0-synopsis:       Tool to manage project publishing history.-description:    Please see README.md+version:        0.2.0+synopsis:       Changelog manager for Git projects.+description:    Please see the README on Github at <https://github.com/GetShopTV/changelogged#readme> category:       Development homepage:       https://github.com/GetShopTV/changelogged#readme bug-reports:    https://github.com/GetShopTV/changelogged/issues@@ -21,6 +21,15 @@  extra-source-files:     ChangeLog.md+    images/bump.png+    images/chlog_diff.png+    images/common_run.png+    images/force.png+    images/no_bump.png+    images/no_check.png+    images/no_force.png+    images/release.png+    images/suggest.png     README.md  source-repository head@@ -55,15 +64,15 @@   exposed-modules:       Changelogged       Changelogged.Bump.Common-      Changelogged.Bump.General       Changelogged.Bump.Local       Changelogged.CheckLog.Check       Changelogged.CheckLog.Common+      Changelogged.Config       Changelogged.Git+      Changelogged.Main       Changelogged.Options       Changelogged.Pattern       Changelogged.Pure-      Changelogged.Settings       Changelogged.Types       Changelogged.Utils   other-modules:

binary file changed (absent → 18169 bytes)

binary file changed (absent → 197414 bytes)

binary file changed (absent → 145002 bytes)

binary file changed (absent → 154310 bytes)

binary file changed (absent → 10332 bytes)

binary file changed (absent → 16008 bytes)

binary file changed (absent → 216464 bytes)

binary file changed (absent → 16402 bytes)

binary file changed (absent → 209888 bytes)

@@ -11,6 +11,7 @@  import Filesystem.Path.CurrentOS (encodeString) +import Changelogged.Config import Changelogged.Types import Changelogged.Pattern @@ -25,14 +26,14 @@  -- |Bump version in any supported file. -- Unlike sed it reads all the file and is less memory efficient.-bumpAny :: (Text -> Pattern Text) -> TaggedFile -> Text -> Shell ()-bumpAny extGrep TaggedFile{..} version = do-  file <- fold (input taggedFilePath) Fold.list-  matched <- fold (grep (extGrep taggedFileVariable) (select file)) Fold.list+bumpAny :: VersionFile -> Text -> Shell ()+bumpAny VersionFile{..} version = do+  file <- fold (input versionFilePath) Fold.list+  matched <- fold (grep (has (text versionFileVersionPattern)) (select file)) Fold.list   when (null matched) $-    throw (PatternMatchFail ("ERROR: Cannot bump. Cannot detect version in file " <> encodeString taggedFilePath <> ". Check config.\n"))+    throw (PatternMatchFail ("ERROR: Cannot bump. Cannot detect version in file " <> encodeString versionFilePath <> ". Check config.\n"))   changed <- fold (sed (versionExactRegex $> version) (select matched)) Fold.list-  output taggedFilePath (select $ generateVersionedFile file changed matched)+  output versionFilePath (select $ generateVersionedFile file changed matched)  -- |Replace given lines in the file. -- Here is used and called to write new lines wih versions.@@ -56,15 +57,10 @@       | otherwise = xvar : replaceLine xvars newLine oldLine  -- |Bump version in file regarding extension.-bumpPart :: Text -> TaggedFile -> IO ()-bumpPart version file@TaggedFile{..} = do-  printf ("- Updating version for "%fp%"\n") taggedFilePath-  case extension taggedFilePath of-    Just "hs" -> sh $ bumpAny hsGrep file version-    Just "json" -> sh $ bumpAny jsonGrep file version-    Just "yaml" -> sh $ bumpAny yamlGrep file version-    Just "cabal" -> sh $ bumpAny cabalGrep file version-    _ -> throw (PatternMatchFail ("ERROR: Cannot bump version. Unsupported extension in file " <> encodeString taggedFilePath <> ". Check config."))+bumpPart :: Text -> VersionFile -> IO ()+bumpPart version file@VersionFile{..} = do+  printf ("- Updating version for "%fp%"\n") versionFilePath+  sh $ bumpAny file version  -- |Get level of changes from changelog. getChangelogEntries :: FilePath -> IO (Maybe Level)

@@ -1,30 +0,0 @@-module Changelogged.Bump.General where--import Turtle-import Prelude hiding (FilePath)--import Data.Text (Text)--import System.Console.ANSI (Color(..))--import Changelogged.Types-import Changelogged.Pure-import Changelogged.Utils-import Changelogged.Bump.Common---- |Generate new version based on given level and current version.-generateVersion :: Level -> Text -> IO Text-generateVersion lev current = return $ bump (delimited current) lev---- |Infer version from changelog.-generateVersionByChangelog :: Bool -> FilePath -> Text -> IO (Maybe Text)-generateVersionByChangelog True _ _ = do-  coloredPrint Yellow "You are bumping version with no explicit version modifiers and changelog checks. It can result in anything. Please retry.\n"-  return Nothing-generateVersionByChangelog False changelogFile curVersion = do-  versionedChanges <- getChangelogEntries changelogFile-  case versionedChanges of-    Just lev -> Just <$> generateVersion lev curVersion-    Nothing -> do-      coloredPrint Yellow ("WARNING: keep old version since " <> showPath changelogFile <> " apparently does not contain any new entries.\n")-      return Nothing

@@ -6,7 +6,7 @@ import Control.Exception import qualified Control.Foldl as Fold -import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, listToMaybe) import Data.Text (Text)  import Filesystem.Path.CurrentOS (encodeString)@@ -17,24 +17,20 @@ import Changelogged.Pure import Changelogged.Pattern import Changelogged.Bump.Common+import Changelogged.Config  -- |Get current local version.-currentLocalVersion :: TaggedFile -> IO Text-currentLocalVersion TaggedFile{..} = do-  ver <- case extension taggedFilePath of-    Just "json" -> fold (grep (has $ jsonVarGrep taggedFileVariable) (input taggedFilePath)) Fold.head-    Just "hs" -> fold (grep (has $ hsVarGrep taggedFileVariable) (input taggedFilePath)) Fold.head-    Just "yaml" -> fold (grep (has $ yamlVarGrep taggedFileVariable) (input taggedFilePath)) Fold.head-    Just "cabal" -> fold (grep (has $ cabalVarGrep taggedFileVariable) (input taggedFilePath)) Fold.head-    _ -> throw (PatternMatchFail $ "ERROR: Cannot get local version. Unsupported extension in indicator file " <> encodeString taggedFilePath <> ". Check config.\n")+currentLocalVersion :: VersionFile -> IO Text+currentLocalVersion VersionFile{..} = do+  ver <- fold (grep (has (text versionFileVersionPattern)) (input versionFilePath)) Fold.head   return $ case ver of     Just realVer -> fromMaybe-      (throw (PatternMatchFail $ "ERROR: Cannot get local version. Given variable " <> show taggedFileVariable <> " doesn't store version. Check config.\n"))+      (throw (PatternMatchFail $ "cannot get local version. Given variable " <> show versionFileVersionPattern <> " doesn't store version. Check config.\n"))       (versionMatch . lineToText $ realVer)-    Nothing -> throw (PatternMatchFail $ "ERROR: Cannot get local version. Cannot find given variable " <> show taggedFileVariable <> " in file " <> encodeString taggedFilePath <> ". Check config.\n")+    Nothing -> throw (PatternMatchFail $ "cannot get local version. Cannot find given variable " <> show versionFileVersionPattern <> " in file " <> encodeString versionFilePath <> ". Check config.\n")  -- |Generate new local version.-generateLocalVersion :: Level -> TaggedFile -> IO Text+generateLocalVersion :: Level -> VersionFile -> IO Text generateLocalVersion lev indicator = do   current <- currentLocalVersion indicator   -- This print must not be here but I think it's better than throw current vrsion to main.@@ -45,14 +41,16 @@     new current = bump (delimited current) lev  -- |Infer new local version.-generateLocalVersionByChangelog :: Bool -> TaggedLog -> IO (Maybe Text)-generateLocalVersionByChangelog True _ = do-  coloredPrint Yellow "You are bumping API version with no explicit version modifiers and changelog checks. It can result in anything. Please retry.\n"-  return Nothing-generateLocalVersionByChangelog False TaggedLog{..} = do-  versionedChanges <- getChangelogEntries taggedLogPath+generateLocalVersionByChangelog :: ChangelogConfig -> IO (Maybe Text)+generateLocalVersionByChangelog ChangelogConfig{..} = do+  versionedChanges <- getChangelogEntries changelogChangelog   case versionedChanges of-    Just lev -> Just <$> generateLocalVersion lev (fromJustCustom "No file with current local version specified." taggedLogIndicator)+    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     Nothing -> do-      coloredPrint Yellow ("WARNING: keep old API version since " <> showPath taggedLogPath <> " apparently does not contain any new entries.\n")+      warning $ "keeping current version since " <> showPath changelogChangelog <> " apparently does not contain any new entries"       return Nothing

@@ -3,9 +3,10 @@  import Turtle hiding (stdout, stderr) import Prelude hiding (FilePath)+import Data.Foldable (asum)  import qualified Control.Foldl as Fold-import Control.Monad (when, filterM)+import Control.Monad (when)  import System.Console.ANSI (Color(..)) @@ -15,74 +16,63 @@ import Changelogged.Pure import Changelogged.Pattern import Changelogged.CheckLog.Common---- |This is actually part if '@Main@'--- Check common changelog.-checkCommonChangelogF :: WarningFormat -> Bool -> Git -> FilePath -> IO Bool-checkCommonChangelogF fmt writeLog Git{..} changelog = do-  printf ("Checking "%fp%"\n") changelog--  pullCommits <- map (fromJustCustom "Cannot find commit hash in git log entry" . hashMatch . lineToText)-    <$> fold (grep githubRefGrep (input gitHistory)) Fold.list-  pulls <- map (fromJustCustom "Cannot find pull request number in git log entry" . githubRefMatch . lineToText)-    <$> fold (grep githubRefGrep (input gitHistory)) Fold.list-  singles <- map (fromJustCustom "Cannot find commit hash in git log entry" . hashMatch . lineToText)-    <$> fold (grep hashGrepExclude (input gitHistory)) Fold.list-  -  filteredSingles <- filterM noMarkdown singles-  -  pullHeaders <- mapM (commitMessage PR) pullCommits-  singleHeaders <- mapM (commitMessage Commit) filteredSingles-  flagsPR <- mapM (\(i,m) -> changelogIsUp fmt writeLog gitLink i PR m changelog) (zip pulls pullHeaders)-  flagsCommit <- mapM (\(i, m) -> changelogIsUp fmt writeLog gitLink i Commit m changelog) (zip filteredSingles singleHeaders)-  return $ and (flagsPR ++ flagsCommit)+import Changelogged.Config+import Changelogged.Git  -- |This is actually part if '@Main@' -- Check local changelog - local means what changelog is specific and has some indicator file. If file is changed changelog must change.-checkLocalChangelogF :: WarningFormat -> Bool -> Git -> FilePath -> FilePath -> IO Bool-checkLocalChangelogF fmt writeLog Git{..} path indicator = do-  printf ("Checking "%fp%"\n") path+checkLocalChangelogF :: WarningFormat -> Bool -> GitInfo -> ChangelogConfig -> IO Bool+checkLocalChangelogF fmt writeLog GitInfo{..} ChangelogConfig{..} = do+  info $ "looking for missing entries in " <> format fp changelogChangelog      commits <- map (fromJustCustom "Cannot find commit hash in git log entry" . hashMatch . lineToText)-    <$> fold (input gitHistory) Fold.list+    <$> fold (select gitHistory) Fold.list -  flags <- mapM (eval gitHistory) commits+  flags <- mapM eval commits   return $ and flags   where-    eval hist commit = do-      linePresent <- fold-        (grep (has $ text $ showPath indicator)-          (inproc "git" ["show", "--stat", commit] empty))-        countLines-      case linePresent of-        0 -> return True-        _ -> do-          pull <- fmap (fromJustCustom "Cannot find commit hash in git log entry" . githubRefMatch . lineToText) <$>-              fold (grep githubRefGrep (grep (has (text commit)) (input hist))) Fold.head-          case pull of-            Nothing -> do-              message <- commitMessage Commit commit-              changelogIsUp fmt writeLog gitLink commit Commit message path-            Just pnum -> do-              message <- commitMessage PR commit-              changelogIsUp fmt writeLog gitLink pnum PR message path+    eval commit = do+      ignoreChange <- case changelogWatchFiles of+        Nothing -> case changelogIgnoreFiles of+          Nothing -> return False+          Just files -> do+            linePresent <- fold+              (grep (invert (asum (map (has . text . showPath) files)))+                (inproc "git" ["show", "--stat", commit] empty))+              countLines+            return (linePresent == 0)+        Just files -> do+          linePresent <- fold+            (grep (asum (map (has . text . showPath) files))+              (inproc "git" ["show", "--stat", commit] empty))+            countLines+          return (linePresent == 0)+      if ignoreChange then return True else do+        pull <- fmap (fromJustCustom "Cannot find commit hash in git log entry" . githubRefMatch . lineToText) <$>+            fold (grep githubRefGrep (grep (has (text commit)) (select gitHistory))) Fold.head+        case pull of+          Nothing -> do+            message <- commitMessage Commit commit+            changelogIsUp fmt writeLog gitRemoteUrl commit Commit message changelogChangelog+          Just pnum -> do+            message <- commitMessage PR commit+            changelogIsUp fmt writeLog gitRemoteUrl pnum PR message changelogChangelog  -- |This is actually part if '@Main@' -- Check given changelog regarding options.-checkChangelogWrap :: Options -> Git -> Bool -> TaggedLog -> IO Bool-checkChangelogWrap _ _ True _ = do-  coloredPrint Yellow "WARNING: skipping checks for API changelog.\n"-  return True-checkChangelogWrap Options{..} git False TaggedLog{..} = do-  when optFromBC $ printf ("Checking "%fp%" from start of project\n") taggedLogPath-  upToDate <- case taggedLogIndicator of-    Nothing -> checkCommonChangelogF optFormat optWrite git taggedLogPath-    Just ind -> checkLocalChangelogF optFormat optWrite git taggedLogPath (taggedFilePath ind)-  if upToDate-    then coloredPrint Green (showPath taggedLogPath <> " is up to date.\n")-    else coloredPrint Yellow ("WARNING: " <> showPath taggedLogPath <> " is out of date.\n")-  if upToDate-    then return True+checkChangelogWrap :: Options -> GitInfo -> ChangelogConfig -> IO Bool+checkChangelogWrap Options{..} git config@ChangelogConfig{..} = do+  if (optUpdateChangelog && optFormat == WarnSimple)+    then do+      failure "--update-changelog does not work with --format=simple (try --format=suggest instead)"+      return False     else do-      coloredPrint Red ("ERROR: " <> showPath taggedLogPath <> " is not up-to-date. Use -c or --no-check options if you want to ignore changelog checks and -f to bump anyway.\n")-      return optForce+      when optFromBC $ printf ("Checking "%fp%" from start of project\n") changelogChangelog+      upToDate <- checkLocalChangelogF optFormat optUpdateChangelog git config+      if upToDate+        then coloredPrint Green (showPath changelogChangelog <> " is up to date.\n")+        else do+          warning $ showPath changelogChangelog <> " is out of date." <>+            if optUpdateChangelog then "" else+              "\nUse --update-changelog to add missing changelog entries automatically."+      return upToDate

@@ -65,11 +65,11 @@   printf ("- "%s%" (see ") message   case mode of     PR -> do-      coloredPrint Cyan ("[" <> item <> "]")-      printf ("("%s%")") (prLink link item)+      coloredPrint Cyan $ "[" <> item <> "]"+      coloredPrint Blue $ "(" <> prLink link item <> ")"     Commit -> do       coloredPrint Cyan ("[`" <> item <> "`]")-      printf ("("%s%")") (commitLink link item)+      coloredPrint Blue $ "(" <> commitLink link item <> ")"   printf ");\n"  -- |Add generated suggestion directly to changelog.

@@ -0,0 +1,84 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+module Changelogged.Config where++import Data.Aeson+import Data.Monoid ((<>))+import Data.String (fromString)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Yaml as Yaml++import qualified Turtle++data Config = Config+  { configChangelogs    :: [ChangelogConfig]+  , configIgnoreCommits :: Maybe [Text]+  , configBranch        :: Maybe Text+  }++data ChangelogConfig = ChangelogConfig+  { changelogChangelog    :: Turtle.FilePath+  , changelogWatchFiles   :: Maybe [Turtle.FilePath]+  , changelogIgnoreFiles  :: Maybe [Turtle.FilePath]+  , changelogVersionFiles :: Maybe [VersionFile]+  }++data VersionFile = VersionFile+  { versionFilePath :: Turtle.FilePath+  , versionFileVersionPattern :: Text+  }++instance FromJSON Config where+  parseJSON = withObject "Config" $ \o -> Config+    <$> o .:  "changelogs"+    <*> o .:? "ignore_commits"+    <*> o .:? "branch"++instance FromJSON ChangelogConfig where+  parseJSON = withObject "ChangelogConfig" $ \o -> ChangelogConfig+    <$> (fromString <$> o .:  "changelog")+    <*> (fmap (map fromString) <$> o .:? "watch_files")+    <*> (fmap (map fromString) <$> o .:? "ignore_files")+    <*> o .:? "version_files"++instance FromJSON VersionFile where+  parseJSON = withObject "VersionFile" $ \o -> VersionFile+    <$> (fromString <$> o .: "path")+    <*> o .: "version_pattern"++defaultConfig :: Config+defaultConfig = Config+  { configChangelogs    = pure ChangelogConfig+      { changelogChangelog    = "ChangeLog.md"+      , changelogWatchFiles   = Nothing  -- watch everything+      , changelogIgnoreFiles  = Nothing  -- ignore nothing+      , changelogVersionFiles = Just [VersionFile "package.yaml" "version:"]+      }+  , configIgnoreCommits = Nothing+  , configBranch = Nothing+  }++loadConfig :: FilePath -> IO (Maybe Config)+loadConfig path = do+  ms <- Yaml.decodeFileEither path+  return $ case ms of+    Left _wrong -> Nothing+    Right paths -> Just paths++ppConfig :: Config -> Text+ppConfig Config{..} = mconcat+  [ "Main branch (with version tags)" ?: configBranch+  , "Ignored commits" ?: (Text.pack . show . length <$> configIgnoreCommits)+  , "Changelogs" !: formatItems Turtle.fp (map changelogChangelog configChangelogs)+  ]+  where+    formatItems fmt+      = ("\n" <>)+      . Text.unlines+      . map (\x -> "- " <> Turtle.format fmt x)++    name !: val = name <> ": " <> val <> "\n"++    _    ?: Nothing = ""+    name ?: Just val = name !: val

@@ -1,3 +1,4 @@+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Changelogged.Git where @@ -12,35 +13,79 @@  import Turtle -import Changelogged.Types+-- | Information about the state of a git repository.+data GitInfo = GitInfo+  { gitHistory   :: [Turtle.Line]+    -- ^ A list of git commit messages.+  , gitRemoteUrl :: Text+    -- ^ An HTTP(S) link to the repository.+    -- This will be used to construct links to issues, commits and pull requests.+  , gitLatestVersion :: Maybe Text+    -- ^ Latest version (tag) in the current branch.+  } deriving (Show) --- |Get latest git tag in origin/master if present.-latestGitTag :: Text -> IO Text-latestGitTag repl = do-  ver <- fold ((fromRight "" <$> inprocWithErr "git" ["describe", "--tags", "origin/master"] empty) `catch` \ (_ :: ExitCode) -> empty) Fold.head-  return $ case ver of-    Nothing -> repl-    Just v -> lineToText v+-- | Get latest git tag in a given branch (if present).+-- If no branch is specified then @HEAD^@ is used.+loadGitLatestTag :: Maybe Text -> IO (Maybe Text)+loadGitLatestTag mbranch = do+  let branch = fromMaybe "HEAD^" mbranch+  ver <- fold ((fromRight "" <$> inprocWithErr "git" ["describe", "--tags", "--abbrev=0", branch] empty) `catch` \ (_ :: ExitCode) -> empty) Fold.head+  return $ fmap lineToText ver --- |Get link to origin and strip '.git' to get valid url to project page.-getLink :: IO Text-getLink = do-  raw <- strict $ inproc "git" ["remote", "get-url", "origin"] empty-  return $ fromMaybe (Text.stripEnd raw) (Text.stripSuffix ".git\n" raw)+-- | Get link to origin and strip '.git' to get valid url to project page.+loadGitRemoteUrl :: IO Text+loadGitRemoteUrl = remoteUrlToHttps+  <$> strict (inproc "git" ["remote", "get-url", "origin"] empty) --- |Extract latest history and origin link from git through temporary file and store it in '@Git@'.-gitData :: Bool -> IO Git-gitData start = do-  curDir <- pwd-  tmpFile <- with (mktempfile curDir "tmp_") return-  latestTag <- latestGitTag ""-  link <- getLink-  hist <- if start || (latestTag == "")-    then fold (grep (invert (has (text "Merge branch"))) (inproc "git" ["log", "--oneline", "--first-parent"] empty)) Fold.list-    else fold (grep (invert (has (text "Merge branch"))) (inproc "git" ["log", "--oneline", "--first-parent", latestTag <> "..HEAD"] empty)) Fold.list-  liftIO $ append tmpFile (select hist)-  return $ Git tmpFile link (version latestTag)+-- | Change git remote URL so that it can be used in the browser.+--+-- >>> remoteUrlToHttps "git@github.com:GetShopTV/changelogged.git"+-- "https://github.com/GetShopTV/changelogged"+--+-- >>> remoteUrlToHttps "https://github.com/GetShopTV/changelogged.git"+-- "https://github.com/GetShopTV/changelogged"+remoteUrlToHttps :: Text -> Text+remoteUrlToHttps+  = whenPossible (Text.stripSuffix ".git")+  . Text.replace "git@github.com:" "https://github.com/"+  . Text.strip   where-    version tag = case tag of-      "" -> "0.0.0.0.0"-      v -> Text.dropWhile (not . isDigit) v+    whenPossible fn y = fromMaybe y (fn y)++-- | Load git history from a given commit or from the start of the project.+loadGitHistory+  :: Maybe Text  -- ^ A commit/tag to mark the start of history.+  -> IO [Turtle.Line]+loadGitHistory from = do+  fold (grep+    (invert (has (text "Merge branch"))) -- FIXME: why ignore Merge branch commits?+    (inproc "git" (["log", "--oneline", "--first-parent"] <> range) empty))+    Fold.list+  where+    range = case from of+      Nothing     -> []+      Just commit -> [commit <> "..HEAD"]++-- | Extract latest history and origin link from git through temporary file and store it in 'GitInfo'.+loadGitInfo+  :: Bool       -- ^ Include the whole project history?+  -> Maybe Text -- ^ Branch with version tags (@HEAD@ is used by default).+  -> IO GitInfo+loadGitInfo entireHistory branch = do+  latestTag    <- loadGitLatestTag branch+  gitHistory   <- loadGitHistory (if entireHistory then Nothing else latestTag)+  gitRemoteUrl <- loadGitRemoteUrl+  let gitLatestVersion = extractVersion latestTag+  return GitInfo {..}+  where+    extractVersion tag = case Text.dropWhile (not . isDigit) <$> tag of+      Just ver | not (Text.null ver) -> Just ver+      _ -> Nothing++-- | Pretty print known information about a Git project.+ppGitInfo :: GitInfo -> Text+ppGitInfo GitInfo{..} = Text.unlines+  [ "Git remote URL: " <> gitRemoteUrl+  , "Latest release: " <> fromMaybe "<none>" gitLatestVersion+  , "Changes since last release: " <> Text.pack (show (length gitHistory))+  ]

@@ -0,0 +1,75 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Changelogged.Main where++import Turtle hiding (FilePath)++import Control.Exception+import Data.Maybe (fromMaybe)++import System.Console.ANSI (Color(..))++import Changelogged.CheckLog.Check+import Changelogged.Bump.Local+import Changelogged.Bump.Common+import Changelogged.Git+import Changelogged.Options+import Changelogged.Utils+import Changelogged.Pure (showText)+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++processChangelogs :: Config -> Options -> GitInfo -> IO ()+processChangelogs config opts gitInfo = do+  mapM_ (processChangelog opts gitInfo) (configChangelogs config)++processChangelog :: Options -> GitInfo -> ChangelogConfig -> IO ()+processChangelog opts@Options{..} gitInfo config@ChangelogConfig{..} = do+  putStrLn ""+  info $ "processing " <> format fp changelogChangelog+  changelogExists <- testfile changelogChangelog+  when (not changelogExists) $ do+    info (format fp changelogChangelog <> " does not exist. Creating an empty changelog.")+    touch changelogChangelog++  upToDate <- if optNoCheck+    then do+      warning $ "skipping checks for " <> format fp changelogChangelog <> " (due to --no-check)."+      return True+    else do+      checkChangelogWrap opts gitInfo config++  when optBumpVersions $ if+    | not upToDate && not optForce ->+        failure $ "cannot bump versions because " <> format fp changelogChangelog <> " is out of date.\nUse --no-check to skip changelog checks.\nUse --force to force bump version."+    | not upToDate && optForce ->+        warning $ format fp changelogChangelog <> " is out of date. Bumping versions anyway due to --force."+    | otherwise -> (do+        newVersion <- if optNoCheck+          then do+            failure "cannot infer new version from changelog because of --no-check.\nUse explicit --level CHANGE_LEVEL."+            return Nothing+          else do+            generateLocalVersionByChangelog config++        case newVersion of+          Nothing -> return ()+          Just version -> case changelogVersionFiles of+            Just versionFiles -> do+              mapM_ (bumpPart version) versionFiles+              headChangelog version changelogChangelog+            Nothing -> warning "no files specified to bump versions in"+        ) `catch` (\(ex :: PatternMatchFail) -> failure (showText ex))+

@@ -1,18 +1,25 @@ module Changelogged.Options where  import Data.Char (toLower)+import Data.List (intercalate)+import Data.Monoid ((<>)) -import Options.Applicative hiding (switch)-import Turtle hiding (option)+import Options.Applicative+import qualified Turtle  import Changelogged.Types +-- |+-- >>> availableWarningFormats+-- [simple,suggest] availableWarningFormats :: [WarningFormat] availableWarningFormats = [minBound..maxBound] +-- |+-- >>> availableWarningFormatsStr+-- "'simple' or 'suggest'" availableWarningFormatsStr :: String-availableWarningFormatsStr-  = "(" <> unwords (map (map toLower . show) availableWarningFormats) <> ")"+availableWarningFormatsStr = prettyPossibleValues availableWarningFormats  readWarningFormat :: ReadM WarningFormat readWarningFormat = eitherReader (r . map toLower)@@ -31,11 +38,18 @@  -- | -- >>> availableLevelsStr--- "(app major minor fix doc)"+-- "'app', 'major', 'minor', 'fix' or 'doc'" availableLevelsStr :: String-availableLevelsStr-  = "(" <> unwords (map (map toLower . show) availableLevels) <> ")"+availableLevelsStr = prettyPossibleValues availableLevels +prettyPossibleValues :: Show a => [a] -> String+prettyPossibleValues xs = case reverse xs of+  []  -> "none"+  [y] -> prettyValue y+  (y:ys) -> intercalate ", " (map prettyValue (reverse ys)) <> " or " <> prettyValue y+  where+    prettyValue v = "'" <> map toLower (show v) <> "'"+ readLevel :: ReadM Level readLevel = eitherReader (r . map toLower)   where@@ -46,62 +60,65 @@     r "doc"   = Right Doc     r lvl = Left $          "Unknown level of changes: " <> show lvl <> ".\n"-      <> "Use one of " <> availableLevelsStr <> ".\n"+      <> "Should be " <> availableLevelsStr <> ".\n"  parser :: Parser Options parser = Options-  <$> optional packagesLevel-  <*> optional apiLevel-  <*> warningFormat-  <*> switch  "with-api"  'W' "Assume there is changelog for API."-  <*> switch  "multiple"  'm' "Assume there is more than one changelog."-  <*> switch  "no-check"  'c' "Do not check changelogs."-  <*> switch  "no-bump"  'C' "Do not bump versions. Only check changelogs."-  <*> switch  "from-bc"  'e' "Check changelogs from start of project."-  <*> switch  "force"  'f' "Bump version even if changelogs are outdated. Cannot be mixed with -c."-  <*> switch  "write"  'y' "Write changelog suggestions to changelog directly. Available with --format suggest."+  <$> warningFormat+  <*> longSwitch "update-changelog"+        "Add missing entries to changelogs (works with --format=suggest)."+  <*> longSwitch "bump-versions" "Bump versions in version files."+  <*> optional changesLevel+  <*> hiddenSwitch "from-bc"+        "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."   where-    packagesLevel = option readLevel $+    longSwitch name description = switch $+         long name+      <> help description++    hiddenSwitch name description = switch $+         long name+      <> help description+      <> hidden++    changesLevel = option readLevel $          long "level"-      <> short 'l'-      <> help ("Level of changes (for packages). One of " <> availableLevelsStr)-    apiLevel = option readLevel $-         long "api-level"-      <> short 'a'-      <> help ("Level of changes (for API). One of " <> availableLevelsStr)+      <> metavar "CHANGE_LEVEL"+      <> help (unlines+           [ "Level of changes (to override one inferred from changelogs)."+           , "CHANGE_LEVEL can be " <> availableLevelsStr <> "."+           ])+      <> hidden     warningFormat = option readWarningFormat $          long "format"-      <> help ("Warning format. One of " <> availableWarningFormatsStr)+      <> metavar "FORMAT"+      <> help ("Format for missing changelog entry warnings. FORMAT can be " <> availableWarningFormatsStr <> ".")       <> value WarnSimple       <> showDefault -welcome :: Description-welcome = Description $ "---\n"-        <> "This tool can check your changelogs and bump versions in project.\n"-        <> "It assumes to be run in root directory of project and that changelog is here.\n"-        <> "You can specify these levels of changes: app, major, minor, fix, doc.\n"-        <> "It can infer version from changelog.\n"-        <> "But it will refuse to do it if it's not sure changelogs are up to date."+welcome :: Turtle.Description+welcome = Turtle.Description "changelogged - Changelog Manager for Git Projects" +-- | Command line options for @changelogged@. data Options = Options-  { -- |Explicit level of changes for files with common versioning.-    optPackagesLevel   :: Maybe Level-  -- |Explicit level of changes in API.-  , optApiLevel        :: Maybe Level-  -- |Output formatting.-  , optFormat          :: WarningFormat-  -- |Assume there is API to check and bump.-  , optWithAPI         :: Bool-  -- |Assume there is some changelogs with unpredicted meanings.-  , optDifferentChlogs :: Bool-  -- |Do not check changelogs.-  , optNoCheck         :: Bool-  -- |Do not bump versions.-  , optNoBump          :: Bool-  -- |Check changelogs from start of project.+  { -- | Format for missing changelog entry warnings.+    optFormat          :: WarningFormat+    -- | Add missing changelog entries to changelog files.+  , optUpdateChangelog :: Bool+    -- | Bump versions in version files.+  , optBumpVersions    :: Bool+    -- | Level of changes (to override one inferred from changelogs).+  , optChangeLevel     :: Maybe Level+    -- | Look for missing changelog entries from the start of the project.   , optFromBC          :: Bool-  -- |Bump versions even if changelogs are outdated.+    -- | Bump versions ignoring possibly outdated changelogs.   , optForce           :: Bool-  -- |Write suggestions to changelog directly.-  , optWrite           :: Bool+    -- | Do not check if changelogs have any missing entries.+  , optNoCheck         :: Bool   }++-- | Parse command line options.+parseOptions :: IO Options+parseOptions = Turtle.options welcome parser

@@ -84,75 +84,3 @@ -- Just "#444" githubRefMatch :: Text -> Maybe Text githubRefMatch str = maxByLen $ match githubRefRegex str---- >>> match (jsonGrep "var") "\"var\" : \"1.1.1\""--- ["\"var\" : \"1.1.1\""]--- >>> match (jsonGrep "v") "\"var\" : \"1.1.1\""--- []--- >>> match (jsonGrep "v") "\"v\" : 1.1.1\""--- []--- >>> match (jsonGrep "v") "\"v\":\"1.1.1\""--- ["\"v\":\"1.1.1\""]--- >>> match (jsonGrep "v") "\"v\"=\"1.1.1\""--- []-jsonGrep :: Text -> Pattern Text-jsonGrep var = has $ jsonVarGrep var <> spaces <> "\"" <> versionExactRegex <> "\""---- >>> match (cabalGrep "var") "var: 1.1.1"--- ["var: 1.1.1","var: 1.1"]--- >>> match (cabalGrep "var") "v: 1.1.1"--- []--- >>> match (cabalGrep "var") "var: (1.1.1)"--- []--- >>> match (cabalGrep "var") "var: 1.1.1 2.2.2.2 "--- ["var: 1.1.1","var: 1.1"]--- >>> match (cabalGrep "var") "var: 1.1.1"--- ["var: 1.1.1"]--- >>> match (cabalGrep "var") "var: 1.1.1 "--- ["var:1.1.1"]--- >>> match (cabalGrep "var") "var: 1.1.1h "--- []-cabalGrep :: Text -> Pattern Text-cabalGrep var = choice [has $ cabalVarGrep var <> between spaces spaces1 versionExactRegex, suffix $ cabalVarGrep var <> spaces <> versionExactRegex]---- >>> match (hsGrep "var") "var= \"1.1.1\" "--- ["var= \"1.1.1\""]--- >>> match (hsGrep "var") "v= \"1.1.1\" "--- []--- >>> match (hsGrep "var") "var= 1.1.1 "--- []-hsGrep :: Text -> Pattern Text-hsGrep var = has $ hsVarGrep var <> spaces <> "\"" <> versionExactRegex <> "\""--yamlGrep :: Text -> Pattern Text-yamlGrep = cabalGrep---- >>> match (jsonVarGrep "var") "var :" --- []--- >>> match (jsonVarGrep "var") "var =" --- []--- >>> match (jsonVarGrep "var") "\"var\" :" --- ["\"var\" :"]-jsonVarGrep :: Text -> Pattern Text-jsonVarGrep var = "\"" <> text var <> "\"" <> spaces <> ":"---- >>> match (hsVarGrep "var") "var =" --- ["var ="]--- >>> match (hsVarGrep "var") "var :" --- []--- >>> match (hsVarGrep "var") "\"var\" :" --- []-cabalVarGrep :: Text -> Pattern Text-cabalVarGrep var = text var <> spaces <> ":"---- >>> match (cabalVarGrep "var") "\"var\" :" --- []--- >>> match (cabalVarGrep "var") "var :" --- ["var :"]--- >>> match (cabalVarGrep "var") "var =" --- []-hsVarGrep :: Text -> Pattern Text-hsVarGrep var = text var <> spaces <> "="--yamlVarGrep :: Text -> Pattern Text-yamlVarGrep = cabalVarGrep

@@ -1,67 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Changelogged.Settings where--import Prelude hiding (FilePath)-import Turtle--import qualified Control.Foldl as Fold-import Filesystem.Path.CurrentOS ((<.>), encodeString, decodeString)--import Data.Aeson.Types (typeMismatch)-import qualified Data.HashMap.Strict as HM-import Data.List (isInfixOf)-import Data.Text (Text)-import qualified Data.Yaml as Yaml-import Data.Vector ((!))-import Data.Yaml ((.:), (.:?))--import GHC.Generics--import Changelogged.Types--data Paths = Paths {-  -- Changelogs data-    changelogs :: Maybe (HM.HashMap Text TaggedLog)-  -- Files to bump data-  , versioned :: Maybe (HM.HashMap Text [TaggedFile])-  } deriving (Show, Generic)--makeDefaultPaths :: IO Paths-makeDefaultPaths = do-  cabals <- fold (find (suffix (text "package.yaml")) ".") Fold.list-  let textualCabals = map encodeString cabals-      filedCabals = map decodeString-      taggedFiles = map (`TaggedFile` "version") (filedCabals $ filter (not . isInfixOf "/.") textualCabals)-      defaultChLog = TaggedLog ("ChangeLog" <.> "md") Nothing-  return $ Paths (Just $ HM.singleton "main" defaultChLog) (Just $ HM.singleton "main" taggedFiles)--instance Yaml.FromJSON Paths--instance Yaml.FromJSON TaggedFile where-  parseJSON (Yaml.Object v) = TaggedFile-        <$> v .: "path"-        <*> v .: "variable"-  parseJSON (Yaml.Array v) = TaggedFile-        <$> Yaml.parseJSON (v ! 0)-        <*> Yaml.parseJSON (v ! 1)-  parseJSON invalid = typeMismatch "TaggedFile" invalid--instance Yaml.FromJSON TaggedLog where-  parseJSON (Yaml.Object v) = TaggedLog-        <$> v .: "path"-        <*> v .:? "indicator"-  parseJSON (Yaml.Array v) = TaggedLog-        <$> Yaml.parseJSON (v ! 0)-        <*> Yaml.parseJSON (v ! 1)-  parseJSON invalid = typeMismatch "TaggedLog" invalid--instance Yaml.FromJSON FilePath where-  parseJSON = fmap fromText . Yaml.parseJSON--loadPaths :: IO (Maybe Paths)-loadPaths = do-  ms <- Yaml.decodeFileEither "./changelogged.yaml"-  return $ case ms of-    Left _wrong -> Nothing-    Right paths -> Just paths

@@ -3,11 +3,6 @@  import Data.Text (Text) -import Prelude hiding (FilePath)-import Turtle--import GHC.Generics- type Variable = Text type Key = Text @@ -18,33 +13,14 @@ -- |Type of entry in git history. data Mode = PR | Commit --- |Structure to save once token git data.-data Git = Git-  { gitHistory :: FilePath-  , gitLink :: Text-  , gitRevision :: Text-  }---- |File with identifier of version to bump.-data TaggedFile = TaggedFile-  { taggedFilePath :: FilePath-  , taggedFileVariable :: Variable-  } deriving (Show, Generic)---- |Changelog with optional file indicating changes.-data TaggedLog = TaggedLog-  { taggedLogPath :: FilePath-  , taggedLogIndicator :: Maybe TaggedFile-  } deriving (Show, Generic)- instance Show Mode where   show PR = "Pull request"-  show Commit = "Single commit"+  show Commit = "Commit"  data WarningFormat   = WarnSimple   | WarnSuggest-  deriving (Enum, Bounded)+  deriving (Eq, Enum, Bounded)  instance Show WarningFormat where   show WarnSimple  = "simple"

@@ -1,6 +1,7 @@ module Changelogged.Utils where  import Data.Text (Text)+import Data.Monoid ((<>))  import System.Console.ANSI @@ -12,3 +13,15 @@   setSGR [SetColor Foreground Vivid color]   printf s line   setSGR [Reset]++warning :: Text -> IO ()+warning msg = coloredPrint Yellow $+  "WARNING: " <> msg <> "\n"++failure :: Text -> IO ()+failure msg = coloredPrint Red $+  "FAILURE: " <> msg <> "\n"++info :: Text -> IO ()+info msg = coloredPrint Cyan $+  "INFO: " <> msg <> "\n"