api: also serve files from static/; drop ServerT
This commit is contained in:
parent
cabcd80ad5
commit
fb32d54a90
@ -74,19 +74,6 @@ serveApi f p j = do
|
||||
printf "Starting web api for %s on port %d\nPress ctrl-c to quit\n" f p
|
||||
Warp.run p $ hledgerApiApp j
|
||||
|
||||
hledgerApiApp :: Journal -> Wai.Application
|
||||
hledgerApiApp j = Servant.serve hledgerApi hledgerApiServer
|
||||
where
|
||||
hledgerApi :: Proxy HledgerApi
|
||||
hledgerApi = Proxy
|
||||
|
||||
-- add Reader to the server monad so handlers can see the journal
|
||||
hledgerApiServer :: Servant.Server HledgerApi
|
||||
hledgerApiServer = Servant.enter readerToEither hledgerAPIServer
|
||||
where
|
||||
readerToEither :: Reader Journal :~> EitherT ServantErr IO
|
||||
readerToEither = Nat $ \r -> return (runReader r j)
|
||||
|
||||
type HledgerApi =
|
||||
"accountnames" :> Get '[JSON] [AccountName]
|
||||
:<|> "transactions" :> Get '[JSON] [Transaction]
|
||||
@ -95,32 +82,39 @@ type HledgerApi =
|
||||
:<|> "accounts" :> Get '[JSON] [Account]
|
||||
:<|> "reports" :>
|
||||
"accounttransactions" :> Capture "acct" AccountName :> Get '[JSON] AccountTransactionsReport
|
||||
:<|> Raw
|
||||
|
||||
hledgerAPIServer :: ServerT HledgerApi (Reader Journal)
|
||||
hledgerAPIServer =
|
||||
accountnamesH
|
||||
:<|> transactionsH
|
||||
:<|> pricesH
|
||||
:<|> commoditiesH
|
||||
:<|> accountsH
|
||||
:<|> accounttransactionsH
|
||||
hledgerApiApp :: Journal -> Wai.Application
|
||||
hledgerApiApp j = Servant.serve api server
|
||||
where
|
||||
accountnamesH = journalAccountNames <$> ask
|
||||
transactionsH = jtxns <$> ask
|
||||
pricesH = jmarketprices <$> ask
|
||||
commoditiesH = (M.keys . jcommoditystyles) <$> ask
|
||||
accountsH = laccounts . ledgerFromJournal Hledger.Cli.Any <$> ask
|
||||
accounttransactionsH (a::AccountName) = do
|
||||
j <- ask
|
||||
-- d <- liftIO getCurrentDay
|
||||
let
|
||||
ropts = defreportopts
|
||||
-- ropts' = ropts {depth_=Nothing
|
||||
-- ,balancetype_=HistoricalBalance
|
||||
-- }
|
||||
q = Hledger.Query.Any --filterQuery (not . queryIsDepth) $ queryFromOpts d ropts'
|
||||
thisacctq = Acct $ accountNameToAccountRegex a -- includes subs
|
||||
return $ accountTransactionsReport ropts j q thisacctq
|
||||
api :: Proxy HledgerApi
|
||||
api = Proxy
|
||||
|
||||
server :: Server HledgerApi
|
||||
server =
|
||||
accountnamesH
|
||||
:<|> transactionsH
|
||||
:<|> pricesH
|
||||
:<|> commoditiesH
|
||||
:<|> accountsH
|
||||
:<|> accounttransactionsH
|
||||
:<|> serveDirectory "static"
|
||||
where
|
||||
accountnamesH = return $ journalAccountNames j
|
||||
transactionsH = return $ jtxns j
|
||||
pricesH = return $ jmarketprices j
|
||||
commoditiesH = return $ (M.keys . jcommoditystyles) j
|
||||
accountsH = return $ laccounts $ ledgerFromJournal Hledger.Cli.Any j
|
||||
accounttransactionsH (a::AccountName) = do
|
||||
-- d <- liftIO getCurrentDay
|
||||
let
|
||||
ropts = defreportopts
|
||||
-- ropts' = ropts {depth_=Nothing
|
||||
-- ,balancetype_=HistoricalBalance
|
||||
-- }
|
||||
q = Hledger.Query.Any --filterQuery (not . queryIsDepth) $ queryFromOpts d ropts'
|
||||
thisacctq = Acct $ accountNameToAccountRegex a -- includes subs
|
||||
return $ accountTransactionsReport ropts j q thisacctq
|
||||
|
||||
-- brief toJSON definitions included to avoid https://github.com/bos/aeson/issues/290
|
||||
-- use toEncoding = genericToEncoding defaultOptions instead ?
|
||||
|
||||
1
hledger-api/static/README.txt
Normal file
1
hledger-api/static/README.txt
Normal file
@ -0,0 +1 @@
|
||||
Files under this directory are served by hledger-api when no other API route is matched.
|
||||
Loading…
Reference in New Issue
Block a user