web: offer a choice of files to edit when there are multiple (included) files

This commit is contained in:
Simon Michael 2010-09-24 01:56:11 +00:00
parent 78db98366f
commit 7714bab58d
10 changed files with 165 additions and 94 deletions

View File

@ -10,6 +10,7 @@ module Hledger.Data.Journal
where
import qualified Data.Map as Map
import Data.Map (findWithDefault, (!))
import Safe (headDef)
import System.Time (ClockTime(TOD))
import Hledger.Data.Utils
import Hledger.Data.Types
@ -24,7 +25,7 @@ import Hledger.Data.TimeLog
instance Show Journal where
show j = printf "Journal %s with %d transactions, %d accounts: %s"
(filepath j)
(journalFilePath j)
(length (jtxns j) +
length (jmodifiertxns j) +
length (jperiodictxns j))
@ -40,10 +41,8 @@ nulljournal = Journal { jmodifiertxns = []
, open_timelog_entries = []
, historical_prices = []
, final_comment_lines = []
, filepath = ""
, allfilepaths = []
, files = []
, filereadtime = TOD 0 0
, jtext = ""
}
nullfilterspec = FilterSpec {
@ -58,6 +57,15 @@ nullfilterspec = FilterSpec {
,depth=Nothing
}
journalFilePath :: Journal -> FilePath
journalFilePath = fst . mainfile
journalFilePaths :: Journal -> [FilePath]
journalFilePaths = map fst . files
mainfile :: Journal -> (FilePath, String)
mainfile = headDef ("", "") . files
addTransaction :: Transaction -> Journal -> Journal
addTransaction t l0 = l0 { jtxns = t : jtxns l0 }
@ -214,10 +222,11 @@ journalSelectingDate EffectiveDate j =
-- | Do post-parse processing on a journal, to make it ready for use.
journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> Journal -> Journal
journalFinalise tclock tlocal path txt j = journalCanonicaliseAmounts $
journalApplyHistoricalPrices $
journalCloseTimeLogEntries tlocal
j{filepath=path, allfilepaths=path:(allfilepaths j), filereadtime=tclock, jtext=txt}
journalFinalise tclock tlocal path txt j@Journal{files=fs} =
journalCanonicaliseAmounts $
journalApplyHistoricalPrices $
journalCloseTimeLogEntries tlocal
j{files=(path,txt):fs, filereadtime=tclock}
-- | Convert all the journal's amounts to their canonical display
-- settings. Ie, all amounts in a given commodity will use (a) the

View File

@ -128,10 +128,11 @@ data Journal = Journal {
open_timelog_entries :: [TimeLogEntry],
historical_prices :: [HistoricalPrice],
final_comment_lines :: String, -- ^ any trailing comments from the journal file
filepath :: FilePath, -- ^ file path of this journal
allfilepaths :: [FilePath], -- ^ file paths of this and any included journals
filereadtime :: ClockTime, -- ^ when this journal was read from its file
jtext :: String -- ^ the raw text read from the journal's file
files :: [(FilePath, String)], -- ^ the file path and raw text of the main and
-- any included journal files. The main file is
-- first followed by any included files in the
-- order encountered.
filereadtime :: ClockTime -- ^ when this journal was last read from its file(s)
} deriving (Eq, Typeable)
data Ledger = Ledger {

View File

@ -26,7 +26,6 @@ module Test.HUnit,
where
import Data.Char
import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded)
import Control.Exception
import Control.Monad
import Data.List
--import qualified Data.Map as Map
@ -361,9 +360,6 @@ isLeft _ = False
isRight :: Either a b -> Bool
isRight = not . isLeft
strictReadFile :: FilePath -> IO String
strictReadFile f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s
-- -- | Expand ~ in a file path (does not handle ~name).
-- tildeExpand :: FilePath -> IO FilePath
-- tildeExpand ('~':[]) = getHomeDirectory

View File

@ -107,6 +107,7 @@ module Hledger.Read.Journal (
tests_Journal,
reader,
journalFile,
journalAddFile,
someamount,
ledgeraccountname,
ledgerExclamationDirective,
@ -150,7 +151,9 @@ detect f _ = fileSuffix f == format
-- | Parse and post-process a "Journal" from hledger's journal file
-- format, or give an error.
parse :: FilePath -> String -> ErrorT String IO Journal
parse = parseJournalWith journalFile
parse = do
j <- parseJournalWith journalFile
return j
-- | Top-level journal parser. Returns a single composite, I/O performing,
-- error-raising "JournalUpdate" which can be applied to an empty journal
@ -176,8 +179,8 @@ journalFile = do journalupdates <- many journalItem
, emptyLine >> return (return id)
] <?> "journal transaction or directive"
journalAddFilePath :: FilePath -> Journal -> Journal
journalAddFilePath f j@Journal{allfilepaths=fs} = j{allfilepaths=fs++[f]}
journalAddFile :: (FilePath,String) -> Journal -> Journal
journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}
emptyLine :: GenParser Char JournalContext ()
emptyLine = do many spacenonewline
@ -218,10 +221,10 @@ ledgerInclude = do
outerState <- getState
outerPos <- getPosition
return $ do filepath <- expandPath outerPos filename
contents <- readFileOrError outerPos filepath
txt <- readFileOrError outerPos filepath
let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
case runParser journalFile outerState filepath contents of
Right ju -> juSequence [return $ journalAddFilePath filepath, ju] `catchError` (throwError . (inIncluded ++))
case runParser journalFile outerState filepath txt of
Right ju -> juSequence [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++))
Left err -> throwError $ inIncluded ++ show err
where readFileOrError pos fp =
ErrorT $ liftM Right (readFile fp) `catch`

View File

@ -27,7 +27,7 @@ import Yesod.Helpers.Auth
import Text.Hamlet (defaultHamletSettings)
import Text.Hamlet.RT
import Hledger.Cli.Commands.Add (journalAddTransaction)
import Hledger.Cli.Commands.Add (appendToJournalFile)
import Hledger.Cli.Commands.Balance
import Hledger.Cli.Commands.Print
import Hledger.Cli.Commands.Register
@ -339,7 +339,7 @@ navbar TD{p=p,j=j,today=today} = [$hamlet|
journalTitleDesc :: Journal -> String -> Day -> (String, String)
journalTitleDesc j p today = (title, desc)
where
title = printf "%s" (takeFileName $ filepath j) :: String
title = printf "%s" (takeFileName $ journalFilePath j) :: String
desc = printf "%s" (showspan span) :: String
span = either (const $ DateSpan Nothing Nothing) snd (parsePeriodExpr today p)
showspan (DateSpan Nothing Nothing) = ""
@ -503,7 +503,7 @@ getJournalR = do
br = balanceReportAsHtml opts td $ balanceReport opts fspec j
jr = journalReportAsHtml opts td $ journalReport opts fspec j
td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td $ jtext j
editform' = editform td
hamletToRepHtml $ pageLayout td [$hamlet|
%div.ledger
%div.accounts!style=float:left; ^br^
@ -534,7 +534,7 @@ getRegisterR = do
br = balanceReportAsHtml opts td $ balanceReport opts fspec j
rr = registerReportAsHtml opts td $ registerReport opts fspec j
td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td $ jtext j
editform' = editform td
hamletToRepHtml $ pageLayout td [$hamlet|
%div.ledger
%div.accounts!style=float:left; ^br^
@ -635,7 +635,7 @@ getJournalOnlyR = do
(a, p, opts, fspec, j, msg, here) <- getHandlerData
today <- liftIO getCurrentDay
let td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
editform' = editform td $ jtext j
editform' = editform td
txns = journalReportAsHtml opts td $ journalReport opts fspec j
hamletToRepHtml $ pageLayout td [$hamlet|
%div.journal
@ -714,6 +714,8 @@ addform td = [$hamlet|
%td!colspan=4
%input!type=hidden!name=action!value=add
%input!type=submit!name=submit!value="add transaction"
$if manyfiles
\ to: ^journalselect.files.j.td^
|]
where
-- datehelplink = helplink "dates" "..."
@ -721,6 +723,7 @@ addform td = [$hamlet|
deschelp = "eg: supermarket (optional)"
date = "today"
descriptions = sort $ nub $ map tdescription $ jtxns $ j td
manyfiles = (length $ files $ j td) > 1
postingsfields :: TemplateData -> Hamlet AppRoute
postingsfields td = [$hamlet|
@ -732,7 +735,7 @@ postingsfields td = [$hamlet|
p2 = postingfields td 2
postingfields :: TemplateData -> Int -> Hamlet AppRoute
postingfields td n = [$hamlet|
postingfields TD{j=j} n = [$hamlet|
%tr#postingrow
%td!align=right $acctlabel$:
%td
@ -753,7 +756,7 @@ postingfields td n = [$hamlet|
numbered = (++ show n)
acctvar = numbered "account"
amtvar = numbered "amount"
acctnames = sort $ journalAccountNamesUsed $ j td
acctnames = sort $ journalAccountNamesUsed j
(acctlabel, accthelp, amtfield, amthelp)
| n == 1 = ("To account"
,"eg: expenses:food"
@ -771,14 +774,19 @@ postingfields td n = [$hamlet|
,""
)
editform :: TemplateData -> String -> Hamlet AppRoute
editform _ content = [$hamlet|
editform :: TemplateData -> Hamlet AppRoute
editform TD{j=j} = [$hamlet|
%form#editform!method=POST!style=display:none;
%table.form#editform
$if manyfiles
%tr
%td!colspan=2
Editing ^journalselect.files.j^
%tr
%td!colspan=2
%textarea!name=text!rows=30!cols=80
$content$
$forall files.j f
%textarea!id=$fst.f$_textarea!name=text!rows=25!cols=80!style=display:none;!disabled=disabled
$snd.f$
%tr#addbuttonrow
%td
%span.help ^formathelp^
@ -788,10 +796,18 @@ editform _ content = [$hamlet|
%input!type=submit!name=submit!value="save journal"
\ or $
%a!href!onclick="return editformToggle()" cancel
|]
|] -- XXX textarea ids are unquoted journal file paths, which is not valid html
where
manyfiles = (length $ files j) > 1
formathelp = helplink "file-format" "file format help"
journalselect :: [(FilePath,String)] -> Hamlet AppRoute
journalselect journalfiles = [$hamlet|
%select!id=journalselect!name=journal!onchange="editformJournalSelect()"
$forall journalfiles f
%option!value=$fst.f$ $fst.f$
|]
importform :: Hamlet AppRoute
importform = [$hamlet|
%form#importform!method=POST!style=display:none;
@ -815,17 +831,18 @@ postJournalOnlyR = do
-- | Handle a journal add form post.
postAddForm :: Handler RepPlain
postAddForm = do
(_, _, opts, _, _, _, _) <- getHandlerData
(_, _, _, _, j, _, _) <- getHandlerData
today <- liftIO getCurrentDay
-- get form input values. M means a Maybe value.
(dateM, descM, acct1M, amt1M, acct2M, amt2M) <- runFormPost'
$ (,,,,,)
(dateM, descM, acct1M, amt1M, acct2M, amt2M, journalM) <- runFormPost'
$ (,,,,,,)
<$> maybeStringInput "date"
<*> maybeStringInput "description"
<*> maybeStringInput "account1"
<*> maybeStringInput "amount1"
<*> maybeStringInput "account2"
<*> maybeStringInput "amount2"
<*> maybeStringInput "journal"
-- supply defaults and parse date and amounts, or get errors.
let dateE = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today) dateM
descE = Right $ fromMaybe "" descM
@ -833,11 +850,16 @@ postAddForm = do
acct2E = maybe (Left "from account required") Right acct2M
amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parse someamount "") amt1M
amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parse someamount "") amt2M
strEs = [dateE, descE, acct1E, acct2E]
journalE = maybe (Right $ journalFilePath j)
(\f -> if f `elem` journalFilePaths j
then Right f
else Left $ "unrecognised journal file path: " ++ f)
journalM
strEs = [dateE, descE, acct1E, acct2E, journalE]
amtEs = [amt1E, amt2E]
[date,desc,acct1,acct2] = rights strEs
[amt1,amt2] = rights amtEs
errs = lefts strEs ++ lefts amtEs
[date,desc,acct1,acct2,journalpath] = rights strEs
[amt1,amt2] = rights amtEs
-- if no errors so far, generate a transaction and balance it or get the error.
tE | not $ null errs = Left errs
| otherwise = either (\e -> Left ["unbalanced postings: " ++ (head $ lines e)]) Right
@ -863,46 +885,54 @@ postAddForm = do
Right t -> do
let t' = txnTieKnot t -- XXX move into balanceTransaction
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
liftIO $ journalAddTransaction j opts t'
liftIO $ appendToJournalFile journalpath $ showTransaction t'
setMessage $ string $ printf "Added transaction:\n%s" (show t')
redirect RedirectTemporary RegisterR
-- | Handle a journal edit form post.
postEditForm :: Handler RepPlain
postEditForm = do
-- get form input values, or basic validation errors. E means an Either value.
textM <- runFormPost' $ maybeStringInput "text"
(_, _, _, _, j, _, _) <- getHandlerData
-- get form input values, or validation errors.
-- getRequest >>= liftIO (reqRequestBody req) >>= mtrace
(textM, journalM) <- runFormPost'
$ (,)
<$> maybeStringInput "text"
<*> maybeStringInput "journal"
let textE = maybe (Left "No value provided") Right textM
-- display errors or add transaction
case textE of
Left errs -> do
-- XXX should save current form values in session
setMessage $ string errs
journalE = maybe (Right $ journalFilePath j)
(\f -> if f `elem` journalFilePaths j
then Right f
else Left "unrecognised journal file path")
journalM
strEs = [textE, journalE]
errs = lefts strEs
[text,journalpath] = rights strEs
-- display errors or perform edit
if not $ null errs
then do
setMessage $ string $ intercalate "; " errs
redirect RedirectTemporary JournalR
Right t' -> do
else do
-- try to avoid unnecessary backups or saving invalid data
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
filechanged' <- liftIO $ journalFileIsNewer j
let f = filepath j
told = jtext j
tnew = filter (/= '\r') t'
filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath
told <- liftIO $ readFileStrictly journalpath
let tnew = filter (/= '\r') text
changed = tnew /= told || filechanged'
-- changed <- liftIO $ writeFileWithBackupIfChanged f t''
if not changed
then do
setMessage $ string $ "No change"
redirect RedirectTemporary JournalR
else do
jE <- liftIO $ journalFromPathAndString Nothing f tnew
jE <- liftIO $ journalFromPathAndString Nothing journalpath tnew
either
(\e -> do
setMessage $ string e
redirect RedirectTemporary JournalR)
(const $ do
liftIO $ writeFileWithBackup f tnew
setMessage $ string $ printf "Saved journal %s\n" (show f)
liftIO $ writeFileWithBackup journalpath tnew
setMessage $ string $ printf "Saved journal %s\n" (show journalpath)
redirect RedirectTemporary JournalR)
jE

View File

@ -70,6 +70,7 @@ function addformToggle() {
function editformToggle() {
var a = document.getElementById('addform');
var e = document.getElementById('editform');
var ej = document.getElementById('journalselect');
var f = document.getElementById('filterform');
var i = document.getElementById('importform');
var t = document.getElementById('transactions');
@ -87,9 +88,10 @@ function editformToggle() {
jlink.style['font-weight'] = 'normal';
rlink.style['font-weight'] = 'normal';
a.style.display = 'none';
e.style.display = 'block';
i.style.display = 'none';
t.style.display = 'none';
e.style.display = 'block';
editformJournalSelect();
} else {
alink.style['font-weight'] = 'normal';
elink.style['font-weight'] = 'normal';
@ -102,6 +104,24 @@ function editformToggle() {
return false;
}
function editformJournalSelect() {
var textareas = $('textarea', $('form#editform'));
for (i=0; i<textareas.length; i++) {
textareas[i].style.display = 'none';
textareas[i].disabled = true;
}
if (event.target.value) {
var journalid = event.target.value+'_textarea';
var textarea = document.getElementById(journalid);
}
else {
var textarea = textareas[0];
}
textarea.style.display = 'block';
textarea.disabled = false;
return true;
}
function importformToggle() {
var a = document.getElementById('addform');
var e = document.getElementById('editform');

View File

@ -36,7 +36,7 @@ add opts args j
++"To complete a transaction, enter . as account name. To quit, press control-c."
today <- getCurrentDay
getAndAddTransactions j opts args today `catch` (\e -> unless (isEOFError e) $ ioError e)
where f = filepath j
where f = journalFilePath j
-- | Read a number of transactions from the command line, prompting,
-- validating, displaying and appending them to the journal file, until
@ -132,30 +132,28 @@ askFor prompt def validator = do
Nothing -> return input
where showdef s = " [" ++ s ++ "]"
-- | Append this transaction to the journal's file. Also, to the journal's
-- transaction list, but we don't bother updating the other fields - this
-- is enough to include new transactions in the history matching.
-- | Append this transaction to the journal's file, and to the journal's
-- transaction list.
journalAddTransaction :: Journal -> [Opt] -> Transaction -> IO Journal
journalAddTransaction j@Journal{jtxns=ts} opts t = do
appendToJournalFile j $ showTransaction t
let f = journalFilePath j
appendToJournalFile f $ showTransaction t
when (Debug `elem` opts) $ do
putStrLn $ printf "\nAdded transaction to %s:" (filepath j)
putStrLn $ printf "\nAdded transaction to %s:" f
putStrLn =<< registerFromString (show t)
return j{jtxns=ts++[t]}
-- | Append data to the journal's file, ensuring proper separation from
-- any existing data; or if the file is "-", dump it to stdout.
appendToJournalFile :: Journal -> String -> IO ()
appendToJournalFile Journal{filepath=f, jtext=t} s =
-- | Append data to a journal file; or if the file is "-", dump it to stdout.
appendToJournalFile :: FilePath -> String -> IO ()
appendToJournalFile f s =
if f == "-"
then putStr $ sep ++ s
else appendFile f $ sep++s
where
-- XXX we are looking at the original raw text from when the journal
-- was first read, but that's good enough for now
sep | null $ strip t = ""
| otherwise = replicate (2 - min 2 (length lastnls)) '\n'
where lastnls = takeWhile (=='\n') $ reverse t
sep = "\n\n"
-- sep | null $ strip t = ""
-- | otherwise = replicate (2 - min 2 (length lastnls)) '\n'
-- where lastnls = takeWhile (=='\n') $ reverse t
-- | Convert a string of journal data into a register report.
registerFromString :: String -> IO String

View File

@ -38,7 +38,7 @@ showLedgerStats _ _ l today span =
w1 = maximum $ map (length . fst) stats
w2 = maximum $ map (length . show . snd) stats
stats = [
("Journal file", filepath $ journal l)
("Journal file", journalFilePath $ journal l)
,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days)
,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed)
,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)

View File

@ -63,7 +63,7 @@ tests = TestList [
"account directive" ~:
let sameParse str1 str2 = do j1 <- readJournal Nothing str1 >>= either error' return
j2 <- readJournal Nothing str2 >>= either error' return
j1 `is` j2{filereadtime=filereadtime j1, jtext=jtext j1}
j1 `is` j2{filereadtime=filereadtime j1, files=files j1}
in TestList
[
"account directive 1" ~: sameParse
@ -1059,9 +1059,8 @@ journal7 = Journal
[]
[]
""
""
[]
(TOD 0 0)
""
ledger7 = journalToLedger nullfilterspec journal7
@ -1091,8 +1090,7 @@ journalWithAmounts as =
[]
[]
""
""
[]
(TOD 0 0)
""
where parse = fromparse . parseWithCtx emptyCtx someamount

View File

@ -13,15 +13,18 @@ module Hledger.Cli.Utils
journalReload,
journalReloadIfChanged,
journalFileIsNewer,
journalFileModificationTime,
journalSpecifiedFileIsNewer,
fileModificationTime,
openBrowserOn,
writeFileWithBackup,
writeFileWithBackupIfChanged,
readFileStrictly,
)
where
import Hledger.Data
import Hledger.Read
import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) -- ,optsToFilterSpec)
import Control.Exception
import Safe (readMay)
import System.Directory (getModificationTime, getDirectoryContents, copyFile)
import System.Exit
@ -38,7 +41,7 @@ withJournalDo opts args _ cmd = do
-- We kludgily read the file before parsing to grab the full text, unless
-- it's stdin, or it doesn't exist and we are adding. We read it strictly
-- to let the add command work.
journalFilePathFromOpts opts >>= readJournalFile Nothing >>= either (error'.trace "BBB") runcmd
journalFilePathFromOpts opts >>= readJournalFile Nothing >>= either error' runcmd
where
costify = (if CostBasis `elem` opts then journalConvertAmountsToCost else id)
runcmd = cmd opts args . costify
@ -52,7 +55,7 @@ readJournalWithOpts opts s = do
-- | Re-read a journal from its data file, or return an error string.
journalReload :: Journal -> IO (Either String Journal)
journalReload Journal{filepath=f} = readJournalFile Nothing f
journalReload j = readJournalFile Nothing $ journalFilePath j
-- | Re-read a journal from its data file mostly, only if the file has
-- changed since last read (or if there is no file, ie data read from
@ -60,26 +63,36 @@ journalReload Journal{filepath=f} = readJournalFile Nothing f
-- the error message while reading it, and a flag indicating whether it
-- was re-read or not.
journalReloadIfChanged :: [Opt] -> Journal -> IO (Either String Journal, Bool)
journalReloadIfChanged opts j@Journal{filepath=f} = do
changed <- journalFileIsNewer j
if changed
journalReloadIfChanged opts j = do
let maybeChangedFilename f = do newer <- journalSpecifiedFileIsNewer j f
return $ if newer then Just f else Nothing
changedfiles <- catMaybes `fmap` mapM maybeChangedFilename (journalFilePaths j)
if not $ null changedfiles
then do
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (head changedfiles)
jE <- journalReload j
return (jE, True)
else
return (Right j, False)
-- | Has the journal's data file changed since last parsed ?
-- | Has the journal's main data file changed since the journal was last
-- read ?
journalFileIsNewer :: Journal -> IO Bool
journalFileIsNewer j@Journal{filereadtime=tread} = do
tmod <- journalFileModificationTime j
tmod <- fileModificationTime $ journalFilePath j
return $ diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
-- | Get the last modified time of the journal's data file (or if there is no
-- file, the current time).
journalFileModificationTime :: Journal -> IO ClockTime
journalFileModificationTime Journal{filepath=f}
-- | Has the specified file (presumably one of journal's data files)
-- changed since journal was last read ?
journalSpecifiedFileIsNewer :: Journal -> FilePath -> IO Bool
journalSpecifiedFileIsNewer Journal{filereadtime=tread} f = do
tmod <- fileModificationTime f
return $ diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
-- | Get the last modified time of the specified file, or if it does not
-- exist or there is some other error, the current time.
fileModificationTime :: FilePath -> IO ClockTime
fileModificationTime f
| null f = getClockTime
| otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime
@ -120,6 +133,9 @@ writeFileWithBackupIfChanged f t = do
writeFileWithBackup :: FilePath -> String -> IO ()
writeFileWithBackup f t = backUpFile f >> writeFile f t
readFileStrictly :: FilePath -> IO String
readFileStrictly f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s
-- | Back up this file with a (incrementing) numbered suffix, or give an error.
backUpFile :: FilePath -> IO ()
backUpFile fp = do