diff --git a/shift.cabal b/shift.cabal
index 523d573042d51cde5a7a3d25d73b7c248195f670..95eab874be02e74a75112a89e3e844ef08d5f516 100644
--- a/shift.cabal
+++ b/shift.cabal
@@ -47,6 +47,7 @@ library
, vector
, exceptions
, semigroups
+ , cmark-gfm
default-language: Haskell2010
executable shift
diff --git a/src/Shift/Git.hs b/src/Shift/Git.hs
index 1863b6c957da35e7216c32a28c5850148c80d4ac..929a5e76eb893d496069a9e30e40871a58e36114 100644
--- a/src/Shift/Git.hs
+++ b/src/Shift/Git.hs
@@ -14,8 +14,15 @@ 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) )
import Data.Git.Ref (HashAlgorithm, fromHex, isHex)
-import Data.Git.Storage.Object
+import Data.Git.Storage.Object ( Object(ObjCommit) )
import Data.List (sortBy)
import Data.Maybe (catMaybes)
import Data.Set as S (toList)
@@ -30,13 +37,14 @@ import GitHub.Auth (Auth (OAuth))
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Shift.CLI
-import Shift.Processing
-import Shift.Rendering
+import Shift.Processing ( generateReport, parseCommit )
+import Shift.Rendering ( printReport )
import Shift.Types
import Shift.Utilities (orError, pairs)
-import System.Process
+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
@@ -44,23 +52,31 @@ parseTag ref = case versioning . cs . refNameRaw $ ref of
Right v -> Right (TagRef ref v)
tempMain :: ShiftOptions -> IO ()
-tempMain opts = withRepo ".git" $ \repo -> do
+tempMain opts = do
+ node <- renderToNode opts
+
+ liftIO $ TIO.putStr $ nodeToCommonmark [] Nothing node
+
+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
- case opts ^. soHostingType of
+ nodes <- case opts ^. soHostingType of
GitHubType -> do
state <- initGitHubState
- runReaderT
- (void $ runStateT (mapM_ (renderDiff repo) pairedTags) state)
+ fst <$> runReaderT
+ (runStateT (mapM (renderDiff repo) pairedTags) state)
opts
GitType ->
- runReaderT
- (void $ runStateT (mapM_ (renderDiff repo) pairedTags) GitClientState)
+ fst <$> runReaderT
+ (runStateT (mapM (renderDiff repo) pairedTags) GitClientState)
opts
+
+ pure (Node Nothing DOCUMENT (concat nodes))
where
initGitHubState = do
manager <- newManager tlsManagerSettings
@@ -80,15 +96,13 @@ tempMain opts = withRepo ".git" $ \repo -> do
_gcsRepository = cs repositoryName
}
-renderDiff :: (ClientState s, HashAlgorithm hash) => Git hash -> (TagRef, TagRef) -> GitM s ()
+renderDiff :: (ClientState s, HashAlgorithm hash) => Git hash -> (TagRef, TagRef) -> GitM s [Node]
renderDiff repo (tx, ty) = do
- liftIO . TIO.putStrLn . headerOne $ renderRange tx ty
-
diff <- lookupCommitsDiff repo tx ty
case diff of
[] -> throwM SEUnableToComputeDiff
- diff_ -> printReport (generateReport . rights $ parseCommit <$> diff_)
+ diff_ -> printReport (tx, ty) (generateReport . rights $ parseCommit <$> diff_)
lookupCommitsDiff :: (HashAlgorithm hash) => Git hash -> TagRef -> TagRef -> GitM s [(Ref hash, Commit hash)]
lookupCommitsDiff repo x y = do
diff --git a/src/Shift/Rendering.hs b/src/Shift/Rendering.hs
index 1242ad215ecea749fe8465b42d64ad3c2d2ab5dd..ea1944d852f72ee818e5f50e19d8d17544d8faa9 100644
--- a/src/Shift/Rendering.hs
+++ b/src/Shift/Rendering.hs
@@ -1,117 +1,157 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Shift.Rendering where
+import CMarkGFM as M
+import Control.Lens ((^.))
+import Control.Monad.Catch (MonadThrow)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.State (MonadState)
+import Control.Monad.Trans.Writer (WriterT (runWriterT), execWriterT, runWriter)
+import Control.Monad.Trans.Writer.Lazy (tell)
+import Data.Git (Commit, Ref, commitAuthor)
import Data.List (sortOn)
-
-import Control.Lens ((^.))
-import Control.Monad.Catch (MonadThrow)
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Monad.State (MonadState)
-import Data.Git (Commit, Ref, commitAuthor)
-import Data.Monoid ((<>))
-import Data.String.Conversions (cs)
-import Data.Text (Text)
-import qualified Data.Text as T (take)
-import qualified Data.Text.IO as TIO (putStrLn)
-import Data.Versions (prettyV)
-
+import Data.Maybe (catMaybes)
+import Data.Monoid ((<>))
+import Data.String.Conversions (cs)
+import Data.Text (Text)
+import qualified Data.Text as T (take)
+import qualified Data.Text.IO as TIO (putStr, putStrLn)
+import Data.Versions (prettyV)
import Shift.Types
-renderRef
- :: (MonadIO m, MonadState s m, ClientState s, MonadThrow m)
- => Ref hash
- -> m Text
+renderRef ::
+ (MonadIO m, MonadState s m, ClientState s, MonadThrow m) =>
+ Ref hash ->
+ m [Node]
renderRef ref = do
url <- getRefURL ref
let shortRef = T.take 7 . cs . show $ ref
+ let shortRefNode = leafNode (CODE shortRef)
pure $ case url of
- Just url_ -> "[[`" <> shortRef <> "`](" <> url_ <> ")]"
- Nothing -> "[`" <> shortRef <> "`]"
+ Just url_ -> [textNode "[", parentNode (LINK url_ shortRef) [shortRefNode], textNode "]"]
+ Nothing -> [textNode "[", shortRefNode, textNode "]"]
-renderConventionalCommit
- :: (MonadIO m, MonadState s m, ClientState s, MonadThrow m)
- => ConventionalGroup hash
- -> m Text
+renderConventionalCommit ::
+ (MonadIO m, MonadState s m, ClientState s, MonadThrow m) =>
+ ConventionalGroup hash ->
+ m Node
renderConventionalCommit (ref, commit, pc) = do
renderedRef <- renderRef ref
authorText <- renderAuthor commit ref
- pure . mconcat $
- [ "- "
- , renderedRef
- , " "
- , bold $ pc ^. ccScope <> ":"
- , " "
- , pc ^. ccSubject
- , authorText
- ]
-
-renderAuthor
- :: (MonadIO m, MonadState s m, ClientState s, MonadThrow m)
- => Commit hash
- -> Ref hash
- -> m Text
+ pure $
+ listItemNode
+ [ paragraphNode $
+ renderedRef
+ <> catMaybes
+ [ Just $ textNode " ",
+ Just . bold $ pc ^. ccScope <> ":",
+ Just $ textNode " ",
+ Just . textNode $ pc ^. ccSubject,
+ Just $ textNode " ",
+ authorText
+ ]
+ ]
+
+renderAuthor ::
+ (MonadIO m, MonadState s m, ClientState s, MonadThrow m) =>
+ Commit hash ->
+ Ref hash ->
+ m (Maybe Node)
renderAuthor commit ref = do
authorInfo <- getAuthorInfo (commitAuthor commit) ref
pure $ case authorInfo of
- Just (username, authorUrl) -> " [(" <> username <> ")](" <> authorUrl <> ")"
- Nothing -> ""
+ Just (username, authorUrl) -> Just $ parentNode (LINK authorUrl username) [textNode username]
+ Nothing -> Nothing
-renderMiscCommit
- :: (MonadIO m, MonadState s m, ClientState s, MonadThrow m)
- => MiscGroup hash
- -> m Text
+renderMiscCommit ::
+ (MonadIO m, MonadState s m, ClientState s, MonadThrow m) =>
+ MiscGroup hash ->
+ m Node
renderMiscCommit (ref, commit, MiscCommit subject) = do
renderedRef <- renderRef ref
authorText <- renderAuthor commit ref
- pure $ "- " <> renderedRef <> " " <> subject <> authorText
-
-renderMergeCommit
- :: (MonadIO m, MonadState s m, ClientState s, MonadThrow m)
- => MergeGroup hash
- -> m Text
+ pure $
+ listItemNode
+ [ paragraphNode $
+ renderedRef
+ <> catMaybes
+ [ Just $ textNode subject,
+ Just $ textNode " ",
+ authorText
+ ]
+ ]
+
+renderMergeCommit ::
+ (MonadIO m, MonadState s m, ClientState s, MonadThrow m) =>
+ MergeGroup hash ->
+ m Node
renderMergeCommit (ref, commit, MergeCommit subject) = do
renderedRef <- renderRef ref
authorText <- renderAuthor commit ref
- pure $ "- " <> renderedRef <> " Merge " <> subject <> authorText
+ pure $
+ listItemNode
+ [ paragraphNode $
+ renderedRef
+ <> catMaybes
+ [ Just $ textNode $ "Merge " <> subject,
+ authorText
+ ]
+ ]
renderRange :: TagRef -> TagRef -> Text
-renderRange tx ty = mconcat
- [prettyV . _tVersioning $ tx, " to ", prettyV . _tVersioning $ ty]
+renderRange tx ty =
+ mconcat
+ [prettyV . _tVersioning $ tx, " to ", prettyV . _tVersioning $ ty]
-bold :: Text -> Text
-bold x = "**" <> x <> "**"
+bold :: Text -> Node
+bold x = parentNode STRONG [textNode x]
indented :: Int -> Text -> Text
-indented levels x = foldl (\acc _ -> acc <> " ") "" [1..levels] <> x
+indented levels x = foldl (\acc _ -> acc <> " ") "" [1 .. levels] <> x
indentedL :: Int -> Text -> Text
-indentedL levels x = "\\" <> foldl (\acc _ -> acc <> "-") "" [1..levels] <> x
+indentedL levels x = "\\" <> foldl (\acc _ -> acc <> "-") "" [1 .. levels] <> x
+
+headerOne :: Text -> Node
+headerOne t = parentNode (HEADING 1) [textNode t]
+
+headerTwo :: Text -> Node
+headerTwo t = parentNode (HEADING 2) [textNode t]
-linePadded :: Text -> Text
-linePadded x = "\n" <> x <> "\n"
+headerThree :: Text -> Node
+headerThree t = parentNode (HEADING 3) [textNode t]
-headerOne :: Text -> Text
-headerOne = linePadded . (<>) "# "
+textNode :: Text -> Node
+textNode t = Node Nothing (TEXT t) []
-headerTwo :: Text -> Text
-headerTwo = linePadded . (<>) "## "
+leafNode :: NodeType -> Node
+leafNode n = Node Nothing n []
-headerThree :: Text -> Text
-headerThree = linePadded . (<>) "### "
+parentNode :: NodeType -> [Node] -> Node
+parentNode = Node Nothing
+
+listItemNode :: [Node] -> Node
+listItemNode = parentNode ITEM
+
+paragraphNode :: [Node] -> Node
+paragraphNode = parentNode PARAGRAPH
+
+printReport ::
+ (MonadIO m, MonadState s m, ClientState s, MonadThrow m) =>
+ (TagRef, TagRef) ->
+ ChangeReport hash ->
+ m [Node]
+printReport (rangeStart, rangeEnd) report = execWriterT $ do
+ tell [headerOne $ renderRange rangeStart rangeEnd]
-printReport
- :: (MonadIO m, MonadState s m, ClientState s, MonadThrow m)
- => ChangeReport hash
- -> m ()
-printReport report = do
-- Print conventional commits
conventionalSection "New features:" crFeatures
conventionalSection "Fixes:" crFixes
@@ -129,7 +169,7 @@ printReport report = do
textSection "Merge commits:" mergeCommits
where
conventionalSection label sectionLens = do
- let rawCommits = sortOn (\(_,_,pc) -> pc ^. ccScope) (report ^. sectionLens)
+ let rawCommits = sortOn (\(_, _, pc) -> pc ^. ccScope) (report ^. sectionLens)
commits <- mapM renderConventionalCommit rawCommits
textSection label commits
@@ -137,7 +177,6 @@ printReport report = do
textSection label commits = case commits of
[] -> pure ()
_ -> do
- liftIO . TIO.putStrLn . headerTwo $ label
-
- liftIO $ mapM_ (TIO.putStrLn . indented 1) commits
+ tell [headerTwo label]
+ tell [parentNode (LIST (ListAttributes BULLET_LIST False 0 PAREN_DELIM)) commits]
diff --git a/src/Shift/Types.hs b/src/Shift/Types.hs
index c31b0aaccd038677ea9c74660dde0393b932f624..46e9252e5f773c59d93af369cc2a03beea16b997 100644
--- a/src/Shift/Types.hs
+++ b/src/Shift/Types.hs
@@ -43,7 +43,6 @@ import GitHub (URL(URL))
import GitHub (getUrl)
import GitHub (getUrl)
import Data.Aeson (FromJSON)
-import Data.Aeson (FromJSON)
class ClientState s where
getRefURL