diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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)); diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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: diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/changelogged.cabal b/changelogged.cabal --- a/changelogged.cabal +++ b/changelogged.cabal @@ -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 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: diff --git a/images/bump.png b/images/bump.png new file mode 100644 Binary files /dev/null and b/images/bump.png differ diff --git a/images/chlog_diff.png b/images/chlog_diff.png new file mode 100644 Binary files /dev/null and b/images/chlog_diff.png differ diff --git a/images/common_run.png b/images/common_run.png new file mode 100644 Binary files /dev/null and b/images/common_run.png differ diff --git a/images/force.png b/images/force.png new file mode 100644 Binary files /dev/null and b/images/force.png differ diff --git a/images/no_bump.png b/images/no_bump.png new file mode 100644 Binary files /dev/null and b/images/no_bump.png differ diff --git a/images/no_check.png b/images/no_check.png new file mode 100644 Binary files /dev/null and b/images/no_check.png differ diff --git a/images/no_force.png b/images/no_force.png new file mode 100644 Binary files /dev/null and b/images/no_force.png differ diff --git a/images/release.png b/images/release.png new file mode 100644 Binary files /dev/null and b/images/release.png differ diff --git a/images/suggest.png b/images/suggest.png new file mode 100644 Binary files /dev/null and b/images/suggest.png differ diff --git a/src/Changelogged/Bump/Common.hs b/src/Changelogged/Bump/Common.hs --- a/src/Changelogged/Bump/Common.hs +++ b/src/Changelogged/Bump/Common.hs @@ -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) diff --git a/src/Changelogged/Bump/General.hs b/src/Changelogged/Bump/General.hs deleted file mode 100644 --- a/src/Changelogged/Bump/General.hs +++ /dev/null @@ -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 diff --git a/src/Changelogged/Bump/Local.hs b/src/Changelogged/Bump/Local.hs --- a/src/Changelogged/Bump/Local.hs +++ b/src/Changelogged/Bump/Local.hs @@ -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 diff --git a/src/Changelogged/CheckLog/Check.hs b/src/Changelogged/CheckLog/Check.hs --- a/src/Changelogged/CheckLog/Check.hs +++ b/src/Changelogged/CheckLog/Check.hs @@ -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 diff --git a/src/Changelogged/CheckLog/Common.hs b/src/Changelogged/CheckLog/Common.hs --- a/src/Changelogged/CheckLog/Common.hs +++ b/src/Changelogged/CheckLog/Common.hs @@ -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. diff --git a/src/Changelogged/Config.hs b/src/Changelogged/Config.hs new file mode 100644 --- /dev/null +++ b/src/Changelogged/Config.hs @@ -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 diff --git a/src/Changelogged/Git.hs b/src/Changelogged/Git.hs --- a/src/Changelogged/Git.hs +++ b/src/Changelogged/Git.hs @@ -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 "" gitLatestVersion + , "Changes since last release: " <> Text.pack (show (length gitHistory)) + ] diff --git a/src/Changelogged/Main.hs b/src/Changelogged/Main.hs new file mode 100644 --- /dev/null +++ b/src/Changelogged/Main.hs @@ -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)) + diff --git a/src/Changelogged/Options.hs b/src/Changelogged/Options.hs --- a/src/Changelogged/Options.hs +++ b/src/Changelogged/Options.hs @@ -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 diff --git a/src/Changelogged/Pattern.hs b/src/Changelogged/Pattern.hs --- a/src/Changelogged/Pattern.hs +++ b/src/Changelogged/Pattern.hs @@ -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 diff --git a/src/Changelogged/Settings.hs b/src/Changelogged/Settings.hs deleted file mode 100644 --- a/src/Changelogged/Settings.hs +++ /dev/null @@ -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 diff --git a/src/Changelogged/Types.hs b/src/Changelogged/Types.hs --- a/src/Changelogged/Types.hs +++ b/src/Changelogged/Types.hs @@ -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" diff --git a/src/Changelogged/Utils.hs b/src/Changelogged/Utils.hs --- a/src/Changelogged/Utils.hs +++ b/src/Changelogged/Utils.hs @@ -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"