gdritter repos bunyan / e9ff4f5
Initial-ish commit: quick-and-dirty code for parsing git logs and walking them Getty Ritter 3 years ago
9 changed file(s) with 364 addition(s) and 0 deletion(s). Collapse all Expand all
1 *~
2 .ghc.env*
3 dist-newstyle
4 dist
5 .dante-dist
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.
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
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)
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
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 }
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
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)
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)