web: move old edit/import stuff out of AddForm
This commit is contained in:
parent
55967e9192
commit
16aaf35c4b
@ -90,96 +90,3 @@ postAddForm = do
|
|||||||
setMessage [shamlet|<span>Transaction added.|]
|
setMessage [shamlet|<span>Transaction added.|]
|
||||||
|
|
||||||
redirect (JournalR) -- , [("add","1")])
|
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
|
|
||||||
|
|
||||||
|
|||||||
75
hledger-web/Handler/EditForm.hs
Normal file
75
hledger-web/Handler/EditForm.hs
Normal file
@ -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
|
||||||
|
|
||||||
|
|
||||||
18
hledger-web/Handler/ImportForm.hs
Normal file
18
hledger-web/Handler/ImportForm.hs
Normal file
@ -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
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user