module Handler.Post where
import Import
import Data.Either (lefts,rights)
import Data.List (intercalate)
import qualified Data.List as L (head)
import Data.Text (unpack)
import qualified Data.Text as T (null)
import Text.Hamlet (shamlet)
import Text.Printf (printf)
import Handler.Utils
import Hledger.Utils
import Hledger.Data
import Hledger.Read
import Hledger.Cli
handlePost :: Handler RepHtml
handlePost = do
action <- lookupPostParam "action"
case action of Just "add" -> handleAdd
Just "edit" -> handleEdit
Just "import" -> handleImport
_ -> invalidArgs ["invalid action"]
handleAdd :: Handler RepHtml
handleAdd = do
VD{..} <- getViewData
dateM <- lookupPostParam "date"
descM <- lookupPostParam "description"
acct1M <- lookupPostParam "account1"
amt1M <- lookupPostParam "amount1"
acct2M <- lookupPostParam "account2"
amt2M <- lookupPostParam "amount2"
journalM <- lookupPostParam "journal"
let dateE = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . unpack) dateM
descE = Right $ maybe "" unpack descM
maybeNonNull = maybe Nothing (\t -> if T.null t then Nothing else Just t)
acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M
acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M
amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt1M
amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt2M
journalE = maybe (Right $ journalFilePath j)
(\f -> let f' = unpack f in
if f' `elem` journalFilePaths j
then Right f'
else Left $ "unrecognised journal file path: " ++ f'
)
journalM
strEs = [dateE, descE, acct1E, acct2E, journalE]
amtEs = [amt1E, amt2E]
errs = lefts strEs ++ lefts amtEs
[date,desc,acct1,acct2,journalpath] = rights strEs
[amt1,amt2] = rights amtEs
tE | not $ null errs = Left errs
| otherwise = either (\e -> Left ["unbalanced postings: " ++ (L.head $ lines e)]) Right
(balanceTransaction Nothing $ nulltransaction {
tdate=parsedate date
,tdescription=desc
,tpostings=[
Posting Nothing Nothing False acct1 (mixed amt1) "" RegularPosting [] Nothing
,Posting Nothing Nothing False acct2 (mixed amt2) "" RegularPosting [] Nothing
]
})
case tE of
Left errs' -> do
setMessage [shamlet|
Errors:<br>
$forall e<-errs'
#{e}<br>
|]
Right t -> do
let t' = txnTieKnot t
liftIO $ do ensureJournalFileExists journalpath
appendToJournalFileOrStdout journalpath $ showTransaction t'
setMessage [shamlet|<span>Added transaction:<small><pre>#{chomp $ show t'}</pre></small>|]
redirect (RegisterR, [("add","1")])
handleEdit :: Handler RepHtml
handleEdit = do
VD{..} <- getViewData
textM <- lookupPostParam "text"
journalM <- lookupPostParam "journal"
let textE = maybe (Left "No value provided") (Right . unpack) textM
journalE = maybe (Right $ journalFilePath j)
(\f -> let f' = unpack f in
if f' `elem` journalFilePaths j
then Right f'
else Left "unrecognised journal file path")
journalM
strEs = [textE, journalE]
errs = lefts strEs
[text,journalpath] = rights strEs
if not $ null errs
then do
setMessage $ toHtml (intercalate "; " errs :: String)
redirect JournalR
else do
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 (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
handleImport :: Handler RepHtml
handleImport = do
setMessage "can't handle file upload yet"
redirect JournalR