feat(Git): Add support for configuring the diff range

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"

src/Shift/Git.hs

+{-# 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