{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Hledger.Web.Handler.MiscR
  ( getVersionR
  , getAccountnamesR
  , getTransactionsR
  , getPricesR
  , getCommoditiesR
  , getAccountsR
  , getAccounttransactionsR
  , getDownloadR
  , getFaviconR
  , getManageR
  , getRobotsR
  , getRootR
  ) where

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.WebOptions (packageversion)
import Hledger.Web.Widget.Common (journalFile404)

getRootR :: Handler Html
getRootR :: Handler Html
getRootR = do
  Handler ()
checkServerSideUiEnabled
  Route App -> Handler Html
forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect Route App
JournalR

getManageR :: Handler Html
getManageR :: Handler Html
getManageR = do
  Handler ()
checkServerSideUiEnabled
  VD{[Capability]
caps :: ViewData -> [Capability]
caps :: [Capability]
caps, Journal
j :: ViewData -> Journal
j :: Journal
j} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapManage Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'manage' capability")
  WidgetFor App () -> Handler Html
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout (WidgetFor App () -> Handler Html)
-> WidgetFor App () -> Handler Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> WidgetFor App ()
forall (m :: * -> *). MonadWidget m => Html -> m ()
setTitle Html
"Manage journal"
    $(widgetFile "manage")

getDownloadR :: FilePath -> Handler TypedContent
getDownloadR :: String -> Handler TypedContent
getDownloadR String
f = do
  Handler ()
checkServerSideUiEnabled
  VD{[Capability]
caps :: [Capability]
caps :: ViewData -> [Capability]
caps, Journal
j :: Journal
j :: ViewData -> Journal
j} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapManage Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'manage' capability")
  (String
f', Text
txt) <- String -> Journal -> HandlerFor App (String, Text)
forall m. String -> Journal -> HandlerFor m (String, Text)
journalFile404 String
f Journal
j
  Text -> Text -> Handler ()
forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
addHeader Text
"Content-Disposition" (Text
"attachment; filename=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
f' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")
  (ByteString, Content) -> Handler TypedContent
forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
c -> m a
sendResponse (ByteString
"text/plain" :: ByteString, Text -> Content
forall a. ToContent a => a -> Content
toContent Text
txt)

-- hledger-web equivalents of the old hledger-api's handlers

getVersionR :: Handler TypedContent
getVersionR :: Handler TypedContent
getVersionR = do
  VD{[Capability]
caps :: [Capability]
caps :: ViewData -> [Capability]
caps} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep (Writer (Endo [ProvidedRep (HandlerFor App)]) ()
 -> Handler TypedContent)
-> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall a b. (a -> b) -> a -> b
$ do
    String -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson (String -> Writer (Endo [ProvidedRep (HandlerFor App)]) ())
-> String -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall a b. (a -> b) -> a -> b
$ String
packageversion

getAccountnamesR :: Handler TypedContent
getAccountnamesR :: Handler TypedContent
getAccountnamesR = do
  VD{[Capability]
caps :: [Capability]
caps :: ViewData -> [Capability]
caps, Journal
j :: Journal
j :: ViewData -> Journal
j} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep (Writer (Endo [ProvidedRep (HandlerFor App)]) ()
 -> Handler TypedContent)
-> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall a b. (a -> b) -> a -> b
$ do
    [Text] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson ([Text] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ())
-> [Text] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
journalAccountNames Journal
j

getTransactionsR :: Handler TypedContent
getTransactionsR :: Handler TypedContent
getTransactionsR = do
  VD{[Capability]
caps :: [Capability]
caps :: ViewData -> [Capability]
caps, Journal
j :: Journal
j :: ViewData -> Journal
j} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep (Writer (Endo [ProvidedRep (HandlerFor App)]) ()
 -> Handler TypedContent)
-> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall a b. (a -> b) -> a -> b
$ do
    [Transaction] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson ([Transaction] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ())
-> [Transaction] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j

getPricesR :: Handler TypedContent
getPricesR :: Handler TypedContent
getPricesR = do
  VD{[Capability]
caps :: [Capability]
caps :: ViewData -> [Capability]
caps, Journal
j :: Journal
j :: ViewData -> Journal
j} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep (Writer (Endo [ProvidedRep (HandlerFor App)]) ()
 -> Handler TypedContent)
-> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall a b. (a -> b) -> a -> b
$ do
    [MarketPrice] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson ([MarketPrice] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ())
-> [MarketPrice] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall a b. (a -> b) -> a -> b
$ (PriceDirective -> MarketPrice)
-> [PriceDirective] -> [MarketPrice]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> MarketPrice
priceDirectiveToMarketPrice ([PriceDirective] -> [MarketPrice])
-> [PriceDirective] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j

getCommoditiesR :: Handler TypedContent
getCommoditiesR :: Handler TypedContent
getCommoditiesR = do
  VD{[Capability]
caps :: [Capability]
caps :: ViewData -> [Capability]
caps, Journal
j :: Journal
j :: ViewData -> Journal
j} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep (Writer (Endo [ProvidedRep (HandlerFor App)]) ()
 -> Handler TypedContent)
-> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall a b. (a -> b) -> a -> b
$ do
    [Text] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson ([Text] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ())
-> [Text] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall a b. (a -> b) -> a -> b
$ (Map Text AmountStyle -> [Text]
forall k a. Map k a -> [k]
M.keys (Map Text AmountStyle -> [Text])
-> (Journal -> Map Text AmountStyle) -> Journal -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Map Text AmountStyle
jinferredcommodities) Journal
j

getAccountsR :: Handler TypedContent
getAccountsR :: Handler TypedContent
getAccountsR = do
  VD{[Capability]
caps :: [Capability]
caps :: ViewData -> [Capability]
caps, Journal
j :: Journal
j :: ViewData -> Journal
j} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep (Writer (Endo [ProvidedRep (HandlerFor App)]) ()
 -> Handler TypedContent)
-> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall a b. (a -> b) -> a -> b
$ do
    [Account] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson ([Account] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ())
-> [Account] -> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall a b. (a -> b) -> a -> b
$ Ledger -> [Account]
laccounts (Ledger -> [Account]) -> Ledger -> [Account]
forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Ledger
ledgerFromJournal Query
Any Journal
j

getAccounttransactionsR :: Text -> Handler TypedContent
getAccounttransactionsR :: Text -> Handler TypedContent
getAccounttransactionsR Text
a = do
  VD{[Capability]
caps :: [Capability]
caps :: ViewData -> [Capability]
caps, Journal
j :: Journal
j :: ViewData -> Journal
j} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  let
    rspec :: ReportSpec
rspec = ReportSpec
defreportspec
    thisacctq :: Query
thisacctq = Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ Text -> Regexp
accountNameToAccountRegex Text
a -- includes subs
  Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep (Writer (Endo [ProvidedRep (HandlerFor App)]) ()
 -> Handler TypedContent)
-> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
-> Handler TypedContent
forall a b. (a -> b) -> a -> b
$ do
    AccountTransactionsReport
-> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson (AccountTransactionsReport
 -> Writer (Endo [ProvidedRep (HandlerFor App)]) ())
-> AccountTransactionsReport
-> Writer (Endo [ProvidedRep (HandlerFor App)]) ()
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> Query -> AccountTransactionsReport
accountTransactionsReport ReportSpec
rspec{_rsQuery :: Query
_rsQuery=Query
Any} Journal
j Query
thisacctq