web: sync with recent refactoring

This commit is contained in:
Simon Michael 2010-11-15 23:01:47 +00:00
parent 355b09e5e3
commit dbba128f29

View File

@ -16,7 +16,6 @@ import Data.Either
-- import System.Directory -- import System.Directory
import System.FilePath ((</>), takeFileName) import System.FilePath ((</>), takeFileName)
import System.IO.Storage (putValue, getValue) import System.IO.Storage (putValue, getValue)
import Text.ParserCombinators.Parsec (parse)
import Database.Persist.GenericSql (ConnectionPool, SqlPersist, runMigration, migrate) import Database.Persist.GenericSql (ConnectionPool, SqlPersist, runMigration, migrate)
import Yesod import Yesod
@ -848,8 +847,8 @@ postAddForm = do
descE = Right $ fromMaybe "" descM descE = Right $ fromMaybe "" descM
acct1E = maybe (Left "to account required") Right acct1M acct1E = maybe (Left "to account required") Right acct1M
acct2E = maybe (Left "from account required") Right acct2M acct2E = maybe (Left "from account required") Right acct2M
amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parse someamount "") amt1M amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx someamount) amt1M
amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parse someamount "") amt2M amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx someamount) amt2M
journalE = maybe (Right $ journalFilePath j) journalE = maybe (Right $ journalFilePath j)
(\f -> if f `elem` journalFilePaths j (\f -> if f `elem` journalFilePaths j
then Right f then Right f
@ -865,16 +864,11 @@ postAddForm = do
| otherwise = either (\e -> Left ["unbalanced postings: " ++ (head $ lines e)]) Right | otherwise = either (\e -> Left ["unbalanced postings: " ++ (head $ lines e)]) Right
(balanceTransaction $ nulltransaction { (balanceTransaction $ nulltransaction {
tdate=parsedate date tdate=parsedate date
,teffectivedate=Nothing
,tstatus=False
,tcode=""
,tdescription=desc ,tdescription=desc
,tcomment=""
,tpostings=[ ,tpostings=[
Posting False acct1 amt1 "" RegularPosting Nothing Posting False acct1 amt1 "" RegularPosting [] Nothing
,Posting False acct2 amt2 "" RegularPosting Nothing ,Posting False acct2 amt2 "" RegularPosting [] Nothing
] ]
,tpreceding_comment_lines=""
}) })
-- display errors or add transaction -- display errors or add transaction
case tE of case tE of
@ -1008,16 +1002,16 @@ mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | A standalone journal edit form page. -- | A standalone journal edit form page.
getEditR :: Handler RepHtml -- getEditR :: Handler RepHtml
getEditR = do -- getEditR = do
(a, p, _, _, _, msg, here) <- getHandlerData -- (a, p, _, _, _, msg, here) <- getHandlerData
today <- liftIO getCurrentDay -- today <- liftIO getCurrentDay
-- reload journal's text without parsing, if changed -- XXX are we doing this right ? -- -- reload journal's text without parsing, if changed -- XXX are we doing this right ?
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" -- j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
changed <- liftIO $ journalFileIsNewer j -- changed <- liftIO $ journalFileIsNewer j
s <- liftIO $ if changed then readFile (filepath j) else return (jtext j) -- XXX readFile may throw an error -- s <- liftIO $ if changed then readFile (filepath j) else return (jtext j) -- XXX readFile may throw an error
let td = mktd{here=here, title="hledger journal edit", msg=msg, a=a, p=p, j=j, today=today} -- let td = mktd{here=here, title="hledger journal edit", msg=msg, a=a, p=p, j=j, today=today}
hamletToRepHtml $ pageLayout td $ editform td s -- hamletToRepHtml $ pageLayout td $ editform td s
---------------------------------------------------------------------- ----------------------------------------------------------------------