web: add the same 6 JSON routes as in hledger-api (#316)

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
+import Hledger.Web.Handler.AddR
-       (getDownloadR, getFaviconR, getManageR, getRobotsR, getRootR)
+import Hledger.Web.Handler.MiscR 
-import Hledger.Web.Handler.EditR (getEditR, postEditR)
+import Hledger.Web.Handler.EditR
-import Hledger.Web.Handler.UploadR (getUploadR, postUploadR)
+import Hledger.Web.Handler.UploadR
-import Hledger.Web.Handler.JournalR (getJournalR)
+import Hledger.Web.Handler.JournalR
-import Hledger.Web.Handler.RegisterR (getRegisterR)
+import Hledger.Web.Handler.RegisterR
 import Hledger.Web.Import
 import Hledger.Web.WebOptions (WebOpts(serve_))
 

hledger-web/Hledger/Web/Handler/Common.hs

@@ -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)

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
+

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

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

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

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