;tools: changelog: a silly tool that makes changelog work more pleasant

This commit is contained in:
Simon Michael 2021-11-26 12:31:36 -10:00
parent 8c57d70940
commit 8464fed4f6

140
bin/changelog.hs Executable file
View File

@ -0,0 +1,140 @@
#!/usr/bin/env stack
{- stack script --resolver nightly-2021-11-19
--package data-default
--package extra
--package hledger-lib
--package process
--package text
-}
{- stack ghc
--package text
-}
-- changelog.hs CHANGELOGFILE
--
-- Manipulate a hledger changelog. Currently does one thing: prompts
-- for a rewrite of the oldest uncategorised pending changelog item
-- and updates the file, printing a diff.
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
-- {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
import Data.Char
import Data.Default
import GHC.Generics
import Data.List.Extra
import qualified Data.Text as T
import System.Environment
import System.IO
import System.Process
import Text.Printf
import Hledger.Utils
-- The one-line heading for a top level section in the changelog,
-- with the leading #(s) removed.
type ChangelogHeading = String
-- One change description in the changelog, with the list bullet and
-- corresponding indentation removed.
type ChangelogItem = String
-- A top level section in the changelog, corresponding to one release.
data ChangelogSection = ChangelogSection {
heading :: ChangelogHeading
,unknownitems :: [ChangelogItem]
,featureitems :: [ChangelogItem]
,improvementitems :: [ChangelogItem]
,fixitems :: [ChangelogItem]
}
deriving (Show, Generic, Default)
main = do
(i:_) <- getArgs
-- read specified changelog
(preamble:first:rest) <- splitOn "\n# " <$> readFile i
let
o = i ++ ".new"
s@ChangelogSection{..} = readSection first
s' <- editOneUnknown s
-- write back to new file
writeFile o $ init $ unlines $
preamble :
showSection s' :
map ("# "++) rest
-- show the diff
system' $ printf "diff %s %s" i o
-- overwrite the old file
system' $ printf "mv %s %s" o i
editOneUnknown :: ChangelogSection -> IO ChangelogSection
editOneUnknown s@ChangelogSection{..}
| null unknownitems = return s
| otherwise = do
let u = last unknownitems
putStrLn "Old:\n"
putStrLn u
putStrLn "New: (prefix with feat:/imp:/fix: to categorise, ctrl-d to finish):\n" -- Just an = keeps it unchanged, empty string removes it.\n"
i <- getContents
let s' =
case i of
'f':'e':'a':'t':':':' ':t -> s{featureitems = readItem t : featureitems}
'f':'i':'x':':':' ':t -> s{fixitems = readItem t : fixitems}
'i':'m':'p':':':' ':t -> s{improvementitems = readItem t : improvementitems}
t -> s{improvementitems = readItem t : improvementitems}
return s'{unknownitems=init unknownitems}
-- Parse a changelog section which may or may not have the Features/Improvements/Fixes subheadings.
readSection :: String -> ChangelogSection
readSection s =
let
(heading,rest) = break (=='\n') s
parts = splitOn "\nFeatures\n" rest
(unknownitems, featureitems, improvementitems, fixitems) =
case parts of
[] -> ([], [], [], [])
[u] -> (readItems u, [], [], [])
(u:xs:_) -> (readItems u, readItems f, readItems i, readItems x)
where
(f:ys:_) = splitOn "\nImprovements\n" xs
(i:x:_) = splitOn "\nFixes\n" ys
in ChangelogSection{..}
where
readItems = map readItem . filter (not.all isSpace) . splitOn "\n- "
showSection ChangelogSection{..} =
unlines $
[("# "++heading), ""]
++ map showItem unknownitems
++ ["Features", ""]
++ map showItem featureitems
++ ["Improvements", ""]
++ map showItem improvementitems
++ ["Fixes", ""]
++ map showItem fixitems
readItem :: String -> ChangelogItem
readItem "" = def
readItem s =
let
(first:rest) = lines s
stripto2spaces (' ':' ':t) = t
stripto2spaces (' ':t) = t
stripto2spaces t = t
in unlines $
first :
map stripto2spaces rest
showItem "" = ""
showItem i =
let (first:rest) = lines i
in unlines $ ("- "++first) : map (" "++) rest
system' s = putStrLn s >> system s
re = toRegex' . T.pack