web: begin json support
This commit is contained in:
parent
f6ec3a7803
commit
7c6c90f205
@ -8,6 +8,7 @@ hledger-web's request handlers, and helpers.
|
|||||||
module Handlers where
|
module Handlers where
|
||||||
|
|
||||||
import Control.Applicative ((<$>), (<*>))
|
import Control.Applicative ((<$>), (<*>))
|
||||||
|
import Data.Aeson
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import Data.Either (lefts,rights)
|
import Data.Either (lefts,rights)
|
||||||
import Data.List
|
import Data.List
|
||||||
@ -21,6 +22,7 @@ import Text.ParserCombinators.Parsec -- hiding (string)
|
|||||||
import Text.Printf
|
import Text.Printf
|
||||||
import Text.RegexPR
|
import Text.RegexPR
|
||||||
import Yesod.Form
|
import Yesod.Form
|
||||||
|
import Yesod.Json
|
||||||
|
|
||||||
import Hledger.Cli.Add
|
import Hledger.Cli.Add
|
||||||
import Hledger.Cli.Balance
|
import Hledger.Cli.Balance
|
||||||
@ -100,13 +102,22 @@ getRegisterOnlyR = do
|
|||||||
postRegisterOnlyR :: Handler RepPlain
|
postRegisterOnlyR :: Handler RepPlain
|
||||||
postRegisterOnlyR = handlePost
|
postRegisterOnlyR = handlePost
|
||||||
|
|
||||||
-- | A simple accounts view, like hledger balance.
|
-- | A simple accounts view, like hledger balance. If the Accept header
|
||||||
getAccountsOnlyR :: Handler RepHtml
|
-- specifies json, returns the chart of accounts as json.
|
||||||
|
getAccountsOnlyR :: Handler RepHtmlJson
|
||||||
getAccountsOnlyR = do
|
getAccountsOnlyR = do
|
||||||
vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData
|
vd@VD{opts=opts,fspec=fspec,j=j} <- getViewData
|
||||||
defaultLayout $ do
|
let json = jsonMap [("accounts", toJSON $ journalAccountNames j)]
|
||||||
setTitle "hledger-web accounts"
|
html = do
|
||||||
addHamlet $ balanceReportAsHtml opts vd $ balanceReport opts fspec j
|
setTitle "hledger-web accounts"
|
||||||
|
addHamlet $ balanceReportAsHtml opts vd $ balanceReport opts fspec j
|
||||||
|
defaultLayoutJson html json
|
||||||
|
|
||||||
|
-- | Return the chart of accounts as json, without needing a special Accept header.
|
||||||
|
getAccountsJsonR :: Handler RepJson
|
||||||
|
getAccountsJsonR = do
|
||||||
|
VD{j=j} <- getViewData
|
||||||
|
jsonToRepJson $ jsonMap [("accounts", toJSON $ journalAccountNames j)]
|
||||||
|
|
||||||
-- helpers
|
-- helpers
|
||||||
|
|
||||||
|
|||||||
@ -86,7 +86,9 @@ executable hledger-web
|
|||||||
-- ,yesod >= 0.8 && < 0.9
|
-- ,yesod >= 0.8 && < 0.9
|
||||||
,yesod-core >= 0.8 && < 0.9
|
,yesod-core >= 0.8 && < 0.9
|
||||||
,yesod-form == 0.1.*
|
,yesod-form == 0.1.*
|
||||||
|
,yesod-json
|
||||||
,yesod-static == 0.1.0
|
,yesod-static == 0.1.0
|
||||||
|
,aeson == 0.3.*
|
||||||
,hamlet == 0.8.*
|
,hamlet == 0.8.*
|
||||||
,transformers
|
,transformers
|
||||||
,wai
|
,wai
|
||||||
|
|||||||
@ -7,3 +7,4 @@
|
|||||||
/journalonly JournalOnlyR GET POST
|
/journalonly JournalOnlyR GET POST
|
||||||
/registeronly RegisterOnlyR GET POST
|
/registeronly RegisterOnlyR GET POST
|
||||||
/accountsonly AccountsOnlyR GET
|
/accountsonly AccountsOnlyR GET
|
||||||
|
/accountsjson AccountsJsonR GET
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user