diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index e76c1e76b..5f4fb266f 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/Hledger/Cli/Commands/Web.hs @@ -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 + diff --git a/Hledger/Cli/Utils.hs b/Hledger/Cli/Utils.hs index 8f493ce30..be0bf2ad2 100644 --- a/Hledger/Cli/Utils.hs +++ b/Hledger/Cli/Utils.hs @@ -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 diff --git a/data/web/style.css b/data/web/style.css index ef0618a01..53b8d6ff1 100644 --- a/data/web/style.css +++ b/data/web/style.css @@ -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; } diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 4d37222f4..99bd7f6ab 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -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.