changelogged (empty) → 0.1.0

raw patch · 20 files changed

+1403/−0 lines, 20 filesdep +Globdep +QuickCheckdep +aesonbuild-type:Customsetup-changed

Dependencies added: Glob, QuickCheck, aeson, ansi-terminal, base, changelogged, doctest, either, exceptions, foldl, mtl, optparse-applicative, system-filepath, text, turtle, unordered-containers, vector, yaml

Files

• ChangeLog.md +5/−0
• LICENSE +29/−0
• README.md +246/−0
• Setup.hs +33/−0
• app/Main.hs +117/−0
• changelogged.cabal +103/−0
• src/Changelogged.hs +1/−0
• src/Changelogged/Bump/Common.hs +90/−0
• src/Changelogged/Bump/General.hs +30/−0
• src/Changelogged/Bump/Local.hs +58/−0
• src/Changelogged/CheckLog/Check.hs +88/−0
• src/Changelogged/CheckLog/Common.hs +96/−0
• src/Changelogged/Git.hs +46/−0
• src/Changelogged/Options.hs +107/−0
• src/Changelogged/Pattern.hs +158/−0
• src/Changelogged/Pure.hs +52/−0
• src/Changelogged/Settings.hs +67/−0
• src/Changelogged/Types.hs +51/−0
• src/Changelogged/Utils.hs +14/−0
• test/doctests.hs +12/−0

@@ -0,0 +1,5 @@+# Changelog for changelogged++## Unreleased changes++

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2017, GetShop.TV+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,246 @@+# Changelogged++## What and how to?++### Purpose+This is the tool for tracking project history and release documentation.+It guides developer through writing changelogs are bump version in project files.+With proper usage it guarantees that every pull request or commit from git history is mentioned in project changelogs and that versions all over the project are up to date.+It can also write changelogs based on git history and infer new version from changelog if it contains rubrication by level of changes.++### Configuration file+[example](changelogged.yaml.skel)+```+changelogs:+  main:+    # You can simply use arrays here.+    path: "CHANGELOG.md"+  api:+    path: "API_CHANGELOG.md"+    indicator:+      path: "file.json"+      variable: "version"+versioned:+  main:+  - path: "file.cabal"+    variable: "version"+  - path: "file2.cabal"+    variable: "version"+  - path: "file3.hs"+    variable: "version"+  - path: "file4.json"+    variable: "version"+  api:+  - path: "file.hs"+    variable: "apiVersion"+  - path: "file.json"+    variable: "version"+```++Config is optional.+With no config tool will try to check file named `ChangeLog.md` as far as it's part of Stack project template and bump versions in `package.yaml` files all over the project.++Config (named `changelogged.yaml`) is split in two sections.++`changelogs` record contains records about each changelog to track.+Each changelog has a key - key of the record. Two keys are reserved - `main` and `api` for common project changelog and API changelog correspondingly.+For each key there is a value. `path` is path to changelog from directory where you intent to run `changelogged`. `indicator` is optional.+`indicator` is used e.g. for API changelogs - it's file such that changing this file is equivalent to change API. This record contains `path` to file and `variable` where version is stored.+Current version for parts tracked by local changelogs is known from `indicator`. That's why `variable` key persists. General version of project is known from latest git tag.++`versioned` section contains same key-names as `changelogs`. Each key contains array of files with `path` to file and `variable` where version is stored.++### Features reference++#### Text of 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.++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]++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.+```++See examples [below](#guiding-examples)++#### Checking changelogs+This is default feature. Changelogged will output all missing pull requests and commits with their messages.+It ignores commits and pull requests affecting only `.md` files.++You can skip it with `-c` option or ignore results with `-f` option. Also you can check changelog from the first commit with `-e`.++#### Bumping versions+This is also default feature. In default way if changelogs are up to day changelogged will bump versions all over the project.++You can variously combine changelog checking and bumping versions. For example you may just want to be sure changelogs are up to date. There is `-C` option for that.+By default new version is inferred from changelog. It will work if you have some of `* App...` `* Major...`, `* Minor...`, `* Fix...`, and `* Doc...` sections in changelog and name versions correspondingly.+Suggested versioning: `app.major.minor.fix.doc`.+Otherwise you can specify new version explicitly with `-l` option. It's also the only way to work with `-c` option.++#### Multiple changelogs and subversions+This feature requires `changelogged.yaml`.++With `-m` option tool will assume there is more than one changelog and check all of them by keys from configuration file. Here is also subversioning from the box.+Current version is known from indicator file and new version is known from changelog.++You cannot explicitly set new version for arbitrary changelog but `-W` option provides special checking of API changelog. And you can set new version with `-a`.+It's impossible to check only API changelog for now. See [issue](https://github.com/GetShopTV/changelogged/issues/54).++#### Writing changelogs.+`--format suggest` provides another format for records you see on the screen.+It can be used with `-y` option to write these strings to the top of changelog they are relevant to.+This option cannot be used with `--format simple` which is default.++### Guiding examples:++#### Common run:+```+changelogged (master):$ changelogged+```+![image1](example_images/common_run.png)++#### Suggest changelog entries:+```+changelogged (master):$ changelogged --format suggest+```+![image2](example_images/suggest.png)++Force with no entries in changelog:+```+changelogged (master):$ changelogged --format suggest -f+```+![image3](example_images/no_force.png)++Force with explicit version:+```+changelogged (master):$ changelogged -f -l major+```+![image4](example_images/force.png)++#### Write suggested entries to changelog (works only with `--format suggest`)+```+changelogged (master):$ changelogged --format suggest -y+```+![image5](example_images/suggest.png)+```+changelogged (master):$ git diff ChangeLog.md+```+![image6](example_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)+```+changelogged (master):$ git diff ChangeLog.md+```+![image8](example_images/release.png)++Do not bump even if changelogs are up to date+```+changelogged -C+```+![image9](example_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)++### Typical daily workflow to keep project and API changelogs up to date (assuming existing changelogged.yaml):+See missing entries:+```+changelogged -C --format suggest -W+```+Record these changes.+```+changelogged --format suggest -W -y+```+And then edit changelogs manually.++### Suggested simple workflow on release (for project with no `changelogged.yaml` and API changelog):+See missing entries:+```+changelogged -C+```+Record these changes:+```+changelogged --format suggest -y+```+Manually edit changelog++Bump versions:+```+changelogged+```+_Next part is subject to change:_++Commit files with bumped versions.++Record commit with version bumps:+```+changelogged --format suggest -y+```+Edit changelog - move new entry under version milestone.+Note: changes in `.md` files are ignored.++Commit changelog, push and release.++## Setting up++### Requirements+It works with git projects only.+It was never tested on Windows. Ideally it will work if you have Git Bash installed.+As tool was designed for Haskell ecosystem first there are these extensions supported: `.hs`, `.cabal`, `.yaml` and `.json`. You cannot bump version in any other file.+But new extensions can be easily provided as far as changelogged aims to have the most wide users community. See [Add new extension](#add-new-extension) section. ++### Getting and building+First of all you should go to project [Github](https://github.com/GetShopTV/changelogged)++Then you can simply download it - there is a binary in `bin` directory. After execute something like `cp bin/changelogged ~/.local/bin`.++Or you can clone repo and build it from source. You need latest [Stack](https://docs.haskellstack.org/en/stable/README/) installed.+To build run+```+stack install+```++## Contributing++### Common+Bug reports and feature requests are welcome on [Github](https://github.com/GetShopTV/changelogged/issues)++You are free to fork project and make a pull request.++### Add new extension+You may want to use this tool inside project written not in Haskell. You are very welcome.++Version bumping is restricted with extension of file. There is no euristic rules like "version is placed in `version = `" to have determined behaviour.+You may request for extension you want to be supported in [special issue](https://github.com/GetShopTV/changelogged/issues/35). It will be here ASAP.+Or you may write it yourself.+You are welcome to ask about how in comments in that issue (or browse comments).

@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif++#if MIN_VERSION_cabal_doctest(1,0,0)++import Distribution.Extra.Doctest ( defaultMainWithDoctests )+main :: IO ()+main = defaultMainWithDoctests "doctests"++#else++#ifdef MIN_VERSION_Cabal+-- If the macro is defined, we have new cabal-install,+-- but for some reason we don't have cabal-doctest in package-db+--+-- Probably we are running cabal sdist, when otherwise using new-build+-- workflow+#warning You are configuring this package without cabal-doctest installed. \+         The doctests test-suite will not work as a result. \+         To fix this, install cabal-doctest before configuring.+#endif++import Distribution.Simple++main :: IO ()+main = defaultMain++#endif

@@ -0,0 +1,117 @@+{-# 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))++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

@@ -0,0 +1,103 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 603efc893dd29ab0891f45438ea57f2caee1d8d76eb24a1e2aa0677b19bf8c3b++name:           changelogged+version:        0.1.0+synopsis:       Tool to manage project publishing history.+description:    Please see README.md+category:       Development+homepage:       https://github.com/GetShopTV/changelogged#readme+bug-reports:    https://github.com/GetShopTV/changelogged/issues+author:         Vitalii Guzeev <vitaliy@getshoptv.com>+maintainer:     Vitalii Guzeev <vitaliy@getshoptv.com>+copyright:      (c) 2017-2018, GetShop.TV+license:        BSD3+license-file:   LICENSE+build-type:     Custom+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/GetShopTV/changelogged++custom-setup+  setup-depends:+      Cabal+    , base+    , cabal-doctest >=1.0.2 && <1.1++library+  hs-source-dirs:+      src+  default-extensions: OverloadedStrings RecordWildCards+  build-depends:+      aeson+    , ansi-terminal+    , base >=4.7 && <5+    , either+    , exceptions+    , foldl+    , mtl+    , optparse-applicative+    , system-filepath+    , text+    , turtle >=1.5.0+    , unordered-containers+    , vector+    , yaml+  exposed-modules:+      Changelogged+      Changelogged.Bump.Common+      Changelogged.Bump.General+      Changelogged.Bump.Local+      Changelogged.CheckLog.Check+      Changelogged.CheckLog.Common+      Changelogged.Git+      Changelogged.Options+      Changelogged.Pattern+      Changelogged.Pure+      Changelogged.Settings+      Changelogged.Types+      Changelogged.Utils+  other-modules:+      Paths_changelogged+  default-language: Haskell2010++executable changelogged+  main-is: Main.hs+  hs-source-dirs:+      app+  default-extensions: OverloadedStrings RecordWildCards+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      ansi-terminal+    , base >=4.7 && <5+    , changelogged+    , turtle >=1.5.0+    , unordered-containers+  other-modules:+      Paths_changelogged+  default-language: Haskell2010++test-suite doctests+  type: exitcode-stdio-1.0+  main-is: doctests.hs+  hs-source-dirs:+      test+  default-extensions: OverloadedStrings RecordWildCards+  build-depends:+      Glob+    , QuickCheck+    , ansi-terminal+    , base+    , doctest+    , turtle >=1.5.0+    , unordered-containers+  default-language: Haskell2010

@@ -0,0 +1,1 @@+module Changelogged where

@@ -0,0 +1,90 @@+module Changelogged.Bump.Common where++import Prelude hiding (FilePath)+import Turtle++import Control.Exception+import qualified Control.Foldl as Fold++import Data.Functor (($>))+import Data.Text (Text)++import Filesystem.Path.CurrentOS (encodeString)++import Changelogged.Types+import Changelogged.Pattern++-- |Add version label to changelog.+headChangelog :: Text -> FilePath -> IO ()+headChangelog version changelog = do+  currentLogs <- fold (input changelog) Fold.list+  output changelog (return $ unsafeTextToLine version)+  append changelog "---"+  append changelog ""+  append changelog (select currentLogs)++-- |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+  when (null matched) $+    throw (PatternMatchFail ("ERROR: Cannot bump. Cannot detect version in file " <> encodeString taggedFilePath <> ". Check config.\n"))+  changed <- fold (sed (versionExactRegex $> version) (select matched)) Fold.list+  output taggedFilePath (select $ generateVersionedFile file changed matched)++-- |Replace given lines in the file.+-- Here is used and called to write new lines wih versions.+generateVersionedFile+  -- template file+  :: [Line]+  -- new lines+  -> [Line]+  -- lines to be replaced+  -> [Line]+  --result+  -> [Line]+generateVersionedFile file [] [] = file+generateVersionedFile _ [] _ = error "internal sed error"+generateVersionedFile _ _ [] = error "internal sed error"+generateVersionedFile file (new:news) (old:olds) = generateVersionedFile (replaceLine file new old) news olds+  where+    replaceLine [] _ _ = []+    replaceLine (xvar:xvars) newLine oldLine +      | xvar == oldLine = newLine:xvars+      | 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."))++-- |Get level of changes from changelog.+getChangelogEntries :: FilePath -> IO (Maybe Level)+getChangelogEntries changelogFile = do+  app <- fold (grep (prefix "* App") unreleased) countLines+  major <- fold (grep (prefix "* Major") unreleased) countLines+  minor <- fold (grep (prefix "* Minor") unreleased) countLines+  fixes <- fold (grep (prefix "* Fix") unreleased) countLines+  docs  <- fold (grep (prefix "* Doc") unreleased) countLines++  return $ case app of+    0 -> case major of+      0 -> case minor of+        0 -> case fixes of+          0 -> case docs of+            0 -> Nothing+            _ -> Just Doc+          _ -> Just Fix+        _ -> Just Minor+      _ -> Just Major+    _ -> Just App+  where+    unreleased = limitWhile (null . match (prefix versionExactRegex) . lineToText) (input changelogFile)

@@ -0,0 +1,30 @@+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

@@ -0,0 +1,58 @@+module Changelogged.Bump.Local where++import Turtle+import Prelude hiding (FilePath)++import Control.Exception+import qualified Control.Foldl as Fold++import Data.Maybe (fromMaybe)+import Data.Text (Text)++import Filesystem.Path.CurrentOS (encodeString)+import System.Console.ANSI (Color(..))++import Changelogged.Types+import Changelogged.Utils+import Changelogged.Pure+import Changelogged.Pattern+import Changelogged.Bump.Common++-- |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")+  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"))+      (versionMatch . lineToText $ realVer)+    Nothing -> throw (PatternMatchFail $ "ERROR: Cannot get local version. Cannot find given variable " <> show taggedFileVariable <> " in file " <> encodeString taggedFilePath <> ". Check config.\n")++-- |Generate new local version.+generateLocalVersion :: Level -> TaggedFile -> 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.+  printf ("Version: "%s%" -> ") current+  coloredPrint Yellow (new current <> "\n")+  return (new current)+  where+    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+  case versionedChanges of+    Just lev -> Just <$> generateLocalVersion lev (fromJustCustom "No file with current local version specified." taggedLogIndicator)+    Nothing -> do+      coloredPrint Yellow ("WARNING: keep old API version since " <> showPath taggedLogPath <> " apparently does not contain any new entries.\n")+      return Nothing

@@ -0,0 +1,88 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Changelogged.CheckLog.Check where++import Turtle hiding (stdout, stderr)+import Prelude hiding (FilePath)++import qualified Control.Foldl as Fold+import Control.Monad (when, filterM)++import System.Console.ANSI (Color(..))++import Changelogged.Types+import Changelogged.Options+import Changelogged.Utils+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)++-- |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+  +  commits <- map (fromJustCustom "Cannot find commit hash in git log entry" . hashMatch . lineToText)+    <$> fold (input gitHistory) Fold.list++  flags <- mapM (eval gitHistory) 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++-- |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+    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

@@ -0,0 +1,96 @@+module Changelogged.CheckLog.Common where++import Prelude hiding (FilePath)+import Turtle++import qualified Control.Foldl as Fold++import Data.Text (Text)+import qualified Data.Text as Text++import System.Console.ANSI (Color(..))++import Changelogged.Types+import Changelogged.Utils+import Changelogged.Pure++-- |Check if commit/pr is present in changelog. Return '@True@' if present.+changelogIsUp :: WarningFormat -> Bool -> Text -> Text -> Mode -> Text -> FilePath -> IO Bool+changelogIsUp fmt writeSug link item mode message changelog = do+  grepLen <- fold (grep (has (text item)) (input changelog)) countLines+  case grepLen of+    0 -> do+      case fmt of+        WarnSimple  -> warnMissing item mode message+        WarnSuggest -> do+          suggestMissing link item mode message+          when writeSug $ addMissing link item mode message changelog+      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+  printf ("- "%s%" ") (showText mode)+  coloredPrint Cyan item+  printf (" is missing: "%s%".\n") message++-- |+-- >>> prLink "https://github.com/GetShopTV/changelogged" "#13"+-- "https://github.com/GetShopTV/changelogged/pull/13"+prLink :: Text -> Text -> Text+prLink link num = link <> "/pull/" <> Text.drop 1 num++-- |+-- >>> commitLink "https://github.com/GetShopTV/changelogged" "9e14840"+-- "https://github.com/GetShopTV/changelogged/commit/9e14840"+commitLink :: Text -> Text -> Text+commitLink link sha = link <> "/commit/" <> sha++-- |+suggestMissing :: Text -> Text -> Mode -> Text -> IO ()+suggestMissing link item mode message = do+  printf ("- "%s%" (see ") message+  case mode of+    PR -> do+      coloredPrint Cyan ("[" <> item <> "]")+      printf ("("%s%")") (prLink link item)+    Commit -> do+      coloredPrint Cyan ("[`" <> item <> "`]")+      printf ("("%s%")") (commitLink link item)+  printf ");\n"++-- |Add generated suggestion directly to changelog.+addMissing :: Text -> Text -> Mode -> Text -> FilePath -> IO ()+addMissing link item mode message changelog = do+  currentLogs <- fold (input changelog) Fold.list+  output changelog (return $ unsafeTextToLine entry)+  append changelog (select currentLogs)+  where+    entry = prolog <> sense <> epilog+    prolog = "- " <> message <> " (see "+    sense = case mode of+        PR -> "[" <> item <> "]" <> "(" <> prLink link item <> ")"+        Commit -> "[`" <> item <> "`]" <> "(" <> commitLink link item <> ")"+    epilog = ");"++-- |Get commit message for any entry in history.+commitMessage :: Mode -> Text -> IO Text+commitMessage _ "" = return ""+commitMessage mode commit = do+  summary <- fold (inproc "git" ["show", commit] empty) Fold.list+  return $ Text.stripStart $ lineToText $ case mode of+    PR -> summary !! 7+    Commit -> summary !! 4

@@ -0,0 +1,46 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Changelogged.Git where++import qualified Control.Foldl as Fold+import Control.Monad.Catch (catch)++import Data.Char (isDigit)+import Data.Either.Combinators (fromRight)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as Text++import Turtle++import Changelogged.Types++-- |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 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)++-- |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)+  where+    version tag = case tag of+      "" -> "0.0.0.0.0"+      v -> Text.dropWhile (not . isDigit) v

@@ -0,0 +1,107 @@+module Changelogged.Options where++import Data.Char (toLower)++import Options.Applicative hiding (switch)+import Turtle hiding (option)++import Changelogged.Types++availableWarningFormats :: [WarningFormat]+availableWarningFormats = [minBound..maxBound]++availableWarningFormatsStr :: String+availableWarningFormatsStr+  = "(" <> unwords (map (map toLower . show) availableWarningFormats) <> ")"++readWarningFormat :: ReadM WarningFormat+readWarningFormat = eitherReader (r . map toLower)+  where+    r "simple"  = Right WarnSimple+    r "suggest" = Right WarnSuggest+    r fmt = Left $+         "Unknown warning format: " <> show fmt <> ".\n"+      <> "Use one of " <> availableWarningFormatsStr <> ".\n"++-- |+-- >>> availableLevels+-- [App,Major,Minor,Fix,Doc]+availableLevels :: [Level]+availableLevels = [minBound..maxBound]++-- |+-- >>> availableLevelsStr+-- "(app major minor fix doc)"+availableLevelsStr :: String+availableLevelsStr+  = "(" <> unwords (map (map toLower . show) availableLevels) <> ")"++readLevel :: ReadM Level+readLevel = eitherReader (r . map toLower)+  where+    r "app"   = Right App+    r "major" = Right Major+    r "minor" = Right Minor+    r "fix"   = Right Fix+    r "doc"   = Right Doc+    r lvl = Left $+         "Unknown level of changes: " <> show lvl <> ".\n"+      <> "Use one of " <> 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."+  where+    packagesLevel = 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)+    warningFormat = option readWarningFormat $+         long "format"+      <> help ("Warning format. One of " <> 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."++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.+  , optFromBC          :: Bool+  -- |Bump versions even if changelogs are outdated.+  , optForce           :: Bool+  -- |Write suggestions to changelog directly.+  , optWrite           :: Bool+  }

@@ -0,0 +1,158 @@+-- |Common regexps in Turtle syntax.+module Changelogged.Pattern where++import Turtle.Pattern+import Turtle ((<>), (<|>))+import Data.Text (Text, intercalate)++import Changelogged.Pure++-- >>> match versionExactRegex "version:   1.1.1"+-- []+-- >>> match versionExactRegex "1.1.1"+-- ["1.1.1"]+-- >>> match versionExactRegex "1.1.1   yy"+-- []+versionExactRegex :: Pattern Text+versionExactRegex = once digit <> "." <> (intercalate "." <$> plus digit `sepBy1` ".")++-- >>> versionMatch "\"version\":    \"1.1.1\""+-- Just "1.1.1"+-- >>> versionMatch "version =    1.1.1"+-- Just "1.1.1"+-- >>> versionMatch "version =    v1.1.1"+-- Just "1.1.1"+-- >>> versionMatch "version =    v1.1."+-- Just "1.1"+-- >>> versionMatch "version =    v.1."+-- Nothing+-- >>> versionMatch "version =    .1."+-- Nothing+-- >>> versionMatch "version =    1.1."+-- Just "1.1"+versionMatch :: Text -> Maybe Text+versionMatch str = maxByLen $ match (has versionExactRegex) str++-- >>> match hashRegex "f4875f4 Update changelog"+-- ["f4875f4","f4875f","f4875","f487","f48","f4","f"]+-- >>> match hashRegex "f4875f4 Update changelog d1123d"+-- ["f4875f4","f4875f","f4875","f487","f48","f4","f"]+-- >>> match hashRegex "f4875f423d Update changelog d1123d"+-- ["f4875f423d","f4875f423","f4875f42","f4875f4","f4875f","f4875","f487","f48","f4","f"]+-- >>> match hashRegex "fE4875f423d Update changelog"+-- []+-- >>> match hashRegex "Update changelog"+-- []+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"+-- Nothing+hashMatch :: Text -> Maybe Text+hashMatch str = maxByLen $ match hashRegex str++-- >>> match githubRefRegex "d #444 f"+-- ["#444","#44","#4"]+-- >>> match githubRefRegex "d 444 f"+-- []+-- >>> match githubRefRegex "d # f"+-- []+-- >>> match githubRefRegex "d (#444) f"+-- ["#444","#44","#4"]+githubRefRegex :: Pattern Text+githubRefRegex = has $ "#" <> plus digit++-- >>> match githubRefGrep "pull request #44"+-- ["pull request #"]+-- >>> match githubRefGrep "pull request"+-- []+-- >>> match githubRefGrep "#44"+-- []+githubRefGrep :: Pattern Text+githubRefGrep = has (text "pull request #")++-- >>> githubRefMatch "text #444 text"+-- 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

@@ -0,0 +1,52 @@+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++-- | 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+fromJustCustom _ (Just a) = a++-- I leave tuple here cause it's all functions for internal usage only (tuplify, delimited, bump).+tuplify :: [Int] -> (Int, Int, Int, Int, Int)+tuplify [] = (0,0,0,0,0)+tuplify [a1] = (a1,0,0,0,0)+tuplify [a1,a2] = (a1,a2,0,0,0)+tuplify [a1,a2,a3] = (a1,a2,a3,0,0)+tuplify [a1,a2,a3,a4] = (a1,a2,a3,a4,0)+tuplify [a1,a2,a3,a4,a5] = (a1,a2,a3,a4,a5)+tuplify (a1:a2:a3:a4:a5:_) = (a1,a2,a3,a4,a5)++delimited :: Text -> (Int, Int, Int, Int, Int)+delimited ver = tuplify $ map (read . Text.unpack) (Text.split (=='.') ver)++bump :: (Int, Int, Int, Int, Int) -> Level -> Text+bump (app, major, minor, fix, doc) lev = Text.intercalate "." $ map showText $ case lev of+  App -> [app + 1, 0]+  Major -> [app, major + 1, 0]+  Minor -> [app, major, minor + 1, 0]+  Fix -> [app, major, minor, fix + 1, 0]+  Doc -> [app, major, minor, fix, doc + 1]++showPath :: FilePath -> Text+showPath = Text.pack . encodeString++showText :: Show a => a -> Text+showText = Text.pack . show

@@ -0,0 +1,67 @@+{-# 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

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveGeneric #-}+module Changelogged.Types where++import Data.Text (Text)++import Prelude hiding (FilePath)+import Turtle++import GHC.Generics++type Variable = Text+type Key = Text++-- |Level of changes to bump to.+data Level = App | Major | Minor | Fix | Doc+  deriving (Show, Enum, Bounded)++-- |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"++data WarningFormat+  = WarnSimple+  | WarnSuggest+  deriving (Enum, Bounded)++instance Show WarningFormat where+  show WarnSimple  = "simple"+  show WarnSuggest = "suggest"

@@ -0,0 +1,14 @@+module Changelogged.Utils where++import Data.Text (Text)++import System.Console.ANSI++import Turtle.Format++-- |Print '@text@' with ansi-terminal color.+coloredPrint :: Color -> Text -> IO ()+coloredPrint color line = do+  setSGR [SetColor Foreground Vivid color]+  printf s line+  setSGR [Reset]

@@ -0,0 +1,12 @@+module Main where++import Build_doctests (flags, pkgs, module_sources)+import Data.Foldable (traverse_)+import Test.DocTest++main :: IO ()+main = do+    traverse_ putStrLn args+    doctest args+  where+    args = flags ++ pkgs ++ module_sources