diff --git a/src/Shift/CLI.hs b/src/Shift/CLI.hs
index f4193c915996c2312e1be9c141827eb0f5442cf7..cca83a8cf5814ca8663483922c6df3c7906fdf22 100644
--- a/src/Shift/CLI.hs
+++ b/src/Shift/CLI.hs
@@ -10,6 +10,9 @@ import Options.Applicative
data ShiftOptions = ShiftOptions
{ _soCommand :: ShiftCommand,
_soHostingType :: HostingType,
+ _soIncludeHead :: Bool,
+ _soFromRef :: Maybe String,
+ _soToRef :: Maybe String,
_soGitHubOwner :: Maybe String,
_soGitHubRepository :: Maybe String,
_soGitHubToken :: Maybe String
@@ -31,6 +34,24 @@ shiftOptions =
<> metavar "TYPE"
<> help "Which kind of service the repository is hosted on"
)
+ <*> switch
+ ( long "include-head"
+ <> help "Whether to include the current HEAD as a ref in the change report"
+ )
+ <*> optional
+ ( strOption
+ ( long "from-ref"
+ <> metavar "REF"
+ <> help "Start ref to use for generating a change report"
+ )
+ )
+ <*> optional
+ ( strOption
+ ( long "to-ref"
+ <> metavar "REF"
+ <> help "End ref to use for generating a change report"
+ )
+ )
<*> optional
( strOption
( long "github-owner"
diff --git a/src/Shift/Git.hs b/src/Shift/Git.hs
index 8f72dd72ec7106bc34a6b4dcaf3431d7cb5900a1..fdcf7504a221c2cb454966d7f080892664c531b5 100644
--- a/src/Shift/Git.hs
+++ b/src/Shift/Git.hs
@@ -1,8 +1,11 @@
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
module Shift.Git where
+import CMarkGFM (Node (Node), NodeType (DOCUMENT), nodeToCommonmark)
import Control.Lens ((^.))
import Control.Monad (void)
import Control.Monad.Catch (throwM)
@@ -14,18 +17,20 @@ import qualified Data.ByteString.Char8 as BS
import Data.Default (def)
import Data.Either (rights)
import Data.Git
- ( tagList,
- getObject,
- withRepo,
- RefName(refNameRaw),
- Ref,
- Git,
- Commit(commitMessage) )
+ ( Commit (commitMessage),
+ Git,
+ Ref,
+ RefName (refNameRaw),
+ getObject,
+ tagList,
+ withRepo,
+ )
+import Data.Git.Named (RefName (RefName))
import Data.Git.Ref (HashAlgorithm, fromHex, isHex)
-import Data.Git.Storage.Object ( Object(ObjCommit) )
-import Data.List (sortBy)
+import Data.Git.Storage.Object (Object (ObjCommit))
+import Data.List (find, sortBy)
import Data.Maybe (catMaybes)
-import Data.Set as S (toList)
+import Data.Set as S (Set, toList)
import Data.String.Conversions (cs)
import Data.Text (Text)
import qualified Data.Text as T
@@ -37,14 +42,13 @@ import GitHub.Auth (Auth (OAuth))
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Shift.CLI
-import Shift.Processing ( generateReport, parseCommit )
-import Shift.Rendering ( printReport )
+import Shift.Processing (generateReport, parseCommit)
+import Shift.Rendering (printReport)
import Shift.Types
import Shift.Utilities (orError, pairs)
-import System.Process ( readCreateProcess, shell )
+import System.Process (readCreateProcess, shell)
import Text.Megaparsec (ParseError)
import Text.Megaparsec.Error (ParseErrorBundle)
-import CMarkGFM (NodeType(DOCUMENT), NodeType(DOCUMENT), nodeToCommonmark, nodeToCommonmark, Node(Node))
parseTag :: RefName -> Either (ParseErrorBundle Text Void) TagRef
parseTag ref = case versioning . cs . refNameRaw $ ref of
@@ -59,22 +63,21 @@ tempMain opts = do
renderToNode :: ShiftOptions -> IO Node
renderToNode opts = withRepo ".git" $ \repo -> do
- tags <- tagList repo
-
- let sortedVersions = sortBy (flip compare) . rights $ parseTag <$> toList tags
- pairedTags = swap <$> pairs sortedVersions
+ pairedTags <- pairedTagsFromOpts opts repo
nodes <- case opts ^. soHostingType of
GitHubType -> do
state <- initGitHubState
- fst <$> runReaderT
- (runStateT (mapM (renderDiff repo) pairedTags) state)
- opts
+ fst
+ <$> runReaderT
+ (runStateT (mapM (renderDiff repo) pairedTags) state)
+ opts
GitType ->
- fst <$> runReaderT
- (runStateT (mapM (renderDiff repo) pairedTags) GitClientState)
- opts
+ fst
+ <$> runReaderT
+ (runStateT (mapM (renderDiff repo) pairedTags) GitClientState)
+ opts
pure (Node Nothing DOCUMENT (concat nodes))
where
@@ -96,7 +99,49 @@ renderToNode opts = withRepo ".git" $ \repo -> do
_gcsRepository = cs repositoryName
}
-renderDiff :: (ClientState s, HashAlgorithm hash) => Git hash -> (TagRef, TagRef) -> GitM s [Node]
+pairedTagsFromOpts :: HashAlgorithm hash => ShiftOptions -> Git hash -> IO [(TagRef, TagRef)]
+pairedTagsFromOpts opts repo = case opts of
+ ShiftOptions {_soFromRef = Just fromRefRaw, _soToRef = Just toRefRaw, ..} -> do
+ pure [(TagRef (RefName fromRefRaw) Nothing, TagRef (RefName toRefRaw) Nothing)]
+ ShiftOptions {_soFromRef = Just fromRefRaw, _soIncludeHead, ..} -> do
+ tags <- tagList repo
+
+ let pairs = refsPairsFromRefs $ maybeIncludeHead _soIncludeHead $ parseAndSortRefs tags
+ fromRef = RefName fromRefRaw
+
+ pure $ case find (\pair -> (_tRef $ fst pair) == fromRef) pairs of
+ Just matchedPair -> [matchedPair]
+ Nothing -> []
+ ShiftOptions {_soToRef = Just toRefRaw, ..} -> do
+ tags <- tagList repo
+
+ let pairs = refsPairsFromRefs $ maybeIncludeHead _soIncludeHead $ parseAndSortRefs tags
+ toRef = RefName toRefRaw
+
+ pure $ case find (\pair -> (_tRef $ snd pair) == toRef) pairs of
+ Just matchedPair -> [matchedPair]
+ Nothing -> []
+ ShiftOptions {_soIncludeHead, ..} -> do
+ tags <- tagList repo
+
+ pure $ refsPairsFromRefs $ maybeIncludeHead _soIncludeHead $ parseAndSortRefs tags
+ where
+ maybeIncludeHead includeHead tagRefs = if includeHead then [TagRef "HEAD" Nothing] <> tagRefs else tagRefs
+
+-- Takes a list of `TagRef`s and builds a list of tuples (e.g. From/To tuples)
+refsPairsFromRefs :: [TagRef] -> [(TagRef, TagRef)]
+refsPairsFromRefs refs = swap <$> pairs refs
+
+-- Takes a set of `RefName`s and returns a sorted list of `TagRef`s, ordered in
+-- descending version numbers.
+parseAndSortRefs :: Set RefName -> [TagRef]
+parseAndSortRefs tags = sortBy (flip compare) . rights $ parseTag <$> toList tags
+
+renderDiff ::
+ (ClientState s, HashAlgorithm hash) =>
+ Git hash ->
+ (TagRef, TagRef) ->
+ GitM s [Node]
renderDiff repo (tx, ty) = do
diff <- lookupCommitsDiff repo tx ty
@@ -104,7 +149,12 @@ renderDiff repo (tx, ty) = do
[] -> throwM SEUnableToComputeDiff
diff_ -> printReport (tx, ty) (generateReport . rights $ parseCommit <$> diff_)
-lookupCommitsDiff :: (HashAlgorithm hash) => Git hash -> TagRef -> TagRef -> GitM s [(Ref hash, Commit hash)]
+lookupCommitsDiff ::
+ (HashAlgorithm hash) =>
+ Git hash ->
+ TagRef ->
+ TagRef ->
+ GitM s [(Ref hash, Commit hash)]
lookupCommitsDiff repo x y = do
rawOutput <- liftIO $ readCreateProcess (shell gitCommand) ""
@@ -121,7 +171,11 @@ lookupCommitsDiff repo x y = do
refNameRaw . _tRef $ y
]
-lookupRawRef :: (HashAlgorithm hash) => Git hash -> Text -> GitM s (Maybe (Ref hash, Commit hash))
+lookupRawRef ::
+ (HashAlgorithm hash) =>
+ Git hash ->
+ Text ->
+ GitM s (Maybe (Ref hash, Commit hash))
lookupRawRef repo rr =
if isHex . cs $ rr
then do