From afd7931ca00f340d5c82bdc6e783835696572a45 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 18 Feb 2019 23:57:58 -0800 Subject: [PATCH] web: add the same 6 JSON routes as in hledger-api (#316) --- hledger-web/Hledger/Web/Application.hs | 14 +-- hledger-web/Hledger/Web/Handler/Common.hs | 38 ------- hledger-web/Hledger/Web/Handler/MiscR.hs | 132 ++++++++++++++++++++++ hledger-web/config/routes | 7 ++ hledger-web/hledger-web.cabal | 9 +- hledger-web/hledger-web.m4.md | 14 +++ hledger-web/package.yaml | 5 +- 7 files changed, 170 insertions(+), 49 deletions(-) delete mode 100644 hledger-web/Hledger/Web/Handler/Common.hs create mode 100644 hledger-web/Hledger/Web/Handler/MiscR.hs diff --git a/hledger-web/Hledger/Web/Application.hs b/hledger-web/Hledger/Web/Application.hs index 7de1b16c3..07c546aec 100644 --- a/hledger-web/Hledger/Web/Application.hs +++ b/hledger-web/Hledger/Web/Application.hs @@ -15,13 +15,13 @@ import Network.HTTP.Conduit (newManager) import Yesod.Default.Config import Hledger.Data (Journal, nulljournal) -import Hledger.Web.Handler.AddR (getAddR, postAddR) -import Hledger.Web.Handler.Common - (getDownloadR, getFaviconR, getManageR, getRobotsR, getRootR) -import Hledger.Web.Handler.EditR (getEditR, postEditR) -import Hledger.Web.Handler.UploadR (getUploadR, postUploadR) -import Hledger.Web.Handler.JournalR (getJournalR) -import Hledger.Web.Handler.RegisterR (getRegisterR) + +import Hledger.Web.Handler.AddR +import Hledger.Web.Handler.MiscR +import Hledger.Web.Handler.EditR +import Hledger.Web.Handler.UploadR +import Hledger.Web.Handler.JournalR +import Hledger.Web.Handler.RegisterR import Hledger.Web.Import import Hledger.Web.WebOptions (WebOpts(serve_)) diff --git a/hledger-web/Hledger/Web/Handler/Common.hs b/hledger-web/Hledger/Web/Handler/Common.hs deleted file mode 100644 index c77edf3b6..000000000 --- a/hledger-web/Hledger/Web/Handler/Common.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} - -module Hledger.Web.Handler.Common - ( getDownloadR - , getFaviconR - , getManageR - , getRobotsR - , getRootR - ) where - -import qualified Data.Text as T -import Yesod.Default.Handlers (getFaviconR, getRobotsR) - -import Hledger (jfiles) -import Hledger.Web.Import -import Hledger.Web.Widget.Common (journalFile404) - -getRootR :: Handler Html -getRootR = redirect JournalR - -getManageR :: Handler Html -getManageR = do - VD{caps, j} <- getViewData - when (CapManage `notElem` caps) (permissionDenied "Missing the 'manage' capability") - defaultLayout $ do - setTitle "Manage journal" - $(widgetFile "manage") - -getDownloadR :: FilePath -> Handler TypedContent -getDownloadR f = do - VD{caps, j} <- getViewData - when (CapManage `notElem` caps) (permissionDenied "Missing the 'manage' capability") - (f', txt) <- journalFile404 f j - addHeader "Content-Disposition" ("attachment; filename=\"" <> T.pack f' <> "\"") - sendResponse ("text/plain" :: ByteString, toContent txt) diff --git a/hledger-web/Hledger/Web/Handler/MiscR.hs b/hledger-web/Hledger/Web/Handler/MiscR.hs new file mode 100644 index 000000000..014036327 --- /dev/null +++ b/hledger-web/Hledger/Web/Handler/MiscR.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module Hledger.Web.Handler.MiscR + ( getAccountnamesR + , getTransactionsR + , getPricesR + , getCommoditiesR + , getAccountsR + , getAccounttransactionsR + , getDownloadR + , getFaviconR + , getManageR + , getRobotsR + , getRootR + ) where + +import Data.Aeson +import Data.Decimal +import qualified Data.Map as M +import qualified Data.Text as T +import Yesod.Default.Handlers (getFaviconR, getRobotsR) + +import Hledger +import Hledger.Web.Import +import Hledger.Web.Widget.Common (journalFile404) + +getRootR :: Handler Html +getRootR = redirect JournalR + +getManageR :: Handler Html +getManageR = do + VD{caps, j} <- getViewData + when (CapManage `notElem` caps) (permissionDenied "Missing the 'manage' capability") + defaultLayout $ do + setTitle "Manage journal" + $(widgetFile "manage") + +getDownloadR :: FilePath -> Handler TypedContent +getDownloadR f = do + VD{caps, j} <- getViewData + when (CapManage `notElem` caps) (permissionDenied "Missing the 'manage' capability") + (f', txt) <- journalFile404 f j + addHeader "Content-Disposition" ("attachment; filename=\"" <> T.pack f' <> "\"") + sendResponse ("text/plain" :: ByteString, toContent txt) + +-- copied from hledger-api +instance ToJSON Status +instance ToJSON GenericSourcePos +instance ToJSON Decimal where toJSON = toJSON . show +instance ToJSON Amount +instance ToJSON AmountStyle +instance ToJSON Side +instance ToJSON DigitGroupStyle +instance ToJSON MixedAmount +instance ToJSON BalanceAssertion +instance ToJSON Price +instance ToJSON MarketPrice +instance ToJSON PostingType +instance ToJSON Posting where + toJSON Posting{..} = + object + ["pdate" .= toJSON pdate + ,"pdate2" .= toJSON pdate2 + ,"pstatus" .= toJSON pstatus + ,"paccount" .= toJSON paccount + ,"pamount" .= toJSON pamount + ,"pcomment" .= toJSON pcomment + ,"ptype" .= toJSON ptype + ,"ptags" .= toJSON ptags + ,"pbalanceassertion" .= toJSON pbalanceassertion + ,"ptransactionidx" .= toJSON (maybe "" (show.tindex) ptransaction) + ] +instance ToJSON Transaction +instance ToJSON Account where + toJSON a = + object + ["aname" .= toJSON (aname a) + ,"aebalance" .= toJSON (aebalance a) + ,"aibalance" .= toJSON (aibalance a) + ,"anumpostings" .= toJSON (anumpostings a) + ,"aboring" .= toJSON (aboring a) + ,"aparentname" .= toJSON (maybe "" aname $ aparent a) + ,"asubs" .= toJSON (map toJSON $ asubs a) + ] + +-- hledger-web implementations of hledger-api's handlers, keep synced + +getAccountnamesR :: Handler TypedContent +getAccountnamesR = do + VD{caps, j} <- getViewData + when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability") + selectRep $ do + provideJson $ journalAccountNames j + +getTransactionsR = do + VD{caps, j} <- getViewData + when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability") + selectRep $ do + provideJson $ jtxns j + +getPricesR = do + VD{caps, j} <- getViewData + when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability") + selectRep $ do + provideJson $ jmarketprices j + +getCommoditiesR = do + VD{caps, j} <- getViewData + when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability") + selectRep $ do + provideJson $ (M.keys . jinferredcommodities) j + +getAccountsR = do + VD{caps, j} <- getViewData + when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability") + selectRep $ do + provideJson $ ledgerTopAccounts $ ledgerFromJournal Any j + +getAccounttransactionsR a = do + VD{caps, j} <- getViewData + when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability") + let + ropts = defreportopts + q = Any --filterQuery (not . queryIsDepth) $ queryFromOpts d ropts' + thisacctq = Acct $ accountNameToAccountRegex a -- includes subs + selectRep $ do + provideJson $ accountTransactionsReport ropts j q thisacctq + diff --git a/hledger-web/config/routes b/hledger-web/config/routes index f33b12441..ddf1f80b2 100644 --- a/hledger-web/config/routes +++ b/hledger-web/config/routes @@ -11,3 +11,10 @@ /edit/#FilePath EditR GET POST /upload/#FilePath UploadR GET POST /download/#FilePath DownloadR GET + +/accountnames AccountnamesR GET +/transactions TransactionsR GET +/prices PricesR GET +/commodities CommoditiesR GET +/accounts AccountsR GET +/accounttransactions/#AccountName AccounttransactionsR GET diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index 9b3a8e908..b39b310e3 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 111bbf39fca3b1185b40e54b3537eee7c1798cd31d4b60ac071410e7ec0631f9 +-- hash: 561c0c98e7883244294c66058dba4862cbb498a2f5211e2abdd034ff7156be9a name: hledger-web version: 1.13.99 @@ -133,9 +133,9 @@ library Hledger.Web.Application Hledger.Web.Foundation Hledger.Web.Handler.AddR - Hledger.Web.Handler.Common Hledger.Web.Handler.EditR Hledger.Web.Handler.JournalR + Hledger.Web.Handler.MiscR Hledger.Web.Handler.RegisterR Hledger.Web.Handler.UploadR Hledger.Web.Import @@ -152,7 +152,9 @@ library ghc-options: -Wall -fwarn-tabs cpp-options: -DVERSION="1.13.99" build-depends: - base >=4.8 && <4.13 + Decimal + , aeson + , base >=4.8 && <4.13 , blaze-html , blaze-markup , bytestring @@ -161,6 +163,7 @@ library , cmdargs >=0.10 , conduit , conduit-extra >=1.1 + , containers , data-default , directory , filepath diff --git a/hledger-web/hledger-web.m4.md b/hledger-web/hledger-web.m4.md index 9969b3331..ad38dcfa1 100644 --- a/hledger-web/hledger-web.m4.md +++ b/hledger-web/hledger-web.m4.md @@ -127,6 +127,20 @@ when you reload the page or navigate to a new page. If a change makes a file unparseable, hledger-web will display an error message until the file has been fixed. +# JSON API + +In addition to the web UI, hledger-web provides some JSON API routes. +These are similar to the API provided by the hledger-api tool, but +it may be convenient to have them in hledger-web also. +``` +/accountnames +/transactions +/prices +/commodities +/accounts +/accounttransactions/#AccountName +``` + # OPTIONS Command-line options and arguments may be used to set an initial diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml index 45b00a49d..fe106faea 100644 --- a/hledger-web/package.yaml +++ b/hledger-web/package.yaml @@ -85,9 +85,9 @@ library: - Hledger.Web.Application - Hledger.Web.Foundation - Hledger.Web.Handler.AddR - - Hledger.Web.Handler.Common - Hledger.Web.Handler.EditR - Hledger.Web.Handler.JournalR + - Hledger.Web.Handler.MiscR - Hledger.Web.Handler.RegisterR - Hledger.Web.Handler.UploadR - Hledger.Web.Import @@ -100,6 +100,7 @@ library: dependencies: - hledger-lib >=1.13.99 && <1.14 - hledger >=1.13.99 && <1.14 + - aeson - base >=4.8 && <4.13 - blaze-html - blaze-markup @@ -109,7 +110,9 @@ library: - cmdargs >=0.10 - conduit - conduit-extra >=1.1 + - containers - data-default + - Decimal - directory - filepath - hjsmin