webyesod: a destructive wiki-style edit form for journals
Warning: this is the first hledger feature which can alter your existing journal data. You can now edit, or ERASE, the (top-level) journal file through the web ui, and there is no access control. A numbered backup of the file will be saved at each edit, in normal circumstances.
This commit is contained in:
Simon Michael
parent
b462eea9de
commit
aa21f95b9e
@ -79,6 +79,7 @@ mkYesod "HledgerWebApp" [$parseRoutes|
|
||||
/ IndexPage GET
|
||||
/style.css StyleCss GET
|
||||
/journal JournalPage GET POST
|
||||
/edit EditPage GET POST
|
||||
/register RegisterPage GET
|
||||
/balance BalancePage GET
|
||||
|]
|
||||
@ -164,12 +165,14 @@ navbar here a p = [$hamlet|
|
||||
navlinks :: HledgerWebAppRoutes -> String -> String -> Hamlet HledgerWebAppRoutes
|
||||
navlinks here a p = [$hamlet|
|
||||
#navlinks
|
||||
^journallink^ | $
|
||||
^registerlink^ | $
|
||||
^balancelink^
|
||||
^journallink^ $
|
||||
(^editlink^) $
|
||||
| ^registerlink^ $
|
||||
| ^balancelink^ $
|
||||
|]
|
||||
where
|
||||
journallink = navlink here "journal" JournalPage
|
||||
editlink = navlink here "edit" EditPage
|
||||
registerlink = navlink here "register" RegisterPage
|
||||
balancelink = navlink here "balance" BalancePage
|
||||
navlink here s dest = [$hamlet|%a.$style$!href=@?u@ $string.s$|]
|
||||
@ -203,10 +206,9 @@ helplink topic label = [$hamlet|%a!href=$string.u$ $string.label$|]
|
||||
addform :: Hamlet HledgerWebAppRoutes
|
||||
addform = [$hamlet|
|
||||
%form!method=POST
|
||||
%table#addform!cellpadding=0!cellspacing=0!!border=0
|
||||
%table.form#addform!cellpadding=0!cellspacing=0!!border=0
|
||||
%tr.formheading
|
||||
%td!colspan=4
|
||||
%span!style=float:right; ^formhelp^
|
||||
%span#formheading Add a transaction:
|
||||
%tr
|
||||
%td!colspan=4
|
||||
@ -332,3 +334,93 @@ postJournalPage = do
|
||||
setMessage $ string $ printf "Added transaction:\n%s" (show t')
|
||||
redirect RedirectTemporary JournalPage
|
||||
|
||||
getEditPage :: Handler HledgerWebApp RepHtml
|
||||
getEditPage = do
|
||||
-- app <- getYesod
|
||||
params <- getParams
|
||||
-- t <- liftIO $ getCurrentLocalTime
|
||||
let head' x = if null x then "" else head x
|
||||
a = head' $ params "a"
|
||||
p = head' $ params "p"
|
||||
-- opts = appOpts app ++ [Period p]
|
||||
-- args = appArgs app ++ [a]
|
||||
-- fspec = optsToFilterSpec opts args t
|
||||
-- reload journal's text, without parsing, if changed
|
||||
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
|
||||
changed <- liftIO $ journalFileIsNewer j
|
||||
-- XXX readFile may throw an error
|
||||
s <- liftIO $ if changed then readFile (filepath j) else return (jtext j)
|
||||
-- render the page
|
||||
msg <- getMessage
|
||||
Just here <- getRoute
|
||||
hamletToRepHtml $ template' here msg a p "hledger" s
|
||||
|
||||
template' here msg a p title content = [$hamlet|
|
||||
!!!
|
||||
%html
|
||||
%head
|
||||
%title $string.title$
|
||||
%meta!http-equiv=Content-Type!content=$string.metacontent$
|
||||
%link!rel=stylesheet!type=text/css!href=@stylesheet@!media=all
|
||||
%body
|
||||
^navbar'^
|
||||
#messages $m$
|
||||
^editform'^
|
||||
|]
|
||||
where m = fromMaybe (string "") msg
|
||||
navbar' = navbar here a p
|
||||
stylesheet = StyleCss
|
||||
metacontent = "text/html; charset=utf-8"
|
||||
editform' = editform content
|
||||
|
||||
editform :: String -> Hamlet HledgerWebAppRoutes
|
||||
editform t = [$hamlet|
|
||||
%form!method=POST
|
||||
%table.form#editform!cellpadding=0!cellspacing=0!!border=0
|
||||
%tr.formheading
|
||||
%td!colspan=2
|
||||
%span!style=float:right; ^formhelp^
|
||||
%span#formheading Edit journal:
|
||||
%tr
|
||||
%td!colspan=2
|
||||
%textarea!name=text!rows=50!cols=80
|
||||
$string.t$
|
||||
%tr#addbuttonrow
|
||||
%td
|
||||
%a!href=@JournalPage@ cancel
|
||||
%td!align=right
|
||||
%input!type=submit!value=$string.submitlabel$
|
||||
%tr.helprow
|
||||
%td
|
||||
%td!align=right
|
||||
#help $string.edithelp$
|
||||
|]
|
||||
where
|
||||
submitlabel = "save journal"
|
||||
formhelp = helplink "file-format" "file format help"
|
||||
edithelp = "Are you sure ? All previous data will be replaced"
|
||||
|
||||
postEditPage :: Handler HledgerWebApp RepPlain
|
||||
postEditPage = do
|
||||
-- get form input values, or basic validation errors. E means an Either value.
|
||||
textE <- runFormPost $ catchFormError $ required $ input "text"
|
||||
-- display errors or add transaction
|
||||
case textE of
|
||||
Left errs -> do
|
||||
-- save current form values in session
|
||||
setMessage $ string $ intercalate "; " $ map (intercalate ", " . map (\(a,b) -> a++": "++b)) [errs]
|
||||
redirect RedirectTemporary JournalPage
|
||||
|
||||
Right t' -> do
|
||||
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
|
||||
filechanged' <- liftIO $ journalFileIsNewer j
|
||||
let f = filepath j
|
||||
told = jtext j
|
||||
tnew = filter (/= '\r') t'
|
||||
changed = tnew /= told || filechanged'
|
||||
-- changed <- liftIO $ writeFileWithBackupIfChanged f t''
|
||||
liftIO $ writeFileWithBackup f tnew
|
||||
setMessage $ string $ if changed then printf "Saved journal to %s\n" (show f)
|
||||
else "No change"
|
||||
redirect RedirectTemporary JournalPage
|
||||
|
||||
|
||||
@ -13,14 +13,18 @@ module Hledger.Cli.Utils
|
||||
journalReload,
|
||||
journalReloadIfChanged,
|
||||
journalFileModificationTime,
|
||||
openBrowserOn
|
||||
openBrowserOn,
|
||||
writeFileWithBackup,
|
||||
writeFileWithBackupIfChanged,
|
||||
)
|
||||
where
|
||||
import Hledger.Data
|
||||
import Hledger.Read
|
||||
import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) -- ,optsToFilterSpec)
|
||||
import System.Directory (doesFileExist, getModificationTime)
|
||||
import Safe (readMay)
|
||||
import System.Directory (doesFileExist, getModificationTime, getDirectoryContents, copyFile)
|
||||
import System.Exit
|
||||
import System.FilePath ((</>), splitFileName, takeDirectory)
|
||||
import System.Info (os)
|
||||
import System.Process (readProcessWithExitCode)
|
||||
import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff))
|
||||
@ -100,3 +104,33 @@ openBrowserOn u = trybrowsers browsers u
|
||||
-- ::ShellExecute(NULL, "open", "www.somepage.com", NULL, NULL, SW_SHOWNORMAL);
|
||||
-- ::ShellExecute(NULL, "open", "firefox.exe", "www.somepage.com" NULL, SW_SHOWNORMAL);
|
||||
|
||||
-- | Back up this file with a (incrementing) numbered suffix then
|
||||
-- overwrite it with this new text, or give an error, but only if the text
|
||||
-- is different from the current file contents, and return a flag
|
||||
-- indicating whether we did anything.
|
||||
writeFileWithBackupIfChanged :: FilePath -> String -> IO Bool
|
||||
writeFileWithBackupIfChanged f t = do
|
||||
s <- readFile f
|
||||
if t == s then return False
|
||||
else backUpFile f >> writeFile f t >> return True
|
||||
|
||||
-- | Back up this file with a (incrementing) numbered suffix, then
|
||||
-- overwrite it with this new text, or give an error.
|
||||
writeFileWithBackup :: FilePath -> String -> IO ()
|
||||
writeFileWithBackup f t = backUpFile f >> writeFile f t
|
||||
|
||||
-- | Back up this file with a (incrementing) numbered suffix, or give an error.
|
||||
backUpFile :: FilePath -> IO ()
|
||||
backUpFile fp = do
|
||||
fs <- getDirectoryContents $ takeDirectory fp
|
||||
let (d,f) = splitFileName fp
|
||||
versions = catMaybes $ map (f `backupNumber`) fs
|
||||
next = maximum (0:versions) + 1
|
||||
f' = printf "%s.%d" f next
|
||||
copyFile fp (d </> f')
|
||||
|
||||
-- | Does the second file represent a backup of the first, and if so which version is it ?
|
||||
backupNumber :: FilePath -> FilePath -> Maybe Int
|
||||
backupNumber f g = case matchRegexPR ("^" ++ f ++ "\\.([0-9]+)$") g of
|
||||
Just (_, ((_,suffix):_)) -> readMay suffix
|
||||
_ -> Nothing
|
||||
|
||||
@ -9,11 +9,13 @@ body { font-family: "helvetica","arial", "sans serif"; margin:0; }
|
||||
#resetlink { font-size:small; }
|
||||
.toprightlink { font-size:small; margin-left:1em; float:right; }
|
||||
#messages { color:red; background-color:#ffeeee; margin:0.5em;}
|
||||
#addform { margin:1em; font-size:small; }
|
||||
.form { margin:1em; font-size:small; }
|
||||
#addform { background-color:#eeeeee; border:2px solid #dddddd; cell-padding:0; cell-spacing:0; }
|
||||
#addform { float:right; }
|
||||
#addform #descriptionrow { }
|
||||
#addform #postingrow { }
|
||||
#addform #addbuttonrow { text-align:right; }
|
||||
#editform textarea { background-color:#eeeeee; }
|
||||
#content { margin:1em; }
|
||||
.formheading td { padding-bottom:8px; }
|
||||
#formheading { font-size:medium; font-weight:bold; }
|
||||
|
||||
@ -28,7 +28,7 @@ import System.Directory (getHomeDirectory)
|
||||
import System.Environment (getEnv)
|
||||
import System.FilePath ((</>))
|
||||
import System.Exit
|
||||
import System.IO (stderr)
|
||||
import System.IO (IOMode(..), withFile, hGetContents, stderr)
|
||||
#if __GLASGOW_HASKELL__ <= 610
|
||||
import Prelude hiding (readFile, putStr, putStrLn, print, getContents)
|
||||
import System.IO.UTF8
|
||||
@ -82,10 +82,10 @@ journalFromPathAndString format fp s = do
|
||||
fmt fs = intercalate ", " (init fs) ++ " or " ++ last fs ++ " "
|
||||
|
||||
-- | Read a journal from this file, using the specified data format or
|
||||
-- trying all known formats, or give an error.
|
||||
-- trying all known formats, or give an error (and ensure the file is closed).
|
||||
readJournalFile :: Maybe String -> FilePath -> IO Journal
|
||||
readJournalFile format "-" = getContents >>= journalFromPathAndString format "(stdin)"
|
||||
readJournalFile format f = readFile f >>= journalFromPathAndString format f
|
||||
readJournalFile format f = withFile f ReadMode $ \h -> hGetContents h >>= journalFromPathAndString format f
|
||||
|
||||
-- | Read a Journal from this string, using the specified data format or
|
||||
-- trying all known formats, or give an error.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user