diff --git a/hledger-web/App.hs b/hledger-web/App.hs index 9fbc580f4..43368a15a 100644 --- a/hledger-web/App.hs +++ b/hledger-web/App.hs @@ -74,7 +74,7 @@ instance Yesod App where approot = appRoot defaultLayout widget = do - mmsg <- getMessage + mmsg <- return (Nothing :: Maybe String) -- getMessage -- XXX let getHandlerData get it pc <- widgetToPageContent $ do widget addCassius $(Settings.cassiusFile "default-layout") diff --git a/hledger-web/Handlers.hs b/hledger-web/Handlers.hs index faca353be..08fc6a9bc 100644 --- a/hledger-web/Handlers.hs +++ b/hledger-web/Handlers.hs @@ -1,14 +1,17 @@ {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} module Handlers where -import Control.Applicative ((<$>)) --, (<*>)) +import Control.Applicative ((<$>), (<*>)) import Data.ByteString (ByteString) +import Data.Either (lefts,rights) import Data.Text(Text,pack,unpack) import System.FilePath (takeFileName, ()) import System.IO.Storage (putValue, getValue) import Text.Hamlet hiding (hamletFile) import Text.ParserCombinators.Parsec hiding (string) +import Yesod.Form +import Hledger.Cli.Add import Hledger.Cli.Balance import Hledger.Cli.Print import Hledger.Cli.Register @@ -16,6 +19,8 @@ import Hledger.Cli.Options hiding (value) import Hledger.Cli.Utils import Hledger.Cli.Version (version) import Hledger.Data hiding (insert, today) +import Hledger.Read (journalFromPathAndString) +import Hledger.Read.JournalReader (someamount) import App import Settings @@ -58,8 +63,8 @@ getJournalR = do setTitle "hledger-web journal" addHamlet $(Settings.hamletFile "journal") --- postJournalR :: Handler RepPlain --- postJournalR = postJournalOnlyR +postJournalR :: Handler RepPlain +postJournalR = postJournalOnlyR ---------------------------------------------------------------------- @@ -81,8 +86,8 @@ getRegisterR = do setTitle "hledger-web register" addHamlet $(Settings.hamletFile "register") --- postRegisterR :: Handler RepPlain --- postRegisterR = postJournalOnlyR +postRegisterR :: Handler RepPlain +postRegisterR = postJournalOnlyR ---------------------------------------------------------------------- @@ -201,7 +206,37 @@ journalselect journalfiles = $(Settings.hamletFile "journalselect") importform :: Hamlet AppRoute importform = $(Settings.hamletFile "importform") -{- +---------------------------------------------------------------------- + +-- | A simple postings view, like hledger register. +getRegisterOnlyR :: Handler RepHtml +getRegisterOnlyR = do + (a, p, opts, fspec, j, msg, here) <- getHandlerData + today <- liftIO getCurrentDay + let td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today} + hamletToRepHtml $ hledgerLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j + +-- | Render a register report as HTML. +registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet AppRoute +registerReportAsHtml _ td items = $(Settings.hamletFile "registerreport") + where + number = zip [1..] + itemAsHtml' = itemAsHtml td + itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet AppRoute + itemAsHtml TD{here=here,p=p} (n, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem") + where + evenodd = if even n then "even" else "odd" :: String + (firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de) + Nothing -> ("", "", "") :: (String,String,String) + acct = paccount posting + acctpat = accountNameToAccountRegex acct + pparam = if null p then "" else "&p="++p + +mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "
" $ lines $ show b + where addclass = printf "%s" (c :: String) + c = case isNegativeMixedAmount b of Just True -> "negative amount" + _ -> "positive amount" + postJournalOnlyR :: Handler RepPlain postJournalOnlyR = do action <- runFormPost' $ maybeStringInput "action" @@ -332,38 +367,6 @@ postImportForm = do -- Right s -> do -- setMessage s -- redirect RedirectTemporary JournalR --} - ----------------------------------------------------------------------- - --- | A simple postings view like hledger register. -getRegisterOnlyR :: Handler RepHtml -getRegisterOnlyR = do - (a, p, opts, fspec, j, msg, here) <- getHandlerData - today <- liftIO getCurrentDay - let td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today} - hamletToRepHtml $ hledgerLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j - --- | Render a register report as HTML. -registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet AppRoute -registerReportAsHtml _ td items = $(Settings.hamletFile "registerreport") - where - number = zip [1..] - itemAsHtml' = itemAsHtml td - itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet AppRoute - itemAsHtml TD{here=here,p=p} (n, (ds, posting, b)) = $(Settings.hamletFile "registerreportitem") - where - evenodd = if even n then "even" else "odd" :: String - (firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de) - Nothing -> ("", "", "") :: (String,String,String) - acct = paccount posting - acctpat = accountNameToAccountRegex acct - pparam = if null p then "" else "&p="++p - -mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "
" $ lines $ show b - where addclass = printf "%s" (c :: String) - c = case isNegativeMixedAmount b of Just True -> "negative amount" - _ -> "positive amount" ---------------------------------------------------------------------- -- common templates, helpers, utilities @@ -509,4 +512,3 @@ getHandlerData = do getMessage' newmsgstr = do oldmsg <- getMessage return $ maybe oldmsg (Just . toHtml) newmsgstr - diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index b8941d5a6..b3bc9aa95 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -86,6 +86,7 @@ executable hledger-web ,template-haskell >= 2.4 && < 2.6 -- ,yesod >= 0.8 && < 0.9 ,yesod-core >= 0.8 && < 0.9 + ,yesod-form == 0.1.* ,yesod-static == 0.1.0 ,hamlet == 0.8.* ,transformers diff --git a/hledger-web/routes b/hledger-web/routes index ee2da362b..165aaf796 100644 --- a/hledger-web/routes +++ b/hledger-web/routes @@ -2,7 +2,7 @@ /favicon.ico FaviconR GET /robots.txt RobotsR GET / RootR GET -/journal JournalR GET -/register RegisterR GET -/accounts AccountsOnlyR GET -/journalonly JournalOnlyR GET +/journal JournalR GET POST +/register RegisterR GET POST +/journalonly JournalOnlyR GET POST +/accountsonly AccountsOnlyR GET