Commit e9ff4f588975bf340e3aa1189110d8e572077549 - bunyan

+5

-0

.gitignore less more

	1	*~
	2	.ghc.env*
	3	dist-newstyle
	4	dist
	5	.dante-dist

+12

-0

LICENSE less more

	1	Copyright (c) 2017, Getty Ritter
	2	All rights reserved.
	3
	4	Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
	5
	6	1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
	7
	8	2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
	9
	10	3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
	11
	12	THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+9

-0

bunyan/Main.hs less more

	1	module Main where
	2
	3	import qualified Bunyan
	4	import qualified Options
	5
	6	main :: IO ()
	7	main = do
	8	bunyan <- Options.getOpts
	9	Bunyan.main bunyan

+67

-0

bunyan/Options.hs less more

	1	module Options (getOpts) where
	2
	3	import Control.Monad (when)
	4	import qualified System.Console.GetOpt as Opt
	5	import qualified System.Directory as Sys
	6	import qualified System.Environment as Sys
	7	import qualified System.Exit as Sys
	8
	9	import qualified Bunyan
	10
	11	data Options = Options
	12	{ optShowVersion :: Bool
	13	, optShowHelp :: Bool
	14	, optEditorCmd :: Maybe String
	15	, optRepoPath :: FilePath
	16	} deriving (Eq, Show)
	17
	18	options :: [Opt.OptDescr (Options -> Options)]
	19	options =
	20	[ Opt.Option ['v'] ["version"]
	21	(Opt.NoArg (\ o -> o { optShowVersion = True }))
	22	"Show version number"
	23	, Opt.Option ['h'] ["help"]
	24	(Opt.NoArg (\ o -> o { optShowHelp = True }))
	25	"Show this help screen"
	26	, Opt.Option ['e'] ["editor"]
	27	(Opt.ReqArg (\ e o -> o { optEditorCmd = Just e }) "CMD")
	28	"desired editor command (defaults to $EDITOR)"
	29	, Opt.Option ['r'] ["repository"]
	30	(Opt.ReqArg (\ p o -> o { optRepoPath = p }) "PATH")
	31	"git repository location (defaults to $CWD)"
	32	]
	33
	34	usageInfo :: String
	35	usageInfo = Opt.usageInfo header options
	36	where header = "Usage: bunyan [OPTIONS]..."
	37
	38	getOpts :: IO Bunyan.Config
	39	getOpts = do
	40	args <- Sys.getArgs
	41	defaultEditor <- Sys.lookupEnv "EDITOR"
	42	defaultPath <- Sys.getCurrentDirectory
	43	let defOpts = Options
	44	{ optShowVersion = False
	45	, optShowHelp = False
	46	, optEditorCmd = defaultEditor
	47	, optRepoPath = defaultPath
	48	}
	49	case Opt.getOpt Opt.Permute options args of
	50	(o, [], []) -> do
	51	let opts = foldl (flip id) defOpts o
	52	when (optShowVersion opts) $ do
	53	putStrLn "bunyan, version 0.1.0.0"
	54	Sys.exitSuccess
	55	when (optShowHelp opts) $ do
	56	putStrLn usageInfo
	57	Sys.exitSuccess
	58	editor <- case optEditorCmd opts of
	59	Just e -> return e
	60	Nothing ->
	61	Sys.die "No $EDITOR set and no editor command supplied!"
	62	return $ Bunyan.Config
	63	{ Bunyan.cfgEditorCommand = editor
	64	, Bunyan.cfgGitRepo = optRepoPath opts
	65	}
	66	(_, _, errs) -> do
	67	Sys.die (concat errs ++ usageInfo)

+38

-0

bunyan.cabal less more

	1	name: bunyan
	2	version: 0.1.0.0
	3	-- synopsis:
	4	-- description:
	5	license: BSD3
	6	license-file: LICENSE
	7	author: Getty Ritter <gdritter@galois.com>
	8	maintainer: Getty Ritter <gdritter@galois.com>
	9	copyright: ©2017 Getty Ritter
	10	-- category:
	11	build-type: Simple
	12	cabal-version: >= 1.14
	13
	14	library
	15	exposed-modules: Bunyan
	16	other-modules: Bunyan.App
	17	Bunyan.Log
	18	Bunyan.Pretty
	19	hs-source-dirs: src
	20	build-depends: base >=4.7 && <5
	21	, brick
	22	, containers
	23	, process
	24	, text
	25	, vty
	26	default-language: Haskell2010
	27	default-extensions: ScopedTypeVariables
	28
	29	executable bunyan
	30	hs-source-dirs: bunyan
	31	main-is: Main.hs
	32	other-modules: Options
	33	default-extensions: ScopedTypeVariables
	34	ghc-options: -Wall -threaded
	35	build-depends: base >=4.7 && <5
	36	, bunyan
	37	, directory
	38	default-language: Haskell2010

+138

-0

src/Bunyan/App.hs less more

	1	{-# LANGUAGE OverloadedStrings #-}
	2
	3	module Bunyan.App (runApp) where
	4
	5	import qualified Brick
	6	import qualified Data.Map as M
	7	import Data.Monoid ((<>))
	8	import qualified Data.Sequence as S
	9	import qualified Data.Text as T
	10	import qualified Graphics.Vty as Vty
	11	import qualified Graphics.Vty.Input.Events as Vty
	12
	13	import qualified Bunyan.Log as Log
	14
	15
	16	data Modal
	17	= AddSectionModal ()
	18	\| ConfirmQuitModal
	19	deriving (Eq, Show)
	20
	21	data Annot
	22	= Annot T.Text Log.Entry
	23	\| Skip Log.Entry
	24	deriving (Eq, Show)
	25
	26	data State = State
	27	{ stateSections :: M.Map T.Text (S.Seq (S.Seq T.Text))
	28	, stateCommits :: S.Seq Log.Entry
	29	, stateFinished :: S.Seq Annot
	30	, stateKeys :: M.Map Char T.Text
	31	, stateModal :: Maybe Modal
	32	, stateStatus :: T.Text
	33	} deriving (Eq, Show)
	34
	35
	36	defaultSections :: [(Char, T.Text)]
	37	defaultSections =
	38	[ ('f', "New features")
	39	, ('b', "Bug fixes")
	40	, ('p', "Package changes")
	41	, ('d', "Documentation changes")
	42	, ('i', "Performance improvements")
	43	]
	44
	45	newState :: S.Seq Log.Entry -> State
	46	newState commits = State
	47	{ stateSections = M.fromList
	48	[ (name, mempty) \| (_, name) <- defaultSections ]
	49	, stateKeys = M.fromList defaultSections
	50	, stateCommits = commits
	51	, stateFinished = S.empty
	52	, stateModal = Nothing
	53	, stateStatus = ""
	54	}
	55
	56
	57
	58	runApp :: S.Seq Log.Entry -> IO (M.Map T.Text (S.Seq (S.Seq T.Text)))
	59	runApp entries = do
	60	let state = newState entries
	61	vty = Vty.mkVty Vty.defaultConfig
	62	final <- Brick.customMain vty Nothing app state
	63	return (stateSections final)
	64
	65
	66	app :: Brick.App State () ()
	67	app = Brick.App
	68	{ Brick.appDraw = draw
	69	, Brick.appChooseCursor = Brick.showFirstCursor
	70	, Brick.appHandleEvent = event
	71	, Brick.appStartEvent = return
	72	, Brick.appAttrMap = \ _ -> Brick.forceAttrMap mempty
	73	}
	74
	75
	76	draw :: State -> [Brick.Widget ()]
	77	draw st
	78	\| Just ConfirmQuitModal <- stateModal st =
	79	[ Brick.txt "Are you sure you want to quit? (y/n)" ]
	80	\| otherwise =
	81	[ Brick.vBox
	82	[ Brick.str (show (stateModal st))
	83	, Brick.txt (stateStatus st)
	84	]
	85	]
	86
	87
	88	type EventHandler =
	89	State -> Vty.Key -> [Vty.Modifier] -> Brick.EventM () (Brick.Next State)
	90
	91	event :: State -> Brick.BrickEvent () () -> Brick.EventM () (Brick.Next State)
	92	event st (Brick.VtyEvent (Vty.EvKey key mod)) =
	93	case stateModal st of
	94	Nothing -> mainEvent st key mod
	95	Just ConfirmQuitModal -> confirmQuitEvent st key mod
	96	Just (AddSectionModal ()) -> addSectionEvent st key mod
	97	event st _ = Brick.continue st
	98
	99
	100	mainEvent :: EventHandler
	101	mainEvent st (Vty.KChar ' ') [] = do
	102	let car S.:< cdr = S.viewl (stateCommits st)
	103	Brick.continue st
	104	{ stateFinished = Skip car S.<\| stateFinished st
	105	, stateCommits = cdr
	106	, stateStatus = "skipped"
	107	}
	108
	109	mainEvent st (Vty.KChar 'q') [] =
	110	Brick.continue st { stateModal = Just ConfirmQuitModal }
	111
	112	mainEvent st (Vty.KChar 'a') [] =
	113	Brick.continue st { stateModal = Just (AddSectionModal ()) }
	114
	115	mainEvent st (Vty.KChar c) []
	116	\| Just annot <- M.lookup c (stateKeys st) = do
	117	let car S.:< cdr = S.viewl (stateCommits st)
	118	Brick.continue st
	119	{ stateFinished = Annot annot car S.<\| stateFinished st
	120	, stateCommits = cdr
	121	, stateSections =
	122	M.adjust ((Log.logMessage car) S.<\|) annot (stateSections st)
	123	, stateStatus =
	124	"Added " <> Log.logCommit car <> " to section " <> annot
	125	}
	126	\| otherwise =
	127	Brick.continue st { stateStatus = "Unknown keybindings: " <> T.pack (show c) }
	128
	129	mainEvent st _ _ = Brick.continue st
	130
	131
	132	confirmQuitEvent :: EventHandler
	133	confirmQuitEvent st (Vty.KChar 'y') _ = Brick.halt st
	134	confirmQuitEvent st _ _ = Brick.continue st { stateModal = Nothing }
	135
	136
	137	addSectionEvent :: EventHandler
	138	addSectionEvent st _ _ = Brick.continue st { stateModal = Nothing }

+46

-0

src/Bunyan/Log.hs less more

	1	{-# LANGUAGE OverloadedStrings #-}
	2
	3	module Bunyan.Log where
	4
	5	import Data.Monoid ((<>))
	6	import qualified Data.Text as T
	7	import qualified Data.Sequence as S
	8
	9
	10	data Entry = Entry
	11	{ logCommit :: T.Text
	12	, logAuthor :: T.Text
	13	, logDate :: T.Text
	14	, logMessage :: S.Seq T.Text
	15	} deriving (Eq, Show)
	16
	17
	18	emptyLogEntry :: T.Text -> Entry
	19	emptyLogEntry commit = Entry
	20	{ logCommit = commit
	21	, logAuthor = ""
	22	, logDate = ""
	23	, logMessage = mempty
	24	}
	25
	26
	27	parseLogEntry :: T.Text -> S.Seq Entry
	28	parseLogEntry = getNextCommit . T.lines
	29	where getNextCommit [] = S.empty
	30	getNextCommit (x:xs)
	31	\| Just cmt <- T.stripPrefix "commit " x =
	32	parseCommit (emptyLogEntry cmt) xs
	33	\| otherwise = getNextCommit xs
	34
	35	parseCommit entry [] = S.singleton entry
	36	parseCommit entry (x:xs)
	37	\| Just cmt <- T.stripPrefix "commit " x =
	38	entry S.<\| parseCommit (emptyLogEntry cmt) xs
	39	\| Just author <- T.stripPrefix "Author:" x =
	40	parseCommit (entry { logAuthor = T.strip author }) xs
	41	\| Just date <- T.stripPrefix "Date:" x =
	42	parseCommit (entry { logDate = T.strip date }) xs
	43	\| Just line <- T.stripPrefix " " x =
	44	parseCommit (entry { logMessage = logMessage entry <> S.singleton line }) xs
	45	\| otherwise =
	46	parseCommit entry xs

+22

-0

src/Bunyan/Pretty.hs less more

	1	{-# LANGUAGE OverloadedStrings #-}
	2
	3	module Bunyan.Pretty (pretty) where
	4
	5	import qualified Data.Foldable as F
	6	import qualified Data.Map as M
	7	import Data.Monoid ((<>))
	8	import qualified Data.Sequence as S
	9	import qualified Data.Text as T
	10
	11	pretty :: M.Map T.Text (S.Seq (S.Seq T.Text)) -> T.Text
	12	pretty messages = T.unlines $ concat
	13	[ section annot fields
	14	\| (annot, fields) <- M.toList messages
	15	, not (S.null fields)
	16	]
	17
	18	section :: T.Text -> S.Seq (S.Seq T.Text) -> [T.Text]
	19	section annot fields =
	20	let bullet [] = []
	21	bullet (x:xs) = ("* " <> x) : map (" " <>) xs
	22	in "" : (annot <> ":") : F.foldMap bullet (fmap F.toList fields)

+27

-0

src/Bunyan.hs less more

	1	module Bunyan where
	2
	3	import Data.Monoid ((<>))
	4	import qualified Data.Text as T
	5	import qualified Data.Text.IO as T
	6	import qualified System.Process as Sys
	7
	8	import Bunyan.Log
	9	import Bunyan.App
	10	import Bunyan.Pretty
	11
	12	data Config = Config
	13	{ cfgEditorCommand :: String
	14	, cfgGitRepo :: FilePath
	15	} deriving (Eq, Show)
	16
	17
	18	main :: Config -> IO ()
	19	main cfg = do
	20	let pr = (Sys.proc "git" ["log"]) { Sys.cwd = Just (cfgGitRepo cfg)
	21	, Sys.std_out = Sys.CreatePipe
	22	}
	23	rs <- Sys.withCreateProcess pr $ \ _ (Just stdin) _ ph -> do
	24	T.hGetContents stdin
	25	let entries = parseLogEntry rs
	26	cats <- runApp entries
	27	T.putStrLn (pretty cats)