Merge pull request #821 from zarybnicky/web_permissions
web: Import & export, permissions from CLI or headers
This commit is contained in:
Simon Michael
GitHub
commit
282cfbd0d8
@ -29,4 +29,4 @@ set -euo pipefail
|
||||
mkdir -p /var/lib/hledger
|
||||
touch /var/lib/hledger/Ledger
|
||||
cd /var
|
||||
hledger-web --serve --base-url='' -f /var/lib/hledger/Ledger --port 8000
|
||||
hledger-web --capabilities-header=X-Sandstorm-Permissions --serve --base-url='' -f /var/lib/hledger/Ledger --port 8000
|
||||
|
||||
@ -164,74 +164,90 @@ const pkgdef :Spk.PackageDefinition = (
|
||||
# not have been detected as a dependency during `spk dev`. If you list
|
||||
# a directory here, its entire contents will be included recursively.
|
||||
|
||||
#bridgeConfig = (
|
||||
# # Used for integrating permissions and roles into the Sandstorm shell
|
||||
# # and for sandstorm-http-bridge to pass to your app.
|
||||
# # Uncomment this block and adjust the permissions and roles to make
|
||||
# # sense for your app.
|
||||
# # For more information, see high-level documentation at
|
||||
# # https://docs.sandstorm.io/en/latest/developing/auth/
|
||||
# # and advanced details in the "BridgeConfig" section of
|
||||
# # https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/package.capnp
|
||||
# viewInfo = (
|
||||
# # For details on the viewInfo field, consult "ViewInfo" in
|
||||
# # https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/grain.capnp
|
||||
#
|
||||
# permissions = [
|
||||
# # Permissions which a user may or may not possess. A user's current
|
||||
# # permissions are passed to the app as a comma-separated list of `name`
|
||||
# # fields in the X-Sandstorm-Permissions header with each request.
|
||||
# #
|
||||
# # IMPORTANT: only ever append to this list! Reordering or removing fields
|
||||
# # will change behavior and permissions for existing grains! To deprecate a
|
||||
# # permission, or for more information, see "PermissionDef" in
|
||||
# # https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/grain.capnp
|
||||
# (
|
||||
# name = "editor",
|
||||
# # Name of the permission, used as an identifier for the permission in cases where string
|
||||
# # names are preferred. Used in sandstorm-http-bridge's X-Sandstorm-Permissions HTTP header.
|
||||
#
|
||||
# title = (defaultText = "editor"),
|
||||
# # Display name of the permission, e.g. to display in a checklist of permissions
|
||||
# # that may be assigned when sharing.
|
||||
#
|
||||
# description = (defaultText = "grants ability to modify data"),
|
||||
# # Prose describing what this role means, suitable for a tool tip or similar help text.
|
||||
# ),
|
||||
# ],
|
||||
# roles = [
|
||||
# # Roles are logical collections of permissions. For instance, your app may have
|
||||
# # a "viewer" role and an "editor" role
|
||||
# (
|
||||
# title = (defaultText = "editor"),
|
||||
# # Name of the role. Shown in the Sandstorm UI to indicate which users have which roles.
|
||||
#
|
||||
# permissions = [true],
|
||||
# # An array indicating which permissions this role carries.
|
||||
# # It should be the same length as the permissions array in
|
||||
# # viewInfo, and the order of the lists must match.
|
||||
#
|
||||
# verbPhrase = (defaultText = "can make changes to the document"),
|
||||
# # Brief explanatory text to show in the sharing UI indicating
|
||||
# # what a user assigned this role will be able to do with the grain.
|
||||
#
|
||||
# description = (defaultText = "editors may view all site data and change settings."),
|
||||
# # Prose describing what this role means, suitable for a tool tip or similar help text.
|
||||
# ),
|
||||
# (
|
||||
# title = (defaultText = "viewer"),
|
||||
# permissions = [false],
|
||||
# verbPhrase = (defaultText = "can view the document"),
|
||||
# description = (defaultText = "viewers may view what other users have written."),
|
||||
# ),
|
||||
# ],
|
||||
# ),
|
||||
# #apiPath = "/api",
|
||||
# # Apps can export an API to the world. The API is to be used primarily by Javascript
|
||||
# # code and native apps, so it can't serve out regular HTML to browsers. If a request
|
||||
# # comes in to your app's API, sandstorm-http-bridge will prefix the request's path with
|
||||
# # this string, if specified.
|
||||
#),
|
||||
bridgeConfig = (
|
||||
# Used for integrating permissions and roles into the Sandstorm shell
|
||||
# and for sandstorm-http-bridge to pass to your app.
|
||||
# Uncomment this block and adjust the permissions and roles to make
|
||||
# sense for your app.
|
||||
# For more information, see high-level documentation at
|
||||
# https://docs.sandstorm.io/en/latest/developing/auth/
|
||||
# and advanced details in the "BridgeConfig" section of
|
||||
# https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/package.capnp
|
||||
viewInfo = (
|
||||
# For details on the viewInfo field, consult "ViewInfo" in
|
||||
# https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/grain.capnp
|
||||
|
||||
permissions = [
|
||||
# Permissions which a user may or may not possess. A user's current
|
||||
# permissions are passed to the app as a comma-separated list of `name`
|
||||
# fields in the X-Sandstorm-Permissions header with each request.
|
||||
#
|
||||
# IMPORTANT: only ever append to this list! Reordering or removing fields
|
||||
# will change behavior and permissions for existing grains! To deprecate a
|
||||
# permission, or for more information, see "PermissionDef" in
|
||||
# https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/grain.capnp
|
||||
(
|
||||
name = "view",
|
||||
# Name of the permission, used as an identifier for the permission in cases where string
|
||||
# names are preferred. Used in sandstorm-http-bridge's X-Sandstorm-Permissions HTTP header.
|
||||
|
||||
title = (defaultText = "view"),
|
||||
# Display name of the permission, e.g. to display in a checklist of permissions
|
||||
# that may be assigned when sharing.
|
||||
|
||||
description = (defaultText = "grants ability to view the ledger"),
|
||||
# Prose describing what this role means, suitable for a tool tip or similar help text.
|
||||
),
|
||||
(
|
||||
name = "add",
|
||||
title = (defaultText = "add"),
|
||||
description = (defaultText = "grants ability to append transactions to the ledger"),
|
||||
),
|
||||
(
|
||||
name = "manage",
|
||||
title = (defaultText = "manage"),
|
||||
description = (defaultText = "grants ability to modify or replace the entire ledger"),
|
||||
),
|
||||
],
|
||||
roles = [
|
||||
# Roles are logical collections of permissions. For instance, your app may have
|
||||
# a "viewer" role and an "editor" role
|
||||
(
|
||||
title = (defaultText = "manager"),
|
||||
# Name of the role. Shown in the Sandstorm UI to indicate which users have which roles.
|
||||
|
||||
permissions = [true, true, true],
|
||||
# An array indicating which permissions this role carries.
|
||||
# It should be the same length as the permissions array in
|
||||
# viewInfo, and the order of the lists must match.
|
||||
|
||||
verbPhrase = (defaultText = "has full access to the ledger"),
|
||||
# Brief explanatory text to show in the sharing UI indicating
|
||||
# what a user assigned this role will be able to do with the grain.
|
||||
|
||||
description = (defaultText = "managers can modify the ledger in any way."),
|
||||
# Prose describing what this role means, suitable for a tool tip or similar help text.
|
||||
),
|
||||
(
|
||||
title = (defaultText = "editor"),
|
||||
permissions = [true, true, false],
|
||||
verbPhrase = (defaultText = "can append new transactions"),
|
||||
description = (defaultText = "editors can view the ledger or append new transactions to it."),
|
||||
),
|
||||
(
|
||||
title = (defaultText = "viewer"),
|
||||
permissions = [true, false, false],
|
||||
verbPhrase = (defaultText = "can view the ledger"),
|
||||
description = (defaultText = "viewers can only view the ledger."),
|
||||
),
|
||||
],
|
||||
),
|
||||
#apiPath = "/api",
|
||||
# Apps can export an API to the world. The API is to be used primarily by Javascript
|
||||
# code and native apps, so it can't serve out regular HTML to browsers. If a request
|
||||
# comes in to your app's API, sandstorm-http-bridge will prefix the request's path with
|
||||
# this string, if specified.
|
||||
),
|
||||
);
|
||||
|
||||
const myCommand :Spk.Manifest.Command = (
|
||||
|
||||
6
Makefile
6
Makefile
@ -134,11 +134,7 @@ SOURCEFILES:= \
|
||||
hledger-*/Hledger/*hs \
|
||||
hledger-*/Hledger/*/*hs \
|
||||
hledger-lib/other/ledger-parse/Ledger/Parser/*hs \
|
||||
hledger-web/app/*.hs \
|
||||
hledger-web/tests/*.hs \
|
||||
hledger-web/Handler/*.hs \
|
||||
hledger-web/Hledger/*.hs \
|
||||
hledger-web/Settings/*.hs \
|
||||
hledger-web/**/*.hs \
|
||||
|
||||
HPACKFILES:= \
|
||||
hledger/*package.yaml \
|
||||
|
||||
@ -1,88 +0,0 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# LANGUAGE CPP, OverloadedStrings, TemplateHaskell #-}
|
||||
module Application
|
||||
( makeApplication
|
||||
, getApplicationDev
|
||||
, makeFoundation
|
||||
) where
|
||||
|
||||
import Data.Default
|
||||
import Data.IORef
|
||||
import Import
|
||||
import Yesod.Default.Config
|
||||
import Yesod.Default.Main
|
||||
import Yesod.Default.Handlers
|
||||
import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout)
|
||||
import Network.HTTP.Conduit (newManager)
|
||||
import Prelude (head)
|
||||
|
||||
-- adapt to http-conduit 1.x or 2.x when cabal macros are available, otherwise assume 2.x
|
||||
#ifdef MIN_VERSION_http_conduit
|
||||
#if MIN_VERSION_http_conduit(2,0,0)
|
||||
#define http_conduit_2
|
||||
#endif
|
||||
#else
|
||||
#define http_conduit_2
|
||||
#endif
|
||||
#ifdef http_conduit_2
|
||||
import Network.HTTP.Client (defaultManagerSettings)
|
||||
#else
|
||||
import Network.HTTP.Conduit (def)
|
||||
#endif
|
||||
|
||||
-- Import all relevant handler modules here.
|
||||
-- Don't forget to add new modules to your cabal file!
|
||||
import Handler.RootR
|
||||
import Handler.JournalR
|
||||
import Handler.RegisterR
|
||||
import Handler.SidebarR
|
||||
|
||||
import Hledger.Web.WebOptions (WebOpts(..), defwebopts)
|
||||
import Hledger.Data (Journal, nulljournal)
|
||||
import Hledger.Read (readJournalFile)
|
||||
import Hledger.Utils (error')
|
||||
import Hledger.Cli.CliOptions (defcliopts, journalFilePathFromOpts)
|
||||
|
||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||
-- comments there for more details.
|
||||
mkYesodDispatch "App" resourcesApp
|
||||
|
||||
-- This function allocates resources (such as a database connection pool),
|
||||
-- performs initialization and creates a WAI application. This is also the
|
||||
-- place to put your migrate statements to have automatic database
|
||||
-- migrations handled by Yesod.
|
||||
makeApplication :: WebOpts -> Journal -> AppConfig DefaultEnv Extra -> IO Application
|
||||
makeApplication opts j conf = do
|
||||
foundation <- makeFoundation conf opts
|
||||
writeIORef (appJournal foundation) j
|
||||
app <- toWaiAppPlain foundation
|
||||
return $ logWare app
|
||||
where
|
||||
logWare | development = logStdoutDev
|
||||
| serve_ opts = logStdout
|
||||
| otherwise = id
|
||||
|
||||
makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
|
||||
makeFoundation conf opts = do
|
||||
manager <- newManager
|
||||
#ifdef http_conduit_2
|
||||
defaultManagerSettings
|
||||
#else
|
||||
def
|
||||
#endif
|
||||
s <- staticSite
|
||||
jref <- newIORef nulljournal
|
||||
return $ App conf s manager opts jref
|
||||
|
||||
-- for yesod devel
|
||||
-- uses the journal specified by the LEDGER_FILE env var, or ~/.hledger.journal
|
||||
getApplicationDev :: IO (Int, Application)
|
||||
getApplicationDev = do
|
||||
f <- head `fmap` journalFilePathFromOpts defcliopts -- XXX head should be safe for now
|
||||
j <- either error' id `fmap` readJournalFile def f
|
||||
defaultDevelApp loader (makeApplication defwebopts j)
|
||||
where
|
||||
loader = Yesod.Default.Config.loadConfig (configSettings Development)
|
||||
{ csParseExtra = parseExtra
|
||||
}
|
||||
@ -1,394 +0,0 @@
|
||||
{-# LANGUAGE CPP, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, QuasiQuotes, TemplateHaskell, TypeFamilies, TypeSynonymInstances, FlexibleInstances #-}
|
||||
{-
|
||||
|
||||
Define the web application's foundation, in the usual Yesod style.
|
||||
See a default Yesod app's comments for more details of each part.
|
||||
|
||||
-}
|
||||
module Foundation where
|
||||
|
||||
import Prelude
|
||||
import Data.IORef
|
||||
import Yesod
|
||||
import Yesod.Static
|
||||
import Yesod.Default.Config
|
||||
#ifndef DEVELOPMENT
|
||||
import Yesod.Default.Util (addStaticContentExternal)
|
||||
#endif
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
-- import qualified Settings
|
||||
import Settings.StaticFiles
|
||||
import Settings (staticRoot, widgetFile, Extra (..))
|
||||
#ifndef DEVELOPMENT
|
||||
import Settings (staticDir)
|
||||
import Text.Jasmine (minifym)
|
||||
#endif
|
||||
import Text.Blaze.Html.Renderer.String (renderHtml)
|
||||
import Text.Hamlet (hamletFile)
|
||||
|
||||
import Hledger.Web.WebOptions
|
||||
import Hledger.Data.Types
|
||||
-- import Hledger.Web.Settings
|
||||
-- import Hledger.Web.Settings.StaticFiles
|
||||
|
||||
-- for addform
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Text as Text (Text,pack,unpack)
|
||||
import Data.Time.Calendar
|
||||
#if BLAZE_HTML_0_4
|
||||
import Text.Blaze (preEscapedString, Markup)
|
||||
#else
|
||||
import Text.Blaze (Markup)
|
||||
import Text.Blaze.Internal (preEscapedString)
|
||||
#endif
|
||||
import Text.JSON
|
||||
import Hledger.Data.Journal
|
||||
import Hledger.Query
|
||||
import Hledger hiding (is)
|
||||
import Hledger.Cli hiding (version)
|
||||
|
||||
|
||||
-- | The site argument for your application. This can be a good place to
|
||||
-- keep settings and values requiring initialization before your application
|
||||
-- starts running, such as database connections. Every handler will have
|
||||
-- access to the data present here.
|
||||
data App = App
|
||||
{ settings :: AppConfig DefaultEnv Extra
|
||||
, getStatic :: Static -- ^ Settings for static file serving.
|
||||
, httpManager :: Manager
|
||||
--
|
||||
, appOpts :: WebOpts
|
||||
, appJournal :: IORef Journal
|
||||
}
|
||||
|
||||
-- Set up i18n messages. See the message folder.
|
||||
mkMessage "App" "messages" "en"
|
||||
|
||||
-- This is where we define all of the routes in our application. For a full
|
||||
-- explanation of the syntax, please see:
|
||||
-- http://www.yesodweb.com/book/handler
|
||||
--
|
||||
-- This function does three things:
|
||||
--
|
||||
-- * Creates the route datatype AppRoute. Every valid URL in your
|
||||
-- application can be represented as a value of this type.
|
||||
-- * Creates the associated type:
|
||||
-- type instance Route App = AppRoute
|
||||
-- * Creates the value resourcesApp which contains information on the
|
||||
-- resources declared below. This is used in Handler.hs by the call to
|
||||
-- mkYesodDispatch
|
||||
--
|
||||
-- What this function does *not* do is create a YesodSite instance for
|
||||
-- App. Creating that instance requires all of the handler functions
|
||||
-- for our application to be in scope. However, the handler functions
|
||||
-- usually require access to the AppRoute datatype. Therefore, we
|
||||
-- split these actions into two functions and place them in separate files.
|
||||
mkYesodData "App" $(parseRoutesFile "config/routes")
|
||||
|
||||
-- | A convenience alias.
|
||||
type AppRoute = Route App
|
||||
|
||||
#if MIN_VERSION_yesod(1,6,0)
|
||||
type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
|
||||
#else
|
||||
type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
|
||||
#endif
|
||||
|
||||
-- Please see the documentation for the Yesod typeclass. There are a number
|
||||
-- of settings which can be configured by overriding methods here.
|
||||
instance Yesod App where
|
||||
approot = ApprootMaster $ appRoot . settings
|
||||
|
||||
-- -- Store session data on the client in encrypted cookies,
|
||||
-- -- default session idle timeout is 120 minutes
|
||||
-- makeSessionBackend _ = fmap Just $ defaultClientSessionBackend
|
||||
-- (120 * 60)
|
||||
-- ".hledger-web_client_session_key.aes"
|
||||
-- don't use session data
|
||||
makeSessionBackend _ = return Nothing
|
||||
|
||||
defaultLayout widget = do
|
||||
master <- getYesod
|
||||
lastmsg <- getMessage
|
||||
vd@VD{..} <- getViewData
|
||||
|
||||
-- We break up the default layout into two components:
|
||||
-- default-layout is the contents of the body tag, and
|
||||
-- default-layout-wrapper is the entire page. Since the final
|
||||
-- value passed to hamletToRepHtml cannot be a widget, this allows
|
||||
-- you to use normal widget features in default-layout.
|
||||
|
||||
-- pc <- widgetToPageContent $ do
|
||||
-- $(widgetFile "normalize")
|
||||
-- addStylesheet $ StaticR css_bootstrap_css
|
||||
-- $(widgetFile "default-layout")
|
||||
-- hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||
|
||||
pc <- widgetToPageContent $ do
|
||||
addStylesheet $ StaticR css_bootstrap_min_css
|
||||
addStylesheet $ StaticR css_bootstrap_datepicker_standalone_min_css
|
||||
-- load these things early, in HEAD:
|
||||
toWidgetHead [hamlet|
|
||||
<script type="text/javascript" src="@{StaticR js_jquery_min_js}">
|
||||
<script type="text/javascript" src="@{StaticR js_typeahead_bundle_min_js}">
|
||||
|]
|
||||
addScript $ StaticR js_bootstrap_min_js
|
||||
-- addScript $ StaticR js_typeahead_bundle_min_js
|
||||
addScript $ StaticR js_bootstrap_datepicker_min_js
|
||||
addScript $ StaticR js_jquery_url_js
|
||||
addScript $ StaticR js_jquery_cookie_js
|
||||
addScript $ StaticR js_jquery_hotkeys_js
|
||||
addScript $ StaticR js_jquery_flot_min_js
|
||||
addScript $ StaticR js_jquery_flot_time_min_js
|
||||
addScript $ StaticR js_jquery_flot_tooltip_min_js
|
||||
toWidget [hamlet| \<!--[if lte IE 8]> <script type="text/javascript" src="@{StaticR js_excanvas_min_js}"></script> <![endif]--> |]
|
||||
addStylesheet $ StaticR hledger_css
|
||||
addScript $ StaticR hledger_js
|
||||
$(widgetFile "default-layout")
|
||||
|
||||
staticRootUrl <- (staticRoot . settings) <$> getYesod
|
||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||
|
||||
-- TODO outdated, still needed ?
|
||||
-- This is done to provide an optimization for serving static files from
|
||||
-- a separate domain. Please see the staticRoot setting in Settings.hs
|
||||
-- urlRenderOverride y (StaticR s) =
|
||||
-- Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s
|
||||
urlParamRenderOverride _ _ _ = Nothing
|
||||
|
||||
#ifndef DEVELOPMENT
|
||||
-- This function creates static content files in the static folder
|
||||
-- and names them based on a hash of their content. This allows
|
||||
-- expiration dates to be set far in the future without worry of
|
||||
-- users receiving stale content.
|
||||
addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])
|
||||
#endif
|
||||
|
||||
-- Place Javascript at bottom of the body tag so the rest of the page loads first
|
||||
jsLoader _ = BottomOfBody
|
||||
|
||||
-- This instance is required to use forms. You can modify renderMessage to
|
||||
-- achieve customized and internationalized form validation messages.
|
||||
instance RenderMessage App FormMessage where
|
||||
renderMessage _ _ = defaultFormMessage
|
||||
|
||||
-- | Get the 'Extra' value, used to hold data from the settings.yml file.
|
||||
getExtra :: Handler Extra
|
||||
getExtra = fmap (appExtra . settings) getYesod
|
||||
|
||||
-- Note: previous versions of the scaffolding included a deliver function to
|
||||
-- send emails. Unfortunately, there are too many different options for us to
|
||||
-- give a reasonable default. Instead, the information is available on the
|
||||
-- wiki:
|
||||
--
|
||||
-- https://github.com/yesodweb/yesod/wiki/Sending-email
|
||||
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- template and handler utilities
|
||||
|
||||
-- view data, used by the add form and handlers
|
||||
|
||||
-- | A bundle of data useful for hledger-web request handlers and templates.
|
||||
data ViewData = VD {
|
||||
opts :: WebOpts -- ^ the command-line options at startup
|
||||
,here :: AppRoute -- ^ the current route
|
||||
,msg :: Maybe Html -- ^ the current UI message if any, possibly from the current request
|
||||
,today :: Day -- ^ today's date (for queries containing relative dates)
|
||||
,j :: Journal -- ^ the up-to-date parsed unfiltered journal
|
||||
,q :: String -- ^ the current q parameter, the main query expression
|
||||
,m :: Query -- ^ a query parsed from the q parameter
|
||||
,qopts :: [QueryOpt] -- ^ query options parsed from the q parameter
|
||||
,am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)
|
||||
,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr
|
||||
,showpostings :: Bool -- ^ current p parameter, 1 or 0 shows/hides all postings where applicable
|
||||
,showsidebar :: Bool -- ^ current showsidebar cookie value
|
||||
} deriving (Show)
|
||||
|
||||
instance Show Text.Blaze.Markup where show _ = "<blaze markup>"
|
||||
|
||||
-- | Make a default ViewData, using day 0 as today's date.
|
||||
nullviewdata :: ViewData
|
||||
nullviewdata = viewdataWithDateAndParams nulldate "" "" ""
|
||||
|
||||
-- | Make a ViewData using the given date and request parameters, and defaults elsewhere.
|
||||
viewdataWithDateAndParams :: Day -> String -> String -> String -> ViewData
|
||||
viewdataWithDateAndParams d q a p =
|
||||
let (querymatcher,queryopts) = parseQuery d (pack q)
|
||||
(acctsmatcher,acctsopts) = parseQuery d (pack a)
|
||||
in VD {
|
||||
opts = defwebopts
|
||||
,j = nulljournal
|
||||
,here = RootR
|
||||
,msg = Nothing
|
||||
,today = d
|
||||
,q = q
|
||||
,m = querymatcher
|
||||
,qopts = queryopts
|
||||
,am = acctsmatcher
|
||||
,aopts = acctsopts
|
||||
,showpostings = p == "1"
|
||||
,showsidebar = True
|
||||
}
|
||||
|
||||
-- | Gather data used by handlers and templates in the current request.
|
||||
getViewData :: Handler ViewData
|
||||
getViewData = do
|
||||
mhere <- getCurrentRoute
|
||||
case mhere of
|
||||
Nothing -> return nullviewdata
|
||||
Just here -> do
|
||||
app <- getYesod
|
||||
let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app
|
||||
today <- liftIO getCurrentDay
|
||||
(j, merr) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}} today
|
||||
lastmsg <- getLastMessage
|
||||
let msg = maybe lastmsg (Just . toHtml) merr
|
||||
q <- getParameterOrNull "q"
|
||||
a <- getParameterOrNull "a"
|
||||
p <- getParameterOrNull "p"
|
||||
-- sidebar visibility: show it, unless there is a showsidebar cookie
|
||||
-- set to "0", or a ?sidebar=0 query parameter.
|
||||
msidebarparam <- lookupGetParam "sidebar"
|
||||
msidebarcookie <- reqCookies <$> getRequest >>= return . lookup "showsidebar"
|
||||
let showsidebar = maybe (msidebarcookie /= Just "0") (/="0") msidebarparam
|
||||
|
||||
return (viewdataWithDateAndParams today q a p){
|
||||
opts=opts
|
||||
,msg=msg
|
||||
,here=here
|
||||
,today=today
|
||||
,j=j
|
||||
,showsidebar=showsidebar
|
||||
}
|
||||
where
|
||||
-- | Update our copy of the journal if the file changed. If there is an
|
||||
-- error while reloading, keep the old one and return the error, and set a
|
||||
-- ui message.
|
||||
getCurrentJournal :: App -> CliOpts -> Day -> Handler (Journal, Maybe String)
|
||||
getCurrentJournal app opts d = do
|
||||
-- XXX put this inside atomicModifyIORef' for thread safety
|
||||
j <- liftIO $ readIORef $ appJournal app
|
||||
(ej, changed) <- liftIO $ journalReloadIfChanged opts d j
|
||||
-- re-apply any initial filter specified at startup
|
||||
let initq = queryFromOpts d $ reportopts_ opts
|
||||
ej' = filterJournalTransactions initq <$> ej
|
||||
if not changed
|
||||
then return (j,Nothing)
|
||||
else case ej' of
|
||||
Right j' -> do liftIO $ writeIORef (appJournal app) j'
|
||||
return (j',Nothing)
|
||||
Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}
|
||||
return (j, Just e)
|
||||
|
||||
-- | Get the named request parameter, or the empty string if not present.
|
||||
getParameterOrNull :: String -> Handler String
|
||||
getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p)
|
||||
|
||||
-- | Get the message that was set by the last request, in a
|
||||
-- referentially transparent manner (allowing multiple reads).
|
||||
getLastMessage :: Handler (Maybe Html)
|
||||
getLastMessage = cached getMessage
|
||||
|
||||
-- add form dialog, part of the default template
|
||||
|
||||
-- | Add transaction form.
|
||||
addform :: Text -> ViewData -> HtmlUrl AppRoute
|
||||
addform _ vd@VD{..} = [hamlet|
|
||||
|
||||
<script>
|
||||
jQuery(document).ready(function() {
|
||||
|
||||
/* set up typeahead fields */
|
||||
|
||||
descriptionsSuggester = new Bloodhound({
|
||||
local:#{listToJsonValueObjArrayStr descriptions},
|
||||
limit:100,
|
||||
datumTokenizer: function(d) { return [d.value]; },
|
||||
queryTokenizer: function(q) { return [q]; }
|
||||
});
|
||||
descriptionsSuggester.initialize();
|
||||
|
||||
accountsSuggester = new Bloodhound({
|
||||
local:#{listToJsonValueObjArrayStr accts},
|
||||
limit:100,
|
||||
datumTokenizer: function(d) { return [d.value]; },
|
||||
queryTokenizer: function(q) { return [q]; }
|
||||
/*
|
||||
datumTokenizer: Bloodhound.tokenizers.obj.whitespace('value'),
|
||||
datumTokenizer: Bloodhound.tokenizers.whitespace(d.value)
|
||||
queryTokenizer: Bloodhound.tokenizers.whitespace
|
||||
*/
|
||||
});
|
||||
accountsSuggester.initialize();
|
||||
|
||||
enableTypeahead(jQuery('input#description'), descriptionsSuggester);
|
||||
enableTypeahead(jQuery('input#account1, input#account2, input#account3, input#account4'), accountsSuggester);
|
||||
|
||||
});
|
||||
|
||||
<form#addform method=POST .form>
|
||||
<div .form-group>
|
||||
<div .row>
|
||||
<div .col-md-3 .col-xs-6 .col-sm-6>
|
||||
<div #dateWrap .input-group .date>
|
||||
<input #date required lang=en name=date .form-control .input-lg placeholder="Date" >
|
||||
<div .input-group-addon>
|
||||
<span .glyphicon .glyphicon-th>
|
||||
<div .col-md-9 .col-xs-6 .col-sm-6>
|
||||
<input #description required .typeahead .form-control .input-lg type=text size=40 name=description placeholder="Description">
|
||||
<div .account-postings>
|
||||
$forall n <- postingnums
|
||||
^{postingfields vd n}
|
||||
<div .col-md-8 .col-xs-8 .col-sm-8>
|
||||
<div .col-md-4 .col-xs-4 .col-sm-4>
|
||||
<button type=submit .btn .btn-default .btn-lg name=submit>add
|
||||
$if length filepaths > 1
|
||||
<br>
|
||||
<span class="input-lg">to:
|
||||
^{journalselect filepaths}
|
||||
<span style="padding-left:2em;">
|
||||
<span .small>
|
||||
Enter a value in the last field for
|
||||
<a href="#" onclick="addformAddPosting(); return false;">more
|
||||
(or ctrl +, ctrl -)
|
||||
|]
|
||||
where
|
||||
descriptions = sort $ nub $ map tdescription $ jtxns j
|
||||
accts = journalAccountNamesDeclaredOrImplied j
|
||||
escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>" -- #236
|
||||
listToJsonValueObjArrayStr as = preEscapedString $ escapeJSSpecialChars $ encode $ JSArray $ map (\a -> JSObject $ toJSObject [("value", showJSON a)]) as
|
||||
numpostings = 4
|
||||
postingnums = [1..numpostings]
|
||||
filepaths = map fst $ jfiles j
|
||||
postingfields :: ViewData -> Int -> HtmlUrl AppRoute
|
||||
postingfields _ n = [hamlet|
|
||||
<div .form-group .row .account-group ##{grpvar}>
|
||||
<div .col-md-8 .col-xs-8 .col-sm-8>
|
||||
<input ##{acctvar} .account-input .typeahead .form-control .input-lg type=text name=#{acctvar} placeholder="#{acctph}">
|
||||
<div .col-md-4 .col-xs-4 .col-sm-4>
|
||||
<input ##{amtvar} .amount-input .form-control .input-lg type=text name=#{amtvar} placeholder="#{amtph}">
|
||||
|]
|
||||
where
|
||||
acctvar = "account" ++ show n
|
||||
acctph = "Account " ++ show n
|
||||
amtvar = "amount" ++ show n
|
||||
amtph = "Amount " ++ show n
|
||||
grpvar = "grp" ++ show n
|
||||
|
||||
journalselect :: [FilePath] -> HtmlUrl AppRoute
|
||||
journalselect journalfilepaths = [hamlet|
|
||||
<select id=journalselect name=journal onchange="/*journalSelect(event)*/" class="form-control input-lg" style="width:auto; display:inline-block;">
|
||||
$forall p <- journalfilepaths
|
||||
<option value=#{p}>#{p}
|
||||
|]
|
||||
|
||||
journalradio :: [FilePath] -> HtmlUrl AppRoute
|
||||
journalradio journalfilepaths = [hamlet|
|
||||
$forall p <- journalfilepaths
|
||||
<div style="white-space:nowrap;">
|
||||
<span class="input-lg" style="position:relative; top:-8px; left:8px;">#{p}
|
||||
<input name=journal type=radio value=#{p} class="form-control" style="width:auto; display:inline;">
|
||||
|]
|
||||
|
||||
@ -1,123 +0,0 @@
|
||||
{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, QuasiQuotes, RecordWildCards, TypeFamilies #-}
|
||||
-- | Add form data & handler. (The layout and js are defined in
|
||||
-- Foundation so that the add form can be in the default layout for
|
||||
-- all views.)
|
||||
|
||||
module Handler.AddForm where
|
||||
|
||||
import Import
|
||||
|
||||
import Control.Monad.State.Strict (evalStateT)
|
||||
import Data.Either (lefts,rights)
|
||||
import Data.List (sort)
|
||||
import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free
|
||||
import Data.Text (append, pack, unpack)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Data.Void (Void)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger.Utils
|
||||
import Hledger.Data
|
||||
import Hledger.Read
|
||||
import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout)
|
||||
|
||||
|
||||
-- Part of the data required from the add form.
|
||||
-- Don't know how to handle the variable posting fields with yesod-form yet.
|
||||
data AddForm = AddForm
|
||||
{ addFormDate :: Day
|
||||
, addFormDescription :: Maybe Text -- String
|
||||
-- , addFormPostings :: [(AccountName, String)]
|
||||
, addFormJournalFile :: Maybe Text -- FilePath
|
||||
}
|
||||
deriving Show
|
||||
|
||||
postAddForm :: Handler Html
|
||||
postAddForm = do
|
||||
let showErrors errs = do
|
||||
-- error $ show errs -- XXX uncomment to prevent redirect for debugging
|
||||
setMessage [shamlet|
|
||||
Errors:<br>
|
||||
$forall e<-errs
|
||||
\#{e}<br>
|
||||
|]
|
||||
-- 1. process the fixed fields with yesod-form
|
||||
|
||||
VD{..} <- getViewData
|
||||
let
|
||||
validateJournalFile :: Text -> Either FormMessage Text
|
||||
validateJournalFile f
|
||||
| unpack f `elem` journalFilePaths j = Right f
|
||||
| otherwise = Left $ MsgInvalidEntry $ pack "the selected journal file \"" `append` f `append` "\"is unknown"
|
||||
|
||||
validateDate :: Text -> Handler (Either FormMessage Day)
|
||||
validateDate s = return $
|
||||
case fixSmartDateStrEither' today $ T.pack $ strip $ unpack s of
|
||||
Right d -> Right d
|
||||
Left _ -> Left $ MsgInvalidEntry $ pack "could not parse date \"" `append` s `append` pack "\":" -- ++ show e)
|
||||
|
||||
formresult <- runInputPostResult $ AddForm
|
||||
<$> ireq (checkMMap validateDate (pack . show) textField) "date"
|
||||
<*> iopt textField "description"
|
||||
<*> iopt (check validateJournalFile textField) "journal"
|
||||
|
||||
ok <- case formresult of
|
||||
FormMissing -> showErrors ["there is no form data"::String] >> return False
|
||||
FormFailure errs -> showErrors errs >> return False
|
||||
FormSuccess dat -> do
|
||||
let AddForm{
|
||||
addFormDate =date
|
||||
,addFormDescription=mdesc
|
||||
,addFormJournalFile=mjournalfile
|
||||
} = dat
|
||||
desc = maybe "" unpack mdesc
|
||||
journalfile = maybe (journalFilePath j) unpack mjournalfile
|
||||
|
||||
-- 2. the fixed fields look good; now process the posting fields adhocly,
|
||||
-- getting either errors or a balanced transaction
|
||||
|
||||
(params,_) <- runRequestBody
|
||||
let numberedParams s =
|
||||
reverse $ dropWhile (T.null . snd) $ reverse $ sort
|
||||
[ (n,v) | (k,v) <- params
|
||||
, let en = parsewith (paramnamep s) k :: Either (ParseError Char Void) Int
|
||||
, isRight en
|
||||
, let Right n = en
|
||||
]
|
||||
where paramnamep s = do {string s; n <- some digitChar; eof; return (read n :: Int)}
|
||||
acctparams = numberedParams "account"
|
||||
amtparams = numberedParams "amount"
|
||||
num = length acctparams
|
||||
paramErrs | num == 0 = ["at least one posting must be entered"]
|
||||
| map fst acctparams == [1..num] &&
|
||||
map fst amtparams `elem` [[1..num], [1..num-1]] = []
|
||||
| otherwise = ["the posting parameters are malformed"]
|
||||
eaccts = map (runParser (accountnamep <* eof) "" . textstrip . snd) acctparams
|
||||
eamts = map (runParser (evalStateT (amountp <* eof) mempty) "" . textstrip . snd) amtparams
|
||||
(accts, acctErrs) = (rights eaccts, map show $ lefts eaccts)
|
||||
(amts', amtErrs) = (rights eamts, map show $ lefts eamts)
|
||||
amts | length amts' == num = amts'
|
||||
| otherwise = amts' ++ [missingamt]
|
||||
errs = if not (null paramErrs) then paramErrs else (acctErrs ++ amtErrs)
|
||||
etxn | not $ null errs = Left errs
|
||||
| otherwise = either (\e -> Left [L.head $ lines e]) Right
|
||||
(balanceTransaction Nothing $ nulltransaction {
|
||||
tdate=date
|
||||
,tdescription=T.pack desc
|
||||
,tpostings=[nullposting{paccount=acct, pamount=Mixed [amt]} | (acct,amt) <- zip accts amts]
|
||||
})
|
||||
case etxn of
|
||||
Left errs -> showErrors errs >> return False
|
||||
Right t -> do
|
||||
-- 3. all fields look good and form a balanced transaction; append it to the file
|
||||
liftIO $ do ensureJournalFileExists journalfile
|
||||
appendToJournalFileOrStdout journalfile $
|
||||
showTransaction $
|
||||
txnTieKnot -- XXX move into balanceTransaction
|
||||
t
|
||||
setMessage [shamlet|<span>Transaction added.|]
|
||||
return True
|
||||
|
||||
if ok then redirect JournalR else redirect (JournalR, [("add","1")])
|
||||
@ -1,251 +0,0 @@
|
||||
{-# LANGUAGE CPP, OverloadedStrings, QuasiQuotes, RecordWildCards #-}
|
||||
-- | Common page components and rendering helpers.
|
||||
-- For global page layout, see Application.hs.
|
||||
|
||||
module Handler.Common where
|
||||
|
||||
import Import
|
||||
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import System.FilePath (takeFileName)
|
||||
#if BLAZE_HTML_0_4
|
||||
import Text.Blaze (preEscapedString)
|
||||
#else
|
||||
import Text.Blaze.Internal (preEscapedString)
|
||||
#endif
|
||||
import Text.Printf
|
||||
|
||||
import Hledger.Utils
|
||||
import Hledger.Data
|
||||
import Hledger.Query
|
||||
import Hledger.Reports
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Web.WebOptions
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Common page layout
|
||||
|
||||
-- | Standard hledger-web page layout.
|
||||
#if MIN_VERSION_yesod(1,6,0)
|
||||
hledgerLayout :: ViewData -> String -> HtmlUrl AppRoute -> HandlerFor App Html
|
||||
#else
|
||||
hledgerLayout :: ViewData -> String -> HtmlUrl AppRoute -> HandlerT App IO Html
|
||||
#endif
|
||||
hledgerLayout vd title content = do
|
||||
defaultLayout $ do
|
||||
setTitle $ toHtml $ title ++ " - hledger-web"
|
||||
toWidget [hamlet|
|
||||
^{topbar vd}
|
||||
^{sidebar vd}
|
||||
<div #main-content .col-xs-12 .#{showmd} .#{showsm}>
|
||||
^{searchform vd}
|
||||
^{content}
|
||||
|]
|
||||
where
|
||||
showmd = if showsidebar vd then "col-md-8" else "col-md-12" :: String
|
||||
showsm = if showsidebar vd then "col-sm-8" else "col-sm-12" :: String
|
||||
|
||||
-- | Global toolbar/heading area.
|
||||
topbar :: ViewData -> HtmlUrl AppRoute
|
||||
topbar VD{..} = [hamlet|
|
||||
<div#spacer .#{showsm} .#{showmd} .col-xs-2>
|
||||
<h1>
|
||||
<button .visible-xs .btn .btn-default type="button" data-toggle="offcanvas">
|
||||
<span .glyphicon .glyphicon-align-left .tgl-icon>
|
||||
<div#topbar .col-md-8 .col-sm-8 .col-xs-10>
|
||||
<h1>#{title}
|
||||
|
||||
|]
|
||||
where
|
||||
title = takeFileName $ journalFilePath j
|
||||
showmd = if showsidebar then "col-md-4" else "col-any-0" :: String
|
||||
showsm = if showsidebar then "col-sm-4" else "" :: String
|
||||
|
||||
-- | The sidebar used on most views.
|
||||
sidebar :: ViewData -> HtmlUrl AppRoute
|
||||
sidebar vd@VD{..} =
|
||||
[hamlet|
|
||||
<div #sidebar-menu .#{showmd} .#{showsm} .sidebar-offcanvas>
|
||||
<table .main-menu .table>
|
||||
<tr .#{journalcurrent}>
|
||||
<td .top .acct>
|
||||
<a href=@{JournalR} .#{journalcurrent} title="Show general journal entries, most recent first">Journal
|
||||
<td .top>
|
||||
^{accounts}
|
||||
|]
|
||||
where
|
||||
journalcurrent = if here == JournalR then "inacct" else "" :: String
|
||||
ropts = reportopts_ $ cliopts_ opts
|
||||
-- flip the default for items with zero amounts, show them by default
|
||||
ropts' = ropts{empty_=not $ empty_ ropts}
|
||||
accounts = balanceReportAsHtml opts vd $ balanceReport ropts' am j
|
||||
showmd = if showsidebar then "col-md-4" else "col-any-0" :: String
|
||||
showsm = if showsidebar then "col-sm-4" else "" :: String
|
||||
|
||||
-- -- | Navigation link, preserving parameters and possibly highlighted.
|
||||
-- navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute
|
||||
-- navlink VD{..} s dest title = [hamlet|
|
||||
-- <a##{s}link.#{style} href=@?{u'} title="#{title}">#{s}
|
||||
-- |]
|
||||
-- where u' = (dest, if null q then [] else [("q", pack q)])
|
||||
-- style | dest == here = "navlinkcurrent"
|
||||
-- | otherwise = "navlink" :: Text
|
||||
|
||||
-- -- | Links to the various journal editing forms.
|
||||
-- editlinks :: HtmlUrl AppRoute
|
||||
-- editlinks = [hamlet|
|
||||
-- <a#editformlink href="#" onclick="return editformToggle(event)" title="Toggle journal edit form">edit
|
||||
-- \ | #
|
||||
-- <a#addformlink href="#" onclick="return addformToggle(event)" title="Toggle transaction add form">add
|
||||
-- <a#importformlink href="#" onclick="return importformToggle(event)" style="display:none;">import transactions
|
||||
-- |]
|
||||
|
||||
-- | Search form for entering custom queries to filter journal data.
|
||||
searchform :: ViewData -> HtmlUrl AppRoute
|
||||
searchform VD{..} = [hamlet|
|
||||
<div#searchformdiv .row>
|
||||
<form#searchform .form-inline method=GET>
|
||||
<div .form-group .col-md-12 .col-sm-12 .col-xs-12>
|
||||
<div #searchbar .input-group>
|
||||
<input .form-control name=q value=#{q} title="Enter hledger search patterns to filter the data below" placeholder="Search">
|
||||
<div .input-group-btn>
|
||||
$if filtering
|
||||
<a href=@{here} .btn .btn-default title="Clear search terms">
|
||||
<span .glyphicon .glyphicon-remove-circle>
|
||||
<button .btn .btn-default type=submit title="Apply search terms">
|
||||
<span .glyphicon .glyphicon-search>
|
||||
<button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal" title="Show search and general help">?
|
||||
|]
|
||||
where
|
||||
filtering = not $ null q
|
||||
|
||||
-- -- | Edit journal form.
|
||||
-- editform :: ViewData -> HtmlUrl AppRoute
|
||||
-- editform VD{..} = [hamlet|
|
||||
-- <form#editform method=POST style=display:none;>
|
||||
-- <h2#contenttitle>#{title}>
|
||||
-- <table.form>
|
||||
-- $if manyfiles
|
||||
-- <tr>
|
||||
-- <td colspan=2>
|
||||
-- Editing ^{journalselect $ files j}
|
||||
-- <tr>
|
||||
-- <td colspan=2>
|
||||
-- <!-- XXX textarea ids are unquoted journal file paths here, not valid html -->
|
||||
-- $forall f <- files j
|
||||
-- <textarea id=#{fst f}_textarea name=text rows=25 cols=80 style=display:none; disabled=disabled>
|
||||
-- \#{snd f}
|
||||
-- <tr#addbuttonrow>
|
||||
-- <td>
|
||||
-- <span.help>^{formathelp}
|
||||
-- <td>
|
||||
-- <span.help>
|
||||
-- Are you sure ? This will overwrite the journal. #
|
||||
-- <input type=hidden name=action value=edit>
|
||||
-- <input type=submit name=submit value="save journal">
|
||||
-- \ or #
|
||||
-- <a href="#" onclick="return editformToggle(event)">cancel
|
||||
-- |]
|
||||
-- where
|
||||
-- title = "Edit journal" :: String
|
||||
-- manyfiles = length (files j) > 1
|
||||
-- formathelp = helplink "file-format" "file format help"
|
||||
|
||||
-- -- | Import journal form.
|
||||
-- importform :: HtmlUrl AppRoute
|
||||
-- importform = [hamlet|
|
||||
-- <form#importform method=POST style=display:none;>
|
||||
-- <table.form>
|
||||
-- <tr>
|
||||
-- <td>
|
||||
-- <input type=file name=file>
|
||||
-- <input type=hidden name=action value=import>
|
||||
-- <input type=submit name=submit value="import from file">
|
||||
-- \ or #
|
||||
-- <a href="#" onclick="return importformToggle(event)">cancel
|
||||
-- |]
|
||||
|
||||
-- | Link to a topic in the manual.
|
||||
helplink :: String -> String -> HtmlUrl AppRoute
|
||||
helplink topic label = [hamlet|
|
||||
<a href=#{u} target=hledgerhelp>#{label}
|
||||
|]
|
||||
where u = manualurl ++ if null topic then "" else '#':topic
|
||||
|
||||
nulltemplate :: HtmlUrl AppRoute
|
||||
nulltemplate = [hamlet||]
|
||||
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- hledger report renderers
|
||||
|
||||
-- | Render a "BalanceReport" as html.
|
||||
balanceReportAsHtml :: WebOpts -> ViewData -> BalanceReport -> HtmlUrl AppRoute
|
||||
balanceReportAsHtml _ vd@VD{..} (items',total) =
|
||||
[hamlet|
|
||||
$forall i <- items
|
||||
^{itemAsHtml vd i}
|
||||
<tr .total>
|
||||
<td>
|
||||
<td>
|
||||
#{mixedAmountAsHtml total}
|
||||
|]
|
||||
where
|
||||
l = ledgerFromJournal Any j
|
||||
inacctmatcher = inAccountQuery qopts
|
||||
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
|
||||
itemAsHtml :: ViewData -> BalanceReportItem -> HtmlUrl AppRoute
|
||||
itemAsHtml _ (acct, adisplay, aindent, abal) = [hamlet|
|
||||
<tr .#{inacctclass}>
|
||||
<td .acct>
|
||||
<div .ff-wrapper>
|
||||
\#{indent}
|
||||
<a href="@?{acctquery}" .#{inacctclass} title="Show transactions affecting this account and subaccounts">#{adisplay}
|
||||
$if hassubs
|
||||
<a href="@?{acctonlyquery}" .only .hidden-sm .hidden-xs title="Show transactions affecting this account but not subaccounts">only
|
||||
<td>
|
||||
#{mixedAmountAsHtml abal}
|
||||
|]
|
||||
where
|
||||
hassubs = not $ maybe False (null.asubs) $ ledgerAccount l acct
|
||||
inacctclass = case inacctmatcher of
|
||||
Just m' -> if m' `matchesAccount` acct then "inacct" else ""
|
||||
Nothing -> "" :: String
|
||||
indent = preEscapedString $ concat $ replicate (2 * (1+aindent)) " "
|
||||
acctquery = (RegisterR, [("q", T.pack $ accountQuery acct)])
|
||||
acctonlyquery = (RegisterR, [("q", T.pack $ accountOnlyQuery acct)])
|
||||
|
||||
accountQuery :: AccountName -> String
|
||||
accountQuery a = "inacct:" ++ T.unpack (quoteIfSpaced a) -- (accountNameToAccountRegex a)
|
||||
|
||||
accountOnlyQuery :: AccountName -> String
|
||||
accountOnlyQuery a = "inacctonly:" ++ T.unpack (quoteIfSpaced a ) -- (accountNameToAccountRegex a)
|
||||
|
||||
accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)])
|
||||
accountUrl r a = (r, [("q", T.pack $ accountQuery a)])
|
||||
|
||||
-- stringIfLongerThan :: Int -> String -> String
|
||||
-- stringIfLongerThan n s = if length s > n then s else ""
|
||||
|
||||
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
|
||||
numberTransactionsReportItems [] = []
|
||||
numberTransactionsReportItems items = number 0 nulldate items
|
||||
where
|
||||
number :: Int -> Day -> [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
|
||||
number _ _ [] = []
|
||||
number n prevd (i@(Transaction{tdate=d},_,_,_,_,_):rest) = (n+1,newday,newmonth,newyear,i): number (n+1) d rest
|
||||
where
|
||||
newday = d/=prevd
|
||||
newmonth = dm/=prevdm || dy/=prevdy
|
||||
newyear = dy/=prevdy
|
||||
(dy,dm,_) = toGregorian d
|
||||
(prevdy,prevdm,_) = toGregorian prevd
|
||||
|
||||
mixedAmountAsHtml :: MixedAmount -> Html
|
||||
mixedAmountAsHtml b = preEscapedString $ unlines $ map addclass $ lines $ showMixedAmountWithoutPrice b
|
||||
where addclass = printf "<span class=\"%s\">%s</span><br/>" (c :: String)
|
||||
c = case isNegativeMixedAmount b of Just True -> "negative amount"
|
||||
_ -> "positive amount"
|
||||
|
||||
@ -1,75 +0,0 @@
|
||||
-- -- | Handle a post from the journal edit form.
|
||||
-- handleEdit :: Handler Html
|
||||
-- handleEdit = do
|
||||
-- VD{..} <- getViewData
|
||||
-- -- get form input values, or validation errors.
|
||||
-- -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace
|
||||
-- mtext <- lookupPostParam "text"
|
||||
-- mtrace "--------------------------"
|
||||
-- mtrace (journalFilePaths j)
|
||||
-- mjournalpath <- lookupPostParam "journal"
|
||||
-- let etext = maybe (Left "No value provided") (Right . unpack) mtext
|
||||
-- ejournalpath = maybe
|
||||
-- (Right $ journalFilePath j)
|
||||
-- (\f -> let f' = unpack f in
|
||||
-- if f' `elem` dbg0 "paths2" (journalFilePaths j)
|
||||
-- then Right f'
|
||||
-- else Left ("unrecognised journal file path"::String))
|
||||
-- mjournalpath
|
||||
-- estrs = [etext, ejournalpath]
|
||||
-- errs = lefts estrs
|
||||
-- [text,journalpath] = rights estrs
|
||||
-- -- display errors or perform edit
|
||||
-- if not $ null errs
|
||||
-- then do
|
||||
-- setMessage $ toHtml (intercalate "; " errs :: String)
|
||||
-- redirect JournalR
|
||||
|
||||
-- -- | Handle a post from the journal edit form.
|
||||
-- handleEdit :: Handler Html
|
||||
-- handleEdit = do
|
||||
-- VD{..} <- getViewData
|
||||
-- -- get form input values, or validation errors.
|
||||
-- -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace
|
||||
-- mtext <- lookupPostParam "text"
|
||||
-- mjournalpath <- lookupPostParam "journal"
|
||||
-- let etext = maybe (Left "No value provided") (Right . unpack) mtext
|
||||
-- ejournalpath = maybe
|
||||
-- (Right $ journalFilePath j)
|
||||
-- (\f -> let f' = unpack f in
|
||||
-- if f' `elem` journalFilePaths j
|
||||
-- then Right f'
|
||||
-- else Left ("unrecognised journal file path"::String))
|
||||
-- mjournalpath
|
||||
-- estrs = [etext, ejournalpath]
|
||||
-- errs = lefts estrs
|
||||
-- [text,journalpath] = rights estrs
|
||||
-- -- display errors or perform edit
|
||||
-- if not $ null errs
|
||||
-- then do
|
||||
-- setMessage $ toHtml (intercalate "; " errs :: String)
|
||||
-- redirect JournalR
|
||||
|
||||
-- else do
|
||||
-- -- try to avoid unnecessary backups or saving invalid data
|
||||
-- filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath
|
||||
-- told <- liftIO $ readFileStrictly journalpath
|
||||
-- let tnew = filter (/= '\r') text
|
||||
-- changed = tnew /= told || filechanged'
|
||||
-- if not changed
|
||||
-- then do
|
||||
-- setMessage "No change"
|
||||
-- redirect JournalR
|
||||
-- else do
|
||||
-- jE <- liftIO $ readJournal def (Just journalpath) tnew
|
||||
-- either
|
||||
-- (\e -> do
|
||||
-- setMessage $ toHtml e
|
||||
-- redirect JournalR)
|
||||
-- (const $ do
|
||||
-- liftIO $ writeFileWithBackup journalpath tnew
|
||||
-- setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String)
|
||||
-- redirect JournalR)
|
||||
-- jE
|
||||
|
||||
|
||||
@ -1,18 +0,0 @@
|
||||
-- -- | Handle a post from the journal import form.
|
||||
-- handleImport :: Handler Html
|
||||
-- handleImport = do
|
||||
-- setMessage "can't handle file upload yet"
|
||||
-- redirect JournalR
|
||||
-- -- -- get form input values, or basic validation errors. E means an Either value.
|
||||
-- -- fileM <- runFormPost $ maybeFileInput "file"
|
||||
-- -- let fileE = maybe (Left "No file provided") Right fileM
|
||||
-- -- -- display errors or import transactions
|
||||
-- -- case fileE of
|
||||
-- -- Left errs -> do
|
||||
-- -- setMessage errs
|
||||
-- -- redirect JournalR
|
||||
|
||||
-- -- Right s -> do
|
||||
-- -- setMessage s
|
||||
-- -- redirect JournalR
|
||||
|
||||
@ -1,88 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-}
|
||||
-- | /journal handlers.
|
||||
|
||||
module Handler.JournalR where
|
||||
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Import
|
||||
|
||||
import Handler.AddForm
|
||||
import Handler.Common
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Query
|
||||
import Hledger.Reports
|
||||
import Hledger.Utils
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Web.WebOptions
|
||||
|
||||
-- | The formatted journal view, with sidebar.
|
||||
getJournalR :: Handler Html
|
||||
getJournalR = do
|
||||
vd@VD{..} <- getViewData
|
||||
let -- XXX like registerReportAsHtml
|
||||
inacct = inAccount qopts
|
||||
-- injournal = isNothing inacct
|
||||
filtering = m /= Any
|
||||
-- showlastcolumn = if injournal && not filtering then False else True
|
||||
title = case inacct of
|
||||
Nothing -> "General Journal"++s2
|
||||
Just (a,inclsubs) -> "Transactions in "++T.unpack a++s1++s2
|
||||
where s1 = if inclsubs then "" else " (excluding subaccounts)"
|
||||
where
|
||||
s2 = if filtering then ", filtered" else ""
|
||||
maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
|
||||
hledgerLayout vd "journal" [hamlet|
|
||||
<div .row>
|
||||
<h2 #contenttitle>#{title}
|
||||
<!-- p>Journal entries record movements of commodities between accounts. -->
|
||||
<a #addformlink role="button" style="cursor:pointer; margin-top:1em;" data-toggle="modal" data-target="#addmodal" title="Add a new transaction to the journal" href="#">Add a transaction
|
||||
<div .table-responsive>
|
||||
^{maincontent}
|
||||
|]
|
||||
|
||||
postJournalR :: Handler Html
|
||||
postJournalR = postAddForm
|
||||
|
||||
-- | Render a "TransactionsReport" as html for the formatted journal view.
|
||||
journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
||||
journalTransactionsReportAsHtml _ vd (_,items) = [hamlet|
|
||||
<table .transactionsreport .table .table-condensed>
|
||||
<thead>
|
||||
<th .date style="text-align:left;">
|
||||
Date
|
||||
<th .description style="text-align:left;">Description
|
||||
<th .account style="text-align:left;">Account
|
||||
<th .amount style="text-align:right;">Amount
|
||||
$forall i <- numberTransactionsReportItems items
|
||||
^{itemAsHtml vd i}
|
||||
|]
|
||||
where
|
||||
-- .#{datetransition}
|
||||
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
||||
itemAsHtml VD{..} (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet|
|
||||
<tr .title #transaction-#{tindex torig}>
|
||||
<td .date nowrap>#{date}
|
||||
<td .description colspan=2>#{textElideRight 60 desc}
|
||||
<td .amount style="text-align:right;">
|
||||
$if showamt
|
||||
\#{mixedAmountAsHtml amt}
|
||||
$forall p' <- tpostings torig
|
||||
<tr .item .posting title="#{show torig}">
|
||||
<td .nonhead>
|
||||
<td .nonhead>
|
||||
<td .nonhead>
|
||||
|
||||
<a href="@?{acctlink (paccount p')}##{tindex torig}" title="#{paccount p'}">#{elideAccountName 40 $ paccount p'}
|
||||
<td .amount .nonhead style="text-align:right;">#{mixedAmountAsHtml $ pamount p'}
|
||||
|]
|
||||
where
|
||||
acctlink a = (RegisterR, [("q", T.pack $ accountQuery a)])
|
||||
-- datetransition | newm = "newmonth"
|
||||
-- | newd = "newday"
|
||||
-- | otherwise = "" :: String
|
||||
(date, desc) = (show $ tdate torig, tdescription torig)
|
||||
-- acctquery = (here, [("q", T.pack $ accountQuery acct)])
|
||||
showamt = not split || not (isZeroMixedAmount amt)
|
||||
|
||||
@ -1,181 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-}
|
||||
-- | /register handlers.
|
||||
|
||||
module Handler.RegisterR where
|
||||
|
||||
import Import
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Safe
|
||||
|
||||
import Handler.AddForm
|
||||
import Handler.Common
|
||||
import Handler.Utils
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Query
|
||||
import Hledger.Reports
|
||||
import Hledger.Utils
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Web.WebOptions
|
||||
|
||||
-- | The main journal/account register view, with accounts sidebar.
|
||||
getRegisterR :: Handler Html
|
||||
getRegisterR = do
|
||||
vd@VD{..} <- getViewData
|
||||
-- staticRootUrl <- (staticRoot . settings) <$> getYesod
|
||||
let -- injournal = isNothing inacct
|
||||
filtering = m /= Any
|
||||
-- title = "Transactions in "++a++s1++s2
|
||||
title = T.unpack a++s1++s2
|
||||
where
|
||||
(a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
|
||||
s1 = if inclsubs then "" else " (excluding subaccounts)"
|
||||
s2 = if filtering then ", filtered" else ""
|
||||
maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
|
||||
hledgerLayout vd "register" [hamlet|
|
||||
<h2 #contenttitle>#{title}
|
||||
<!-- p>Transactions affecting this account, with running balance. -->
|
||||
^{maincontent}
|
||||
|]
|
||||
|
||||
postRegisterR :: Handler Html
|
||||
postRegisterR = postAddForm
|
||||
|
||||
-- Generate html for an account register, including a balance chart and transaction list.
|
||||
registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
||||
registerReportHtml opts vd r = [hamlet|
|
||||
<div .hidden-xs>
|
||||
^{registerChartHtml $ transactionsReportByCommodity r}
|
||||
^{registerItemsHtml opts vd r}
|
||||
|]
|
||||
|
||||
-- Generate html for a transaction list from an "TransactionsReport".
|
||||
registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
|
||||
registerItemsHtml _ vd (balancelabel,items) = [hamlet|
|
||||
<div .table-responsive>
|
||||
<table.registerreport .table .table-striped .table-condensed>
|
||||
<thead>
|
||||
<tr>
|
||||
<th style="text-align:left;">
|
||||
Date
|
||||
<span .glyphicon .glyphicon-chevron-up>
|
||||
<th style="text-align:left;">Description
|
||||
<th style="text-align:left;">To/From Account(s)
|
||||
<th style="text-align:right; white-space:normal;">Amount Out/In
|
||||
<th style="text-align:right; white-space:normal;">#{balancelabel'}
|
||||
$forall i <- numberTransactionsReportItems items
|
||||
^{itemAsHtml vd i}
|
||||
|]
|
||||
where
|
||||
insomeacct = isJust $ inAccount $ qopts vd
|
||||
balancelabel' = if insomeacct then balancelabel else "Total"
|
||||
|
||||
-- filtering = m /= Any
|
||||
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
|
||||
itemAsHtml VD{..} (n, newd, newm, _, (torig, tacct, split, acct, amt, bal)) = [hamlet|
|
||||
|
||||
<tr ##{tindex torig} .item.#{evenodd}.#{firstposting}.#{datetransition} title="#{show torig}" style="vertical-align:top;">
|
||||
<td .date>
|
||||
<a href="@{JournalR}#transaction-#{tindex torig}">#{date}
|
||||
<td .description title="#{show torig}">#{textElideRight 30 desc}
|
||||
<td .account>#{elideRight 40 acct}
|
||||
<td .amount style="text-align:right; white-space:nowrap;">
|
||||
$if showamt
|
||||
\#{mixedAmountAsHtml amt}
|
||||
<td .balance style="text-align:right;">#{mixedAmountAsHtml bal}
|
||||
|]
|
||||
|
||||
where
|
||||
evenodd = if even n then "even" else "odd" :: String
|
||||
datetransition | newm = "newmonth"
|
||||
| newd = "newday"
|
||||
| otherwise = "" :: String
|
||||
(firstposting, date, desc) = (False, show $ tdate tacct, tdescription tacct)
|
||||
-- acctquery = (here, [("q", pack $ accountQuery acct)])
|
||||
showamt = not split || not (isZeroMixedAmount amt)
|
||||
|
||||
-- | Generate javascript/html for a register balance line chart based on
|
||||
-- the provided "TransactionsReportItem"s.
|
||||
-- registerChartHtml :: forall t (t1 :: * -> *) t2 t3 t4 t5.
|
||||
-- Data.Foldable.Foldable t1 =>
|
||||
-- t1 (Transaction, t2, t3, t4, t5, MixedAmount)
|
||||
-- -> t -> Text.Blaze.Internal.HtmlM ()
|
||||
registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute
|
||||
registerChartHtml percommoditytxnreports =
|
||||
-- have to make sure plot is not called when our container (maincontent)
|
||||
-- is hidden, eg with add form toggled
|
||||
[hamlet|
|
||||
<label #register-chart-label style=""><br>
|
||||
<div #register-chart style="height:150px; margin-bottom:1em; display:block;">
|
||||
<script type=text/javascript>
|
||||
\$(document).ready(function() {
|
||||
var $chartdiv = $('#register-chart');
|
||||
if ($chartdiv.is(':visible')) {
|
||||
\$('#register-chart-label').text('#{charttitle}');
|
||||
var seriesData = [
|
||||
$forall (c,(_,items)) <- percommoditytxnreports
|
||||
/* we render each commodity using two series:
|
||||
* one with extra data points added to show a stepped balance line */
|
||||
{
|
||||
data: [
|
||||
$forall i <- reverse items
|
||||
[
|
||||
#{dayToJsTimestamp $ triDate i},
|
||||
#{simpleMixedAmountQuantity $ triCommodityBalance c i}
|
||||
],
|
||||
/* [] */
|
||||
],
|
||||
label: '#{shownull $ T.unpack c}',
|
||||
color: #{colorForCommodity c},
|
||||
lines: {
|
||||
show: true,
|
||||
steps: true,
|
||||
},
|
||||
points: {
|
||||
show: false,
|
||||
},
|
||||
clickable: false,
|
||||
hoverable: false,
|
||||
},
|
||||
/* and one with the original data, showing one clickable, hoverable point per transaction */
|
||||
{
|
||||
data: [
|
||||
$forall i <- reverse items
|
||||
[
|
||||
#{dayToJsTimestamp $ triDate i},
|
||||
#{simpleMixedAmountQuantity $ triCommodityBalance c i},
|
||||
'#{showMixedAmountWithZeroCommodity $ triCommodityAmount c i}',
|
||||
'#{showMixedAmountWithZeroCommodity $ triCommodityBalance c i}',
|
||||
'#{concat $ intersperse "\\n" $ lines $ show $ triOrigTransaction i}',
|
||||
#{tindex $ triOrigTransaction i}
|
||||
],
|
||||
/* [] */
|
||||
],
|
||||
label: '',
|
||||
color: #{colorForCommodity c},
|
||||
lines: {
|
||||
show: false,
|
||||
},
|
||||
points: {
|
||||
show: true,
|
||||
},
|
||||
},
|
||||
]
|
||||
var plot = registerChart($chartdiv, seriesData);
|
||||
\$chartdiv.bind("plotclick", registerChartClick);
|
||||
};
|
||||
});
|
||||
|]
|
||||
-- [#{dayToJsTimestamp $ ltrace "\ndate" $ triDate i}, #{ltrace "balancequantity" $ simpleMixedAmountQuantity $ triCommodityBalance c i}, '#{ltrace "balance" $ show $ triCommodityBalance c i}, '#{ltrace "amount" $ show $ triCommodityAmount c i}''],
|
||||
where
|
||||
charttitle = case maybe "" (fst.snd) $ headMay percommoditytxnreports
|
||||
of "" -> ""
|
||||
s -> s++":"
|
||||
colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex
|
||||
commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]
|
||||
simpleMixedAmountQuantity = maybe 0 aquantity . headMay . amounts
|
||||
shownull c = if null c then " " else c
|
||||
@ -1,8 +0,0 @@
|
||||
-- | Site root and misc. handlers.
|
||||
|
||||
module Handler.RootR where
|
||||
|
||||
import Import
|
||||
|
||||
getRootR :: Handler Html
|
||||
getRootR = redirect defaultroute where defaultroute = JournalR
|
||||
@ -1,15 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-}
|
||||
-- | /sidebar
|
||||
|
||||
module Handler.SidebarR where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Common
|
||||
|
||||
-- | Render just the accounts sidebar, useful when opening the sidebar.
|
||||
getSidebarR :: Handler Html
|
||||
getSidebarR = do
|
||||
vd <- getViewData
|
||||
withUrlRenderer [hamlet|^{sidebar vd}|]
|
||||
|
||||
@ -1,20 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
-- | Web handler utilities. More of these are in Foundation.hs, where
|
||||
-- they can be used in the default template.
|
||||
|
||||
module Handler.Utils where
|
||||
|
||||
import Prelude
|
||||
import Data.Time.Calendar
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Format
|
||||
#if !(MIN_VERSION_time(1,5,0))
|
||||
import System.Locale (defaultTimeLocale)
|
||||
#endif
|
||||
|
||||
numbered :: [a] -> [(Int,a)]
|
||||
numbered = zip [1..]
|
||||
|
||||
dayToJsTimestamp :: Day -> Integer
|
||||
dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX read
|
||||
where t = UTCTime d (secondsToDiffTime 0)
|
||||
@ -2,12 +2,12 @@
|
||||
Re-export the modules of the hledger-web program.
|
||||
-}
|
||||
|
||||
module Hledger.Web (
|
||||
module Hledger.Web.WebOptions,
|
||||
module Hledger.Web.Main,
|
||||
tests_Hledger_Web
|
||||
)
|
||||
where
|
||||
module Hledger.Web
|
||||
( module Hledger.Web.WebOptions
|
||||
, module Hledger.Web.Main
|
||||
, tests_Hledger_Web
|
||||
) where
|
||||
|
||||
import Test.HUnit
|
||||
|
||||
import Hledger.Web.WebOptions
|
||||
|
||||
53
hledger-web/Hledger/Web/Application.hs
Normal file
53
hledger-web/Hledger/Web/Application.hs
Normal file
@ -0,0 +1,53 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Hledger.Web.Application
|
||||
( makeApplication
|
||||
, makeFoundation
|
||||
) where
|
||||
|
||||
import Data.IORef (newIORef, writeIORef)
|
||||
import Network.Wai.Middleware.RequestLogger (logStdoutDev, logStdout)
|
||||
import Network.HTTP.Client (defaultManagerSettings)
|
||||
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
|
||||
(getDownloadR, getFaviconR, getManageR, getRobotsR, getRootR)
|
||||
import Hledger.Web.Handler.EditR (getEditR, postEditR)
|
||||
import Hledger.Web.Handler.UploadR (getUploadR, postUploadR)
|
||||
import Hledger.Web.Handler.JournalR (getJournalR)
|
||||
import Hledger.Web.Handler.RegisterR (getRegisterR)
|
||||
import Hledger.Web.Import
|
||||
import Hledger.Web.WebOptions (WebOpts(serve_))
|
||||
|
||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||
-- comments there for more details.
|
||||
mkYesodDispatch "App" resourcesApp
|
||||
|
||||
-- This function allocates resources (such as a database connection pool),
|
||||
-- performs initialization and creates a WAI application. This is also the
|
||||
-- place to put your migrate statements to have automatic database
|
||||
-- migrations handled by Yesod.
|
||||
makeApplication :: WebOpts -> Journal -> AppConfig DefaultEnv Extra -> IO Application
|
||||
makeApplication opts' j' conf' = do
|
||||
foundation <- makeFoundation conf' opts'
|
||||
writeIORef (appJournal foundation) j'
|
||||
logWare <$> toWaiApp foundation
|
||||
where
|
||||
logWare | development = logStdoutDev
|
||||
| serve_ opts' = logStdout
|
||||
| otherwise = id
|
||||
|
||||
makeFoundation :: AppConfig DefaultEnv Extra -> WebOpts -> IO App
|
||||
makeFoundation conf opts' = do
|
||||
manager <- newManager defaultManagerSettings
|
||||
s <- staticSite
|
||||
jref <- newIORef nulljournal
|
||||
return $ App conf s manager opts' jref
|
||||
232
hledger-web/Hledger/Web/Foundation.hs
Normal file
232
hledger-web/Hledger/Web/Foundation.hs
Normal file
@ -0,0 +1,232 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
-- | Define the web application's foundation, in the usual Yesod style.
|
||||
-- See a default Yesod app's comments for more details of each part.
|
||||
|
||||
module Hledger.Web.Foundation where
|
||||
|
||||
import Control.Monad (join)
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.Traversable (for)
|
||||
import Data.IORef (IORef, readIORef, writeIORef)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Network.Wai (requestHeaders)
|
||||
import System.FilePath (takeFileName)
|
||||
import Text.Blaze (Markup)
|
||||
import Text.Hamlet (hamletFile)
|
||||
import Yesod
|
||||
import Yesod.Static
|
||||
import Yesod.Default.Config
|
||||
|
||||
#ifndef DEVELOPMENT
|
||||
import Hledger.Web.Settings (staticDir)
|
||||
import Text.Jasmine (minifym)
|
||||
import Yesod.Default.Util (addStaticContentExternal)
|
||||
#endif
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli (CliOpts(..), journalReloadIfChanged)
|
||||
import Hledger.Web.Settings (Extra(..), widgetFile)
|
||||
import Hledger.Web.Settings.StaticFiles
|
||||
import Hledger.Web.WebOptions
|
||||
import Hledger.Web.Widget.Common (balanceReportAsHtml)
|
||||
|
||||
-- | The site argument for your application. This can be a good place to
|
||||
-- keep settings and values requiring initialization before your application
|
||||
-- starts running, such as database connections. Every handler will have
|
||||
-- access to the data present here.
|
||||
data App = App
|
||||
{ settings :: AppConfig DefaultEnv Extra
|
||||
, getStatic :: Static -- ^ Settings for static file serving.
|
||||
, httpManager :: Manager
|
||||
--
|
||||
, appOpts :: WebOpts
|
||||
, appJournal :: IORef Journal
|
||||
}
|
||||
|
||||
|
||||
-- This is where we define all of the routes in our application. For a full
|
||||
-- explanation of the syntax, please see:
|
||||
-- http://www.yesodweb.com/book/handler
|
||||
--
|
||||
-- This function does three things:
|
||||
--
|
||||
-- * Creates the route datatype AppRoute. Every valid URL in your
|
||||
-- application can be represented as a value of this type.
|
||||
-- * Creates the associated type:
|
||||
-- type instance Route App = AppRoute
|
||||
-- * Creates the value resourcesApp which contains information on the
|
||||
-- resources declared below. This is used in Handler.hs by the call to
|
||||
-- mkYesodDispatch
|
||||
--
|
||||
-- What this function does *not* do is create a YesodSite instance for
|
||||
-- App. Creating that instance requires all of the handler functions
|
||||
-- for our application to be in scope. However, the handler functions
|
||||
-- usually require access to the AppRoute datatype. Therefore, we
|
||||
-- split these actions into two functions and place them in separate files.
|
||||
mkYesodData "App" $(parseRoutesFile "config/routes")
|
||||
|
||||
-- | A convenience alias.
|
||||
type AppRoute = Route App
|
||||
|
||||
#if MIN_VERSION_yesod(1,6,0)
|
||||
type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
|
||||
#else
|
||||
type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
|
||||
#endif
|
||||
|
||||
-- Please see the documentation for the Yesod typeclass. There are a number
|
||||
-- of settings which can be configured by overriding methods here.
|
||||
instance Yesod App where
|
||||
approot = ApprootMaster $ appRoot . settings
|
||||
|
||||
makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 ".hledger-web_client_session_key.aes"
|
||||
|
||||
defaultLayout widget = do
|
||||
master <- getYesod
|
||||
here <- fromMaybe RootR <$> getCurrentRoute
|
||||
VD {caps, j, m, opts, q, qopts} <- getViewData
|
||||
msg <- getMessage
|
||||
showSidebar <- shouldShowSidebar
|
||||
hideEmptyAccts <- (== Just "1") . lookup "hideemptyaccts" . reqCookies <$> getRequest
|
||||
|
||||
let ropts = reportopts_ (cliopts_ opts)
|
||||
-- flip the default for items with zero amounts, show them by default
|
||||
ropts' = ropts { empty_ = not (empty_ ropts) }
|
||||
accounts =
|
||||
balanceReportAsHtml (JournalR, RegisterR) here hideEmptyAccts j qopts $
|
||||
balanceReport ropts' m j
|
||||
|
||||
topShowmd = if showSidebar then "col-md-4" else "col-any-0" :: Text
|
||||
topShowsm = if showSidebar then "col-sm-4" else "" :: Text
|
||||
sideShowmd = if showSidebar then "col-md-4" else "col-any-0" :: Text
|
||||
sideShowsm = if showSidebar then "col-sm-4" else "" :: Text
|
||||
mainShowmd = if showSidebar then "col-md-8" else "col-md-12" :: Text
|
||||
mainShowsm = if showSidebar then "col-sm-8" else "col-sm-12" :: Text
|
||||
|
||||
-- We break up the default layout into two components:
|
||||
-- default-layout is the contents of the body tag, and
|
||||
-- default-layout-wrapper is the entire page. Since the final
|
||||
-- value passed to hamletToRepHtml cannot be a widget, this allows
|
||||
-- you to use normal widget features in default-layout.
|
||||
pc <- widgetToPageContent $ do
|
||||
addStylesheet $ StaticR css_bootstrap_min_css
|
||||
addStylesheet $ StaticR css_bootstrap_datepicker_standalone_min_css
|
||||
-- load these things early, in HEAD:
|
||||
toWidgetHead [hamlet|
|
||||
<script type="text/javascript" src="@{StaticR js_jquery_min_js}">
|
||||
<script type="text/javascript" src="@{StaticR js_typeahead_bundle_min_js}">
|
||||
|]
|
||||
addScript $ StaticR js_bootstrap_min_js
|
||||
addScript $ StaticR js_bootstrap_datepicker_min_js
|
||||
addScript $ StaticR js_jquery_url_js
|
||||
addScript $ StaticR js_jquery_cookie_js
|
||||
addScript $ StaticR js_jquery_hotkeys_js
|
||||
addScript $ StaticR js_jquery_flot_min_js
|
||||
addScript $ StaticR js_jquery_flot_time_min_js
|
||||
addScript $ StaticR js_jquery_flot_tooltip_min_js
|
||||
toWidget [hamlet| \<!--[if lte IE 8]> <script type="text/javascript" src="@{StaticR js_excanvas_min_js}"></script> <![endif]--> |]
|
||||
addStylesheet $ StaticR hledger_css
|
||||
addScript $ StaticR hledger_js
|
||||
$(widgetFile "default-layout")
|
||||
|
||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||
|
||||
#ifndef DEVELOPMENT
|
||||
-- This function creates static content files in the static folder
|
||||
-- and names them based on a hash of their content. This allows
|
||||
-- expiration dates to be set far in the future without worry of
|
||||
-- users receiving stale content.
|
||||
addStaticContent = addStaticContentExternal minifym base64md5 staticDir (StaticR . flip StaticRoute [])
|
||||
#endif
|
||||
|
||||
-- This instance is required to use forms. You can modify renderMessage to
|
||||
-- achieve customized and internationalized form validation messages.
|
||||
instance RenderMessage App FormMessage where
|
||||
renderMessage _ _ = defaultFormMessage
|
||||
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- template and handler utilities
|
||||
|
||||
-- view data, used by the add form and handlers
|
||||
-- XXX Parameter p - show/hide postings
|
||||
|
||||
-- | A bundle of data useful for hledger-web request handlers and templates.
|
||||
data ViewData = VD
|
||||
{ opts :: WebOpts -- ^ the command-line options at startup
|
||||
, today :: Day -- ^ today's date (for queries containing relative dates)
|
||||
, j :: Journal -- ^ the up-to-date parsed unfiltered journal
|
||||
, q :: Text -- ^ the current q parameter, the main query expression
|
||||
, m :: Query -- ^ a query parsed from the q parameter
|
||||
, qopts :: [QueryOpt] -- ^ query options parsed from the q parameter
|
||||
, caps :: [Capability] -- ^ capabilities enabled for this request
|
||||
} deriving (Show)
|
||||
|
||||
instance Show Text.Blaze.Markup where show _ = "<blaze markup>"
|
||||
|
||||
-- | Gather data used by handlers and templates in the current request.
|
||||
getViewData :: Handler ViewData
|
||||
getViewData = do
|
||||
App {appOpts = opts, appJournal} <- getYesod
|
||||
today <- liftIO getCurrentDay
|
||||
let copts = cliopts_ opts
|
||||
(j, merr) <-
|
||||
getCurrentJournal
|
||||
appJournal
|
||||
copts {reportopts_ = (reportopts_ copts) {no_elide_ = True}}
|
||||
today
|
||||
maybe (pure ()) (setMessage . toHtml) merr
|
||||
q <- fromMaybe "" <$> lookupGetParam "q"
|
||||
let (m, qopts) = parseQuery today q
|
||||
caps <- case capabilitiesHeader_ opts of
|
||||
Nothing -> return (capabilities_ opts)
|
||||
Just h -> do
|
||||
hs <- fmap (BC.split ',' . snd) . filter ((== h) . fst) . requestHeaders <$> waiRequest
|
||||
fmap join . for (join hs) $ \x -> case capabilityFromBS x of
|
||||
Left e -> [] <$ addMessage "" ("Unknown permission: " <> toHtml (BC.unpack e))
|
||||
Right c -> pure [c]
|
||||
return VD {opts, today, j, q, m, qopts, caps}
|
||||
|
||||
-- | Find out if the sidebar should be visible. Show it, unless there is a
|
||||
-- showsidebar cookie set to "0", or a ?sidebar=0 query parameter.
|
||||
shouldShowSidebar :: Handler Bool
|
||||
shouldShowSidebar = do
|
||||
msidebarparam <- lookupGetParam "sidebar"
|
||||
msidebarcookie <- lookup "showsidebar" . reqCookies <$> getRequest
|
||||
return $ maybe (msidebarcookie /= Just "0") (/="0") msidebarparam
|
||||
|
||||
-- | Update our copy of the journal if the file changed. If there is an
|
||||
-- error while reloading, keep the old one and return the error, and set a
|
||||
-- ui message.
|
||||
getCurrentJournal :: IORef Journal -> CliOpts -> Day -> Handler (Journal, Maybe String)
|
||||
getCurrentJournal jref opts d = do
|
||||
-- XXX put this inside atomicModifyIORef' for thread safety
|
||||
j <- liftIO (readIORef jref)
|
||||
(ej, changed) <- liftIO $ journalReloadIfChanged opts d j
|
||||
-- re-apply any initial filter specified at startup
|
||||
let initq = queryFromOpts d (reportopts_ opts)
|
||||
case (changed, filterJournalTransactions initq <$> ej) of
|
||||
(False, _) -> return (j, Nothing)
|
||||
(True, Right j') -> do
|
||||
liftIO $ writeIORef jref j'
|
||||
return (j',Nothing)
|
||||
(True, Left e) -> do
|
||||
setMessage "error while reading journal"
|
||||
return (j, Just e)
|
||||
40
hledger-web/Hledger/Web/Handler/AddR.hs
Normal file
40
hledger-web/Hledger/Web/Handler/AddR.hs
Normal file
@ -0,0 +1,40 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Hledger.Web.Handler.AddR
|
||||
( getAddR
|
||||
, postAddR
|
||||
) where
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout)
|
||||
import Hledger.Web.Import
|
||||
import Hledger.Web.Widget.AddForm (addForm)
|
||||
import Hledger.Web.Widget.Common (fromFormSuccess)
|
||||
|
||||
getAddR :: Handler ()
|
||||
getAddR = postAddR
|
||||
|
||||
postAddR :: Handler ()
|
||||
postAddR = do
|
||||
VD{caps, j, today} <- getViewData
|
||||
when (CapAdd `notElem` caps) (permissionDenied "Missing the 'add' capability")
|
||||
|
||||
((res, view), enctype) <- runFormPost $ addForm j today
|
||||
t <- txnTieKnot <$> fromFormSuccess (showForm view enctype) res
|
||||
-- XXX(?) move into balanceTransaction
|
||||
liftIO $ ensureJournalFileExists (journalFilePath j)
|
||||
liftIO $ appendToJournalFileOrStdout (journalFilePath j) (showTransaction t)
|
||||
setMessage "Transaction added."
|
||||
redirect JournalR
|
||||
where
|
||||
showForm view enctype =
|
||||
sendResponse =<< defaultLayout [whamlet|
|
||||
<h2>Add transaction
|
||||
<div .row style="margin-top:1em">
|
||||
<form#addform.form.col-xs-12.col-md-8 method=post enctype=#{enctype}>
|
||||
^{view}
|
||||
|]
|
||||
38
hledger-web/Hledger/Web/Handler/Common.hs
Normal file
38
hledger-web/Hledger/Web/Handler/Common.hs
Normal file
@ -0,0 +1,38 @@
|
||||
{-# 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)
|
||||
47
hledger-web/Hledger/Web/Handler/EditR.hs
Normal file
47
hledger-web/Hledger/Web/Handler/EditR.hs
Normal file
@ -0,0 +1,47 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Web.Handler.EditR
|
||||
( getEditR
|
||||
, postEditR
|
||||
) where
|
||||
|
||||
import Hledger.Web.Import
|
||||
import Hledger.Web.Widget.Common
|
||||
(fromFormSuccess, helplink, journalFile404, writeValidJournal)
|
||||
|
||||
editForm :: FilePath -> Text -> Markup -> MForm Handler (FormResult Text, Widget)
|
||||
editForm f txt =
|
||||
identifyForm "edit" $ \extra -> do
|
||||
(tRes, tView) <- mreq textareaField fs (Just (Textarea txt))
|
||||
pure (unTextarea <$> tRes, $(widgetFile "edit-form"))
|
||||
where
|
||||
fs = FieldSettings "text" mzero mzero mzero [("class", "form-control"), ("rows", "25")]
|
||||
|
||||
getEditR :: FilePath -> Handler ()
|
||||
getEditR = postEditR
|
||||
|
||||
postEditR :: FilePath -> Handler ()
|
||||
postEditR f = do
|
||||
VD {caps, j} <- getViewData
|
||||
when (CapManage `notElem` caps) (permissionDenied "Missing the 'manage' capability")
|
||||
|
||||
(f', txt) <- journalFile404 f j
|
||||
((res, view), enctype) <- runFormPost (editForm f' txt)
|
||||
text <- fromFormSuccess (showForm view enctype) res
|
||||
writeValidJournal f text >>= \case
|
||||
Left e -> do
|
||||
setMessage $ "Failed to load journal: " <> toHtml e
|
||||
showForm view enctype
|
||||
Right () -> do
|
||||
setMessage $ "Saved journal " <> toHtml f <> "\n"
|
||||
redirect JournalR
|
||||
where
|
||||
showForm view enctype =
|
||||
sendResponse <=< defaultLayout $ do
|
||||
setTitle "Edit journal"
|
||||
[whamlet|<form method=post enctype=#{enctype}>^{view}|]
|
||||
31
hledger-web/Hledger/Web/Handler/JournalR.hs
Normal file
31
hledger-web/Hledger/Web/Handler/JournalR.hs
Normal file
@ -0,0 +1,31 @@
|
||||
-- | /journal handlers.
|
||||
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Web.Handler.JournalR where
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Web.Import
|
||||
import Hledger.Web.WebOptions
|
||||
import Hledger.Web.Widget.AddForm (addModal)
|
||||
import Hledger.Web.Widget.Common (accountQuery, mixedAmountAsHtml)
|
||||
|
||||
-- | The formatted journal view, with sidebar.
|
||||
getJournalR :: Handler Html
|
||||
getJournalR = do
|
||||
VD{caps, j, m, opts, qopts, today} <- getViewData
|
||||
when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability")
|
||||
let title = case inAccount qopts of
|
||||
Nothing -> "General Journal"
|
||||
Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
|
||||
title' = title <> if m /= Any then ", filtered" else ""
|
||||
acctlink a = (RegisterR, [("q", accountQuery a)])
|
||||
(_, items) = journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
|
||||
|
||||
defaultLayout $ do
|
||||
setTitle "journal - hledger-web"
|
||||
$(widgetFile "journal")
|
||||
60
hledger-web/Hledger/Web/Handler/RegisterR.hs
Normal file
60
hledger-web/Hledger/Web/Handler/RegisterR.hs
Normal file
@ -0,0 +1,60 @@
|
||||
-- | /register handlers.
|
||||
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Web.Handler.RegisterR where
|
||||
|
||||
import Data.List (intersperse)
|
||||
import qualified Data.Text as T
|
||||
import Text.Hamlet (hamletFile)
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Web.Import
|
||||
import Hledger.Web.WebOptions
|
||||
import Hledger.Web.Widget.AddForm (addModal)
|
||||
import Hledger.Web.Widget.Common (mixedAmountAsHtml)
|
||||
|
||||
-- | The main journal/account register view, with accounts sidebar.
|
||||
getRegisterR :: Handler Html
|
||||
getRegisterR = do
|
||||
VD{caps, j, m, opts, qopts, today} <- getViewData
|
||||
when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability")
|
||||
|
||||
let (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
|
||||
s1 = if inclsubs then "" else " (excluding subaccounts)"
|
||||
s2 = if m /= Any then ", filtered" else ""
|
||||
header = a <> s1 <> s2
|
||||
|
||||
let ropts = reportopts_ (cliopts_ opts)
|
||||
acctQuery = fromMaybe Any (inAccountQuery qopts)
|
||||
r@(balancelabel,items) = accountTransactionsReport ropts j m acctQuery
|
||||
balancelabel' = if isJust (inAccount qopts) then balancelabel else "Total"
|
||||
defaultLayout $ do
|
||||
setTitle "register - hledger-web"
|
||||
$(widgetFile "register")
|
||||
|
||||
-- | Generate javascript/html for a register balance line chart based on
|
||||
-- the provided "TransactionsReportItem"s.
|
||||
registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute
|
||||
registerChartHtml percommoditytxnreports = $(hamletFile "templates/chart.hamlet")
|
||||
-- have to make sure plot is not called when our container (maincontent)
|
||||
-- is hidden, eg with add form toggled
|
||||
where
|
||||
charttitle = case maybe "" (fst . snd) $ listToMaybe percommoditytxnreports of
|
||||
"" -> ""
|
||||
s -> s <> ":"
|
||||
colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex
|
||||
commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]
|
||||
simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts
|
||||
shownull c = if null c then " " else c
|
||||
|
||||
dayToJsTimestamp :: Day -> Integer
|
||||
dayToJsTimestamp d =
|
||||
read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX read
|
||||
where
|
||||
t = UTCTime d (secondsToDiffTime 0)
|
||||
63
hledger-web/Hledger/Web/Handler/UploadR.hs
Normal file
63
hledger-web/Hledger/Web/Handler/UploadR.hs
Normal file
@ -0,0 +1,63 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Web.Handler.UploadR
|
||||
( getUploadR
|
||||
, postUploadR
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Conduit (connect)
|
||||
import Data.Conduit.Binary (sinkLbs)
|
||||
import qualified Data.Text.Encoding as TE
|
||||
|
||||
import Hledger.Web.Import
|
||||
import Hledger.Web.Widget.Common (fromFormSuccess, journalFile404, writeValidJournal)
|
||||
|
||||
uploadForm :: FilePath -> Markup -> MForm Handler (FormResult FileInfo, Widget)
|
||||
uploadForm f =
|
||||
identifyForm "upload" $ \extra -> do
|
||||
(res, _) <- mreq fileField fs Nothing
|
||||
-- Ignoring the view - setting the name of the element is enough here
|
||||
pure (res, $(widgetFile "upload-form"))
|
||||
where
|
||||
fs = FieldSettings "file" Nothing (Just "file") (Just "file") []
|
||||
|
||||
getUploadR :: FilePath -> Handler ()
|
||||
getUploadR = postUploadR
|
||||
|
||||
postUploadR :: FilePath -> Handler ()
|
||||
postUploadR f = do
|
||||
VD {caps, j} <- getViewData
|
||||
when (CapManage `notElem` caps) (permissionDenied "Missing the 'manage' capability")
|
||||
|
||||
(f', _) <- journalFile404 f j
|
||||
((res, view), enctype) <- runFormPost (uploadForm f')
|
||||
fi <- fromFormSuccess (showForm view enctype) res
|
||||
lbs <- BL.toStrict <$> connect (fileSource fi) sinkLbs
|
||||
|
||||
-- Try to parse as UTF-8
|
||||
-- XXX Unfortunate - how to parse as system locale?
|
||||
text <- case TE.decodeUtf8' lbs of
|
||||
Left e -> do
|
||||
setMessage $
|
||||
"Encoding error: '" <> toHtml (show e) <> "'. " <>
|
||||
"If your file is not UTF-8 encoded, try the 'edit form', " <>
|
||||
"where the transcoding should be handled by the browser."
|
||||
showForm view enctype
|
||||
Right text -> return text
|
||||
writeValidJournal f text >>= \case
|
||||
Left e -> do
|
||||
setMessage $ "Failed to load journal: " <> toHtml e
|
||||
showForm view enctype
|
||||
Right () -> do
|
||||
setMessage $ "File " <> toHtml f <> " uploaded successfully"
|
||||
redirect JournalR
|
||||
where
|
||||
showForm view enctype =
|
||||
sendResponse <=< defaultLayout $ do
|
||||
setTitle "Upload journal"
|
||||
[whamlet|<form method=post enctype=#{enctype}>^{view}|]
|
||||
31
hledger-web/Hledger/Web/Import.hs
Normal file
31
hledger-web/Hledger/Web/Import.hs
Normal file
@ -0,0 +1,31 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Hledger.Web.Import
|
||||
( module Import
|
||||
) where
|
||||
|
||||
import Prelude as Import hiding (head, init, last,
|
||||
readFile, tail, writeFile)
|
||||
import Yesod as Import hiding (Route (..))
|
||||
|
||||
import Control.Monad as Import
|
||||
import Data.Bifunctor as Import
|
||||
import Data.ByteString as Import (ByteString)
|
||||
import Data.Default as Import
|
||||
import Data.Either as Import
|
||||
import Data.Foldable as Import
|
||||
import Data.List as Import (unfoldr)
|
||||
import Data.Maybe as Import
|
||||
import Data.Text as Import (Text)
|
||||
import Data.Time as Import hiding (parseTime)
|
||||
import Data.Traversable as Import
|
||||
import Data.Void as Import (Void)
|
||||
import Text.Blaze as Import (Markup)
|
||||
|
||||
import Hledger.Web.Foundation as Import
|
||||
import Hledger.Web.Settings as Import
|
||||
import Hledger.Web.Settings.StaticFiles as Import
|
||||
import Hledger.Web.WebOptions as Import (Capability(..))
|
||||
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Monoid as Import ((<>))
|
||||
#endif
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE CPP, OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-|
|
||||
|
||||
hledger-web - a hledger add-on providing a web interface.
|
||||
@ -7,28 +8,26 @@ Released under GPL version 3 or later.
|
||||
|
||||
-}
|
||||
|
||||
module Hledger.Web.Main
|
||||
where
|
||||
module Hledger.Web.Main where
|
||||
|
||||
-- yesod scaffold imports
|
||||
import Yesod.Default.Config --(fromArgs)
|
||||
-- import Yesod.Default.Main (defaultMain)
|
||||
import Settings -- (parseExtra)
|
||||
import Application (makeApplication)
|
||||
import Data.String
|
||||
import Control.Monad (when)
|
||||
import Data.String (fromString)
|
||||
import qualified Data.Text as T
|
||||
import Network.Wai (Application)
|
||||
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setHost, setPort)
|
||||
import Network.Wai.Handler.Launch (runHostPortUrl)
|
||||
--
|
||||
import Control.Monad
|
||||
import Data.Text (pack)
|
||||
import Prelude hiding (putStrLn)
|
||||
import System.Exit (exitSuccess)
|
||||
import System.IO (hFlush, stdout)
|
||||
import Text.Printf
|
||||
import Prelude hiding (putStrLn)
|
||||
import Text.Printf (printf)
|
||||
import Yesod.Default.Config
|
||||
import Yesod.Default.Main (defaultDevelApp)
|
||||
|
||||
import Hledger
|
||||
import Hledger.Utils.UTF8IOCompat (putStrLn)
|
||||
import Hledger.Cli hiding (progname,prognameandversion)
|
||||
import Hledger.Utils.UTF8IOCompat (putStrLn)
|
||||
import Hledger.Web.Application (makeApplication)
|
||||
import Hledger.Web.Settings (Extra(..), parseExtra)
|
||||
import Hledger.Web.WebOptions
|
||||
|
||||
|
||||
@ -38,27 +37,34 @@ hledgerWebMain = do
|
||||
when (debug_ (cliopts_ opts) > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
|
||||
runWith opts
|
||||
|
||||
hledgerWebDev :: IO (Int, Application)
|
||||
hledgerWebDev =
|
||||
withJournalDoWeb defwebopts (\o j -> defaultDevelApp loader $ makeApplication o j)
|
||||
where
|
||||
loader =
|
||||
Yesod.Default.Config.loadConfig
|
||||
(configSettings Development) {csParseExtra = parseExtra}
|
||||
|
||||
runWith :: WebOpts -> IO ()
|
||||
runWith opts
|
||||
| "help" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess
|
||||
| "version" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
|
||||
| "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
|
||||
| otherwise = do
|
||||
requireJournalFileExists =<< (head `fmap` journalFilePathFromOpts (cliopts_ opts)) -- XXX head should be safe for now
|
||||
withJournalDoWeb opts web
|
||||
| "help" `inRawOpts` rawopts_ (cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess
|
||||
| "version" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
|
||||
| "binary-filename" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn (binaryfilename progname)
|
||||
| otherwise = withJournalDoWeb opts web
|
||||
|
||||
-- | A version of withJournalDo specialised for hledger-web.
|
||||
-- Disallows the special - file to avoid some bug,
|
||||
-- takes WebOpts rather than CliOpts.
|
||||
withJournalDoWeb :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO ()
|
||||
withJournalDoWeb :: WebOpts -> (WebOpts -> Journal -> IO a) -> IO a
|
||||
withJournalDoWeb opts@WebOpts {cliopts_ = copts} cmd = do
|
||||
journalpaths <- journalFilePathFromOpts copts
|
||||
|
||||
-- https://github.com/simonmichael/hledger/issues/202
|
||||
-- -f- gives [Error#yesod-core] <stdin>: hGetContents: illegal operation (handle is closed)
|
||||
-- Also we may try to write to this file. Just disallow -.
|
||||
when (head journalpaths == "-") $ -- always non-empty
|
||||
when ("-" `elem` journalpaths) $ -- always non-empty
|
||||
error' "hledger-web doesn't support -f -, please specify a file path"
|
||||
mapM_ requireJournalFileExists journalpaths
|
||||
|
||||
-- keep synced with withJournalDo TODO refactor
|
||||
readJournalFiles (inputopts_ copts) journalpaths
|
||||
@ -74,11 +80,11 @@ web opts j = do
|
||||
h = host_ opts
|
||||
p = port_ opts
|
||||
u = base_url_ opts
|
||||
staticRoot = pack <$> file_url_ opts
|
||||
staticRoot = T.pack <$> file_url_ opts
|
||||
appconfig = AppConfig{appEnv = Development
|
||||
,appHost = fromString h
|
||||
,appPort = p
|
||||
,appRoot = pack u
|
||||
,appRoot = T.pack u
|
||||
,appExtra = Extra "" Nothing staticRoot
|
||||
}
|
||||
app <- makeApplication opts j' appconfig
|
||||
@ -88,10 +94,7 @@ web opts j = do
|
||||
then do
|
||||
putStrLn "Press ctrl-c to quit"
|
||||
hFlush stdout
|
||||
let warpsettings =
|
||||
setHost (fromString h) $
|
||||
setPort p $
|
||||
defaultSettings
|
||||
let warpsettings = setHost (fromString h) (setPort p defaultSettings)
|
||||
Network.Wai.Handler.Warp.runSettings warpsettings app
|
||||
else do
|
||||
putStrLn "Starting web browser..."
|
||||
|
||||
@ -4,23 +4,34 @@
|
||||
-- In addition, you can configure a number of different aspects of Yesod
|
||||
-- by overriding methods in the Yesod typeclass. That instance is
|
||||
-- declared in the Foundation.hs file.
|
||||
module Settings where
|
||||
module Hledger.Web.Settings where
|
||||
|
||||
import Prelude
|
||||
import Text.Shakespeare.Text (st)
|
||||
import Language.Haskell.TH.Syntax
|
||||
import Yesod.Default.Config
|
||||
import Yesod.Default.Util
|
||||
import Data.Default (def)
|
||||
import Data.Semigroup ((<>))
|
||||
import Data.Text (Text)
|
||||
import Data.Yaml
|
||||
import Settings.Development
|
||||
import Data.Default (def)
|
||||
import Language.Haskell.TH.Syntax (Q, Exp)
|
||||
import Text.Hamlet
|
||||
import Text.Shakespeare.Text (st)
|
||||
import Yesod.Default.Config
|
||||
import Yesod.Default.Util
|
||||
|
||||
development :: Bool
|
||||
development =
|
||||
#if DEVELOPMENT
|
||||
True
|
||||
#else
|
||||
False
|
||||
#endif
|
||||
|
||||
hledgerorgurl, manualurl :: String
|
||||
hledgerorgurl = "http://hledger.org"
|
||||
manualurl = hledgerorgurl++"/manual"
|
||||
production :: Bool
|
||||
production = not development
|
||||
|
||||
hledgerorgurl :: Text
|
||||
hledgerorgurl = "http://hledger.org"
|
||||
|
||||
manualurl :: Text
|
||||
manualurl = hledgerorgurl <> "/manual"
|
||||
|
||||
-- | The default IP address to listen on. May be overridden with --host.
|
||||
defhost :: String
|
||||
@ -1,12 +1,10 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Settings.StaticFiles where
|
||||
module Hledger.Web.Settings.StaticFiles where
|
||||
|
||||
import Prelude (IO, putStrLn, (++), (>>), return)
|
||||
import System.IO (stdout, hFlush)
|
||||
import Yesod.Static
|
||||
import qualified Yesod.Static as Static
|
||||
import Settings (staticDir)
|
||||
import Settings.Development
|
||||
import Yesod.Static (Static, embed, publicFiles, staticDevel)
|
||||
|
||||
import Hledger.Web.Settings (staticDir, development)
|
||||
|
||||
-- | use this to create your static file serving site
|
||||
-- staticSite :: IO Static.Static
|
||||
@ -20,14 +18,14 @@ import Settings.Development
|
||||
-- $(staticFiles Settings.staticDir)
|
||||
|
||||
|
||||
staticSite :: IO Static.Static
|
||||
staticSite :: IO Static
|
||||
staticSite =
|
||||
if development
|
||||
then (do
|
||||
putStrLn ("Using web files from: " ++ staticDir ++ "/") >> hFlush stdout
|
||||
Static.staticDevel staticDir)
|
||||
staticDevel staticDir)
|
||||
else (do
|
||||
-- putStrLn "Using built-in web files" >> hFlush stdout
|
||||
return $(Static.embed staticDir))
|
||||
return $(embed staticDir))
|
||||
|
||||
$(publicFiles staticDir)
|
||||
@ -1,13 +1,19 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Hledger.Web.WebOptions
|
||||
where
|
||||
import Prelude
|
||||
import Data.Default
|
||||
import Data.Maybe
|
||||
import System.Environment
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Hledger.Web.WebOptions where
|
||||
|
||||
import Hledger.Cli hiding (progname,version,prognameandversion)
|
||||
import Settings
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.CaseInsensitive (CI, mk)
|
||||
import Control.Monad (join)
|
||||
import Data.Default (Default(def))
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text (Text)
|
||||
import System.Environment (getArgs)
|
||||
|
||||
import Hledger.Cli hiding (progname, version)
|
||||
import Hledger.Web.Settings (defhost, defport, defbaseurl)
|
||||
|
||||
progname, version :: String
|
||||
progname = "hledger-web"
|
||||
@ -19,81 +25,137 @@ version = ""
|
||||
prognameandversion :: String
|
||||
prognameandversion = progname ++ " " ++ version :: String
|
||||
|
||||
webflags :: [Flag [([Char], [Char])]]
|
||||
webflags = [
|
||||
flagNone ["serve","server"] (setboolopt "serve") ("serve and log requests, don't browse or auto-exit")
|
||||
,flagReq ["host"] (\s opts -> Right $ setopt "host" s opts) "IPADDR" ("listen on this IP address (default: "++defhost++")")
|
||||
,flagReq ["port"] (\s opts -> Right $ setopt "port" s opts) "PORT" ("listen on this TCP port (default: "++show defport++")")
|
||||
,flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "BASEURL" ("set the base url (default: http://IPADDR:PORT)")
|
||||
,flagReq ["file-url"] (\s opts -> Right $ setopt "file-url" s opts) "FILEURL" ("set the static files url (default: BASEURL/static)")
|
||||
]
|
||||
webflags :: [Flag [(String, String)]]
|
||||
webflags =
|
||||
[ flagNone
|
||||
["serve", "server"]
|
||||
(setboolopt "serve")
|
||||
"serve and log requests, don't browse or auto-exit"
|
||||
, flagReq
|
||||
["host"]
|
||||
(\s opts -> Right $ setopt "host" s opts)
|
||||
"IPADDR"
|
||||
("listen on this IP address (default: " ++ defhost ++ ")")
|
||||
, flagReq
|
||||
["port"]
|
||||
(\s opts -> Right $ setopt "port" s opts)
|
||||
"PORT"
|
||||
("listen on this TCP port (default: " ++ show defport ++ ")")
|
||||
, flagReq
|
||||
["base-url"]
|
||||
(\s opts -> Right $ setopt "base-url" s opts)
|
||||
"BASEURL"
|
||||
"set the base url (default: http://IPADDR:PORT)"
|
||||
, flagReq
|
||||
["file-url"]
|
||||
(\s opts -> Right $ setopt "file-url" s opts)
|
||||
"FILEURL"
|
||||
"set the static files url (default: BASEURL/static)"
|
||||
, flagReq
|
||||
["capabilities"]
|
||||
(\s opts -> Right $ setopt "capabilities" s opts)
|
||||
"CAP,CAP2"
|
||||
"enable these capabilities - comma-separated, possible values are: view, add, manage (default: view,add)"
|
||||
, flagReq
|
||||
["capabilities-header"]
|
||||
(\s opts -> Right $ setopt "capabilities-header" s opts)
|
||||
"HEADER"
|
||||
"read enabled capabilities from a HTTP header (e.g. X-Sandstorm-Permissions, disabled by default)"
|
||||
]
|
||||
|
||||
webmode :: Mode [([Char], [Char])]
|
||||
webmode = (mode "hledger-web" [("command","web")]
|
||||
"start serving the hledger web interface"
|
||||
(argsFlag "[PATTERNS]") []){
|
||||
modeGroupFlags = Group {
|
||||
groupUnnamed = webflags
|
||||
,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"]
|
||||
,groupNamed = [generalflagsgroup1]
|
||||
}
|
||||
,modeHelpSuffix=[
|
||||
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
|
||||
]
|
||||
}
|
||||
webmode :: Mode [(String, String)]
|
||||
webmode =
|
||||
(mode
|
||||
"hledger-web"
|
||||
[("command", "web")]
|
||||
"start serving the hledger web interface"
|
||||
(argsFlag "[PATTERNS]")
|
||||
[])
|
||||
{ modeGroupFlags =
|
||||
Group
|
||||
{ groupUnnamed = webflags
|
||||
, groupHidden =
|
||||
[ flagNone
|
||||
["binary-filename"]
|
||||
(setboolopt "binary-filename")
|
||||
"show the download filename for this executable, and exit"
|
||||
]
|
||||
, groupNamed = [generalflagsgroup1]
|
||||
}
|
||||
, modeHelpSuffix = []
|
||||
}
|
||||
|
||||
-- hledger-web options, used in hledger-web and above
|
||||
data WebOpts = WebOpts {
|
||||
serve_ :: Bool
|
||||
,host_ :: String
|
||||
,port_ :: Int
|
||||
,base_url_ :: String
|
||||
,file_url_ :: Maybe String
|
||||
,cliopts_ :: CliOpts
|
||||
} deriving (Show)
|
||||
data WebOpts = WebOpts
|
||||
{ serve_ :: Bool
|
||||
, host_ :: String
|
||||
, port_ :: Int
|
||||
, base_url_ :: String
|
||||
, file_url_ :: Maybe String
|
||||
, capabilities_ :: [Capability]
|
||||
, capabilitiesHeader_ :: Maybe (CI ByteString)
|
||||
, cliopts_ :: CliOpts
|
||||
} deriving (Show)
|
||||
|
||||
defwebopts :: WebOpts
|
||||
defwebopts = WebOpts
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
def
|
||||
defwebopts = WebOpts def def def def def [CapView, CapAdd] Nothing def
|
||||
|
||||
-- instance Default WebOpts where def = defwebopts
|
||||
instance Default WebOpts where def = defwebopts
|
||||
|
||||
rawOptsToWebOpts :: RawOpts -> IO WebOpts
|
||||
rawOptsToWebOpts rawopts = checkWebOpts <$> do
|
||||
cliopts <- rawOptsToCliOpts rawopts
|
||||
let
|
||||
h = fromMaybe defhost $ maybestringopt "host" rawopts
|
||||
p = fromMaybe defport $ maybeintopt "port" rawopts
|
||||
b = maybe (defbaseurl h p) stripTrailingSlash $ maybestringopt "base-url" rawopts
|
||||
return defwebopts {
|
||||
serve_ = boolopt "serve" rawopts
|
||||
,host_ = h
|
||||
,port_ = p
|
||||
,base_url_ = b
|
||||
,file_url_ = stripTrailingSlash <$> maybestringopt "file-url" rawopts
|
||||
,cliopts_ = cliopts
|
||||
}
|
||||
rawOptsToWebOpts rawopts =
|
||||
checkWebOpts <$> do
|
||||
cliopts <- rawOptsToCliOpts rawopts
|
||||
let h = fromMaybe defhost $ maybestringopt "host" rawopts
|
||||
p = fromMaybe defport $ maybeintopt "port" rawopts
|
||||
b =
|
||||
maybe (defbaseurl h p) stripTrailingSlash $
|
||||
maybestringopt "base-url" rawopts
|
||||
caps' = join $ T.splitOn "," . T.pack <$> listofstringopt "capabilities" rawopts
|
||||
caps = case traverse capabilityFromText caps' of
|
||||
Left e -> error' ("Unknown capability: " ++ T.unpack e)
|
||||
Right [] -> [CapView, CapAdd]
|
||||
Right xs -> xs
|
||||
return
|
||||
defwebopts
|
||||
{ serve_ = boolopt "serve" rawopts
|
||||
, host_ = h
|
||||
, port_ = p
|
||||
, base_url_ = b
|
||||
, file_url_ = stripTrailingSlash <$> maybestringopt "file-url" rawopts
|
||||
, capabilities_ = caps
|
||||
, capabilitiesHeader_ = mk . BC.pack <$> maybestringopt "capabilities-header" rawopts
|
||||
, cliopts_ = cliopts
|
||||
}
|
||||
where
|
||||
stripTrailingSlash = reverse . dropWhile (=='/') . reverse -- yesod don't like it
|
||||
stripTrailingSlash = reverse . dropWhile (== '/') . reverse -- yesod don't like it
|
||||
|
||||
checkWebOpts :: WebOpts -> WebOpts
|
||||
checkWebOpts wopts =
|
||||
either usageError (const wopts) $ do
|
||||
let h = host_ wopts
|
||||
if any (not . (`elem` ".0123456789")) h
|
||||
then Left $ "--host requires an IP address, not "++show h
|
||||
else Right ()
|
||||
checkWebOpts wopts = do
|
||||
let h = host_ wopts
|
||||
if any (`notElem` (".0123456789" :: String)) h
|
||||
then usageError $ "--host requires an IP address, not " ++ show h
|
||||
else wopts
|
||||
|
||||
getHledgerWebOpts :: IO WebOpts
|
||||
--getHledgerWebOpts = processArgs webmode >>= return . decodeRawOpts >>= rawOptsToWebOpts
|
||||
getHledgerWebOpts = do
|
||||
args <- getArgs >>= expandArgsAt
|
||||
let args' = replaceNumericFlags args
|
||||
let cmdargopts = either usageError id $ process webmode args'
|
||||
rawOptsToWebOpts $ decodeRawOpts cmdargopts
|
||||
args <- fmap replaceNumericFlags . expandArgsAt =<< getArgs
|
||||
rawOptsToWebOpts . decodeRawOpts . either usageError id $ process webmode args
|
||||
|
||||
data Capability
|
||||
= CapView
|
||||
| CapAdd
|
||||
| CapManage
|
||||
deriving (Eq, Ord, Bounded, Enum, Show)
|
||||
|
||||
capabilityFromText :: Text -> Either Text Capability
|
||||
capabilityFromText "view" = Right CapView
|
||||
capabilityFromText "add" = Right CapAdd
|
||||
capabilityFromText "manage" = Right CapManage
|
||||
capabilityFromText x = Left x
|
||||
|
||||
capabilityFromBS :: ByteString -> Either ByteString Capability
|
||||
capabilityFromBS "view" = Right CapView
|
||||
capabilityFromBS "add" = Right CapAdd
|
||||
capabilityFromBS "manage" = Right CapManage
|
||||
capabilityFromBS x = Left x
|
||||
|
||||
144
hledger-web/Hledger/Web/Widget/AddForm.hs
Normal file
144
hledger-web/Hledger/Web/Widget/AddForm.hs
Normal file
@ -0,0 +1,144 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Web.Widget.AddForm
|
||||
( addForm
|
||||
, addModal
|
||||
) where
|
||||
|
||||
import Control.Monad.State.Strict (evalStateT)
|
||||
import Data.Bifunctor (first)
|
||||
import Data.List (dropWhileEnd, nub, sort, unfoldr)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Semigroup ((<>))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time (Day)
|
||||
import Text.Blaze.Internal (Markup, preEscapedString)
|
||||
import Text.JSON
|
||||
import Text.Megaparsec (eof, parseErrorPretty, runParser)
|
||||
import Yesod
|
||||
|
||||
import Hledger
|
||||
import Hledger.Web.Settings (widgetFile)
|
||||
|
||||
addModal ::
|
||||
( MonadWidget m
|
||||
, r ~ Route (HandlerSite m)
|
||||
#if MIN_VERSION_yesod(1,6,0)
|
||||
, m ~ WidgetFor (HandlerSite m)
|
||||
#else
|
||||
, m ~ WidgetT (HandlerSite m) IO
|
||||
#endif
|
||||
, RenderMessage (HandlerSite m) FormMessage
|
||||
)
|
||||
=> r -> Journal -> Day -> m ()
|
||||
addModal addR j today = do
|
||||
(addView, addEnctype) <- generateFormPost (addForm j today)
|
||||
[whamlet|
|
||||
<div .modal #addmodal tabindex="-1" role="dialog" aria-labelledby="addLabel" aria-hidden="true">
|
||||
<div .modal-dialog .modal-lg>
|
||||
<div .modal-content>
|
||||
<div .modal-header>
|
||||
<button type="button" .close data-dismiss="modal" aria-hidden="true">×
|
||||
<h3 .modal-title #addLabel>Add a transaction
|
||||
<div .modal-body>
|
||||
<form#addform.form action=@{addR} method=POST enctype=#{addEnctype}>
|
||||
^{addView}
|
||||
|]
|
||||
|
||||
addForm ::
|
||||
(site ~ HandlerSite m, RenderMessage site FormMessage, MonadHandler m)
|
||||
=> Journal
|
||||
-> Day
|
||||
-> Markup
|
||||
#if MIN_VERSION_yesod(1,6,0)
|
||||
-> MForm m (FormResult Transaction, WidgetFor site ())
|
||||
#else
|
||||
-> MForm m (FormResult Transaction, WidgetT site IO ())
|
||||
#endif
|
||||
addForm j today = identifyForm "add" $ \extra -> do
|
||||
(dateRes, dateView) <- mreq dateField dateFS Nothing
|
||||
(descRes, descView) <- mreq textField descFS Nothing
|
||||
(acctRes, _) <- mreq listField acctFS Nothing
|
||||
(amtRes, _) <- mreq listField amtFS Nothing
|
||||
|
||||
let (msgs', postRes) = case validatePostings <$> acctRes <*> amtRes of
|
||||
FormSuccess (Left es) -> (es, FormFailure ["Postings validation failed"])
|
||||
FormSuccess (Right xs) -> ([], FormSuccess xs)
|
||||
FormMissing -> ([], FormMissing)
|
||||
FormFailure es -> ([], FormFailure es)
|
||||
msgs = zip [(1 :: Int)..] $ msgs' ++ replicate (4 - length msgs') ("", "", Nothing, Nothing)
|
||||
|
||||
let descriptions = sort $ nub $ tdescription <$> jtxns j
|
||||
escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>" -- #236
|
||||
listToJsonValueObjArrayStr = preEscapedString . escapeJSSpecialChars .
|
||||
encode . JSArray . fmap (\a -> JSObject $ toJSObject [("value", showJSON a)])
|
||||
journals = fst <$> jfiles j
|
||||
|
||||
pure (makeTransaction <$> dateRes <*> descRes <*> postRes, $(widgetFile "add-form"))
|
||||
where
|
||||
makeTransaction date desc postings =
|
||||
nulltransaction {tdate = date, tdescription = desc, tpostings = postings}
|
||||
|
||||
dateFS = FieldSettings "date" Nothing Nothing (Just "date")
|
||||
[("class", "form-control input-lg"), ("placeholder", "Date")]
|
||||
descFS = FieldSettings "desc" Nothing Nothing (Just "description")
|
||||
[("class", "form-control input-lg typeahead"), ("placeholder", "Description"), ("size", "40")]
|
||||
acctFS = FieldSettings "amount" Nothing Nothing (Just "account") []
|
||||
amtFS = FieldSettings "amount" Nothing Nothing (Just "amount") []
|
||||
dateField = checkMMap (pure . validateDate) (T.pack . show) textField
|
||||
validateDate s =
|
||||
first (const ("Invalid date format" :: Text)) $
|
||||
fixSmartDateStrEither' today (T.strip s)
|
||||
|
||||
listField = Field
|
||||
{ fieldParse = const . pure . Right . Just . dropWhileEnd T.null
|
||||
, fieldView = error "Don't render using this!"
|
||||
, fieldEnctype = UrlEncoded
|
||||
}
|
||||
|
||||
validatePostings :: [Text] -> [Text] -> Either [(Text, Text, Maybe Text, Maybe Text)] [Posting]
|
||||
validatePostings a b =
|
||||
case traverse id $ (\(_, _, x) -> x) <$> postings of
|
||||
Left _ -> Left $ foldr catPostings [] postings
|
||||
Right [] -> Left
|
||||
[ ("", "", Just "Missing account", Just "Missing amount")
|
||||
, ("", "", Just "Missing account", Nothing)
|
||||
]
|
||||
Right [p] -> Left
|
||||
[ (paccount p, T.pack . showMixedAmountWithoutPrice $ pamount p, Nothing, Nothing)
|
||||
, ("", "", Just "Missing account", Nothing)
|
||||
]
|
||||
Right xs -> Right xs
|
||||
where
|
||||
postings = unfoldr go (True, a, b)
|
||||
|
||||
go (_, x:xs, y:ys) = Just ((x, y, zipPosting (validateAccount x) (validateAmount y)), (True, xs, ys))
|
||||
go (True, x:y:xs, []) = Just ((x, "", zipPosting (validateAccount x) (Left "Missing amount")), (True, y:xs, []))
|
||||
go (True, x:xs, []) = Just ((x, "", zipPosting (validateAccount x) (Right missingamt)), (False, xs, []))
|
||||
go (False, x:xs, []) = Just ((x, "", zipPosting (validateAccount x) (Left "Missing amount")), (False, xs, []))
|
||||
go (_, [], y:ys) = Just (("", y, zipPosting (Left "Missing account") (validateAmount y)), (False, [], ys))
|
||||
go (_, [], []) = Nothing
|
||||
|
||||
zipPosting = zipEither (\acc amt -> nullposting {paccount = acc, pamount = Mixed [amt]})
|
||||
|
||||
catPostings (t, t', Left (e, e')) xs = (t, t', e, e') : xs
|
||||
catPostings (t, t', Right _) xs = (t, t', Nothing, Nothing) : xs
|
||||
|
||||
errorToFormMsg = first (("Invalid value: " <>) . T.pack . parseErrorPretty)
|
||||
validateAccount = errorToFormMsg . runParser (accountnamep <* eof) "" . T.strip
|
||||
validateAmount = errorToFormMsg . runParser (evalStateT (amountp <* eof) mempty) "" . T.strip
|
||||
|
||||
-- Modification of Align, from the `these` package
|
||||
zipEither :: (a -> a' -> r) -> Either e a -> Either e' a' -> Either (Maybe e, Maybe e') r
|
||||
zipEither f a b = case (a, b) of
|
||||
(Right a', Right b') -> Right (f a' b')
|
||||
(Left a', Right _) -> Left (Just a', Nothing)
|
||||
(Right _, Left b') -> Left (Nothing, Just b')
|
||||
(Left a', Left b') -> Left (Just a', Just b')
|
||||
89
hledger-web/Hledger/Web/Widget/Common.hs
Normal file
89
hledger-web/Hledger/Web/Widget/Common.hs
Normal file
@ -0,0 +1,89 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Web.Widget.Common
|
||||
( accountQuery
|
||||
, accountOnlyQuery
|
||||
, balanceReportAsHtml
|
||||
, helplink
|
||||
, mixedAmountAsHtml
|
||||
, fromFormSuccess
|
||||
, writeValidJournal
|
||||
, journalFile404
|
||||
) where
|
||||
|
||||
import Data.Default (def)
|
||||
import Data.Foldable (find, for_)
|
||||
import Data.Semigroup ((<>))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import System.FilePath (takeFileName)
|
||||
import Text.Blaze ((!), textValue)
|
||||
import qualified Text.Blaze.Html5 as H
|
||||
import qualified Text.Blaze.Html5.Attributes as A
|
||||
import Text.Blaze.Internal (preEscapedString)
|
||||
import Text.Hamlet (hamletFile)
|
||||
import Yesod
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.Utils (writeFileWithBackupIfChanged)
|
||||
import Hledger.Web.Settings (manualurl)
|
||||
|
||||
#if MIN_VERSION_yesod(1,6,0)
|
||||
journalFile404 :: FilePath -> Journal -> HandlerFor m (FilePath, Text)
|
||||
#else
|
||||
journalFile404 :: FilePath -> Journal -> HandlerT m IO (FilePath, Text)
|
||||
#endif
|
||||
journalFile404 f j =
|
||||
case find ((== f) . fst) (jfiles j) of
|
||||
Just (_, txt) -> pure (takeFileName f, txt)
|
||||
Nothing -> notFound
|
||||
|
||||
fromFormSuccess :: Applicative m => m a -> FormResult a -> m a
|
||||
fromFormSuccess h FormMissing = h
|
||||
fromFormSuccess h (FormFailure _) = h
|
||||
fromFormSuccess _ (FormSuccess a) = pure a
|
||||
|
||||
writeValidJournal :: MonadHandler m => FilePath -> Text -> m (Either String ())
|
||||
writeValidJournal f txt =
|
||||
liftIO (readJournal def (Just f) txt) >>= \case
|
||||
Left e -> return (Left e)
|
||||
Right _ -> do
|
||||
_ <- liftIO (writeFileWithBackupIfChanged f txt)
|
||||
return (Right ())
|
||||
|
||||
|
||||
-- | Link to a topic in the manual.
|
||||
helplink :: Text -> Text -> HtmlUrl r
|
||||
helplink topic label _ = H.a ! A.href u ! A.target "hledgerhelp" $ toHtml label
|
||||
where u = textValue $ manualurl <> if T.null topic then "" else T.cons '#' topic
|
||||
|
||||
-- | Render a "BalanceReport" as html.
|
||||
balanceReportAsHtml :: Eq r => (r, r) -> r -> Bool -> Journal -> [QueryOpt] -> BalanceReport -> HtmlUrl r
|
||||
balanceReportAsHtml (journalR, registerR) here hideEmpty j qopts (items, total) =
|
||||
$(hamletFile "templates/balance-report.hamlet")
|
||||
where
|
||||
l = ledgerFromJournal Any j
|
||||
indent a = preEscapedString $ concat $ replicate (2 + 2 * a) " "
|
||||
hasSubAccounts acct = maybe True (not . null . asubs) (ledgerAccount l acct)
|
||||
matchesAcctSelector acct = Just True == ((`matchesAccount` acct) <$> inAccountQuery qopts)
|
||||
|
||||
accountQuery :: AccountName -> Text
|
||||
accountQuery = ("inacct:" <>) . quoteIfSpaced
|
||||
|
||||
accountOnlyQuery :: AccountName -> Text
|
||||
accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
|
||||
|
||||
mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
|
||||
mixedAmountAsHtml b _ =
|
||||
for_ (lines (showMixedAmountWithoutPrice b)) $ \t -> do
|
||||
H.span ! A.class_ c $ toHtml t
|
||||
H.br
|
||||
where
|
||||
c = case isNegativeMixedAmount b of
|
||||
Just True -> "negative amount"
|
||||
_ -> "positive amount"
|
||||
@ -1,19 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Import
|
||||
( module Import
|
||||
) where
|
||||
|
||||
import Prelude as Import hiding (head, init, last,
|
||||
readFile, tail, writeFile)
|
||||
import Yesod as Import hiding (Route (..))
|
||||
|
||||
import Data.Text as Import (Text)
|
||||
|
||||
import Foundation as Import
|
||||
import Settings as Import
|
||||
import Settings.Development as Import
|
||||
import Settings.StaticFiles as Import
|
||||
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Monoid as Import ((<>))
|
||||
#endif
|
||||
@ -1,15 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Settings.Development where
|
||||
|
||||
import Prelude
|
||||
|
||||
development :: Bool
|
||||
development =
|
||||
#if DEVELOPMENT
|
||||
True
|
||||
#else
|
||||
False
|
||||
#endif
|
||||
|
||||
production :: Bool
|
||||
production = not development
|
||||
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
import "hledger-web" Application (getApplicationDev)
|
||||
import "hledger-web" Hledger.Web.Main (hledgerWebDev)
|
||||
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort)
|
||||
import Control.Concurrent (forkIO)
|
||||
import System.Directory (doesFileExist, removeFile)
|
||||
@ -9,7 +9,7 @@ import Control.Concurrent (threadDelay)
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "Starting devel application"
|
||||
(port, app) <- getApplicationDev
|
||||
(port, app) <- hledgerWebDev
|
||||
forkIO $ runSettings (setPort port defaultSettings) app
|
||||
loop
|
||||
|
||||
@ -1,10 +1,13 @@
|
||||
/favicon.ico FaviconR GET
|
||||
/robots.txt RobotsR GET
|
||||
/static StaticR Static getStatic
|
||||
/ RootR GET
|
||||
/journal JournalR GET POST
|
||||
/register RegisterR GET POST
|
||||
/sidebar SidebarR GET
|
||||
|
||||
-- /accounts AccountsR GET
|
||||
-- /api/accounts AccountsJsonR GET
|
||||
/ RootR GET
|
||||
/journal JournalR GET
|
||||
/register RegisterR GET
|
||||
/add AddR GET POST
|
||||
|
||||
/manage ManageR GET
|
||||
/edit/#FilePath EditR GET POST
|
||||
/upload/#FilePath UploadR GET POST
|
||||
/download/#FilePath DownloadR GET
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: f9b958b9292d00ff739999dbd9f5a467b38eac93caa7d16950e03c4c15737b4c
|
||||
-- hash: f95975f3e5a52d5f6d87d3a8fbb3feb0b74e14c550820bb276de675d990010f2
|
||||
|
||||
name: hledger-web
|
||||
version: 1.9.99
|
||||
@ -38,7 +38,6 @@ extra-source-files:
|
||||
hledger-web.1
|
||||
hledger-web.info
|
||||
hledger-web.txt
|
||||
messages/en.msg
|
||||
README
|
||||
static/css/bootstrap-datepicker.standalone.min.css
|
||||
static/css/bootstrap-theme.css
|
||||
@ -97,8 +96,16 @@ extra-source-files:
|
||||
static/js/jquery.url.js
|
||||
static/js/typeahead.bundle.js
|
||||
static/js/typeahead.bundle.min.js
|
||||
templates/add-form.hamlet
|
||||
templates/balance-report.hamlet
|
||||
templates/chart.hamlet
|
||||
templates/default-layout-wrapper.hamlet
|
||||
templates/default-layout.hamlet
|
||||
templates/edit-form.hamlet
|
||||
templates/journal.hamlet
|
||||
templates/manage.hamlet
|
||||
templates/register.hamlet
|
||||
templates/upload-form.hamlet
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@ -120,36 +127,39 @@ flag threaded
|
||||
default: True
|
||||
|
||||
library
|
||||
hs-source-dirs:
|
||||
./.
|
||||
exposed-modules:
|
||||
Application
|
||||
Foundation
|
||||
Handler.AddForm
|
||||
Handler.Common
|
||||
Handler.JournalR
|
||||
Handler.RegisterR
|
||||
Handler.RootR
|
||||
Handler.SidebarR
|
||||
Handler.Utils
|
||||
Hledger.Web
|
||||
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.RegisterR
|
||||
Hledger.Web.Handler.UploadR
|
||||
Hledger.Web.Import
|
||||
Hledger.Web.Main
|
||||
Hledger.Web.Settings
|
||||
Hledger.Web.Settings.StaticFiles
|
||||
Hledger.Web.WebOptions
|
||||
Import
|
||||
Settings
|
||||
Settings.Development
|
||||
Settings.StaticFiles
|
||||
Hledger.Web.Widget.AddForm
|
||||
Hledger.Web.Widget.Common
|
||||
other-modules:
|
||||
Paths_hledger_web
|
||||
ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans
|
||||
ghc-options: -Wall -fwarn-tabs
|
||||
cpp-options: -DVERSION="1.9.99"
|
||||
build-depends:
|
||||
HUnit
|
||||
, base >=4.8 && <4.12
|
||||
, base-compat-batteries >=0.10.1 && <0.11
|
||||
, blaze-html
|
||||
, blaze-markup
|
||||
, bytestring
|
||||
, case-insensitive
|
||||
, clientsession
|
||||
, cmdargs >=0.10
|
||||
, conduit
|
||||
, conduit-extra >=1.1
|
||||
, data-default
|
||||
, directory
|
||||
@ -162,8 +172,7 @@ library
|
||||
, json
|
||||
, megaparsec >=6.4.1
|
||||
, mtl
|
||||
, parsec >=3
|
||||
, safe >=0.2
|
||||
, semigroups
|
||||
, shakespeare >=2.0.2.2
|
||||
, template-haskell
|
||||
, text >=1.2
|
||||
@ -178,10 +187,8 @@ library
|
||||
, yesod-core >=1.4 && <1.7
|
||||
, yesod-form >=1.4 && <1.7
|
||||
, yesod-static >=1.4 && <1.7
|
||||
if (flag(dev)) || (flag(library-only))
|
||||
cpp-options: -DDEVELOPMENT
|
||||
if flag(dev)
|
||||
ghc-options: -O0
|
||||
if impl(ghc >=8)
|
||||
ghc-options: -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints
|
||||
default-language: Haskell2010
|
||||
|
||||
executable hledger-web
|
||||
@ -190,50 +197,13 @@ executable hledger-web
|
||||
Paths_hledger_web
|
||||
hs-source-dirs:
|
||||
app
|
||||
ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans
|
||||
ghc-options: -Wall -fwarn-tabs
|
||||
cpp-options: -DVERSION="1.9.99"
|
||||
build-depends:
|
||||
HUnit
|
||||
, base >=4.8 && <4.12
|
||||
, base-compat-batteries >=0.10.1 && <0.11
|
||||
, blaze-html
|
||||
, blaze-markup
|
||||
, bytestring
|
||||
, clientsession
|
||||
, cmdargs >=0.10
|
||||
, conduit-extra >=1.1
|
||||
, data-default
|
||||
, directory
|
||||
, filepath
|
||||
, hjsmin
|
||||
, hledger >=1.9.99 && <2.0
|
||||
, hledger-lib >=1.9.99 && <2.0
|
||||
base
|
||||
, hledger-web
|
||||
, http-client
|
||||
, http-conduit
|
||||
, json
|
||||
, megaparsec >=6.4.1
|
||||
, mtl
|
||||
, parsec >=3
|
||||
, safe >=0.2
|
||||
, shakespeare >=2.0.2.2
|
||||
, template-haskell
|
||||
, text >=1.2
|
||||
, time >=1.5
|
||||
, transformers
|
||||
, wai
|
||||
, wai-extra
|
||||
, wai-handler-launch >=1.3
|
||||
, warp
|
||||
, yaml
|
||||
, yesod >=1.4 && <1.7
|
||||
, yesod-core >=1.4 && <1.7
|
||||
, yesod-form >=1.4 && <1.7
|
||||
, yesod-static >=1.4 && <1.7
|
||||
if (flag(dev)) || (flag(library-only))
|
||||
cpp-options: -DDEVELOPMENT
|
||||
if flag(dev)
|
||||
ghc-options: -O0
|
||||
if impl(ghc >=8)
|
||||
ghc-options: -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints
|
||||
if flag(library-only)
|
||||
buildable: False
|
||||
if flag(threaded)
|
||||
@ -249,50 +219,13 @@ test-suite test
|
||||
Paths_hledger_web
|
||||
hs-source-dirs:
|
||||
tests
|
||||
ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans
|
||||
ghc-options: -Wall -fwarn-tabs
|
||||
cpp-options: -DVERSION="1.9.99"
|
||||
build-depends:
|
||||
HUnit
|
||||
, base >=4.8 && <4.12
|
||||
, base-compat-batteries >=0.10.1 && <0.11
|
||||
, blaze-html
|
||||
, blaze-markup
|
||||
, bytestring
|
||||
, clientsession
|
||||
, cmdargs >=0.10
|
||||
, conduit-extra >=1.1
|
||||
, data-default
|
||||
, directory
|
||||
, filepath
|
||||
, hjsmin
|
||||
, hledger >=1.9.99 && <2.0
|
||||
, hledger-lib >=1.9.99 && <2.0
|
||||
base
|
||||
, hledger-web
|
||||
, hspec
|
||||
, http-client
|
||||
, http-conduit
|
||||
, json
|
||||
, megaparsec >=6.4.1
|
||||
, mtl
|
||||
, parsec >=3
|
||||
, safe >=0.2
|
||||
, shakespeare >=2.0.2.2
|
||||
, template-haskell
|
||||
, text >=1.2
|
||||
, time >=1.5
|
||||
, transformers
|
||||
, wai
|
||||
, wai-extra
|
||||
, wai-handler-launch >=1.3
|
||||
, warp
|
||||
, yaml
|
||||
, yesod >=1.4 && <1.7
|
||||
, yesod-core >=1.4 && <1.7
|
||||
, yesod-form >=1.4 && <1.7
|
||||
, yesod-static >=1.4 && <1.7
|
||||
, yesod-test
|
||||
if (flag(dev)) || (flag(library-only))
|
||||
cpp-options: -DDEVELOPMENT
|
||||
if flag(dev)
|
||||
ghc-options: -O0
|
||||
if impl(ghc >=8)
|
||||
ghc-options: -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints
|
||||
default-language: Haskell2010
|
||||
|
||||
@ -1 +0,0 @@
|
||||
Hello: Hello
|
||||
@ -30,7 +30,6 @@ extra-source-files:
|
||||
- config/robots.txt
|
||||
- config/routes
|
||||
- config/settings.yml
|
||||
- messages/*.msg
|
||||
- static/css/*.css
|
||||
- static/css/*.map
|
||||
- static/fonts/*.eot
|
||||
@ -45,8 +44,6 @@ extra-source-files:
|
||||
- hledger-web.txt
|
||||
- hledger-web.info
|
||||
|
||||
#data-files:
|
||||
|
||||
flags:
|
||||
library-only:
|
||||
description: Build for use with "yesod devel"
|
||||
@ -61,44 +58,6 @@ flags:
|
||||
manual: false
|
||||
default: true
|
||||
|
||||
dependencies:
|
||||
- hledger-lib >=1.9.99 && <2.0
|
||||
- hledger >=1.9.99 && <2.0
|
||||
- base >=4.8 && <4.12
|
||||
- base-compat-batteries >=0.10.1 && <0.11
|
||||
- blaze-html
|
||||
- blaze-markup
|
||||
- bytestring
|
||||
- clientsession
|
||||
- cmdargs >=0.10
|
||||
- data-default
|
||||
- directory
|
||||
- filepath
|
||||
- hjsmin
|
||||
- http-conduit
|
||||
- http-client
|
||||
- HUnit
|
||||
- conduit-extra >=1.1
|
||||
- safe >=0.2
|
||||
- shakespeare >=2.0.2.2
|
||||
- template-haskell
|
||||
- text >=1.2
|
||||
- time >=1.5
|
||||
- transformers
|
||||
- wai
|
||||
- wai-extra
|
||||
- wai-handler-launch >=1.3
|
||||
- warp
|
||||
- yaml
|
||||
- yesod >=1.4 && < 1.7
|
||||
- yesod-core >=1.4 && < 1.7
|
||||
- yesod-form >=1.4 && < 1.7
|
||||
- yesod-static >=1.4 && < 1.7
|
||||
- json
|
||||
- megaparsec >=6.4.1
|
||||
- mtl
|
||||
- parsec >=3
|
||||
|
||||
when:
|
||||
- condition: (flag(dev)) || (flag(library-only))
|
||||
cpp-options: -DDEVELOPMENT
|
||||
@ -107,31 +66,72 @@ when:
|
||||
|
||||
ghc-options:
|
||||
- -Wall
|
||||
- -fno-warn-unused-do-bind
|
||||
- -fno-warn-name-shadowing
|
||||
- -fno-warn-missing-signatures
|
||||
- -fno-warn-type-defaults
|
||||
- -fno-warn-orphans
|
||||
- -fwarn-tabs
|
||||
when:
|
||||
- condition: impl(ghc >=8)
|
||||
ghc-options:
|
||||
- -Wcompat
|
||||
- -Wincomplete-uni-patterns
|
||||
- -Wincomplete-record-updates
|
||||
- -Wredundant-constraints
|
||||
|
||||
library:
|
||||
source-dirs: .
|
||||
cpp-options: -DVERSION="1.9.99"
|
||||
exposed-modules:
|
||||
- Application
|
||||
- Foundation
|
||||
- Handler.AddForm
|
||||
- Handler.Common
|
||||
- Handler.JournalR
|
||||
- Handler.RegisterR
|
||||
- Handler.RootR
|
||||
- Handler.SidebarR
|
||||
- Handler.Utils
|
||||
- Hledger.Web
|
||||
- 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.RegisterR
|
||||
- Hledger.Web.Handler.UploadR
|
||||
- Hledger.Web.Import
|
||||
- Hledger.Web.Main
|
||||
- Hledger.Web.Settings
|
||||
- Hledger.Web.Settings.StaticFiles
|
||||
- Hledger.Web.WebOptions
|
||||
- Import
|
||||
- Settings
|
||||
- Settings.Development
|
||||
- Settings.StaticFiles
|
||||
- Hledger.Web.Widget.AddForm
|
||||
- Hledger.Web.Widget.Common
|
||||
dependencies:
|
||||
- hledger-lib >=1.9.99 && <2.0
|
||||
- hledger >=1.9.99 && <2.0
|
||||
- base >=4.8 && <4.12
|
||||
- blaze-html
|
||||
- blaze-markup
|
||||
- bytestring
|
||||
- case-insensitive
|
||||
- clientsession
|
||||
- cmdargs >=0.10
|
||||
- conduit
|
||||
- conduit-extra >=1.1
|
||||
- data-default
|
||||
- directory
|
||||
- filepath
|
||||
- hjsmin
|
||||
- http-conduit
|
||||
- http-client
|
||||
- json
|
||||
- megaparsec >=6.4.1
|
||||
- mtl
|
||||
- semigroups
|
||||
- shakespeare >=2.0.2.2
|
||||
- template-haskell
|
||||
- text >=1.2
|
||||
- time >=1.5
|
||||
- transformers
|
||||
- wai
|
||||
- wai-extra
|
||||
- wai-handler-launch >=1.3
|
||||
- warp
|
||||
- yaml
|
||||
- yesod >=1.4 && < 1.7
|
||||
- yesod-core >=1.4 && < 1.7
|
||||
- yesod-form >=1.4 && < 1.7
|
||||
- yesod-static >=1.4 && < 1.7
|
||||
- HUnit
|
||||
|
||||
executables:
|
||||
hledger-web:
|
||||
@ -139,6 +139,7 @@ executables:
|
||||
main: main.hs
|
||||
cpp-options: -DVERSION="1.9.99"
|
||||
dependencies:
|
||||
- base
|
||||
- hledger-web
|
||||
when:
|
||||
- condition: flag(library-only)
|
||||
@ -152,6 +153,7 @@ tests:
|
||||
main: main.hs
|
||||
cpp-options: -DVERSION="1.9.99"
|
||||
dependencies:
|
||||
- base
|
||||
- hledger-web
|
||||
- hspec
|
||||
- yesod-test
|
||||
|
||||
@ -20,37 +20,6 @@
|
||||
/*------------------------------------------------------------------------------------------*/
|
||||
/* 4. typeahead styles */
|
||||
|
||||
/*
|
||||
.typeahead,
|
||||
.tt-query,
|
||||
.tt-hint {
|
||||
width: 396px;
|
||||
height: 30px;
|
||||
padding: 8px 12px;
|
||||
font-size: 24px;
|
||||
line-height: 30px;
|
||||
border: 2px solid #ccc;
|
||||
-webkit-border-radius: 8px;
|
||||
-moz-border-radius: 8px;
|
||||
border-radius: 8px;
|
||||
outline: none;
|
||||
}
|
||||
|
||||
.typeahead {
|
||||
background-color: #fff;
|
||||
}
|
||||
|
||||
.typeahead:focus {
|
||||
border: 2px solid #0097cf;
|
||||
}
|
||||
|
||||
.tt-query {
|
||||
-webkit-box-shadow: inset 0 1px 1px rgba(0, 0, 0, 0.075);
|
||||
-moz-box-shadow: inset 0 1px 1px rgba(0, 0, 0, 0.075);
|
||||
box-shadow: inset 0 1px 1px rgba(0, 0, 0, 0.075);
|
||||
}
|
||||
|
||||
*/
|
||||
.tt-hint {
|
||||
color: #bbb;
|
||||
}
|
||||
@ -70,9 +39,6 @@
|
||||
max-height:300px;
|
||||
}
|
||||
|
||||
.tt-suggestions {
|
||||
}
|
||||
|
||||
.tt-suggestion {
|
||||
padding: 3px 20px;
|
||||
font-size: 18px;
|
||||
@ -82,7 +48,6 @@
|
||||
.tt-suggestion.tt-cursor {
|
||||
color: #fff;
|
||||
background-color: #0097cf;
|
||||
|
||||
}
|
||||
|
||||
.tt-suggestion p {
|
||||
@ -100,7 +65,7 @@ code {
|
||||
|
||||
ul {
|
||||
list-style-type: none;
|
||||
padding: 0;
|
||||
padding: 0;
|
||||
}
|
||||
|
||||
#main-content {
|
||||
@ -136,51 +101,37 @@ ul {
|
||||
|
||||
#sidebar-menu .main-menu a {
|
||||
display: inline;
|
||||
font-size: 16px;
|
||||
font-weight: 500;
|
||||
color: #2F2F2F;
|
||||
padding: 4px 20px;
|
||||
font-size: 16px;
|
||||
font-weight: 500;
|
||||
color: #2F2F2F;
|
||||
padding: 4px 20px;
|
||||
}
|
||||
|
||||
#sidebar-menu .main-menu a:hover {
|
||||
color: #11427D;
|
||||
text-decoration: none;
|
||||
background-color: transparent;
|
||||
color: #11427D;
|
||||
text-decoration: none;
|
||||
background-color: transparent;
|
||||
}
|
||||
|
||||
#sidebar-menu .main-menu .only{
|
||||
#sidebar-menu .main-menu .only {
|
||||
visibility: hidden;
|
||||
padding: 1px;
|
||||
}
|
||||
|
||||
#sidebar-menu .main-menu tr:hover > td > div > .only {
|
||||
#sidebar-menu .main-menu tr:hover .only {
|
||||
visibility: visible;
|
||||
}
|
||||
|
||||
#sidebar-menu .main-menu .only:hover{
|
||||
border-left: none;
|
||||
}
|
||||
#sidebar-menu .main-menu .balance {
|
||||
float: right;
|
||||
}
|
||||
|
||||
#sidebar-menu .main-menu .total {
|
||||
border-left: none;
|
||||
border-right: none;
|
||||
border-bottom: none;
|
||||
border-top: 1px solid black;
|
||||
}
|
||||
|
||||
#sidebar-menu .main-menu .inacct {
|
||||
#sidebar-menu .main-menu .inacct, #sidebar-menu .main-menu .inacct .acct-name {
|
||||
font-weight: bold;
|
||||
color: #11427D;
|
||||
color: #11427D;
|
||||
background-color: #f9f9f9;
|
||||
}
|
||||
|
||||
#sidebar-menu .main-menu .amount {
|
||||
float: right;
|
||||
overflow-x:auto;
|
||||
font-weight: 500 !important;
|
||||
font-weight: 500 !important;
|
||||
}
|
||||
|
||||
#sidebar-menu .main-menu .acct {
|
||||
@ -188,7 +139,7 @@ ul {
|
||||
vertical-align:bottom;
|
||||
}
|
||||
|
||||
.transactionsreport .nonhead {
|
||||
.transactionsreport .posting td {
|
||||
border: none !important;
|
||||
}
|
||||
|
||||
@ -200,24 +151,6 @@ ul {
|
||||
whitespace: nowrap;
|
||||
}
|
||||
|
||||
#main-content {
|
||||
/*
|
||||
-webkit-transition: width 0.3s ease, margin 0.3s ease;
|
||||
-moz-transition: width 0.3s ease, margin 0.3s ease;
|
||||
-o-transition: width 0.3s ease, margin 0.3s ease;
|
||||
transition: width 0.3s ease, margin 0.3s ease;
|
||||
*/
|
||||
}
|
||||
|
||||
#sidebar-menu {
|
||||
/*
|
||||
-webkit-transition: width 0.3s ease, margin 0.3s ease,opacity 0.3s ease,height 1s ease 1s;
|
||||
-moz-transition: width 0.3s ease, margin 0.3s ease,opacity 0.3s ease,height 1s ease 1s;
|
||||
-o-transition: width 0.3s ease, margin 0.3s ease,opacity 0.3s ease,height 1s ease 1s;
|
||||
transition: width 0.3s ease, margin 0.3s ease,opacity 0.3s ease,height 1s ease 1s;
|
||||
*/
|
||||
}
|
||||
|
||||
.col-any-0 {
|
||||
width:0 !important;
|
||||
height:0 !important;
|
||||
@ -229,10 +162,6 @@ ul {
|
||||
font-size:large;
|
||||
}
|
||||
|
||||
#searchbar {
|
||||
width: 100% !important;
|
||||
}
|
||||
|
||||
@media screen and (max-width: 768px) {
|
||||
.row-offcanvas {
|
||||
position: relative;
|
||||
|
||||
@ -4,9 +4,13 @@
|
||||
// STARTUP
|
||||
|
||||
$(document).ready(function() {
|
||||
// cache the input element as a variable
|
||||
// for minor performance benefits
|
||||
var dateEl = $('#dateWrap');
|
||||
// date picker
|
||||
// http://bootstrap-datepicker.readthedocs.io/en/latest/options.html
|
||||
var dateEl = $('#dateWrap').datepicker({
|
||||
showOnFocus: false,
|
||||
autoclose: true,
|
||||
format: 'yyyy-mm-dd'
|
||||
});;
|
||||
|
||||
// ensure add form always focuses its first field
|
||||
$('#addmodal')
|
||||
@ -18,36 +22,22 @@ $(document).ready(function() {
|
||||
dateEl.datepicker('hide');
|
||||
});
|
||||
|
||||
// show add form if ?add=1
|
||||
if ($.url.param('add')) { addformShow(true); }
|
||||
|
||||
// date picker
|
||||
// http://bootstrap-datepicker.readthedocs.io/en/latest/options.html
|
||||
dateEl.datepicker({
|
||||
showOnFocus: false,
|
||||
autoclose: true,
|
||||
format: 'yyyy-mm-dd'
|
||||
});
|
||||
|
||||
// sidebar account hover handlers
|
||||
$('#sidebar td a').mouseenter(function(){ $(this).parent().addClass('mouseover'); });
|
||||
$('#sidebar td').mouseleave(function(){ $(this).removeClass('mouseover'); });
|
||||
|
||||
// keyboard shortcuts
|
||||
// 'body' seems to hold focus better than document in FF
|
||||
$('body').bind('keydown', 'h', function(){ $('#helpmodal').modal('toggle'); return false; });
|
||||
$('body').bind('keydown', 'shift+/', function(){ $('#helpmodal').modal('toggle'); return false; });
|
||||
$('body').bind('keydown', 'j', function(){ location.href = document.hledgerWebBaseurl+'/journal'; return false; });
|
||||
$('body').bind('keydown', 's', function(){ sidebarToggle(); return false; });
|
||||
$('body').bind('keydown', 'e', function(){ emptyAccountsToggle(); return false; });
|
||||
$('body').bind('keydown', 'a', function(){ addformShow(); return false; });
|
||||
$('body').bind('keydown', 'n', function(){ addformShow(); return false; });
|
||||
$('body').bind('keydown', 'f', function(){ $('#searchform input').focus(); return false; });
|
||||
$('body, #addform input, #addform select').bind('keydown', 'ctrl++', addformAddPosting);
|
||||
$('body, #addform input, #addform select').bind('keydown', 'ctrl+shift+=', addformAddPosting);
|
||||
$('body, #addform input, #addform select').bind('keydown', 'ctrl+=', addformAddPosting);
|
||||
$('body, #addform input, #addform select').bind('keydown', 'ctrl+-', addformDeletePosting);
|
||||
$('.amount-input:last').keypress(addformAddPosting);
|
||||
|
||||
|
||||
// highlight the entry from the url hash
|
||||
if (window.location.hash && $(window.location.hash)[0]) {
|
||||
$(window.location.hash).addClass('highlighted');
|
||||
@ -78,10 +68,9 @@ function registerChart($container, series) {
|
||||
position: 'sw'
|
||||
},
|
||||
grid: {
|
||||
markings:
|
||||
function (axes) {
|
||||
markings: function () {
|
||||
var now = Date.now();
|
||||
var markings = [
|
||||
return [
|
||||
{
|
||||
xaxis: { to: now }, // past
|
||||
yaxis: { to: 0 }, // <0
|
||||
@ -103,7 +92,6 @@ function registerChart($container, series) {
|
||||
lineWidth:1
|
||||
},
|
||||
];
|
||||
return markings;
|
||||
},
|
||||
hoverable: true,
|
||||
autoHighlight: true,
|
||||
@ -127,15 +115,16 @@ function registerChart($container, series) {
|
||||
}
|
||||
|
||||
function registerChartClick(ev, pos, item) {
|
||||
if (item) {
|
||||
targetselector = '#'+item.series.data[item.dataIndex][5];
|
||||
$target = $(targetselector);
|
||||
if ($target.length) {
|
||||
window.location.hash = targetselector;
|
||||
$('html, body').animate({
|
||||
scrollTop: $target.offset().top
|
||||
}, 1000);
|
||||
}
|
||||
if (!item) {
|
||||
return;
|
||||
}
|
||||
var targetselector = '#' + item.series.data[item.dataIndex][5];
|
||||
var $target = $(targetselector);
|
||||
if ($target.length) {
|
||||
window.location.hash = targetselector;
|
||||
$('html, body').animate({
|
||||
scrollTop: $target.offset().top
|
||||
}, 1000);
|
||||
}
|
||||
}
|
||||
|
||||
@ -174,59 +163,46 @@ function focus($el) {
|
||||
|
||||
// Insert another posting row in the add form.
|
||||
function addformAddPosting() {
|
||||
$('.amount-input:last').off('keypress');
|
||||
// do nothing if it's not currently visible
|
||||
if (!$('#addform').is(':visible')) return;
|
||||
// save a copy of last row
|
||||
var lastrow = $('#addform .form-group:last').clone();
|
||||
if (!$('#addform').is(':visible')) {
|
||||
return;
|
||||
}
|
||||
|
||||
// replace the submit button with an amount field, clear and renumber it, add the keybindings
|
||||
var prevLastRow = $('#addform .account-group:last');
|
||||
prevLastRow.off('keypress');
|
||||
|
||||
// Clone the currently last row
|
||||
$('#addform .account-postings').append(prevLastRow.clone());
|
||||
var num = $('#addform .account-group').length;
|
||||
|
||||
// insert the new last row
|
||||
$('#addform .account-postings').append(lastrow);
|
||||
// TODO: Enable typehead on dynamically created inputs
|
||||
|
||||
var $acctinput = $('.account-input:last');
|
||||
var $amntinput = $('.amount-input:last');
|
||||
// clear and renumber the field, add keybindings
|
||||
$acctinput
|
||||
// XXX Enable typehead on dynamically created inputs
|
||||
$('.amount-input:last')
|
||||
.val('')
|
||||
.prop('id','account'+(num+1))
|
||||
.prop('name','account'+(num+1))
|
||||
.prop('placeholder','Account '+(num+1));
|
||||
//lastrow.find('input') // not :last this time
|
||||
$acctinput
|
||||
.bind('keydown', 'ctrl+shift+=', addformAddPosting)
|
||||
.bind('keydown', 'ctrl+=', addformAddPosting)
|
||||
.bind('keydown', 'ctrl+-', addformDeletePosting);
|
||||
|
||||
$amntinput
|
||||
.val('')
|
||||
.prop('id','amount'+(num+1))
|
||||
.prop('name','amount'+(num+1))
|
||||
.prop('placeholder','Amount '+(num+1))
|
||||
.prop('placeholder','Amount ' + num)
|
||||
.keypress(addformAddPosting);
|
||||
|
||||
$acctinput
|
||||
$('.account-input:last')
|
||||
.val('')
|
||||
.prop('placeholder', 'Account ' + num)
|
||||
.bind('keydown', 'ctrl++', addformAddPosting)
|
||||
.bind('keydown', 'ctrl+shift+=', addformAddPosting)
|
||||
.bind('keydown', 'ctrl+=', addformAddPosting)
|
||||
.bind('keydown', 'ctrl+-', addformDeletePosting);
|
||||
|
||||
}
|
||||
|
||||
// Remove the add form's last posting row, if empty, keeping at least two.
|
||||
function addformDeletePosting() {
|
||||
var num = $('#addform .account-group').length;
|
||||
if (num <= 2) return;
|
||||
if ($('#addform .account-group').length <= 2) {
|
||||
return;
|
||||
}
|
||||
// remember if the last row's field or button had focus
|
||||
var focuslost =
|
||||
$('.account-input:last').is(':focus')
|
||||
|| $('.amount-input:last').is(':focus');
|
||||
// delete last row
|
||||
$('#addform .account-group:last').remove();
|
||||
if(focuslost){
|
||||
focus($('account-input:last'));
|
||||
if (focuslost) {
|
||||
focus($('.account-input:last'));
|
||||
}
|
||||
// Rebind keypress
|
||||
$('.amount-input:last').keypress(addformAddPosting);
|
||||
@ -242,46 +218,7 @@ function sidebarToggle() {
|
||||
$.cookie('showsidebar', $('#sidebar-menu').hasClass('col-any-0') ? '0' : '1');
|
||||
}
|
||||
|
||||
//----------------------------------------------------------------------
|
||||
// MISC
|
||||
|
||||
function enableTypeahead($el, suggester) {
|
||||
return $el.typeahead(
|
||||
{
|
||||
highlight: true
|
||||
},
|
||||
{
|
||||
source: suggester.ttAdapter()
|
||||
}
|
||||
);
|
||||
function emptyAccountsToggle() {
|
||||
$('.acct.empty').parent().toggleClass('hide');
|
||||
$.cookie('hideemptyaccts', $.cookie('hideemptyaccts') === '1' ? '0' : '1')
|
||||
}
|
||||
|
||||
// function journalSelect(ev) {
|
||||
// var textareas = $('textarea', $('form#editform'));
|
||||
// for (i=0; i<textareas.length; i++) {
|
||||
// textareas[i].style.display = 'none';
|
||||
// textareas[i].disabled = true;
|
||||
// }
|
||||
// var targ = getTarget(ev);
|
||||
// if (targ.value) {
|
||||
// var journalid = targ.value+'_textarea';
|
||||
// var textarea = document.getElementById(journalid);
|
||||
// }
|
||||
// else {
|
||||
// var textarea = textareas[0];
|
||||
// }
|
||||
// textarea.style.display = 'block';
|
||||
// textarea.disabled = false;
|
||||
// return true;
|
||||
// }
|
||||
|
||||
// // Get the current event's target in a robust way.
|
||||
// // http://www.quirksmode.org/js/events_properties.html
|
||||
// function getTarget(ev) {
|
||||
// var targ;
|
||||
// if (!ev) var ev = window.event;
|
||||
// if (ev.target) targ = ev.target;
|
||||
// else if (ev.srcElement) targ = ev.srcElement;
|
||||
// if (targ.nodeType == 3) targ = targ.parentNode;
|
||||
// return targ;
|
||||
// }
|
||||
|
||||
71
hledger-web/templates/add-form.hamlet
Normal file
71
hledger-web/templates/add-form.hamlet
Normal file
@ -0,0 +1,71 @@
|
||||
<script>
|
||||
jQuery(document).ready(function() {
|
||||
descriptionsSuggester = new Bloodhound({
|
||||
local:#{listToJsonValueObjArrayStr descriptions},
|
||||
limit:100,
|
||||
datumTokenizer: function(d) { return [d.value]; },
|
||||
queryTokenizer: function(q) { return [q]; }
|
||||
});
|
||||
descriptionsSuggester.initialize();
|
||||
|
||||
accountsSuggester = new Bloodhound({
|
||||
local:#{listToJsonValueObjArrayStr (journalAccountNamesDeclaredOrImplied j)},
|
||||
limit:100,
|
||||
datumTokenizer: function(d) { return [d.value]; },
|
||||
queryTokenizer: function(q) { return [q]; }
|
||||
});
|
||||
accountsSuggester.initialize();
|
||||
|
||||
jQuery('input[name=description]').typeahead({ highlight: true }, { source: descriptionsSuggester.ttAdapter() });
|
||||
jQuery('input[name=account]').typeahead({ highlight: true }, { source: accountsSuggester.ttAdapter() });
|
||||
});
|
||||
^{extra}
|
||||
|
||||
<div .form-group>
|
||||
<div .row>
|
||||
<div .col-md-3 .col-xs-6 .col-sm-6 :isJust (fvErrors dateView):.has-error>
|
||||
<div #dateWrap .form-group.input-group.date>
|
||||
^{fvInput dateView}
|
||||
<div .input-group-addon>
|
||||
<span .glyphicon .glyphicon-th>
|
||||
$maybe err <- fvErrors dateView
|
||||
<span .help-block .error-block>#{err}
|
||||
<div .col-md-9 .col-xs-6 .col-sm-6 :isJust (fvErrors descView):.has-error>
|
||||
<div .form-group>
|
||||
^{fvInput descView}
|
||||
$maybe err <- fvErrors descView
|
||||
<span .help-block .error-block>#{err}
|
||||
<div .row>
|
||||
<div .col-md-3 .col-xs-6 .col-sm-6>
|
||||
<div .col-md-9 .col-xs-6 .col-sm-6>
|
||||
|
||||
<div .account-postings>
|
||||
$forall (n, (acc, amt, accE, amtE)) <- msgs
|
||||
<div .form-group .row .account-group>
|
||||
<div .col-md-8 .col-xs-8 .col-sm-8 :isJust accE:.has-error>
|
||||
<input .account-input.form-control.input-lg.typeahead type=text
|
||||
name=account placeholder="Account #{n}" value="#{acc}">
|
||||
$maybe err <- accE
|
||||
<span .help-block .error-block>_{err}
|
||||
<div .col-md-4 .col-xs-4 .col-sm-4 :isJust amtE:.has-error>
|
||||
<input .amount-input.form-control.input-lg type=text
|
||||
name=amount placeholder="Amount #{n}" value="#{amt}">
|
||||
$maybe err <- amtE
|
||||
<span .help-block .error-block>_{err}
|
||||
|
||||
<div .row>
|
||||
<div .col-md-8 .col-xs-8 .col-sm-8>
|
||||
<div .col-md-4 .col-xs-4 .col-sm-4>
|
||||
<button type=submit .btn .btn-default .btn-lg name=submit>add
|
||||
|
||||
$if length journals > 1
|
||||
<br>
|
||||
<span .input-lg>to:
|
||||
<select #journalselect .form-control.input-lg name=journal style="width:auto; display:inline-block;">
|
||||
$forall p <- journals
|
||||
<option value=#{p}>#{p}
|
||||
<span .small style="padding-left:2em;">
|
||||
Enter a value in the last field for #
|
||||
<a href="#" onclick="addformAddPosting(); return false;">
|
||||
more
|
||||
\ (or ctrl +, ctrl -)
|
||||
25
hledger-web/templates/balance-report.hamlet
Normal file
25
hledger-web/templates/balance-report.hamlet
Normal file
@ -0,0 +1,25 @@
|
||||
<tr :here == journalR:.inacct>
|
||||
<td .top .acct>
|
||||
<a href=@{journalR} :here == journalR:.inacct
|
||||
title="Show general journal entries, most recent first">
|
||||
Journal
|
||||
<td .top>
|
||||
$forall (acct, adisplay, aindent, abal) <- items
|
||||
<tr
|
||||
:matchesAcctSelector acct:.inacct
|
||||
:isZeroMixedAmount abal && hideEmpty:.hide>
|
||||
<td .acct :isZeroMixedAmount abal:.empty>
|
||||
<div .ff-wrapper>
|
||||
\#{indent aindent}
|
||||
<a.acct-name href="@?{(registerR, [("q", accountQuery acct)])}"
|
||||
title="Show transactions affecting this account and subaccounts">
|
||||
#{adisplay}
|
||||
$if hasSubAccounts acct
|
||||
<a href="@?{(registerR, [("q", accountOnlyQuery acct)])}" .only.hidden-sm.hidden-xs
|
||||
title="Show transactions affecting this account but not subaccounts">only
|
||||
<td>
|
||||
^{mixedAmountAsHtml abal}
|
||||
<tr .total>
|
||||
<td>
|
||||
<td>
|
||||
^{mixedAmountAsHtml total}
|
||||
59
hledger-web/templates/chart.hamlet
Normal file
59
hledger-web/templates/chart.hamlet
Normal file
@ -0,0 +1,59 @@
|
||||
<label #register-chart-label style=""><br>
|
||||
<div #register-chart style="height:150px; margin-bottom:1em; display:block;">
|
||||
<script type=text/javascript>
|
||||
\$(document).ready(function() {
|
||||
var $chartdiv = $('#register-chart');
|
||||
if ($chartdiv.is(':visible')) {
|
||||
\$('#register-chart-label').text('#{charttitle}');
|
||||
var seriesData = [
|
||||
$forall (c,(_,items)) <- percommoditytxnreports
|
||||
/* we render each commodity using two series:
|
||||
* one with extra data points added to show a stepped balance line */
|
||||
{
|
||||
data: [
|
||||
$forall i <- reverse items
|
||||
[
|
||||
#{dayToJsTimestamp $ triDate i},
|
||||
#{simpleMixedAmountQuantity $ triCommodityBalance c i}
|
||||
],
|
||||
],
|
||||
label: '#{shownull $ T.unpack c}',
|
||||
color: #{colorForCommodity c},
|
||||
lines: {
|
||||
show: true,
|
||||
steps: true,
|
||||
},
|
||||
points: {
|
||||
show: false,
|
||||
},
|
||||
clickable: false,
|
||||
hoverable: false,
|
||||
},
|
||||
/* and one with the original data, showing one clickable, hoverable point per transaction */
|
||||
{
|
||||
data: [
|
||||
$forall i <- reverse items
|
||||
[
|
||||
#{dayToJsTimestamp $ triDate i},
|
||||
#{simpleMixedAmountQuantity $ triCommodityBalance c i},
|
||||
'#{showMixedAmountWithZeroCommodity $ triCommodityAmount c i}',
|
||||
'#{showMixedAmountWithZeroCommodity $ triCommodityBalance c i}',
|
||||
'#{concat $ intersperse "\\n" $ lines $ show $ triOrigTransaction i}',
|
||||
#{tindex $ triOrigTransaction i}
|
||||
],
|
||||
/* [] */
|
||||
],
|
||||
label: '',
|
||||
color: #{colorForCommodity c},
|
||||
lines: {
|
||||
show: false,
|
||||
},
|
||||
points: {
|
||||
show: true,
|
||||
},
|
||||
},
|
||||
]
|
||||
var plot = registerChart($chartdiv, seriesData);
|
||||
\$chartdiv.bind("plotclick", registerChartClick);
|
||||
};
|
||||
});
|
||||
@ -29,7 +29,7 @@ $newline never
|
||||
<div .row .row-offcanvas .row-offcanvas-left>
|
||||
^{pageBody pc}
|
||||
<footer>
|
||||
#{extraCopyright $ appExtra $ settings master}
|
||||
#{extraCopyright $ appExtra $ settings master}
|
||||
|
||||
$maybe analytics <- extraAnalytics $ appExtra $ settings master
|
||||
<script>
|
||||
@ -47,61 +47,3 @@ $newline never
|
||||
<script>
|
||||
window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})
|
||||
\<![endif]-->
|
||||
|
||||
<div .modal.fade #helpmodal tabindex="-1" role="dialog" aria-labelledby="helpLabel" aria-hidden="true">
|
||||
<div .modal-dialog .modal-lg>
|
||||
<div .modal-content>
|
||||
<div .modal-header>
|
||||
<button type="button" .close data-dismiss="modal" aria-hidden="true">×
|
||||
<h3 .modal-title #helpLabel>Help
|
||||
<div .modal-body>
|
||||
<div .row>
|
||||
<div .col-xs-6>
|
||||
<p>
|
||||
<b>Keyboard shortcuts
|
||||
<ul>
|
||||
<li> <code>h</code> or maybe <code>?</code> - view this help (escape or click to exit)
|
||||
<li> <code>j</code> - go to the Journal view (home)
|
||||
<li> <code>a</code> - add a transaction (escape to cancel)
|
||||
<li> <code>s</code> - toggle sidebar
|
||||
<li> <code>f</code> - focus search form ("find")
|
||||
<p>
|
||||
<b>General
|
||||
<ul>
|
||||
<li> The Journal view shows general journal entries, representing zero-sum movements of money (or other commodity) between hierarchical accounts
|
||||
<li> The sidebar shows the resulting accounts and their final balances
|
||||
<li> Parent account balances include subaccount balances
|
||||
<li> Multiple currencies in balances are displayed one above the other
|
||||
<li> Click account name links to see transactions affecting that account, with running balance
|
||||
<li> Click date links to see journal entries on that date
|
||||
<div .col-xs-6>
|
||||
<p>
|
||||
<b>Search
|
||||
<ul>
|
||||
<li> <code>acct:REGEXP</code> - filter on to/from account
|
||||
<li> <code>desc:REGEXP</code> - filter on description
|
||||
<li> <code>date:PERIODEXP</code>, <code>date2:PERIODEXP</code> - filter on date or secondary date
|
||||
<li> <code>code:REGEXP</code> - filter on transaction's code (eg check number)
|
||||
<li> <code>status:*</code>, <code>status:!</code>, <code>status:</code> - filter on transaction's cleared status (cleared, pending, uncleared)
|
||||
<!-- <li> <code>empty:BOOL</code> - filter on whether amount is zero -->
|
||||
<li> <code>amt:N</code>, <code>amt:<N</code>, <code>amt:>N</code> - filter on the unsigned amount magnitude. Or with a sign before N, filter on the signed value. (Single-commodity amounts only.)
|
||||
<li> <code>cur:REGEXP</code> - filter on the currency/commodity symbol (must match all of it). Dollar sign must be written as <code>\$</code>
|
||||
<li> <code>tag:NAME</code>, <code>tag:NAME=REGEX</code> - filter on tag name, or tag name and value
|
||||
<!-- <li> <code>depth:N</code> - filter out accounts below this depth -->
|
||||
<li> <code>real:BOOL</code> - filter on postings' real/virtual-ness
|
||||
<li> Enclose search patterns containing spaces in single or double quotes
|
||||
<li> Prepend <code>not:</code> to negate a search term
|
||||
<li> Multiple search terms on different fields are AND'ed, multiple search terms on the same field are OR'ed
|
||||
<li> These search terms also work with command-line hledger
|
||||
|
||||
<div .modal #addmodal tabindex="-1" role="dialog" aria-labelledby="addLabel" aria-hidden="true">
|
||||
<div .modal-dialog .modal-lg>
|
||||
<div .modal-content>
|
||||
<div .modal-header>
|
||||
<button type="button" .close data-dismiss="modal" aria-hidden="true">×
|
||||
<h3 .modal-title #addLabel>Add a transaction
|
||||
<div .modal-body>
|
||||
$maybe m <- lastmsg
|
||||
$if isPrefixOf "Errors" (renderHtml m)
|
||||
<div #message>#{m}
|
||||
^{addform staticRootUrl vd}
|
||||
|
||||
@ -1,4 +1,81 @@
|
||||
$maybe m <- lastmsg
|
||||
$if not $ isPrefixOf "Errors" (renderHtml m)
|
||||
<div #message>#{m}
|
||||
^{widget}
|
||||
|
||||
<div#spacer .col-xs-2.#{topShowsm}.#{topShowmd}>
|
||||
<h1>
|
||||
<button .visible-xs.btn.btn-default type="button" data-toggle="offcanvas">
|
||||
<span .glyphicon.glyphicon-align-left.tgl-icon>
|
||||
|
||||
<div#topbar .col-md-8 .col-sm-8 .col-xs-10>
|
||||
<h1>#{takeFileName (journalFilePath j)}
|
||||
|
||||
$if elem CapView caps
|
||||
<div#sidebar-menu .sidebar-offcanvas.#{sideShowmd}.#{sideShowsm}>
|
||||
<table .main-menu .table>
|
||||
^{accounts}
|
||||
|
||||
<div#main-content .col-xs-12.#{mainShowmd}.#{mainShowsm}>
|
||||
$maybe m <- msg
|
||||
<div #message .alert.alert-info>#{m}
|
||||
$if elem CapView caps
|
||||
<form#searchform.input-group method=GET>
|
||||
<input .form-control name=q value=#{q} placeholder="Search"
|
||||
title="Enter hledger search patterns to filter the data below">
|
||||
<div .input-group-btn>
|
||||
$if not (T.null q)
|
||||
<a href=@{here} .btn .btn-default title="Clear search terms">
|
||||
<span .glyphicon .glyphicon-remove-circle>
|
||||
<button .btn .btn-default type=submit title="Apply search terms">
|
||||
<span .glyphicon .glyphicon-search>
|
||||
$if elem CapManage caps
|
||||
<a href="@{ManageR}" .btn.btn-default title="Manage journal files">
|
||||
<span .glyphicon .glyphicon-wrench>
|
||||
<button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal"
|
||||
title="Show search and general help">
|
||||
<span .glyphicon .glyphicon-question-sign>
|
||||
^{widget}
|
||||
|
||||
<div .modal.fade #helpmodal tabindex="-1" role="dialog" aria-labelledby="helpLabel" aria-hidden="true">
|
||||
<div .modal-dialog .modal-lg>
|
||||
<div .modal-content>
|
||||
<div .modal-header>
|
||||
<button type="button" .close data-dismiss="modal" aria-hidden="true">×
|
||||
<h3 .modal-title #helpLabel>Help
|
||||
<div .modal-body>
|
||||
<div .row>
|
||||
<div .col-xs-6>
|
||||
<p>
|
||||
<b>Keyboard shortcuts
|
||||
<ul>
|
||||
<li> <code>h</code> or maybe <code>?</code> - view this help (escape or click to exit)
|
||||
<li> <code>j</code> - go to the Journal view (home)
|
||||
<li> <code>a</code> - add a transaction (escape to cancel)
|
||||
<li> <code>s</code> - toggle sidebar
|
||||
<li> <code>f</code> - focus search form ("find")
|
||||
<li> <code>e</code> - hide empty accounts in sidebar
|
||||
<p>
|
||||
<b>General
|
||||
<ul>
|
||||
<li> The Journal view shows general journal entries, representing zero-sum movements of money (or other commodity) between hierarchical accounts
|
||||
<li> The sidebar shows the resulting accounts and their final balances
|
||||
<li> Parent account balances include subaccount balances
|
||||
<li> Multiple currencies in balances are displayed one above the other
|
||||
<li> Click account name links to see transactions affecting that account, with running balance
|
||||
<li> Click date links to see journal entries on that date
|
||||
<div .col-xs-6>
|
||||
<p>
|
||||
<b>Search
|
||||
<ul>
|
||||
<li> <code>acct:REGEXP</code> - filter on to/from account
|
||||
<li> <code>desc:REGEXP</code> - filter on description
|
||||
<li> <code>date:PERIODEXP</code>, <code>date2:PERIODEXP</code> - filter on date or secondary date
|
||||
<li> <code>code:REGEXP</code> - filter on transaction's code (eg check number)
|
||||
<li> <code>status:*</code>, <code>status:!</code>, <code>status:</code> - filter on transaction's cleared status (cleared, pending, uncleared)
|
||||
<!-- <li> <code>empty:BOOL</code> - filter on whether amount is zero -->
|
||||
<li> <code>amt:N</code>, <code>amt:<N</code>, <code>amt:>N</code> - filter on the unsigned amount magnitude. Or with a sign before N, filter on the signed value. (Single-commodity amounts only.)
|
||||
<li> <code>cur:REGEXP</code> - filter on the currency/commodity symbol (must match all of it). Dollar sign must be written as <code>\$</code>
|
||||
<li> <code>tag:NAME</code>, <code>tag:NAME=REGEX</code> - filter on tag name, or tag name and value
|
||||
<!-- <li> <code>depth:N</code> - filter out accounts below this depth -->
|
||||
<li> <code>real:BOOL</code> - filter on postings' real/virtual-ness
|
||||
<li> Enclose search patterns containing spaces in single or double quotes
|
||||
<li> Prepend <code>not:</code> to negate a search term
|
||||
<li> Multiple search terms on different fields are AND'ed, multiple search terms on the same field are OR'ed
|
||||
<li> These search terms also work with command-line hledger
|
||||
|
||||
17
hledger-web/templates/edit-form.hamlet
Normal file
17
hledger-web/templates/edit-form.hamlet
Normal file
@ -0,0 +1,17 @@
|
||||
#{extra}
|
||||
<h2>
|
||||
Edit file #
|
||||
<i>#{f}
|
||||
<div.alert.alert-danger>
|
||||
Are you sure? This will overwrite your journal!
|
||||
<table.table.table-condensed>
|
||||
<tr>
|
||||
<td colspan=2 style="border:0">
|
||||
^{fvInput tView}
|
||||
<tr>
|
||||
<td style="border:0">
|
||||
<span.help>
|
||||
^{helplink "file-format" "File format help"}
|
||||
<td .text-right style="border:0">
|
||||
<a.btn.btn-default href="@{ManageR}">Go back
|
||||
<input.btn.btn-default type=submit value="Save">
|
||||
39
hledger-web/templates/journal.hamlet
Normal file
39
hledger-web/templates/journal.hamlet
Normal file
@ -0,0 +1,39 @@
|
||||
<h2>
|
||||
#{title'}
|
||||
|
||||
$if elem CapAdd caps
|
||||
<a #addformlink href="#" role="button" style="cursor:pointer; margin-top:1em;"
|
||||
data-toggle="modal" data-target="#addmodal" title="Add a new transaction to the journal">
|
||||
Add a transaction
|
||||
|
||||
<div .table-responsive>
|
||||
<table .transactionsreport .table .table-condensed>
|
||||
<thead>
|
||||
<th .date style="text-align:left;">Date
|
||||
<th .description style="text-align:left;">Description
|
||||
<th .account style="text-align:left;">Account
|
||||
<th .amount style="text-align:right;">Amount
|
||||
|
||||
$forall (torig, _, split, _, amt, _) <- items
|
||||
<tr .title #transaction-#{tindex torig}>
|
||||
<td .date nowrap>
|
||||
#{show (tdate torig)}
|
||||
<td colspan=2>
|
||||
#{textElideRight 60 (tdescription torig)}
|
||||
<td .amount style="text-align:right;">
|
||||
$if not split && not (isZeroMixedAmount amt)
|
||||
^{mixedAmountAsHtml amt}
|
||||
|
||||
$forall Posting { paccount = acc, pamount = amt } <- tpostings torig
|
||||
<tr .posting title="#{show torig}">
|
||||
<td>
|
||||
<td>
|
||||
<td>
|
||||
|
||||
<a href="@?{acctlink acc}##{tindex torig}" title="#{acc}">
|
||||
#{elideAccountName 40 acc}
|
||||
<td .amount style="text-align:right;">
|
||||
^{mixedAmountAsHtml amt}
|
||||
|
||||
$if elem CapAdd caps
|
||||
^{addModal AddR j today}
|
||||
22
hledger-web/templates/manage.hamlet
Normal file
22
hledger-web/templates/manage.hamlet
Normal file
@ -0,0 +1,22 @@
|
||||
<h2>
|
||||
Your journal's files
|
||||
|
||||
<div.row>
|
||||
<div .col-xs-12.col-sm-8.col-md-6>
|
||||
<table .table.table-condensed>
|
||||
<thead>
|
||||
<th>
|
||||
File
|
||||
<th>
|
||||
<tbody>
|
||||
$forall (path, _) <- jfiles j
|
||||
<tr>
|
||||
<td style="vertical-align:middle">
|
||||
#{path}
|
||||
<td style="text-align:right">
|
||||
<a.btn.btn-default href=@{EditR path}>
|
||||
Edit
|
||||
<a.btn.btn-default href=@{UploadR path}>
|
||||
Upload
|
||||
<a.btn.btn-default href=@{DownloadR path}>
|
||||
Download
|
||||
37
hledger-web/templates/register.hamlet
Normal file
37
hledger-web/templates/register.hamlet
Normal file
@ -0,0 +1,37 @@
|
||||
<h2>
|
||||
#{header}
|
||||
|
||||
<div .hidden-xs>
|
||||
^{registerChartHtml $ transactionsReportByCommodity r}
|
||||
|
||||
<div.table-responsive>
|
||||
<table .table.table-striped.table-condensed>
|
||||
<thead>
|
||||
<tr>
|
||||
<th style="text-align:left;">
|
||||
Date
|
||||
<span .glyphicon.glyphicon-chevron-up>
|
||||
<th style="text-align:left;">Description
|
||||
<th style="text-align:left;">To/From Account(s)
|
||||
<th style="text-align:right; white-space:normal;">Amount Out/In
|
||||
<th style="text-align:right; white-space:normal;">
|
||||
#{balancelabel'}
|
||||
|
||||
<tbody>
|
||||
$forall (torig, tacct, split, acct, amt, bal) <- items
|
||||
<tr ##{tindex torig} title="#{show torig}" style="vertical-align:top;">
|
||||
<td .date>
|
||||
<a href="@{JournalR}#transaction-#{tindex torig}">
|
||||
#{show (tdate tacct)}
|
||||
<td title="#{show torig}">
|
||||
#{textElideRight 30 (tdescription tacct)}
|
||||
<td .account>
|
||||
#{elideRight 40 acct}
|
||||
<td .amount style="text-align:right; white-space:nowrap;">
|
||||
$if not split || not (isZeroMixedAmount amt)
|
||||
^{mixedAmountAsHtml amt}
|
||||
<td style="text-align:right;">
|
||||
^{mixedAmountAsHtml bal}
|
||||
|
||||
$if elem CapAdd caps
|
||||
^{addModal AddR j today}
|
||||
14
hledger-web/templates/upload-form.hamlet
Normal file
14
hledger-web/templates/upload-form.hamlet
Normal file
@ -0,0 +1,14 @@
|
||||
<h2>
|
||||
Upload to file #
|
||||
<i>#{f}
|
||||
<div.alert.alert-danger>
|
||||
Are you sure? This will overwrite your journal!
|
||||
<div.form-group>
|
||||
<label .btn.btn-primary for="file">
|
||||
<input type=file id=file name=file style="display:none"
|
||||
onchange="\$('#file-info').html(this.files[0].name)" />
|
||||
Select file
|
||||
<span .label.label-info id="file-info">
|
||||
<div.form-group>
|
||||
<input .btn.btn-default type=submit value="Upload">
|
||||
#{extra}
|
||||
Loading…
Reference in New Issue
Block a user