From 16aaf35c4bb5f0b4b91de242670819f38dc2d08b Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 16 Feb 2015 18:20:31 +0000 Subject: [PATCH] web: move old edit/import stuff out of AddForm --- hledger-web/Handler/AddForm.hs | 93 ------------------------------- hledger-web/Handler/EditForm.hs | 75 +++++++++++++++++++++++++ hledger-web/Handler/ImportForm.hs | 18 ++++++ 3 files changed, 93 insertions(+), 93 deletions(-) create mode 100644 hledger-web/Handler/EditForm.hs create mode 100644 hledger-web/Handler/ImportForm.hs diff --git a/hledger-web/Handler/AddForm.hs b/hledger-web/Handler/AddForm.hs index c5e227534..cff0c8679 100644 --- a/hledger-web/Handler/AddForm.hs +++ b/hledger-web/Handler/AddForm.hs @@ -90,96 +90,3 @@ postAddForm = do setMessage [shamlet|Transaction added.|] redirect (JournalR) -- , [("add","1")]) - --- -- | Handle a post from the journal edit form. --- handleEdit :: Handler Html --- handleEdit = do --- VD{..} <- getViewData --- -- get form input values, or validation errors. --- -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace --- mtext <- lookupPostParam "text" --- mtrace "--------------------------" --- mtrace (journalFilePaths j) --- mjournalpath <- lookupPostParam "journal" --- let etext = maybe (Left "No value provided") (Right . unpack) mtext --- ejournalpath = maybe --- (Right $ journalFilePath j) --- (\f -> let f' = unpack f in --- if f' `elem` dbg0 "paths2" (journalFilePaths j) --- then Right f' --- else Left ("unrecognised journal file path"::String)) --- mjournalpath --- estrs = [etext, ejournalpath] --- errs = lefts estrs --- [text,journalpath] = rights estrs --- -- display errors or perform edit --- if not $ null errs --- then do --- setMessage $ toHtml (intercalate "; " errs :: String) --- redirect JournalR - --- -- | Handle a post from the journal edit form. --- handleEdit :: Handler Html --- handleEdit = do --- VD{..} <- getViewData --- -- get form input values, or validation errors. --- -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace --- mtext <- lookupPostParam "text" --- mjournalpath <- lookupPostParam "journal" --- let etext = maybe (Left "No value provided") (Right . unpack) mtext --- ejournalpath = maybe --- (Right $ journalFilePath j) --- (\f -> let f' = unpack f in --- if f' `elem` journalFilePaths j --- then Right f' --- else Left ("unrecognised journal file path"::String)) --- mjournalpath --- estrs = [etext, ejournalpath] --- errs = lefts estrs --- [text,journalpath] = rights estrs --- -- display errors or perform edit --- if not $ null errs --- then do --- setMessage $ toHtml (intercalate "; " errs :: String) --- redirect JournalR - --- else do --- -- try to avoid unnecessary backups or saving invalid data --- filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath --- told <- liftIO $ readFileStrictly journalpath --- let tnew = filter (/= '\r') text --- changed = tnew /= told || filechanged' --- if not changed --- then do --- setMessage "No change" --- redirect JournalR --- else do --- jE <- liftIO $ readJournal Nothing Nothing True (Just journalpath) tnew --- either --- (\e -> do --- setMessage $ toHtml e --- redirect JournalR) --- (const $ do --- liftIO $ writeFileWithBackup journalpath tnew --- setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String) --- redirect JournalR) --- jE - --- -- | Handle a post from the journal import form. --- handleImport :: Handler Html --- handleImport = do --- setMessage "can't handle file upload yet" --- redirect JournalR --- -- -- get form input values, or basic validation errors. E means an Either value. --- -- fileM <- runFormPost $ maybeFileInput "file" --- -- let fileE = maybe (Left "No file provided") Right fileM --- -- -- display errors or import transactions --- -- case fileE of --- -- Left errs -> do --- -- setMessage errs --- -- redirect JournalR - --- -- Right s -> do --- -- setMessage s --- -- redirect JournalR - diff --git a/hledger-web/Handler/EditForm.hs b/hledger-web/Handler/EditForm.hs new file mode 100644 index 000000000..a545577c5 --- /dev/null +++ b/hledger-web/Handler/EditForm.hs @@ -0,0 +1,75 @@ +-- -- | Handle a post from the journal edit form. +-- handleEdit :: Handler Html +-- handleEdit = do +-- VD{..} <- getViewData +-- -- get form input values, or validation errors. +-- -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace +-- mtext <- lookupPostParam "text" +-- mtrace "--------------------------" +-- mtrace (journalFilePaths j) +-- mjournalpath <- lookupPostParam "journal" +-- let etext = maybe (Left "No value provided") (Right . unpack) mtext +-- ejournalpath = maybe +-- (Right $ journalFilePath j) +-- (\f -> let f' = unpack f in +-- if f' `elem` dbg0 "paths2" (journalFilePaths j) +-- then Right f' +-- else Left ("unrecognised journal file path"::String)) +-- mjournalpath +-- estrs = [etext, ejournalpath] +-- errs = lefts estrs +-- [text,journalpath] = rights estrs +-- -- display errors or perform edit +-- if not $ null errs +-- then do +-- setMessage $ toHtml (intercalate "; " errs :: String) +-- redirect JournalR + +-- -- | Handle a post from the journal edit form. +-- handleEdit :: Handler Html +-- handleEdit = do +-- VD{..} <- getViewData +-- -- get form input values, or validation errors. +-- -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace +-- mtext <- lookupPostParam "text" +-- mjournalpath <- lookupPostParam "journal" +-- let etext = maybe (Left "No value provided") (Right . unpack) mtext +-- ejournalpath = maybe +-- (Right $ journalFilePath j) +-- (\f -> let f' = unpack f in +-- if f' `elem` journalFilePaths j +-- then Right f' +-- else Left ("unrecognised journal file path"::String)) +-- mjournalpath +-- estrs = [etext, ejournalpath] +-- errs = lefts estrs +-- [text,journalpath] = rights estrs +-- -- display errors or perform edit +-- if not $ null errs +-- then do +-- setMessage $ toHtml (intercalate "; " errs :: String) +-- redirect JournalR + +-- else do +-- -- try to avoid unnecessary backups or saving invalid data +-- filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath +-- told <- liftIO $ readFileStrictly journalpath +-- let tnew = filter (/= '\r') text +-- changed = tnew /= told || filechanged' +-- if not changed +-- then do +-- setMessage "No change" +-- redirect JournalR +-- else do +-- jE <- liftIO $ readJournal Nothing Nothing True (Just journalpath) tnew +-- either +-- (\e -> do +-- setMessage $ toHtml e +-- redirect JournalR) +-- (const $ do +-- liftIO $ writeFileWithBackup journalpath tnew +-- setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String) +-- redirect JournalR) +-- jE + + diff --git a/hledger-web/Handler/ImportForm.hs b/hledger-web/Handler/ImportForm.hs new file mode 100644 index 000000000..1f509f0c5 --- /dev/null +++ b/hledger-web/Handler/ImportForm.hs @@ -0,0 +1,18 @@ +-- -- | Handle a post from the journal import form. +-- handleImport :: Handler Html +-- handleImport = do +-- setMessage "can't handle file upload yet" +-- redirect JournalR +-- -- -- get form input values, or basic validation errors. E means an Either value. +-- -- fileM <- runFormPost $ maybeFileInput "file" +-- -- let fileE = maybe (Left "No file provided") Right fileM +-- -- -- display errors or import transactions +-- -- case fileE of +-- -- Left errs -> do +-- -- setMessage errs +-- -- redirect JournalR + +-- -- Right s -> do +-- -- setMessage s +-- -- redirect JournalR +