diff --git a/src/Shift.hs b/src/Shift.hs
index ef1cc1f56353cbd06614c63660228db520f559fb..2fead35d04b051e334aadedddfbcd429f0944a73 100644
--- a/src/Shift.hs
+++ b/src/Shift.hs
@@ -19,6 +19,8 @@ shiftMain = do
 
   case currentOptions ^. soCommand of
     GenerateCommand -> tempMain currentOptions
+    VersionsCommand -> versionsCommand currentOptions
+    LatestCommand -> latestCommand currentOptions
 
   where
     opts = info (helper <*> shiftOptions)
diff --git a/src/Shift/CLI.hs b/src/Shift/CLI.hs
index 4f40dd5449d77f085a72ac7446e0455a720f2aba..e6fa1df42ee8e32bd3cde1e9cb2ea7d2c3314983 100644
--- a/src/Shift/CLI.hs
+++ b/src/Shift/CLI.hs
@@ -17,7 +17,11 @@ data ShiftOptions = ShiftOptions
   , _soGitHubToken      :: Maybe String
   } deriving (Show, Eq)
 
-data ShiftCommand = GenerateCommand deriving (Show, Eq, Enum)
+data ShiftCommand
+  = GenerateCommand
+  | VersionsCommand
+  | LatestCommand
+  deriving (Show, Eq, Enum)
 
 data HostingType = GitHubType | GitType deriving (Show, Eq, Enum)
 
@@ -57,6 +61,14 @@ shiftCommand = subparser $
     (info (pure GenerateCommand)
       (progDesc "Generate changelog")
     )
+  <> command "versions"
+    (info (pure VersionsCommand)
+      (progDesc "List all versions in the repository")
+    )
+  <> command "latest"
+    (info (pure LatestCommand)
+      (progDesc "Generate a changelog for the latest version only")
+    )
 
 hostingType :: ReadM HostingType
 hostingType = eitherReader $ \case
diff --git a/src/Shift/Git.hs b/src/Shift/Git.hs
index 459d343befa7ff6539423590d23f790f0c17a1f9..b3305bad5a34164aec626f3af8338f979db4837c 100644
--- a/src/Shift/Git.hs
+++ b/src/Shift/Git.hs
@@ -4,7 +4,7 @@
 
 module Shift.Git where
 
-import Control.Monad  (void)
+import Control.Monad  (forM_, void)
 import Data.Either    (rights)
 import Data.List      (sortBy)
 import Data.Maybe     (catMaybes, fromMaybe)
@@ -29,7 +29,7 @@ import           Data.String.Conversions   (cs)
 import           Data.Text                 (Text)
 import qualified Data.Text                 as T
 import qualified Data.Text.IO              as TIO
-import           Data.Versions             (parseV)
+import           Data.Versions             (parseV, prettyV)
 import           Filesystem.Path           (absolute, basename, parent, (</>))
 import           Filesystem.Path.CurrentOS (encodeString)
 import           GitHub.Auth               (Auth (OAuth))
@@ -54,13 +54,29 @@ repoPath opts = fromMaybe ".git" (opts ^. soRepositoryPath)
 withRepo_ :: ShiftOptions -> (Git -> IO c) -> IO c
 withRepo_ opts = withRepo (fromString (repoPath opts))
 
+sortedTagList tags = sortBy (flip compare) . rights $ parseTag <$> toList tags
+
 tempMain :: ShiftOptions -> IO ()
 tempMain opts = withRepo_ opts $ \repo -> do
   tags <- tagList repo
 
-  let sortedVersions = sortBy (flip compare) . rights $ parseTag <$> toList tags
+  let sortedVersions = sortedTagList tags
+      pairedTags = swap <$> pairs sortedVersions
+
+  shift opts repo pairedTags
+
+latestCommand :: ShiftOptions -> IO ()
+latestCommand opts = withRepo_ opts $ \repo -> do
+  tags <- tagList repo
+
+  let sortedVersions = sortedTagList tags
       pairedTags = swap <$> pairs sortedVersions
 
+  case pairedTags of
+    x:_ -> shift opts repo [x]
+    [] -> putStrLn "Unable to find two versions to compare"
+
+shift opts repo pairedTags =
   case opts ^. soHostingType of
     GitHubType -> do
       state <- initGitHubState opts
@@ -72,6 +88,12 @@ tempMain opts = withRepo_ opts $ \repo -> do
       (void $ runStateT (mapM_ (renderDiff repo) pairedTags) GitClientState)
       opts
 
+versionsCommand :: ShiftOptions -> IO ()
+versionsCommand opts = withRepo_ opts $ \repo -> do
+  tags <- tagList repo
+
+  forM_ (sortedTagList tags) $ \version -> putStrLn (T.unpack . prettyV $ _tVersioning version)
+
 initGitHubState :: ShiftOptions -> IO GitHubClientState
 initGitHubState opts = do
   manager <- newManager tlsManagerSettings