{-# 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
  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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapManage forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'manage' capability")
  forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). MonadWidget m => Html -> m ()
setTitle Html
"Manage journal"
    $(widgetFile "manage")

getDownloadR :: FilePath -> Handler TypedContent
getDownloadR :: PackageVersion -> Handler TypedContent
getDownloadR PackageVersion
f = do
  Handler ()
checkServerSideUiEnabled
  VD{[Capability]
caps :: [Capability]
caps :: ViewData -> [Capability]
caps, Journal
j :: Journal
j :: ViewData -> Journal
j} <- Handler ViewData
getViewData
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapManage forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'manage' capability")
  (PackageVersion
f', Text
txt) <- forall m.
PackageVersion -> Journal -> HandlerFor m (PackageVersion, Text)
journalFile404 PackageVersion
f Journal
j
  forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
addHeader Text
"Content-Disposition" (Text
"attachment; filename=\"" forall a. Semigroup a => a -> a -> a
<> PackageVersion -> Text
T.pack PackageVersion
f' forall a. Semigroup a => a -> a -> a
<> Text
"\"")
  forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
c -> m a
sendResponse (ByteString
"text/plain" :: ByteString, 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson forall a b. (a -> b) -> a -> b
$ PackageVersion
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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> MarketPrice
priceDirectiveToMarketPrice 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson forall a b. (a -> b) -> a -> b
$ (forall k a. Map k a -> [k]
M.keys 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson forall a b. (a -> b) -> a -> b
$ Ledger -> [Account]
laccounts 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (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 forall a b. (a -> b) -> a -> b
$ Text -> Regexp
accountNameToAccountRegex Text
a -- includes subs
  forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Writer (Endo [ProvidedRep m]) ()
provideJson forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> Query -> AccountTransactionsReport
accountTransactionsReport ReportSpec
rspec{_rsQuery :: Query
_rsQuery=Query
Any} Journal
j Query
thisacctq