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
|
mkdir -p /var/lib/hledger
|
||||||
touch /var/lib/hledger/Ledger
|
touch /var/lib/hledger/Ledger
|
||||||
cd /var
|
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
|
# not have been detected as a dependency during `spk dev`. If you list
|
||||||
# a directory here, its entire contents will be included recursively.
|
# a directory here, its entire contents will be included recursively.
|
||||||
|
|
||||||
#bridgeConfig = (
|
bridgeConfig = (
|
||||||
# # Used for integrating permissions and roles into the Sandstorm shell
|
# Used for integrating permissions and roles into the Sandstorm shell
|
||||||
# # and for sandstorm-http-bridge to pass to your app.
|
# and for sandstorm-http-bridge to pass to your app.
|
||||||
# # Uncomment this block and adjust the permissions and roles to make
|
# Uncomment this block and adjust the permissions and roles to make
|
||||||
# # sense for your app.
|
# sense for your app.
|
||||||
# # For more information, see high-level documentation at
|
# For more information, see high-level documentation at
|
||||||
# # https://docs.sandstorm.io/en/latest/developing/auth/
|
# https://docs.sandstorm.io/en/latest/developing/auth/
|
||||||
# # and advanced details in the "BridgeConfig" section of
|
# and advanced details in the "BridgeConfig" section of
|
||||||
# # https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/package.capnp
|
# https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/package.capnp
|
||||||
# viewInfo = (
|
viewInfo = (
|
||||||
# # For details on the viewInfo field, consult "ViewInfo" in
|
# For details on the viewInfo field, consult "ViewInfo" in
|
||||||
# # https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/grain.capnp
|
# 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.
|
||||||
#
|
#
|
||||||
# permissions = [
|
# IMPORTANT: only ever append to this list! Reordering or removing fields
|
||||||
# # Permissions which a user may or may not possess. A user's current
|
# will change behavior and permissions for existing grains! To deprecate a
|
||||||
# # permissions are passed to the app as a comma-separated list of `name`
|
# permission, or for more information, see "PermissionDef" in
|
||||||
# # fields in the X-Sandstorm-Permissions header with each request.
|
# https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/grain.capnp
|
||||||
# #
|
(
|
||||||
# # IMPORTANT: only ever append to this list! Reordering or removing fields
|
name = "view",
|
||||||
# # will change behavior and permissions for existing grains! To deprecate a
|
# Name of the permission, used as an identifier for the permission in cases where string
|
||||||
# # permission, or for more information, see "PermissionDef" in
|
# names are preferred. Used in sandstorm-http-bridge's X-Sandstorm-Permissions HTTP header.
|
||||||
# # https://github.com/sandstorm-io/sandstorm/blob/master/src/sandstorm/grain.capnp
|
|
||||||
# (
|
title = (defaultText = "view"),
|
||||||
# name = "editor",
|
# Display name of the permission, e.g. to display in a checklist of permissions
|
||||||
# # Name of the permission, used as an identifier for the permission in cases where string
|
# that may be assigned when sharing.
|
||||||
# # names are preferred. Used in sandstorm-http-bridge's X-Sandstorm-Permissions HTTP header.
|
|
||||||
#
|
description = (defaultText = "grants ability to view the ledger"),
|
||||||
# title = (defaultText = "editor"),
|
# Prose describing what this role means, suitable for a tool tip or similar help text.
|
||||||
# # Display name of the permission, e.g. to display in a checklist of permissions
|
),
|
||||||
# # that may be assigned when sharing.
|
(
|
||||||
#
|
name = "add",
|
||||||
# description = (defaultText = "grants ability to modify data"),
|
title = (defaultText = "add"),
|
||||||
# # Prose describing what this role means, suitable for a tool tip or similar help text.
|
description = (defaultText = "grants ability to append transactions to the ledger"),
|
||||||
# ),
|
),
|
||||||
# ],
|
(
|
||||||
# roles = [
|
name = "manage",
|
||||||
# # Roles are logical collections of permissions. For instance, your app may have
|
title = (defaultText = "manage"),
|
||||||
# # a "viewer" role and an "editor" role
|
description = (defaultText = "grants ability to modify or replace the entire ledger"),
|
||||||
# (
|
),
|
||||||
# title = (defaultText = "editor"),
|
],
|
||||||
# # Name of the role. Shown in the Sandstorm UI to indicate which users have which roles.
|
roles = [
|
||||||
#
|
# Roles are logical collections of permissions. For instance, your app may have
|
||||||
# permissions = [true],
|
# a "viewer" role and an "editor" role
|
||||||
# # An array indicating which permissions this role carries.
|
(
|
||||||
# # It should be the same length as the permissions array in
|
title = (defaultText = "manager"),
|
||||||
# # viewInfo, and the order of the lists must match.
|
# Name of the role. Shown in the Sandstorm UI to indicate which users have which roles.
|
||||||
#
|
|
||||||
# verbPhrase = (defaultText = "can make changes to the document"),
|
permissions = [true, true, true],
|
||||||
# # Brief explanatory text to show in the sharing UI indicating
|
# An array indicating which permissions this role carries.
|
||||||
# # what a user assigned this role will be able to do with the grain.
|
# It should be the same length as the permissions array in
|
||||||
#
|
# viewInfo, and the order of the lists must match.
|
||||||
# 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.
|
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.
|
||||||
# title = (defaultText = "viewer"),
|
|
||||||
# permissions = [false],
|
description = (defaultText = "managers can modify the ledger in any way."),
|
||||||
# verbPhrase = (defaultText = "can view the document"),
|
# Prose describing what this role means, suitable for a tool tip or similar help text.
|
||||||
# description = (defaultText = "viewers may view what other users have written."),
|
),
|
||||||
# ),
|
(
|
||||||
# ],
|
title = (defaultText = "editor"),
|
||||||
# ),
|
permissions = [true, true, false],
|
||||||
# #apiPath = "/api",
|
verbPhrase = (defaultText = "can append new transactions"),
|
||||||
# # Apps can export an API to the world. The API is to be used primarily by Javascript
|
description = (defaultText = "editors can view the ledger or append new transactions to it."),
|
||||||
# # 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.
|
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 = (
|
const myCommand :Spk.Manifest.Command = (
|
||||||
|
|||||||
6
Makefile
6
Makefile
@ -134,11 +134,7 @@ SOURCEFILES:= \
|
|||||||
hledger-*/Hledger/*hs \
|
hledger-*/Hledger/*hs \
|
||||||
hledger-*/Hledger/*/*hs \
|
hledger-*/Hledger/*/*hs \
|
||||||
hledger-lib/other/ledger-parse/Ledger/Parser/*hs \
|
hledger-lib/other/ledger-parse/Ledger/Parser/*hs \
|
||||||
hledger-web/app/*.hs \
|
hledger-web/**/*.hs \
|
||||||
hledger-web/tests/*.hs \
|
|
||||||
hledger-web/Handler/*.hs \
|
|
||||||
hledger-web/Hledger/*.hs \
|
|
||||||
hledger-web/Settings/*.hs \
|
|
||||||
|
|
||||||
HPACKFILES:= \
|
HPACKFILES:= \
|
||||||
hledger/*package.yaml \
|
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.
|
Re-export the modules of the hledger-web program.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Web (
|
module Hledger.Web
|
||||||
module Hledger.Web.WebOptions,
|
( module Hledger.Web.WebOptions
|
||||||
module Hledger.Web.Main,
|
, module Hledger.Web.Main
|
||||||
tests_Hledger_Web
|
, tests_Hledger_Web
|
||||||
)
|
) where
|
||||||
where
|
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
|
|
||||||
import Hledger.Web.WebOptions
|
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.
|
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
|
module Hledger.Web.Main where
|
||||||
where
|
|
||||||
|
|
||||||
-- yesod scaffold imports
|
import Control.Monad (when)
|
||||||
import Yesod.Default.Config --(fromArgs)
|
import Data.String (fromString)
|
||||||
-- import Yesod.Default.Main (defaultMain)
|
import qualified Data.Text as T
|
||||||
import Settings -- (parseExtra)
|
import Network.Wai (Application)
|
||||||
import Application (makeApplication)
|
|
||||||
import Data.String
|
|
||||||
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setHost, setPort)
|
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setHost, setPort)
|
||||||
import Network.Wai.Handler.Launch (runHostPortUrl)
|
import Network.Wai.Handler.Launch (runHostPortUrl)
|
||||||
--
|
import Prelude hiding (putStrLn)
|
||||||
import Control.Monad
|
|
||||||
import Data.Text (pack)
|
|
||||||
import System.Exit (exitSuccess)
|
import System.Exit (exitSuccess)
|
||||||
import System.IO (hFlush, stdout)
|
import System.IO (hFlush, stdout)
|
||||||
import Text.Printf
|
import Text.Printf (printf)
|
||||||
import Prelude hiding (putStrLn)
|
import Yesod.Default.Config
|
||||||
|
import Yesod.Default.Main (defaultDevelApp)
|
||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Utils.UTF8IOCompat (putStrLn)
|
|
||||||
import Hledger.Cli hiding (progname,prognameandversion)
|
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
|
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)
|
when (debug_ (cliopts_ opts) > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
|
||||||
runWith 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 :: WebOpts -> IO ()
|
||||||
runWith opts
|
runWith opts
|
||||||
| "help" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess
|
| "help" `inRawOpts` rawopts_ (cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess
|
||||||
| "version" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
|
| "version" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
|
||||||
| "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
|
| "binary-filename" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn (binaryfilename progname)
|
||||||
| otherwise = do
|
| otherwise = withJournalDoWeb opts web
|
||||||
requireJournalFileExists =<< (head `fmap` journalFilePathFromOpts (cliopts_ opts)) -- XXX head should be safe for now
|
|
||||||
withJournalDoWeb opts web
|
|
||||||
|
|
||||||
-- | A version of withJournalDo specialised for hledger-web.
|
-- | A version of withJournalDo specialised for hledger-web.
|
||||||
-- Disallows the special - file to avoid some bug,
|
-- Disallows the special - file to avoid some bug,
|
||||||
-- takes WebOpts rather than CliOpts.
|
-- 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
|
withJournalDoWeb opts@WebOpts {cliopts_ = copts} cmd = do
|
||||||
journalpaths <- journalFilePathFromOpts copts
|
journalpaths <- journalFilePathFromOpts copts
|
||||||
|
|
||||||
-- https://github.com/simonmichael/hledger/issues/202
|
-- https://github.com/simonmichael/hledger/issues/202
|
||||||
-- -f- gives [Error#yesod-core] <stdin>: hGetContents: illegal operation (handle is closed)
|
-- -f- gives [Error#yesod-core] <stdin>: hGetContents: illegal operation (handle is closed)
|
||||||
-- Also we may try to write to this file. Just disallow -.
|
-- 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"
|
error' "hledger-web doesn't support -f -, please specify a file path"
|
||||||
|
mapM_ requireJournalFileExists journalpaths
|
||||||
|
|
||||||
-- keep synced with withJournalDo TODO refactor
|
-- keep synced with withJournalDo TODO refactor
|
||||||
readJournalFiles (inputopts_ copts) journalpaths
|
readJournalFiles (inputopts_ copts) journalpaths
|
||||||
@ -74,11 +80,11 @@ web opts j = do
|
|||||||
h = host_ opts
|
h = host_ opts
|
||||||
p = port_ opts
|
p = port_ opts
|
||||||
u = base_url_ opts
|
u = base_url_ opts
|
||||||
staticRoot = pack <$> file_url_ opts
|
staticRoot = T.pack <$> file_url_ opts
|
||||||
appconfig = AppConfig{appEnv = Development
|
appconfig = AppConfig{appEnv = Development
|
||||||
,appHost = fromString h
|
,appHost = fromString h
|
||||||
,appPort = p
|
,appPort = p
|
||||||
,appRoot = pack u
|
,appRoot = T.pack u
|
||||||
,appExtra = Extra "" Nothing staticRoot
|
,appExtra = Extra "" Nothing staticRoot
|
||||||
}
|
}
|
||||||
app <- makeApplication opts j' appconfig
|
app <- makeApplication opts j' appconfig
|
||||||
@ -88,10 +94,7 @@ web opts j = do
|
|||||||
then do
|
then do
|
||||||
putStrLn "Press ctrl-c to quit"
|
putStrLn "Press ctrl-c to quit"
|
||||||
hFlush stdout
|
hFlush stdout
|
||||||
let warpsettings =
|
let warpsettings = setHost (fromString h) (setPort p defaultSettings)
|
||||||
setHost (fromString h) $
|
|
||||||
setPort p $
|
|
||||||
defaultSettings
|
|
||||||
Network.Wai.Handler.Warp.runSettings warpsettings app
|
Network.Wai.Handler.Warp.runSettings warpsettings app
|
||||||
else do
|
else do
|
||||||
putStrLn "Starting web browser..."
|
putStrLn "Starting web browser..."
|
||||||
|
|||||||
@ -4,23 +4,34 @@
|
|||||||
-- In addition, you can configure a number of different aspects of Yesod
|
-- In addition, you can configure a number of different aspects of Yesod
|
||||||
-- by overriding methods in the Yesod typeclass. That instance is
|
-- by overriding methods in the Yesod typeclass. That instance is
|
||||||
-- declared in the Foundation.hs file.
|
-- declared in the Foundation.hs file.
|
||||||
module Settings where
|
module Hledger.Web.Settings where
|
||||||
|
|
||||||
import Prelude
|
import Data.Default (def)
|
||||||
import Text.Shakespeare.Text (st)
|
import Data.Semigroup ((<>))
|
||||||
import Language.Haskell.TH.Syntax
|
|
||||||
import Yesod.Default.Config
|
|
||||||
import Yesod.Default.Util
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Yaml
|
import Data.Yaml
|
||||||
import Settings.Development
|
import Language.Haskell.TH.Syntax (Q, Exp)
|
||||||
import Data.Default (def)
|
|
||||||
import Text.Hamlet
|
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
|
production :: Bool
|
||||||
|
production = not development
|
||||||
|
|
||||||
|
hledgerorgurl :: Text
|
||||||
hledgerorgurl = "http://hledger.org"
|
hledgerorgurl = "http://hledger.org"
|
||||||
manualurl = hledgerorgurl++"/manual"
|
|
||||||
|
manualurl :: Text
|
||||||
|
manualurl = hledgerorgurl <> "/manual"
|
||||||
|
|
||||||
-- | The default IP address to listen on. May be overridden with --host.
|
-- | The default IP address to listen on. May be overridden with --host.
|
||||||
defhost :: String
|
defhost :: String
|
||||||
@ -1,12 +1,10 @@
|
|||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
module Settings.StaticFiles where
|
module Hledger.Web.Settings.StaticFiles where
|
||||||
|
|
||||||
import Prelude (IO, putStrLn, (++), (>>), return)
|
|
||||||
import System.IO (stdout, hFlush)
|
import System.IO (stdout, hFlush)
|
||||||
import Yesod.Static
|
import Yesod.Static (Static, embed, publicFiles, staticDevel)
|
||||||
import qualified Yesod.Static as Static
|
|
||||||
import Settings (staticDir)
|
import Hledger.Web.Settings (staticDir, development)
|
||||||
import Settings.Development
|
|
||||||
|
|
||||||
-- | use this to create your static file serving site
|
-- | use this to create your static file serving site
|
||||||
-- staticSite :: IO Static.Static
|
-- staticSite :: IO Static.Static
|
||||||
@ -20,14 +18,14 @@ import Settings.Development
|
|||||||
-- $(staticFiles Settings.staticDir)
|
-- $(staticFiles Settings.staticDir)
|
||||||
|
|
||||||
|
|
||||||
staticSite :: IO Static.Static
|
staticSite :: IO Static
|
||||||
staticSite =
|
staticSite =
|
||||||
if development
|
if development
|
||||||
then (do
|
then (do
|
||||||
putStrLn ("Using web files from: " ++ staticDir ++ "/") >> hFlush stdout
|
putStrLn ("Using web files from: " ++ staticDir ++ "/") >> hFlush stdout
|
||||||
Static.staticDevel staticDir)
|
staticDevel staticDir)
|
||||||
else (do
|
else (do
|
||||||
-- putStrLn "Using built-in web files" >> hFlush stdout
|
-- putStrLn "Using built-in web files" >> hFlush stdout
|
||||||
return $(Static.embed staticDir))
|
return $(embed staticDir))
|
||||||
|
|
||||||
$(publicFiles staticDir)
|
$(publicFiles staticDir)
|
||||||
@ -1,13 +1,19 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
module Hledger.Web.WebOptions
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
where
|
module Hledger.Web.WebOptions where
|
||||||
import Prelude
|
|
||||||
import Data.Default
|
|
||||||
import Data.Maybe
|
|
||||||
import System.Environment
|
|
||||||
|
|
||||||
import Hledger.Cli hiding (progname,version,prognameandversion)
|
import Data.ByteString (ByteString)
|
||||||
import Settings
|
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, version :: String
|
||||||
progname = "hledger-web"
|
progname = "hledger-web"
|
||||||
@ -19,81 +25,137 @@ version = ""
|
|||||||
prognameandversion :: String
|
prognameandversion :: String
|
||||||
prognameandversion = progname ++ " " ++ version :: String
|
prognameandversion = progname ++ " " ++ version :: String
|
||||||
|
|
||||||
webflags :: [Flag [([Char], [Char])]]
|
webflags :: [Flag [(String, String)]]
|
||||||
webflags = [
|
webflags =
|
||||||
flagNone ["serve","server"] (setboolopt "serve") ("serve and log requests, don't browse or auto-exit")
|
[ flagNone
|
||||||
,flagReq ["host"] (\s opts -> Right $ setopt "host" s opts) "IPADDR" ("listen on this IP address (default: "++defhost++")")
|
["serve", "server"]
|
||||||
,flagReq ["port"] (\s opts -> Right $ setopt "port" s opts) "PORT" ("listen on this TCP port (default: "++show defport++")")
|
(setboolopt "serve")
|
||||||
,flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "BASEURL" ("set the base url (default: http://IPADDR:PORT)")
|
"serve and log requests, don't browse or auto-exit"
|
||||||
,flagReq ["file-url"] (\s opts -> Right $ setopt "file-url" s opts) "FILEURL" ("set the static files url (default: BASEURL/static)")
|
, 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 [(String, String)]
|
||||||
webmode = (mode "hledger-web" [("command","web")]
|
webmode =
|
||||||
|
(mode
|
||||||
|
"hledger-web"
|
||||||
|
[("command", "web")]
|
||||||
"start serving the hledger web interface"
|
"start serving the hledger web interface"
|
||||||
(argsFlag "[PATTERNS]") []){
|
(argsFlag "[PATTERNS]")
|
||||||
modeGroupFlags = Group {
|
[])
|
||||||
groupUnnamed = webflags
|
{ modeGroupFlags =
|
||||||
,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"]
|
Group
|
||||||
,groupNamed = [generalflagsgroup1]
|
{ groupUnnamed = webflags
|
||||||
}
|
, groupHidden =
|
||||||
,modeHelpSuffix=[
|
[ flagNone
|
||||||
-- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."
|
["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
|
-- hledger-web options, used in hledger-web and above
|
||||||
data WebOpts = WebOpts {
|
data WebOpts = WebOpts
|
||||||
serve_ :: Bool
|
{ serve_ :: Bool
|
||||||
,host_ :: String
|
, host_ :: String
|
||||||
,port_ :: Int
|
, port_ :: Int
|
||||||
,base_url_ :: String
|
, base_url_ :: String
|
||||||
,file_url_ :: Maybe String
|
, file_url_ :: Maybe String
|
||||||
,cliopts_ :: CliOpts
|
, capabilities_ :: [Capability]
|
||||||
|
, capabilitiesHeader_ :: Maybe (CI ByteString)
|
||||||
|
, cliopts_ :: CliOpts
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
defwebopts :: WebOpts
|
defwebopts :: WebOpts
|
||||||
defwebopts = WebOpts
|
defwebopts = WebOpts def def def def def [CapView, CapAdd] Nothing def
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
def
|
|
||||||
|
|
||||||
-- instance Default WebOpts where def = defwebopts
|
instance Default WebOpts where def = defwebopts
|
||||||
|
|
||||||
rawOptsToWebOpts :: RawOpts -> IO WebOpts
|
rawOptsToWebOpts :: RawOpts -> IO WebOpts
|
||||||
rawOptsToWebOpts rawopts = checkWebOpts <$> do
|
rawOptsToWebOpts rawopts =
|
||||||
|
checkWebOpts <$> do
|
||||||
cliopts <- rawOptsToCliOpts rawopts
|
cliopts <- rawOptsToCliOpts rawopts
|
||||||
let
|
let h = fromMaybe defhost $ maybestringopt "host" rawopts
|
||||||
h = fromMaybe defhost $ maybestringopt "host" rawopts
|
|
||||||
p = fromMaybe defport $ maybeintopt "port" rawopts
|
p = fromMaybe defport $ maybeintopt "port" rawopts
|
||||||
b = maybe (defbaseurl h p) stripTrailingSlash $ maybestringopt "base-url" rawopts
|
b =
|
||||||
return defwebopts {
|
maybe (defbaseurl h p) stripTrailingSlash $
|
||||||
serve_ = boolopt "serve" rawopts
|
maybestringopt "base-url" rawopts
|
||||||
,host_ = h
|
caps' = join $ T.splitOn "," . T.pack <$> listofstringopt "capabilities" rawopts
|
||||||
,port_ = p
|
caps = case traverse capabilityFromText caps' of
|
||||||
,base_url_ = b
|
Left e -> error' ("Unknown capability: " ++ T.unpack e)
|
||||||
,file_url_ = stripTrailingSlash <$> maybestringopt "file-url" rawopts
|
Right [] -> [CapView, CapAdd]
|
||||||
,cliopts_ = cliopts
|
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
|
where
|
||||||
stripTrailingSlash = reverse . dropWhile (=='/') . reverse -- yesod don't like it
|
stripTrailingSlash = reverse . dropWhile (== '/') . reverse -- yesod don't like it
|
||||||
|
|
||||||
checkWebOpts :: WebOpts -> WebOpts
|
checkWebOpts :: WebOpts -> WebOpts
|
||||||
checkWebOpts wopts =
|
checkWebOpts wopts = do
|
||||||
either usageError (const wopts) $ do
|
|
||||||
let h = host_ wopts
|
let h = host_ wopts
|
||||||
if any (not . (`elem` ".0123456789")) h
|
if any (`notElem` (".0123456789" :: String)) h
|
||||||
then Left $ "--host requires an IP address, not "++show h
|
then usageError $ "--host requires an IP address, not " ++ show h
|
||||||
else Right ()
|
else wopts
|
||||||
|
|
||||||
getHledgerWebOpts :: IO WebOpts
|
getHledgerWebOpts :: IO WebOpts
|
||||||
--getHledgerWebOpts = processArgs webmode >>= return . decodeRawOpts >>= rawOptsToWebOpts
|
|
||||||
getHledgerWebOpts = do
|
getHledgerWebOpts = do
|
||||||
args <- getArgs >>= expandArgsAt
|
args <- fmap replaceNumericFlags . expandArgsAt =<< getArgs
|
||||||
let args' = replaceNumericFlags args
|
rawOptsToWebOpts . decodeRawOpts . either usageError id $ process webmode args
|
||||||
let cmdargopts = either usageError id $ process webmode args'
|
|
||||||
rawOptsToWebOpts $ decodeRawOpts cmdargopts
|
|
||||||
|
|
||||||
|
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 #-}
|
{-# LANGUAGE PackageImports #-}
|
||||||
import "hledger-web" Application (getApplicationDev)
|
import "hledger-web" Hledger.Web.Main (hledgerWebDev)
|
||||||
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort)
|
import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort)
|
||||||
import Control.Concurrent (forkIO)
|
import Control.Concurrent (forkIO)
|
||||||
import System.Directory (doesFileExist, removeFile)
|
import System.Directory (doesFileExist, removeFile)
|
||||||
@ -9,7 +9,7 @@ import Control.Concurrent (threadDelay)
|
|||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
putStrLn "Starting devel application"
|
putStrLn "Starting devel application"
|
||||||
(port, app) <- getApplicationDev
|
(port, app) <- hledgerWebDev
|
||||||
forkIO $ runSettings (setPort port defaultSettings) app
|
forkIO $ runSettings (setPort port defaultSettings) app
|
||||||
loop
|
loop
|
||||||
|
|
||||||
@ -1,10 +1,13 @@
|
|||||||
/favicon.ico FaviconR GET
|
/favicon.ico FaviconR GET
|
||||||
/robots.txt RobotsR GET
|
/robots.txt RobotsR GET
|
||||||
/static StaticR Static getStatic
|
/static StaticR Static getStatic
|
||||||
/ RootR GET
|
|
||||||
/journal JournalR GET POST
|
|
||||||
/register RegisterR GET POST
|
|
||||||
/sidebar SidebarR GET
|
|
||||||
|
|
||||||
-- /accounts AccountsR GET
|
/ RootR GET
|
||||||
-- /api/accounts AccountsJsonR 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
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: f9b958b9292d00ff739999dbd9f5a467b38eac93caa7d16950e03c4c15737b4c
|
-- hash: f95975f3e5a52d5f6d87d3a8fbb3feb0b74e14c550820bb276de675d990010f2
|
||||||
|
|
||||||
name: hledger-web
|
name: hledger-web
|
||||||
version: 1.9.99
|
version: 1.9.99
|
||||||
@ -38,7 +38,6 @@ extra-source-files:
|
|||||||
hledger-web.1
|
hledger-web.1
|
||||||
hledger-web.info
|
hledger-web.info
|
||||||
hledger-web.txt
|
hledger-web.txt
|
||||||
messages/en.msg
|
|
||||||
README
|
README
|
||||||
static/css/bootstrap-datepicker.standalone.min.css
|
static/css/bootstrap-datepicker.standalone.min.css
|
||||||
static/css/bootstrap-theme.css
|
static/css/bootstrap-theme.css
|
||||||
@ -97,8 +96,16 @@ extra-source-files:
|
|||||||
static/js/jquery.url.js
|
static/js/jquery.url.js
|
||||||
static/js/typeahead.bundle.js
|
static/js/typeahead.bundle.js
|
||||||
static/js/typeahead.bundle.min.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-wrapper.hamlet
|
||||||
templates/default-layout.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
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
@ -120,36 +127,39 @@ flag threaded
|
|||||||
default: True
|
default: True
|
||||||
|
|
||||||
library
|
library
|
||||||
|
hs-source-dirs:
|
||||||
|
./.
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Application
|
|
||||||
Foundation
|
|
||||||
Handler.AddForm
|
|
||||||
Handler.Common
|
|
||||||
Handler.JournalR
|
|
||||||
Handler.RegisterR
|
|
||||||
Handler.RootR
|
|
||||||
Handler.SidebarR
|
|
||||||
Handler.Utils
|
|
||||||
Hledger.Web
|
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.Main
|
||||||
|
Hledger.Web.Settings
|
||||||
|
Hledger.Web.Settings.StaticFiles
|
||||||
Hledger.Web.WebOptions
|
Hledger.Web.WebOptions
|
||||||
Import
|
Hledger.Web.Widget.AddForm
|
||||||
Settings
|
Hledger.Web.Widget.Common
|
||||||
Settings.Development
|
|
||||||
Settings.StaticFiles
|
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_hledger_web
|
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"
|
cpp-options: -DVERSION="1.9.99"
|
||||||
build-depends:
|
build-depends:
|
||||||
HUnit
|
HUnit
|
||||||
, base >=4.8 && <4.12
|
, base >=4.8 && <4.12
|
||||||
, base-compat-batteries >=0.10.1 && <0.11
|
|
||||||
, blaze-html
|
, blaze-html
|
||||||
, blaze-markup
|
, blaze-markup
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, case-insensitive
|
||||||
, clientsession
|
, clientsession
|
||||||
, cmdargs >=0.10
|
, cmdargs >=0.10
|
||||||
|
, conduit
|
||||||
, conduit-extra >=1.1
|
, conduit-extra >=1.1
|
||||||
, data-default
|
, data-default
|
||||||
, directory
|
, directory
|
||||||
@ -162,8 +172,7 @@ library
|
|||||||
, json
|
, json
|
||||||
, megaparsec >=6.4.1
|
, megaparsec >=6.4.1
|
||||||
, mtl
|
, mtl
|
||||||
, parsec >=3
|
, semigroups
|
||||||
, safe >=0.2
|
|
||||||
, shakespeare >=2.0.2.2
|
, shakespeare >=2.0.2.2
|
||||||
, template-haskell
|
, template-haskell
|
||||||
, text >=1.2
|
, text >=1.2
|
||||||
@ -178,10 +187,8 @@ library
|
|||||||
, yesod-core >=1.4 && <1.7
|
, yesod-core >=1.4 && <1.7
|
||||||
, yesod-form >=1.4 && <1.7
|
, yesod-form >=1.4 && <1.7
|
||||||
, yesod-static >=1.4 && <1.7
|
, yesod-static >=1.4 && <1.7
|
||||||
if (flag(dev)) || (flag(library-only))
|
if impl(ghc >=8)
|
||||||
cpp-options: -DDEVELOPMENT
|
ghc-options: -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints
|
||||||
if flag(dev)
|
|
||||||
ghc-options: -O0
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable hledger-web
|
executable hledger-web
|
||||||
@ -190,50 +197,13 @@ executable hledger-web
|
|||||||
Paths_hledger_web
|
Paths_hledger_web
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
app
|
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"
|
cpp-options: -DVERSION="1.9.99"
|
||||||
build-depends:
|
build-depends:
|
||||||
HUnit
|
base
|
||||||
, 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
|
|
||||||
, hledger-web
|
, hledger-web
|
||||||
, http-client
|
if impl(ghc >=8)
|
||||||
, http-conduit
|
ghc-options: -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints
|
||||||
, 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 flag(library-only)
|
if flag(library-only)
|
||||||
buildable: False
|
buildable: False
|
||||||
if flag(threaded)
|
if flag(threaded)
|
||||||
@ -249,50 +219,13 @@ test-suite test
|
|||||||
Paths_hledger_web
|
Paths_hledger_web
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
tests
|
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"
|
cpp-options: -DVERSION="1.9.99"
|
||||||
build-depends:
|
build-depends:
|
||||||
HUnit
|
base
|
||||||
, 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
|
|
||||||
, hledger-web
|
, hledger-web
|
||||||
, hspec
|
, 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
|
, yesod-test
|
||||||
if (flag(dev)) || (flag(library-only))
|
if impl(ghc >=8)
|
||||||
cpp-options: -DDEVELOPMENT
|
ghc-options: -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints
|
||||||
if flag(dev)
|
|
||||||
ghc-options: -O0
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|||||||
@ -1 +0,0 @@
|
|||||||
Hello: Hello
|
|
||||||
@ -30,7 +30,6 @@ extra-source-files:
|
|||||||
- config/robots.txt
|
- config/robots.txt
|
||||||
- config/routes
|
- config/routes
|
||||||
- config/settings.yml
|
- config/settings.yml
|
||||||
- messages/*.msg
|
|
||||||
- static/css/*.css
|
- static/css/*.css
|
||||||
- static/css/*.map
|
- static/css/*.map
|
||||||
- static/fonts/*.eot
|
- static/fonts/*.eot
|
||||||
@ -45,8 +44,6 @@ extra-source-files:
|
|||||||
- hledger-web.txt
|
- hledger-web.txt
|
||||||
- hledger-web.info
|
- hledger-web.info
|
||||||
|
|
||||||
#data-files:
|
|
||||||
|
|
||||||
flags:
|
flags:
|
||||||
library-only:
|
library-only:
|
||||||
description: Build for use with "yesod devel"
|
description: Build for use with "yesod devel"
|
||||||
@ -61,44 +58,6 @@ flags:
|
|||||||
manual: false
|
manual: false
|
||||||
default: true
|
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:
|
when:
|
||||||
- condition: (flag(dev)) || (flag(library-only))
|
- condition: (flag(dev)) || (flag(library-only))
|
||||||
cpp-options: -DDEVELOPMENT
|
cpp-options: -DDEVELOPMENT
|
||||||
@ -107,31 +66,72 @@ when:
|
|||||||
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -Wall
|
- -Wall
|
||||||
- -fno-warn-unused-do-bind
|
- -fwarn-tabs
|
||||||
- -fno-warn-name-shadowing
|
when:
|
||||||
- -fno-warn-missing-signatures
|
- condition: impl(ghc >=8)
|
||||||
- -fno-warn-type-defaults
|
ghc-options:
|
||||||
- -fno-warn-orphans
|
- -Wcompat
|
||||||
|
- -Wincomplete-uni-patterns
|
||||||
|
- -Wincomplete-record-updates
|
||||||
|
- -Wredundant-constraints
|
||||||
|
|
||||||
library:
|
library:
|
||||||
|
source-dirs: .
|
||||||
cpp-options: -DVERSION="1.9.99"
|
cpp-options: -DVERSION="1.9.99"
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
- Application
|
|
||||||
- Foundation
|
|
||||||
- Handler.AddForm
|
|
||||||
- Handler.Common
|
|
||||||
- Handler.JournalR
|
|
||||||
- Handler.RegisterR
|
|
||||||
- Handler.RootR
|
|
||||||
- Handler.SidebarR
|
|
||||||
- Handler.Utils
|
|
||||||
- Hledger.Web
|
- 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.Main
|
||||||
|
- Hledger.Web.Settings
|
||||||
|
- Hledger.Web.Settings.StaticFiles
|
||||||
- Hledger.Web.WebOptions
|
- Hledger.Web.WebOptions
|
||||||
- Import
|
- Hledger.Web.Widget.AddForm
|
||||||
- Settings
|
- Hledger.Web.Widget.Common
|
||||||
- Settings.Development
|
dependencies:
|
||||||
- Settings.StaticFiles
|
- 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:
|
executables:
|
||||||
hledger-web:
|
hledger-web:
|
||||||
@ -139,6 +139,7 @@ executables:
|
|||||||
main: main.hs
|
main: main.hs
|
||||||
cpp-options: -DVERSION="1.9.99"
|
cpp-options: -DVERSION="1.9.99"
|
||||||
dependencies:
|
dependencies:
|
||||||
|
- base
|
||||||
- hledger-web
|
- hledger-web
|
||||||
when:
|
when:
|
||||||
- condition: flag(library-only)
|
- condition: flag(library-only)
|
||||||
@ -152,6 +153,7 @@ tests:
|
|||||||
main: main.hs
|
main: main.hs
|
||||||
cpp-options: -DVERSION="1.9.99"
|
cpp-options: -DVERSION="1.9.99"
|
||||||
dependencies:
|
dependencies:
|
||||||
|
- base
|
||||||
- hledger-web
|
- hledger-web
|
||||||
- hspec
|
- hspec
|
||||||
- yesod-test
|
- yesod-test
|
||||||
|
|||||||
@ -20,37 +20,6 @@
|
|||||||
/*------------------------------------------------------------------------------------------*/
|
/*------------------------------------------------------------------------------------------*/
|
||||||
/* 4. typeahead styles */
|
/* 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 {
|
.tt-hint {
|
||||||
color: #bbb;
|
color: #bbb;
|
||||||
}
|
}
|
||||||
@ -70,9 +39,6 @@
|
|||||||
max-height:300px;
|
max-height:300px;
|
||||||
}
|
}
|
||||||
|
|
||||||
.tt-suggestions {
|
|
||||||
}
|
|
||||||
|
|
||||||
.tt-suggestion {
|
.tt-suggestion {
|
||||||
padding: 3px 20px;
|
padding: 3px 20px;
|
||||||
font-size: 18px;
|
font-size: 18px;
|
||||||
@ -82,7 +48,6 @@
|
|||||||
.tt-suggestion.tt-cursor {
|
.tt-suggestion.tt-cursor {
|
||||||
color: #fff;
|
color: #fff;
|
||||||
background-color: #0097cf;
|
background-color: #0097cf;
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
.tt-suggestion p {
|
.tt-suggestion p {
|
||||||
@ -148,30 +113,16 @@ ul {
|
|||||||
background-color: transparent;
|
background-color: transparent;
|
||||||
}
|
}
|
||||||
|
|
||||||
#sidebar-menu .main-menu .only{
|
#sidebar-menu .main-menu .only {
|
||||||
visibility: hidden;
|
visibility: hidden;
|
||||||
padding: 1px;
|
padding: 1px;
|
||||||
}
|
}
|
||||||
|
|
||||||
#sidebar-menu .main-menu tr:hover > td > div > .only {
|
#sidebar-menu .main-menu tr:hover .only {
|
||||||
visibility: visible;
|
visibility: visible;
|
||||||
}
|
}
|
||||||
|
|
||||||
#sidebar-menu .main-menu .only:hover{
|
#sidebar-menu .main-menu .inacct, #sidebar-menu .main-menu .inacct .acct-name {
|
||||||
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 {
|
|
||||||
font-weight: bold;
|
font-weight: bold;
|
||||||
color: #11427D;
|
color: #11427D;
|
||||||
background-color: #f9f9f9;
|
background-color: #f9f9f9;
|
||||||
@ -188,7 +139,7 @@ ul {
|
|||||||
vertical-align:bottom;
|
vertical-align:bottom;
|
||||||
}
|
}
|
||||||
|
|
||||||
.transactionsreport .nonhead {
|
.transactionsreport .posting td {
|
||||||
border: none !important;
|
border: none !important;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -200,24 +151,6 @@ ul {
|
|||||||
whitespace: nowrap;
|
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 {
|
.col-any-0 {
|
||||||
width:0 !important;
|
width:0 !important;
|
||||||
height:0 !important;
|
height:0 !important;
|
||||||
@ -229,10 +162,6 @@ ul {
|
|||||||
font-size:large;
|
font-size:large;
|
||||||
}
|
}
|
||||||
|
|
||||||
#searchbar {
|
|
||||||
width: 100% !important;
|
|
||||||
}
|
|
||||||
|
|
||||||
@media screen and (max-width: 768px) {
|
@media screen and (max-width: 768px) {
|
||||||
.row-offcanvas {
|
.row-offcanvas {
|
||||||
position: relative;
|
position: relative;
|
||||||
|
|||||||
@ -4,9 +4,13 @@
|
|||||||
// STARTUP
|
// STARTUP
|
||||||
|
|
||||||
$(document).ready(function() {
|
$(document).ready(function() {
|
||||||
// cache the input element as a variable
|
// date picker
|
||||||
// for minor performance benefits
|
// http://bootstrap-datepicker.readthedocs.io/en/latest/options.html
|
||||||
var dateEl = $('#dateWrap');
|
var dateEl = $('#dateWrap').datepicker({
|
||||||
|
showOnFocus: false,
|
||||||
|
autoclose: true,
|
||||||
|
format: 'yyyy-mm-dd'
|
||||||
|
});;
|
||||||
|
|
||||||
// ensure add form always focuses its first field
|
// ensure add form always focuses its first field
|
||||||
$('#addmodal')
|
$('#addmodal')
|
||||||
@ -18,36 +22,22 @@ $(document).ready(function() {
|
|||||||
dateEl.datepicker('hide');
|
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
|
// keyboard shortcuts
|
||||||
// 'body' seems to hold focus better than document in FF
|
// 'body' seems to hold focus better than document in FF
|
||||||
$('body').bind('keydown', 'h', function(){ $('#helpmodal').modal('toggle'); return false; });
|
$('body').bind('keydown', 'h', function(){ $('#helpmodal').modal('toggle'); return false; });
|
||||||
$('body').bind('keydown', 'shift+/', 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', 'j', function(){ location.href = document.hledgerWebBaseurl+'/journal'; return false; });
|
||||||
$('body').bind('keydown', 's', function(){ sidebarToggle(); 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', 'a', function(){ addformShow(); return false; });
|
||||||
$('body').bind('keydown', 'n', function(){ addformShow(); return false; });
|
$('body').bind('keydown', 'n', function(){ addformShow(); return false; });
|
||||||
$('body').bind('keydown', 'f', function(){ $('#searchform input').focus(); 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+shift+=', addformAddPosting);
|
||||||
$('body, #addform input, #addform select').bind('keydown', 'ctrl+=', addformAddPosting);
|
$('body, #addform input, #addform select').bind('keydown', 'ctrl+=', addformAddPosting);
|
||||||
$('body, #addform input, #addform select').bind('keydown', 'ctrl+-', addformDeletePosting);
|
$('body, #addform input, #addform select').bind('keydown', 'ctrl+-', addformDeletePosting);
|
||||||
$('.amount-input:last').keypress(addformAddPosting);
|
$('.amount-input:last').keypress(addformAddPosting);
|
||||||
|
|
||||||
|
|
||||||
// highlight the entry from the url hash
|
// highlight the entry from the url hash
|
||||||
if (window.location.hash && $(window.location.hash)[0]) {
|
if (window.location.hash && $(window.location.hash)[0]) {
|
||||||
$(window.location.hash).addClass('highlighted');
|
$(window.location.hash).addClass('highlighted');
|
||||||
@ -78,10 +68,9 @@ function registerChart($container, series) {
|
|||||||
position: 'sw'
|
position: 'sw'
|
||||||
},
|
},
|
||||||
grid: {
|
grid: {
|
||||||
markings:
|
markings: function () {
|
||||||
function (axes) {
|
|
||||||
var now = Date.now();
|
var now = Date.now();
|
||||||
var markings = [
|
return [
|
||||||
{
|
{
|
||||||
xaxis: { to: now }, // past
|
xaxis: { to: now }, // past
|
||||||
yaxis: { to: 0 }, // <0
|
yaxis: { to: 0 }, // <0
|
||||||
@ -103,7 +92,6 @@ function registerChart($container, series) {
|
|||||||
lineWidth:1
|
lineWidth:1
|
||||||
},
|
},
|
||||||
];
|
];
|
||||||
return markings;
|
|
||||||
},
|
},
|
||||||
hoverable: true,
|
hoverable: true,
|
||||||
autoHighlight: true,
|
autoHighlight: true,
|
||||||
@ -127,16 +115,17 @@ function registerChart($container, series) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
function registerChartClick(ev, pos, item) {
|
function registerChartClick(ev, pos, item) {
|
||||||
if (item) {
|
if (!item) {
|
||||||
targetselector = '#'+item.series.data[item.dataIndex][5];
|
return;
|
||||||
$target = $(targetselector);
|
}
|
||||||
|
var targetselector = '#' + item.series.data[item.dataIndex][5];
|
||||||
|
var $target = $(targetselector);
|
||||||
if ($target.length) {
|
if ($target.length) {
|
||||||
window.location.hash = targetselector;
|
window.location.hash = targetselector;
|
||||||
$('html, body').animate({
|
$('html, body').animate({
|
||||||
scrollTop: $target.offset().top
|
scrollTop: $target.offset().top
|
||||||
}, 1000);
|
}, 1000);
|
||||||
}
|
}
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
//----------------------------------------------------------------------
|
//----------------------------------------------------------------------
|
||||||
@ -174,59 +163,46 @@ function focus($el) {
|
|||||||
|
|
||||||
// Insert another posting row in the add form.
|
// Insert another posting row in the add form.
|
||||||
function addformAddPosting() {
|
function addformAddPosting() {
|
||||||
$('.amount-input:last').off('keypress');
|
if (!$('#addform').is(':visible')) {
|
||||||
// do nothing if it's not currently visible
|
return;
|
||||||
if (!$('#addform').is(':visible')) return;
|
}
|
||||||
// save a copy of last row
|
|
||||||
var lastrow = $('#addform .form-group:last').clone();
|
|
||||||
|
|
||||||
// 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;
|
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
|
// clear and renumber the field, add keybindings
|
||||||
$acctinput
|
// XXX Enable typehead on dynamically created inputs
|
||||||
|
$('.amount-input:last')
|
||||||
.val('')
|
.val('')
|
||||||
.prop('id','account'+(num+1))
|
.prop('placeholder','Amount ' + num)
|
||||||
.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))
|
|
||||||
.keypress(addformAddPosting);
|
.keypress(addformAddPosting);
|
||||||
|
|
||||||
$acctinput
|
$('.account-input:last')
|
||||||
|
.val('')
|
||||||
|
.prop('placeholder', 'Account ' + num)
|
||||||
|
.bind('keydown', 'ctrl++', addformAddPosting)
|
||||||
.bind('keydown', 'ctrl+shift+=', addformAddPosting)
|
.bind('keydown', 'ctrl+shift+=', addformAddPosting)
|
||||||
.bind('keydown', 'ctrl+=', addformAddPosting)
|
.bind('keydown', 'ctrl+=', addformAddPosting)
|
||||||
.bind('keydown', 'ctrl+-', addformDeletePosting);
|
.bind('keydown', 'ctrl+-', addformDeletePosting);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
// Remove the add form's last posting row, if empty, keeping at least two.
|
// Remove the add form's last posting row, if empty, keeping at least two.
|
||||||
function addformDeletePosting() {
|
function addformDeletePosting() {
|
||||||
var num = $('#addform .account-group').length;
|
if ($('#addform .account-group').length <= 2) {
|
||||||
if (num <= 2) return;
|
return;
|
||||||
|
}
|
||||||
// remember if the last row's field or button had focus
|
// remember if the last row's field or button had focus
|
||||||
var focuslost =
|
var focuslost =
|
||||||
$('.account-input:last').is(':focus')
|
$('.account-input:last').is(':focus')
|
||||||
|| $('.amount-input:last').is(':focus');
|
|| $('.amount-input:last').is(':focus');
|
||||||
// delete last row
|
// delete last row
|
||||||
$('#addform .account-group:last').remove();
|
$('#addform .account-group:last').remove();
|
||||||
if(focuslost){
|
if (focuslost) {
|
||||||
focus($('account-input:last'));
|
focus($('.account-input:last'));
|
||||||
}
|
}
|
||||||
// Rebind keypress
|
// Rebind keypress
|
||||||
$('.amount-input:last').keypress(addformAddPosting);
|
$('.amount-input:last').keypress(addformAddPosting);
|
||||||
@ -242,46 +218,7 @@ function sidebarToggle() {
|
|||||||
$.cookie('showsidebar', $('#sidebar-menu').hasClass('col-any-0') ? '0' : '1');
|
$.cookie('showsidebar', $('#sidebar-menu').hasClass('col-any-0') ? '0' : '1');
|
||||||
}
|
}
|
||||||
|
|
||||||
//----------------------------------------------------------------------
|
function emptyAccountsToggle() {
|
||||||
// MISC
|
$('.acct.empty').parent().toggleClass('hide');
|
||||||
|
$.cookie('hideemptyaccts', $.cookie('hideemptyaccts') === '1' ? '0' : '1')
|
||||||
function enableTypeahead($el, suggester) {
|
|
||||||
return $el.typeahead(
|
|
||||||
{
|
|
||||||
highlight: true
|
|
||||||
},
|
|
||||||
{
|
|
||||||
source: suggester.ttAdapter()
|
|
||||||
}
|
|
||||||
);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
// 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);
|
||||||
|
};
|
||||||
|
});
|
||||||
@ -47,61 +47,3 @@ $newline never
|
|||||||
<script>
|
<script>
|
||||||
window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})
|
window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})
|
||||||
\<![endif]-->
|
\<![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#spacer .col-xs-2.#{topShowsm}.#{topShowmd}>
|
||||||
<div #message>#{m}
|
<h1>
|
||||||
^{widget}
|
<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