slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

api: /accounts returns Accounts, /accountnames just the names

Browse Source
This commit is contained in:
Simon Michael 2016-01-17 09:33:24 -08:00
parent 26ba907a2e
commit 798f4e82d0
1 changed files with 33 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
hledger-api/hledger-api.hs
View File

@ -19,7 +19,7 @@ import Data.Decimal
import qualified Data.Map as M import qualified Data.Map as M
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import Data.Text import Data.Text hiding (map)
import GHC.Generics import GHC.Generics
import Network.Wai as Wai import Network.Wai as Wai
import Network.Wai.Handler.Warp as Warp import Network.Wai.Handler.Warp as Warp
@ -68,7 +68,7 @@ main = do
serveApi :: FilePath -> Int -> Journal -> IO () serveApi :: FilePath -> Int -> Journal -> IO ()
serveApi f p j = do serveApi f p j = do
printf "Starting web api for %s on port %d\nPress ctrl-c to quit\n" f p >> hFlush stdout printf "Starting web api for %s on port %d\nPress ctrl-c to quit\n" f p
Warp.run p $ hledgerApiApp j Warp.run p $ hledgerApiApp j
hledgerApiApp :: Journal -> Wai.Application hledgerApiApp :: Journal -> Wai.Application
@ -77,6 +77,7 @@ hledgerApiApp j = Servant.serve hledgerApi hledgerApiServer
hledgerApi :: Proxy HledgerApi hledgerApi :: Proxy HledgerApi
hledgerApi = Proxy hledgerApi = Proxy
-- add Reader to the server monad so handlers can see the journal
hledgerApiServer :: Servant.Server HledgerApi hledgerApiServer :: Servant.Server HledgerApi
hledgerApiServer = Servant.enter readerToEither hledgerServerT hledgerApiServer = Servant.enter readerToEither hledgerServerT
where where
@ -84,22 +85,25 @@ hledgerApiApp j = Servant.serve hledgerApi hledgerApiServer
readerToEither = Nat $ \r -> return (runReader r j) readerToEither = Nat $ \r -> return (runReader r j)
type HledgerApi = type HledgerApi =
"accounts" :> Get '[JSON] [AccountName] "accountnames" :> Get '[JSON] [AccountName]
:<|> "transactions" :> Get '[JSON] [Transaction] :<|> "transactions" :> Get '[JSON] [Transaction]
:<|> "prices" :> Get '[JSON] [MarketPrice] :<|> "prices" :> Get '[JSON] [MarketPrice]
:<|> "commodities" :> Get '[JSON] [Commodity] :<|> "commodities" :> Get '[JSON] [Commodity]
:<|> "accounts" :> Get '[JSON] [Account]
hledgerServerT :: ServerT HledgerApi (Reader Journal) hledgerServerT :: ServerT HledgerApi (Reader Journal)
hledgerServerT = hledgerServerT =
accountsH accountnamesH
:<|> transactionsH :<|> transactionsH
:<|> pricesH :<|> pricesH
:<|> commoditiesH :<|> commoditiesH
:<|> accountsH
where where
accountsH = journalAccountNames <$> ask accountnamesH = journalAccountNames <$> ask
transactionsH = jtxns <$> ask transactionsH = jtxns <$> ask
pricesH = jmarketprices <$> ask pricesH = jmarketprices <$> ask
commoditiesH = (M.keys . jcommoditystyles) <$> ask commoditiesH = (M.keys . jcommoditystyles) <$> ask
accountsH = laccounts . ledgerFromJournal Hledger.Cli.Any <$> ask
instance ToJSON ClearedStatus where toJSON = genericToJSON defaultOptions -- avoid https://github.com/bos/aeson/issues/290 instance ToJSON ClearedStatus where toJSON = genericToJSON defaultOptions -- avoid https://github.com/bos/aeson/issues/290
@ -124,8 +128,7 @@ instance ToJSON Posting
,"ptype" .= toJSON ptype ,"ptype" .= toJSON ptype
,"ptags" .= toJSON ptags ,"ptags" .= toJSON ptags
,"pbalanceassertion" .= toJSON pbalanceassertion ,"pbalanceassertion" .= toJSON pbalanceassertion
-- just show parent transaction's index ,"ptransactionidx" .= toJSON (maybe "" (show.tindex) ptransaction)
,"ptransaction" .= toJSON (maybe "" (show.tindex) ptransaction)
] ]
instance ToJSON PostingType where toJSON = genericToJSON defaultOptions instance ToJSON PostingType where toJSON = genericToJSON defaultOptions
instance ToJSON Transaction where toJSON = genericToJSON defaultOptions instance ToJSON Transaction where toJSON = genericToJSON defaultOptions
@ -135,3 +138,16 @@ instance ToJSON Decimal
-- object ["places" .= decimalPlaces, "mantissa" .= decimalMantissa] -- object ["places" .= decimalPlaces, "mantissa" .= decimalMantissa]
-- toEncoding = genericToEncoding defaultOptions -- toEncoding = genericToEncoding defaultOptions
toJSON d = toJSON $ show d toJSON d = toJSON $ show d
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)
]