Fix a bit and separate functions depending on git hosting

README.md

@@ -24,6 +24,9 @@ changelogged
 ```
 
 After you refuse to do to interactive mode it will add missing entries to your changelogs and open editor for each if them.
+
+By default editor is set by `$EDITOR` variable.
+
 After you can bummp versions over whole project (usable if you have more than one version file).
 
 That's it! Now you have a proper changelog with no forgotten changes.

src/Changelogged/Changelog/Check.hs

@@ -16,7 +16,7 @@ import           Changelogged.Changelog.Interactive
 import           Changelogged.Changelog.Dry
 import           Changelogged.Common
 import           Changelogged.Pattern
-import           Changelogged.Git (retrieveCommitMessage)
+import           Changelogged.Git (retrieveCommitMessage, parseHostingType)
 
 checkChangelog :: GitInfo -> ChangelogConfig -> Appl ()
 checkChangelog gitInfo@GitInfo{..} config@ChangelogConfig{..} = do
@@ -45,11 +45,11 @@ checkChangelog gitInfo@GitInfo{..} config@ChangelogConfig{..} = do
               then interactiveWalk gitRemoteUrl changelogChangelog 
               else simpleWalk gitRemoteUrl changelogChangelog) $
             checkableCommits
-      success $ showPath changelogChangelog <> " is updated.\n"
-                   <> "You can edit it manually now.\n"
+      success $ showPath changelogChangelog <> " is updated.\nTrying to run editor."
 
 extractCommitMetadata :: GitInfo -> ChangelogConfig -> SHA1 -> Appl (Maybe Commit)
 extractCommitMetadata GitInfo{..} ChangelogConfig{..} commitSHA = do
+  let hosting = parseHostingType gitRemoteUrl
   ignoreChangeReasoned <- sequence $
     [ commitNotWatched changelogWatchFiles commitSHA
     , allFilesIgnored changelogIgnoreFiles commitSHA
@@ -58,7 +58,7 @@ extractCommitMetadata GitInfo{..} ChangelogConfig{..} commitSHA = do
     then return Nothing 
     else do
       -- FIXME: impossible.
-      commitIsPR <- fmap (PR . fromJustCustom "Cannot find commit hash in git log entry" . githubRefMatch . lineToText) <$>
-          fold (grep githubRefGrep (grep (has (text (getSHA1 commitSHA))) (select gitHistory))) Fold.head
+      commitIsPR <- fmap (PR . fromJustCustom "Cannot find commit hash in git log entry" . refMatch hosting . lineToText) <$>
+          fold (grep (refGrep hosting) (grep (has (text (getSHA1 commitSHA))) (select gitHistory))) Fold.head
       commitMessage <- retrieveCommitMessage commitIsPR commitSHA
       return $ Just Commit{..}

src/Changelogged/Changelog/Common.hs

@@ -13,22 +13,40 @@ import qualified Data.Text            as Text
 import           System.Console.ANSI  (Color (..))
 
 import           Changelogged.Common
-import           Changelogged.Git     (getCommitTag)
+import           Changelogged.Git     (getCommitTag, parseHostingType)
 
 -- $setup
 -- >>> :set -XOverloadedStrings
 
+prLink :: Link -> PR -> Link
+prLink link pr =
+  let hostingType = parseHostingType link in
+  case hostingType of
+    GitHub -> githubPrLink link pr
+    -- FIXME: add builders for Bitbucket and Gitlab links.
+    BitBucket -> githubPrLink link pr
+    GitLab -> githubPrLink link pr
+
 -- |
--- >>> prLink (Link "https://github.com/GetShopTV/changelogged") (PR "#13")
+-- >>> githubPrLink (Link "https://github.com/GetShopTV/changelogged") (PR "#13")
 -- Link {getLink = " https://github.com/GetShopTV/changelogged/pull/13 "}
-prLink :: Link -> PR -> Link
-prLink (Link link) (PR num) = Link $ " " <> link <> "/pull/" <> Text.drop 1 num <> " "
+githubPrLink :: Link -> PR -> Link
+githubPrLink (Link link) (PR num) = Link $ " " <> link <> "/pull/" <> Text.drop 1 num <> " "
+
+commitLink :: Link -> SHA1 -> Link
+commitLink link hash =
+  let hostingType = parseHostingType link in
+  case hostingType of
+    GitHub -> githubCommitLink link hash
+    -- FIXME: add builders for Bitbucket and Gitlab links.
+    BitBucket -> githubCommitLink link hash
+    GitLab -> githubCommitLink link hash
 
 -- |
--- >>> commitLink (Link "https://github.com/GetShopTV/changelogged") (SHA1 "9e14840")
+-- >>> githubCommitLink (Link "https://github.com/GetShopTV/changelogged") (SHA1 "9e14840")
 -- Link {getLink = " https://github.com/GetShopTV/changelogged/commit/9e14840 "}
-commitLink :: Link -> SHA1 -> Link
-commitLink (Link link) (SHA1 sha) = Link $ " " <> link <> "/commit/" <> sha <> " "
+githubCommitLink :: Link -> SHA1 -> Link
+githubCommitLink (Link link) (SHA1 sha) = Link $ " " <> link <> "/commit/" <> sha <> " "
 
 printCommitTag :: SHA1 -> Appl ()
 printCommitTag sha = getCommitTag sha >>= \tag -> case tag of

src/Changelogged/Changelog/Interactive.hs

@@ -5,6 +5,7 @@ module Changelogged.Changelog.Interactive where
 import           Prelude              hiding (FilePath)
 import           Turtle               hiding (stdout)
 
+import           Control.Monad        (when)
 import qualified Control.Foldl        as Fold
 
 import           Data.Maybe           (fromMaybe, isJust)
@@ -23,38 +24,38 @@ import           Changelogged.Pattern (isMerge)
 -- >>> :set -XOverloadedStrings
 
 -- It cannot be folded since we have 'Remind' option.
-interactiveSession :: Appl Interaction -> Text -> Link -> FilePath -> [Commit] -> Appl ()
-interactiveSession _ _ _ _ [] = return ()
-interactiveSession prompt entryPrefix repoUrl changelog (current@Commit{..}:rest) = do
-  suggestMissing entryPrefix repoUrl current
+interactiveSession :: Appl Interaction -> Bool -> Text -> Link -> FilePath -> [Commit] -> Appl ()
+interactiveSession _ _ _ _ _ [] = return ()
+interactiveSession prompt printSug entryPrefix repoUrl changelog (current@Commit{..}:rest) = do
+  when printSug $ suggestMissing entryPrefix repoUrl current
   action <- prompt
   Options{..} <- gets envOptions
   case action of
     Write -> do
       addMissing entryPrefix repoUrl current changelog
-      interactiveSession prompt entryPrefix repoUrl changelog rest
+      interactiveSession prompt printSug entryPrefix repoUrl changelog rest
     Expand -> do
       addMissing entryPrefix repoUrl current changelog
       if (isMerge commitMessage || isJust commitIsPR) 
         then do
-          subChanges <- listPRCommits commitSHA
-          interactiveSession prompt ("  " <> entryPrefix) repoUrl changelog subChanges
+          subChanges <- listPRCommits commitSHA repoUrl
+          interactiveSession prompt printSug ("  " <> entryPrefix) repoUrl changelog subChanges
         else return ()
-      interactiveSession prompt entryPrefix repoUrl changelog rest
-    Skip -> interactiveSession prompt entryPrefix repoUrl changelog rest
-    Remind -> showDiff commitSHA >> interactiveSession prompt "" repoUrl changelog (current:rest)
+      interactiveSession prompt printSug entryPrefix repoUrl changelog rest
+    Skip -> interactiveSession prompt printSug entryPrefix repoUrl changelog rest
+    Remind -> showDiff commitSHA >> interactiveSession prompt printSug "" repoUrl changelog (current:rest)
     IgnoreAlways -> do
       debug (showText changelog)
       addCommitToIgnored commitSHA changelog
-      interactiveSession prompt entryPrefix repoUrl changelog rest
-    Quit -> interactiveSession promptSkip "" repoUrl changelog rest
-    WriteRest -> interactiveSession promptSimple "" repoUrl changelog (current:rest)
+      interactiveSession prompt printSug entryPrefix repoUrl changelog rest
+    Quit -> interactiveSession promptSkip False "" repoUrl changelog rest
+    WriteRest -> interactiveSession promptSimple False "" repoUrl changelog (current:rest)
 
 interactiveWalk :: Link -> FilePath -> [Commit] -> Appl ()
-interactiveWalk = interactiveSession promptInteractive ""
+interactiveWalk = interactiveSession promptInteractive True ""
 
 simpleWalk :: Link -> FilePath -> [Commit] -> Appl ()
-simpleWalk = interactiveSession promptSimple ""
+simpleWalk = interactiveSession promptSimple False ""
 
 -- |
 suggestMissing :: Text -> Link -> Commit -> Appl ()

src/Changelogged/Common/Types/Common.hs

@@ -27,6 +27,9 @@ data Commit = Commit
 data Level = App | Major | Minor | Fix | Doc
   deriving (Generic, Show, Enum, Bounded, ToJSON)
 
+data GitHosting = GitHub | BitBucket | GitLab
+  deriving (Generic, Show, Enum, Bounded, ToJSON)
+
 showHumanReadableLevel :: Level -> Text
 showHumanReadableLevel App = "application level changes"
 showHumanReadableLevel Major = "major changes"

src/Changelogged/Config.hs

@@ -24,7 +24,7 @@ defaultConfig = Config
       }
   , configBranch = Nothing
   , configEntryFormat = Nothing
-  , configEditorCommand = Just "vim"
+  , configEditorCommand = Just "$EDITOR"
   }
 
 addCommitToIgnored :: SHA1 -> Turtle.FilePath -> Appl ()

src/Changelogged/Git.hs

@@ -1,7 +1,7 @@
--- | This module is intended to be pure git interface.
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiWayIf          #-}
 module Changelogged.Git where
 
 import qualified System.Process as Proc
@@ -67,19 +67,26 @@ retrieveCommitMessage isPR (SHA1 commit) = do
     Just _  -> summary !! 2
     Nothing -> summary !! 0
 
-messageToCommitData :: Line -> Appl Commit
-messageToCommitData message = do
+parseHostingType :: Link -> GitHosting
+parseHostingType (Link url) = if
+  | "://github.com/" `Text.isInfixOf` url -> GitHub
+  | "://gitlab.com/" `Text.isInfixOf` url -> GitLab
+  | "://bitbucket.org/" `Text.isInfixOf` url -> BitBucket
+
+messageToCommitData :: Link -> Line -> Appl Commit
+messageToCommitData repoUrl message = do
+  let hosting = parseHostingType repoUrl
   --FIXME: departed proofs?
-  commitIsPR <- fmap (PR . fromJustCustom "Cannot find commit hash in git log entry" . githubRefMatch . lineToText) <$>
-    fold (grep githubRefGrep (select [message])) Fold.head
+  commitIsPR <- fmap (PR . fromJustCustom "Cannot find commit hash in git log entry" . refMatch hosting . lineToText) <$>
+    fold (grep (refGrep hosting) (select [message])) Fold.head
   let commitSHA = SHA1 . fst . Text.breakOn " " . lineToText $ message
   commitMessage <- retrieveCommitMessage commitIsPR commitSHA
   return Commit{..}
 
-listPRCommits :: SHA1 -> Appl [Commit]
-listPRCommits (SHA1 sha) = do
+listPRCommits :: SHA1 -> Link -> Appl [Commit]
+listPRCommits (SHA1 sha) repoUrl = do
   messages <- fold (inproc "git" ["log", "--oneline", sha <> "^1..." <> sha <> "^2"] empty) Fold.list
-  commits <- mapM messageToCommitData messages
+  commits <- mapM (messageToCommitData repoUrl) messages
   return . reverse $ commits
 
 getCommitTag :: SHA1 -> Appl (Maybe Text)

src/Changelogged/Pattern.hs

@@ -74,10 +74,19 @@ githubRefRegex = has $ "#" <> plus digit
 githubRefGrep :: Pattern Text
 githubRefGrep = has (text "pull request #")
 
--- >>> githubRefMatch "text #444 text"
+--FIXME: add regexps for Gitlab and Bitbucket.
+
+refGrep :: GitHosting -> Pattern Text
+refGrep GitHub = githubRefGrep
+refGrep GitLab = githubRefGrep
+refGrep BitBucket = githubRefGrep
+
+-- >>> refMatch GitHub "text #444 text"
 -- Just "#444"
-githubRefMatch :: Text -> Maybe Text
-githubRefMatch str = maxByLen $ match githubRefRegex str
+refMatch :: GitHosting -> Text -> Maybe Text
+refMatch GitHub str = maxByLen $ match githubRefRegex str
+refMatch GitLab str = maxByLen $ match githubRefRegex str
+refMatch BitBucket str = maxByLen $ match githubRefRegex str
 
 -- >>> isMerge "Merge branch 'release-v1.0'"
 -- True