hledger-web 1.9.2 → 1.10

raw patch · 51 files changed

+1636/−1913 lines, 51 filesdep +case-insensitivedep +conduitdep +semigroupsdep −base-compatdep −hspecdep −parsecdep ~basedep ~hledgerdep ~hledger-libPVP ok

version bump matches the API change (PVP)

Dependencies added: case-insensitive, conduit, semigroups

Dependencies removed: base-compat, hspec, parsec, safe, yesod-test

Dependency ranges changed: base, hledger, hledger-lib, megaparsec

API changes (from Hackage documentation)

Files

• Application.hs +0/−88
• CHANGES +15/−0
• Foundation.hs +0/−397
• Handler/AddForm.hs +0/−124
• Handler/Common.hs +0/−251
• Handler/JournalR.hs +0/−88
• Handler/RegisterR.hs +0/−181
• Handler/RootR.hs +0/−8
• Handler/SidebarR.hs +0/−15
• Handler/Utils.hs +0/−20
• Hledger/Web.hs +6/−6
• Hledger/Web/Application.hs +53/−0
• Hledger/Web/Foundation.hs +232/−0
• Hledger/Web/Handler/AddR.hs +40/−0
• Hledger/Web/Handler/Common.hs +38/−0
• Hledger/Web/Handler/EditR.hs +47/−0
• Hledger/Web/Handler/JournalR.hs +31/−0
• Hledger/Web/Handler/RegisterR.hs +60/−0
• Hledger/Web/Handler/UploadR.hs +63/−0
• Hledger/Web/Import.hs +31/−0
• Hledger/Web/Main.hs +44/−43
• Hledger/Web/Settings.hs +100/−0
• Hledger/Web/Settings/StaticFiles.hs +31/−0
• Hledger/Web/WebOptions.hs +133/−74
• Hledger/Web/Widget/AddForm.hs +144/−0
• Hledger/Web/Widget/Common.hs +89/−0
• Import.hs +0/−22
• Settings.hs +0/−92
• Settings/Development.hs +0/−15
• Settings/StaticFiles.hs +0/−33
• config/routes +8/−5
• hledger-web.1 +1/−1
• hledger-web.cabal +41/−128
• hledger-web.info +4/−4
• hledger-web.txt +1/−1
• messages/en.msg +0/−1
• static/hledger.css +14/−85
• static/hledger.js +44/−107
• templates/add-form.hamlet +71/−0
• templates/balance-report.hamlet +25/−0
• templates/chart.hamlet +59/−0
• templates/default-layout-wrapper.hamlet +1/−59
• templates/default-layout.hamlet +81/−4
• templates/edit-form.hamlet +17/−0
• templates/journal.hamlet +39/−0
• templates/manage.hamlet +22/−0
• templates/register.hamlet +37/−0
• templates/upload-form.hamlet +14/−0
• tests/HomeTest.hs +0/−25
• tests/TestImport.hs +0/−12
• tests/main.hs +0/−24

@@ -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,6 +1,21 @@ User-visible changes in hledger-web. See also hledger, hledger-lib.  +# 1.10 (2018/6/30)++* multiple -f options, and --auto, work again++* view, add, edit permissions can be set at CLI or by Sandstorm HTTP header++* the edit form has been revived, for whole-journal editing++* the journal can now be uploaded and downloaded++* the e key toggles empty accounts in the sidebar++* use hledger-lib 1.10++ # 1.9.2 (2018/4/30)  * use hledger-lib 1.9.1

@@ -1,397 +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-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif-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,124 +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--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif-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 Text.Megaparsec.Compat (digitChar, eof, some, string, runParser, ParseError, MPErr)--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 MPErr) 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)) "&nbsp;"-       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,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>-   &nbsp;-   <a href="@?{acctlink (paccount p')}##{tindex torig}" title="#{paccount p'}">#{elideAccountName 40 $ paccount p'}-  <td .amount .nonhead style="text-align:right;">#{mixedAmountAsHtml $ pamount p'}-|]-     where-       acctlink a = (RegisterR, [("q", T.pack $ accountQuery a)])-       -- datetransition | newm = "newmonth"-       --                | newd = "newday"-       --                | otherwise = "" :: String-       (date, desc) = (show $ tdate torig, tdescription torig)-       -- acctquery = (here, [("q", T.pack $ accountQuery acct)])-       showamt = not split || not (isZeroMixedAmount amt)-

@@ -1,181 +0,0 @@-{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-}--- | /register handlers.--module Handler.RegisterR where--import Import--import Data.List-import Data.Maybe--- import Data.Text (Text)-import qualified Data.Text as T-import Safe--import Handler.AddForm-import Handler.Common-import Handler.Utils--import Hledger.Data-import Hledger.Query-import Hledger.Reports-import Hledger.Utils-import Hledger.Cli.CliOptions-import Hledger.Web.WebOptions---- | The main journal/account register view, with accounts sidebar.-getRegisterR :: Handler Html-getRegisterR = do-  vd@VD{..} <- getViewData-  -- staticRootUrl <- (staticRoot . settings) <$> getYesod-  let -- injournal = isNothing inacct-      filtering = m /= Any-      -- title = "Transactions in "++a++s1++s2-      title = T.unpack a++s1++s2-               where-                 (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts-                 s1 = if inclsubs then "" else " (excluding subaccounts)"-                 s2 = if filtering then ", filtered" else ""-      maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts-  hledgerLayout vd "register" [hamlet|-       <h2 #contenttitle>#{title}-       <!-- p>Transactions affecting this account, with running balance. -->-       ^{maincontent}-     |]--postRegisterR :: Handler Html-postRegisterR = postAddForm---- Generate html for an account register, including a balance chart and transaction list.-registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute-registerReportHtml opts vd r = [hamlet|- <div .hidden-xs>-  ^{registerChartHtml $ transactionsReportByCommodity r}- ^{registerItemsHtml opts vd r}-|]---- Generate html for a transaction list from an "TransactionsReport".-registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute-registerItemsHtml _ vd (balancelabel,items) = [hamlet|-<div .table-responsive>- <table.registerreport .table .table-striped .table-condensed>-  <thead>-   <tr>-    <th style="text-align:left;">-     Date-     <span .glyphicon .glyphicon-chevron-up>-    <th style="text-align:left;">Description-    <th style="text-align:left;">To/From Account(s)-    <th style="text-align:right; white-space:normal;">Amount Out/In-    <th style="text-align:right; white-space:normal;">#{balancelabel'}-  $forall i <- numberTransactionsReportItems items-   ^{itemAsHtml vd i}- |]- where-   insomeacct = isJust $ inAccount $ qopts vd-   balancelabel' = if insomeacct then balancelabel else "Total"--   -- filtering = m /= Any-   itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute-   itemAsHtml VD{..} (n, newd, newm, _, (torig, tacct, split, acct, amt, bal)) = [hamlet|--<tr ##{tindex torig} .item.#{evenodd}.#{firstposting}.#{datetransition} title="#{show torig}" style="vertical-align:top;">- <td .date>-  <a href="@{JournalR}#transaction-#{tindex torig}">#{date}- <td .description title="#{show torig}">#{textElideRight 30 desc}- <td .account>#{elideRight 40 acct}- <td .amount style="text-align:right; white-space:nowrap;">-  $if showamt-   \#{mixedAmountAsHtml amt}- <td .balance style="text-align:right;">#{mixedAmountAsHtml bal}-|]--     where-       evenodd = if even n then "even" else "odd" :: String-       datetransition | newm = "newmonth"-                      | newd = "newday"-                      | otherwise = "" :: String-       (firstposting, date, desc) = (False, show $ tdate tacct, tdescription tacct)-       -- acctquery = (here, [("q", pack $ accountQuery acct)])-       showamt = not split || not (isZeroMixedAmount amt)---- | Generate javascript/html for a register balance line chart based on--- the provided "TransactionsReportItem"s.-               -- registerChartHtml :: forall t (t1 :: * -> *) t2 t3 t4 t5.-               --                      Data.Foldable.Foldable t1 =>-               --                      t1 (Transaction, t2, t3, t4, t5, MixedAmount)-               --                      -> t -> Text.Blaze.Internal.HtmlM ()-registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute-registerChartHtml percommoditytxnreports =- -- have to make sure plot is not called when our container (maincontent)- -- is hidden, eg with add form toggled- [hamlet|-<label #register-chart-label style=""><br>-<div #register-chart style="height:150px; margin-bottom:1em; display:block;">-<script type=text/javascript>- \$(document).ready(function() {-   var $chartdiv = $('#register-chart');-   if ($chartdiv.is(':visible')) {-     \$('#register-chart-label').text('#{charttitle}');-     var seriesData = [-      $forall (c,(_,items)) <- percommoditytxnreports-       /* we render each commodity using two series:-        * one with extra data points added to show a stepped balance line */-       {-        data: [-          $forall i <- reverse items-           [-            #{dayToJsTimestamp $ triDate i},-            #{simpleMixedAmountQuantity $ triCommodityBalance c i}-           ],-          /* [] */-        ],-        label: '#{shownull $ T.unpack c}',-        color: #{colorForCommodity c},-        lines: {-          show: true,-          steps: true,-        },-        points: {-          show: false,-        },-        clickable: false,-        hoverable: false,-       },-       /* and one with the original data, showing one clickable, hoverable point per transaction */-       {-        data: [-          $forall i <- reverse items-           [-            #{dayToJsTimestamp $ triDate i},-            #{simpleMixedAmountQuantity $ triCommodityBalance c i},-            '#{showMixedAmountWithZeroCommodity $ triCommodityAmount c i}',-            '#{showMixedAmountWithZeroCommodity $ triCommodityBalance c i}',-            '#{concat $ intersperse "\\n" $ lines  $ show $ triOrigTransaction i}',-            #{tindex $ triOrigTransaction i}-           ],-          /* [] */-        ],-        label: '',-        color: #{colorForCommodity c},-        lines: {-          show: false,-        },-        points: {-          show: true,-        },-       },-     ]-     var plot = registerChart($chartdiv, seriesData);-     \$chartdiv.bind("plotclick", registerChartClick);-   };- });-|]-           -- [#{dayToJsTimestamp $ ltrace "\ndate" $ triDate i}, #{ltrace "balancequantity" $ simpleMixedAmountQuantity $ triCommodityBalance c i}, '#{ltrace "balance" $ show $ triCommodityBalance c i}, '#{ltrace "amount" $ show $ triCommodityAmount c i}''],- where-   charttitle = case maybe "" (fst.snd) $ headMay percommoditytxnreports-           of "" -> ""-              s  -> s++":"-   colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex-   commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]-   simpleMixedAmountQuantity = maybe 0 aquantity . headMay . amounts-   shownull c = if null c then " " else c

@@ -1,8 +0,0 @@--- | Site root and misc. handlers.--module Handler.RootR where--import Import--getRootR :: Handler Html-getRootR = redirect defaultroute where defaultroute = JournalR

@@ -1,15 +0,0 @@-{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-}--- | /sidebar--module Handler.SidebarR where--import Import--import Handler.Common---- | Render just the accounts sidebar, useful when opening the sidebar.-getSidebarR :: Handler Html-getSidebarR = do-  vd <- getViewData-  withUrlRenderer [hamlet|^{sidebar vd}|]-

@@ -1,20 +0,0 @@-{-# LANGUAGE CPP #-}--- | Web handler utilities. More of these are in Foundation.hs, where--- they can be used in the default template.--module Handler.Utils where--import Prelude-import Data.Time.Calendar-import Data.Time.Clock-import Data.Time.Format-#if !(MIN_VERSION_time(1,5,0))-import System.Locale (defaultTimeLocale)-#endif--numbered :: [a] -> [(Int,a)]-numbered = zip [1..]--dayToJsTimestamp :: Day -> Integer-dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX read-                     where t = UTCTime d (secondsToDiffTime 0)

@@ -2,12 +2,12 @@ Re-export the modules of the hledger-web program. -} -module Hledger.Web (-                     module Hledger.Web.WebOptions,-                     module Hledger.Web.Main,-                     tests_Hledger_Web-              )-where+module Hledger.Web+  ( module Hledger.Web.WebOptions+  , module Hledger.Web.Main+  , tests_Hledger_Web+  ) where+ import Test.HUnit  import Hledger.Web.WebOptions

@@ -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

@@ -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)

@@ -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}+      |]

@@ -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)

@@ -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}|]

@@ -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")

@@ -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)

@@ -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}|]

@@ -0,0 +1,31 @@+{-# LANGUAGE CPP #-}+module Hledger.Web.Import+  ( module Import+  ) where++import           Prelude              as Import hiding (head, init, last,+                                                 readFile, tail, writeFile)+import           Yesod                as Import hiding (Route (..))++import           Control.Monad        as Import+import           Data.Bifunctor       as Import+import           Data.ByteString      as Import (ByteString)+import           Data.Default         as Import+import           Data.Either          as Import+import           Data.Foldable        as Import+import           Data.List            as Import (unfoldr)+import           Data.Maybe           as Import+import           Data.Text            as Import (Text)+import           Data.Time            as Import hiding (parseTime)+import           Data.Traversable     as Import+import           Data.Void            as Import (Void)+import           Text.Blaze           as Import (Markup)++import           Hledger.Web.Foundation           as Import+import           Hledger.Web.Settings             as Import+import           Hledger.Web.Settings.StaticFiles as Import+import           Hledger.Web.WebOptions           as Import (Capability(..))++#if !(MIN_VERSION_base(4,11,0))+import           Data.Monoid          as Import ((<>))+#endif

@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-|  hledger-web - a hledger add-on providing a web interface.@@ -7,32 +8,26 @@  -} -module Hledger.Web.Main-where+module Hledger.Web.Main where --- yesod scaffold imports-import Yesod.Default.Config --(fromArgs)--- import Yesod.Default.Main   (defaultMain)-import Settings            --  (parseExtra)-import Application          (makeApplication)-import Data.String+import Control.Monad (when)+import Data.String (fromString)+import qualified Data.Text as T+import Network.Wai (Application) import Network.Wai.Handler.Warp (runSettings, defaultSettings, setHost, setPort) import Network.Wai.Handler.Launch (runHostPortUrl)----#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif-import Control.Monad-import Data.Default-import Data.Text (pack)+import Prelude hiding (putStrLn) import System.Exit (exitSuccess) import System.IO (hFlush, stdout)-import Text.Printf-import Prelude hiding (putStrLn)+import Text.Printf (printf)+import Yesod.Default.Config+import Yesod.Default.Main (defaultDevelApp)  import Hledger-import Hledger.Utils.UTF8IOCompat (putStrLn) import Hledger.Cli hiding (progname,prognameandversion)+import Hledger.Utils.UTF8IOCompat (putStrLn)+import Hledger.Web.Application (makeApplication)+import Hledger.Web.Settings (Extra(..), parseExtra) import Hledger.Web.WebOptions  @@ -42,30 +37,39 @@   when (debug_ (cliopts_ opts) > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)   runWith opts +hledgerWebDev :: IO (Int, Application)+hledgerWebDev =+  withJournalDoWeb defwebopts (\o j -> defaultDevelApp loader $ makeApplication o j)+  where+    loader =+      Yesod.Default.Config.loadConfig+        (configSettings Development) {csParseExtra = parseExtra}+ runWith :: WebOpts -> IO () runWith opts-  | "help"            `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess-  | "version"         `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess-  | "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)-  | otherwise = do-    requireJournalFileExists =<< (head `fmap` journalFilePathFromOpts (cliopts_ opts)) -- XXX head should be safe for now-    withJournalDo' opts web+  | "help"            `inRawOpts` rawopts_ (cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess+  | "version"         `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn prognameandversion >> exitSuccess+  | "binary-filename" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn (binaryfilename progname)+  | otherwise = withJournalDoWeb opts web -withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO ()-withJournalDo' opts@WebOpts {cliopts_ = cliopts} cmd = do-  f <- head `fmap` journalFilePathFromOpts cliopts -- XXX head should be safe for now+-- | A version of withJournalDo specialised for hledger-web.+-- Disallows the special - file to avoid some bug,+-- takes WebOpts rather than CliOpts.+withJournalDoWeb :: WebOpts -> (WebOpts -> Journal -> IO a) -> IO a+withJournalDoWeb opts@WebOpts {cliopts_ = copts} cmd = do+  journalpaths <- journalFilePathFromOpts copts    -- https://github.com/simonmichael/hledger/issues/202-  -- -f- gives [Error#yesod-core] <stdin>: hGetContents: illegal operation (handle is closed) for some reason-  -- Also we may be writing to this file. Just disallow it.-  when (f == "-") $ error' "hledger-web doesn't support -f -, please specify a file path"+  -- -f- gives [Error#yesod-core] <stdin>: hGetContents: illegal operation (handle is closed)+  -- Also we may try to write to this file. Just disallow -.+  when ("-" `elem` journalpaths) $  -- always non-empty+    error' "hledger-web doesn't support -f -, please specify a file path"+  mapM_ requireJournalFileExists journalpaths -  let fn = cmd opts-         . pivotByOpts cliopts-         . anonymiseByOpts cliopts-       <=< journalApplyValue (reportopts_ cliopts)-       <=< journalAddForecast cliopts-  readJournalFile def f >>= either error' fn+  -- keep synced with withJournalDo  TODO refactor+  readJournalFiles (inputopts_ copts) journalpaths+  >>= mapM (journalTransform copts)+  >>= either error' (cmd opts)  -- | The web command. web :: WebOpts -> Journal -> IO ()@@ -76,11 +80,11 @@       h = host_ opts       p = port_ opts       u = base_url_ opts-      staticRoot = pack <$> file_url_ opts+      staticRoot = T.pack <$> file_url_ opts       appconfig = AppConfig{appEnv = Development                            ,appHost = fromString h                            ,appPort = p-                           ,appRoot = pack u+                           ,appRoot = T.pack u                            ,appExtra = Extra "" Nothing staticRoot                            }   app <- makeApplication opts j' appconfig@@ -90,10 +94,7 @@     then do       putStrLn "Press ctrl-c to quit"       hFlush stdout-      let warpsettings =-            setHost (fromString h) $-            setPort p $-            defaultSettings+      let warpsettings = setHost (fromString h) (setPort p defaultSettings)       Network.Wai.Handler.Warp.runSettings warpsettings app     else do       putStrLn "Starting web browser..."

@@ -0,0 +1,100 @@+{-# LANGUAGE CPP, OverloadedStrings, QuasiQuotes #-}+-- | Settings are centralized, as much as possible, into this file. This+-- includes database connection settings, static file locations, etc.+-- In addition, you can configure a number of different aspects of Yesod+-- by overriding methods in the Yesod typeclass. That instance is+-- declared in the Foundation.hs file.+module Hledger.Web.Settings where++import Data.Default (def)+import Data.Semigroup ((<>))+import Data.Text (Text)+import Data.Yaml+import Language.Haskell.TH.Syntax (Q, Exp)+import Text.Hamlet+import Text.Shakespeare.Text (st)+import Yesod.Default.Config+import Yesod.Default.Util++development :: Bool+development =+#if DEVELOPMENT+  True+#else+  False+#endif++production :: Bool+production = not development++hledgerorgurl :: Text+hledgerorgurl = "http://hledger.org"++manualurl :: Text+manualurl = hledgerorgurl <> "/manual"++-- | The default IP address to listen on. May be overridden with --host.+defhost :: String+defhost = "127.0.0.1"++-- | The default TCP port to listen on. May be overridden with --port.+defport :: Int+defport = 5000++defbaseurl :: String -> Int -> String+defbaseurl host port =+  "http://" ++ host ++ if port /= 80 then ":" ++ show port else ""++-- Static setting below. Changing these requires a recompile++-- | The location of static files on your system. This is a file system+-- path. The default value works properly with your scaffolded site.+staticDir :: FilePath+staticDir = "static"++-- | The base URL for your static files. As you can see by the default+-- value, this can simply be "static" appended to your application root.+-- A powerful optimization can be serving static files from a separate+-- domain name. This allows you to use a web server optimized for static+-- files, more easily set expires and cache values, and avoid possibly+-- costly transference of cookies on static files. For more information,+-- please see:+--   http://code.google.com/speed/page-speed/docs/request.html#ServeFromCookielessDomain+--+-- If you change the resource pattern for StaticR in Foundation.hs, you will+-- have to make a corresponding change here.+--+-- To see how this value is used, see urlRenderOverride in Foundation.hs+staticRoot :: AppConfig DefaultEnv Extra -> Text+staticRoot conf = case extraStaticRoot $ appExtra conf of+                    Just root -> root+                    Nothing -> [st|#{appRoot conf}/static|]++-- | Settings for 'widgetFile', such as which template languages to support and+-- default Hamlet settings.+widgetFileSettings :: WidgetFileSettings+widgetFileSettings = def+    { wfsHamletSettings = defaultHamletSettings+        { hamletNewlines = AlwaysNewlines+        }+    }++-- The rest of this file contains settings which rarely need changing by a+-- user.++widgetFile :: String -> Q Exp+widgetFile = (if development then widgetFileReload+                             else widgetFileNoReload)+              widgetFileSettings++data Extra = Extra+    { extraCopyright  :: Text+    , extraAnalytics  :: Maybe Text -- ^ Google Analytics+    , extraStaticRoot :: Maybe Text+    } deriving Show++parseExtra :: DefaultEnv -> Object -> Parser Extra+parseExtra _ o = Extra+    <$> o .:  "copyright"+    <*> o .:? "analytics"+    <*> o .:? "staticRoot"

@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell #-}+module Hledger.Web.Settings.StaticFiles where++import System.IO (stdout, hFlush)+import Yesod.Static (Static, embed, publicFiles, staticDevel)++import Hledger.Web.Settings (staticDir, development)++-- | use this to create your static file serving site+-- staticSite :: IO Static.Static+-- staticSite = if development then Static.staticDevel staticDir+--                             else Static.static      staticDir+--+-- | This generates easy references to files in the static directory at compile time,+--   giving you compile-time verification that referenced files exist.+--   Warning: any files added to your static directory during run-time can't be+--   accessed this way. You'll have to use their FilePath or URL to access them.+-- $(staticFiles Settings.staticDir)+++staticSite :: IO Static+staticSite =+  if development+   then (do+            putStrLn ("Using web files from: " ++ staticDir ++ "/") >> hFlush stdout+            staticDevel staticDir)+   else (do+            -- putStrLn "Using built-in web files" >> hFlush stdout+            return $(embed staticDir))++$(publicFiles staticDir)

@@ -1,17 +1,20 @@ {-# LANGUAGE CPP #-}-module Hledger.Web.WebOptions-where-import Prelude-import Data.Default-#if !MIN_VERSION_base(4,8,0)-import Data.Functor.Compat ((<$>))-#endif-import Data.Maybe-import System.Environment+{-# LANGUAGE OverloadedStrings #-}+module Hledger.Web.WebOptions where -import Hledger.Cli hiding (progname,version,prognameandversion)-import Settings+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BC+import Data.CaseInsensitive (CI, mk)+import Control.Monad (join)+import Data.Default (Default(def))+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import Data.Text (Text)+import System.Environment (getArgs) +import Hledger.Cli hiding (progname, version)+import Hledger.Web.Settings (defhost, defport, defbaseurl)+ progname, version :: String progname = "hledger-web" #ifdef VERSION@@ -22,81 +25,137 @@ prognameandversion :: String prognameandversion = progname ++ " " ++ version :: String -webflags :: [Flag [([Char], [Char])]]-webflags = [-  flagNone ["serve","server"]   (setboolopt "serve") ("serve and log requests, don't browse or auto-exit")- ,flagReq  ["host"]     (\s opts -> Right $ setopt "host" s opts) "IPADDR" ("listen on this IP address (default: "++defhost++")")- ,flagReq  ["port"]     (\s opts -> Right $ setopt "port" s opts) "PORT" ("listen on this TCP port (default: "++show defport++")")- ,flagReq  ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "BASEURL" ("set the base url (default: http://IPADDR:PORT)")- ,flagReq  ["file-url"] (\s opts -> Right $ setopt "file-url" s opts) "FILEURL" ("set the static files url (default: BASEURL/static)")- ]+webflags :: [Flag [(String, String)]]+webflags =+  [ flagNone+      ["serve", "server"]+      (setboolopt "serve")+      "serve and log requests, don't browse or auto-exit"+  , flagReq+      ["host"]+      (\s opts -> Right $ setopt "host" s opts)+      "IPADDR"+      ("listen on this IP address (default: " ++ defhost ++ ")")+  , flagReq+      ["port"]+      (\s opts -> Right $ setopt "port" s opts)+      "PORT"+      ("listen on this TCP port (default: " ++ show defport ++ ")")+  , flagReq+      ["base-url"]+      (\s opts -> Right $ setopt "base-url" s opts)+      "BASEURL"+      "set the base url (default: http://IPADDR:PORT)"+  , flagReq+      ["file-url"]+      (\s opts -> Right $ setopt "file-url" s opts)+      "FILEURL"+      "set the static files url (default: BASEURL/static)"+  , flagReq+      ["capabilities"]+      (\s opts -> Right $ setopt "capabilities" s opts)+      "CAP,CAP2"+      "enable these capabilities - comma-separated, possible values are: view, add, manage (default: view,add)"+  , flagReq+      ["capabilities-header"]+      (\s opts -> Right $ setopt "capabilities-header" s opts)+      "HEADER"+      "read enabled capabilities from a HTTP header (e.g. X-Sandstorm-Permissions, disabled by default)"+  ] -webmode :: Mode [([Char], [Char])]-webmode =  (mode "hledger-web" [("command","web")]-            "start serving the hledger web interface"-            (argsFlag "[PATTERNS]") []){-              modeGroupFlags = Group {-                                groupUnnamed = webflags-                               ,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"]-                               ,groupNamed = [generalflagsgroup1]-                               }-             ,modeHelpSuffix=[-                  -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui."-                 ]-           }+webmode :: Mode [(String, String)]+webmode =+  (mode+     "hledger-web"+     [("command", "web")]+     "start serving the hledger web interface"+     (argsFlag "[PATTERNS]")+     [])+  { modeGroupFlags =+      Group+      { groupUnnamed = webflags+      , groupHidden =+          [ flagNone+              ["binary-filename"]+              (setboolopt "binary-filename")+              "show the download filename for this executable, and exit"+          ]+      , groupNamed = [generalflagsgroup1]+      }+  , modeHelpSuffix = []+  }  -- hledger-web options, used in hledger-web and above-data WebOpts = WebOpts {-     serve_    :: Bool-    ,host_     :: String-    ,port_     :: Int-    ,base_url_ :: String-    ,file_url_ :: Maybe String-    ,cliopts_  :: CliOpts- } deriving (Show)+data WebOpts = WebOpts+  { serve_ :: Bool+  , host_ :: String+  , port_ :: Int+  , base_url_ :: String+  , file_url_ :: Maybe String+  , capabilities_ :: [Capability]+  , capabilitiesHeader_ :: Maybe (CI ByteString)+  , cliopts_ :: CliOpts+  } deriving (Show)  defwebopts :: WebOpts-defwebopts = WebOpts-    def-    def-    def-    def-    def-    def+defwebopts = WebOpts def def def def def [CapView, CapAdd] Nothing def --- instance Default WebOpts where def = defwebopts+instance Default WebOpts where def = defwebopts  rawOptsToWebOpts :: RawOpts -> IO WebOpts-rawOptsToWebOpts rawopts = checkWebOpts <$> do-  cliopts <- rawOptsToCliOpts rawopts-  let-    h = fromMaybe defhost $ maybestringopt "host" rawopts-    p = fromMaybe defport $ maybeintopt "port" rawopts-    b = maybe (defbaseurl h p) stripTrailingSlash $ maybestringopt "base-url" rawopts-  return defwebopts {-              serve_ = boolopt "serve" rawopts-             ,host_ = h-             ,port_ = p-             ,base_url_ = b-             ,file_url_ = stripTrailingSlash <$> maybestringopt "file-url" rawopts-             ,cliopts_   = cliopts-             }+rawOptsToWebOpts rawopts =+  checkWebOpts <$> do+    cliopts <- rawOptsToCliOpts rawopts+    let h = fromMaybe defhost $ maybestringopt "host" rawopts+        p = fromMaybe defport $ maybeintopt "port" rawopts+        b =+          maybe (defbaseurl h p) stripTrailingSlash $+          maybestringopt "base-url" rawopts+        caps' = join $ T.splitOn "," . T.pack <$> listofstringopt "capabilities" rawopts+        caps = case traverse capabilityFromText caps' of+          Left e -> error' ("Unknown capability: " ++ T.unpack e)+          Right [] -> [CapView, CapAdd]+          Right xs -> xs+    return+      defwebopts+      { serve_ = boolopt "serve" rawopts+      , host_ = h+      , port_ = p+      , base_url_ = b+      , file_url_ = stripTrailingSlash <$> maybestringopt "file-url" rawopts+      , capabilities_ = caps+      , capabilitiesHeader_ = mk . BC.pack <$> maybestringopt "capabilities-header" rawopts+      , cliopts_ = cliopts+      }   where-    stripTrailingSlash = reverse . dropWhile (=='/') . reverse -- yesod don't like it+    stripTrailingSlash = reverse . dropWhile (== '/') . reverse -- yesod don't like it  checkWebOpts :: WebOpts -> WebOpts-checkWebOpts wopts =-  either usageError (const wopts) $ do-    let h = host_ wopts-    if any (not . (`elem` ".0123456789")) h-    then Left $ "--host requires an IP address, not "++show h-    else Right ()+checkWebOpts wopts = do+  let h = host_ wopts+  if any (`notElem` (".0123456789" :: String)) h+    then usageError $ "--host requires an IP address, not " ++ show h+    else wopts  getHledgerWebOpts :: IO WebOpts---getHledgerWebOpts = processArgs webmode >>= return . decodeRawOpts >>= rawOptsToWebOpts getHledgerWebOpts = do-  args <- getArgs >>= expandArgsAt-  let args' = replaceNumericFlags args -  let cmdargopts = either usageError id $ process webmode args'-  rawOptsToWebOpts $ decodeRawOpts cmdargopts +  args <- fmap replaceNumericFlags . expandArgsAt =<< getArgs+  rawOptsToWebOpts . decodeRawOpts . either usageError id $ process webmode args +data Capability+  = CapView+  | CapAdd+  | CapManage+  deriving (Eq, Ord, Bounded, Enum, Show)++capabilityFromText :: Text -> Either Text Capability+capabilityFromText "view" = Right CapView+capabilityFromText "add" = Right CapAdd+capabilityFromText "manage" = Right CapManage+capabilityFromText x = Left x++capabilityFromBS :: ByteString -> Either ByteString Capability+capabilityFromBS "view" = Right CapView+capabilityFromBS "add" = Right CapAdd+capabilityFromBS "manage" = Right CapManage+capabilityFromBS x = Left x

@@ -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">&times;+        <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')

@@ -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) "&nbsp;"+    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,22 +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 (..))--#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative  as Import (pure, (<$>), (<*>))-#endif-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,92 +0,0 @@-{-# LANGUAGE CPP, OverloadedStrings, QuasiQuotes #-}--- | Settings are centralized, as much as possible, into this file. This--- includes database connection settings, static file locations, etc.--- In addition, you can configure a number of different aspects of Yesod--- by overriding methods in the Yesod typeclass. That instance is--- declared in the Foundation.hs file.-module Settings where--import Prelude-import Text.Shakespeare.Text (st)-import Language.Haskell.TH.Syntax-import Yesod.Default.Config-import Yesod.Default.Util-import Data.Text (Text)-import Data.Yaml-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif-import Settings.Development-import Data.Default (def)-import Text.Hamlet---hledgerorgurl, manualurl :: String-hledgerorgurl     = "http://hledger.org"-manualurl         = hledgerorgurl++"/manual"---- | The default IP address to listen on. May be overridden with --host.-defhost :: String-defhost = "127.0.0.1"---- | The default TCP port to listen on. May be overridden with --port.-defport :: Int-defport = 5000--defbaseurl :: String -> Int -> String-defbaseurl host port =-  "http://" ++ host ++ if port /= 80 then ":" ++ show port else ""---- Static setting below. Changing these requires a recompile---- | The location of static files on your system. This is a file system--- path. The default value works properly with your scaffolded site.-staticDir :: FilePath-staticDir = "static"---- | The base URL for your static files. As you can see by the default--- value, this can simply be "static" appended to your application root.--- A powerful optimization can be serving static files from a separate--- domain name. This allows you to use a web server optimized for static--- files, more easily set expires and cache values, and avoid possibly--- costly transference of cookies on static files. For more information,--- please see:---   http://code.google.com/speed/page-speed/docs/request.html#ServeFromCookielessDomain------ If you change the resource pattern for StaticR in Foundation.hs, you will--- have to make a corresponding change here.------ To see how this value is used, see urlRenderOverride in Foundation.hs-staticRoot :: AppConfig DefaultEnv Extra -> Text-staticRoot conf = case extraStaticRoot $ appExtra conf of-                    Just root -> root-                    Nothing -> [st|#{appRoot conf}/static|]---- | Settings for 'widgetFile', such as which template languages to support and--- default Hamlet settings.-widgetFileSettings :: WidgetFileSettings-widgetFileSettings = def-    { wfsHamletSettings = defaultHamletSettings-        { hamletNewlines = AlwaysNewlines-        }-    }---- The rest of this file contains settings which rarely need changing by a--- user.--widgetFile :: String -> Q Exp-widgetFile = (if development then widgetFileReload-                             else widgetFileNoReload)-              widgetFileSettings--data Extra = Extra-    { extraCopyright  :: Text-    , extraAnalytics  :: Maybe Text -- ^ Google Analytics-    , extraStaticRoot :: Maybe Text-    } deriving Show--parseExtra :: DefaultEnv -> Object -> Parser Extra-parseExtra _ o = Extra-    <$> o .:  "copyright"-    <*> o .:? "analytics"-    <*> o .:? "staticRoot"

@@ -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,33 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module Settings.StaticFiles where--import Prelude (IO, putStrLn, (++), (>>), return)-import System.IO (stdout, hFlush)-import Yesod.Static-import qualified Yesod.Static as Static-import Settings (staticDir)-import Settings.Development---- | use this to create your static file serving site--- staticSite :: IO Static.Static--- staticSite = if development then Static.staticDevel staticDir---                             else Static.static      staticDir------ | This generates easy references to files in the static directory at compile time,---   giving you compile-time verification that referenced files exist.---   Warning: any files added to your static directory during run-time can't be---   accessed this way. You'll have to use their FilePath or URL to access them.--- $(staticFiles Settings.staticDir)---staticSite :: IO Static.Static-staticSite =-  if development-   then (do-            putStrLn ("Using web files from: " ++ staticDir ++ "/") >> hFlush stdout-            Static.staticDevel staticDir)-   else (do-            -- putStrLn "Using built-in web files" >> hFlush stdout-            return $(Static.embed staticDir))--$(publicFiles staticDir)

@@ -1,10 +1,13 @@ /favicon.ico     FaviconR        GET /robots.txt      RobotsR         GET /static          StaticR         Static getStatic+ /                RootR           GET-/journal         JournalR        GET POST-/register        RegisterR       GET POST-/sidebar         SidebarR        GET+/journal         JournalR        GET+/register        RegisterR       GET+/add             AddR            GET POST --- /accounts        AccountsR       GET--- /api/accounts    AccountsJsonR   GET+/manage             ManageR         GET+/edit/#FilePath     EditR           GET POST+/upload/#FilePath   UploadR         GET POST+/download/#FilePath DownloadR       GET

@@ -1,5 +1,5 @@ -.TH "hledger\-web" "1" "April 2018" "hledger\-web 1.9.1" "hledger User Manuals"+.TH "hledger\-web" "1" "June 2018" "hledger\-web 1.9.99" "hledger User Manuals"   

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 1872196bf7e9ff50fae0f3ea64ea81d1155799a2779617be58c9acf7f6aabce8+-- hash: 819abf18972b92028b9ccb3e8b1c5404368f8ca74e855c6fa226884dd01995a8  name:           hledger-web-version:        1.9.2+version:        1.10 synopsis:       Web interface for the hledger accounting tool description:    This is hledger's web interface.                 It provides a more user-friendly and collaborative UI than the@@ -25,7 +25,7 @@ maintainer:     Simon Michael <simon@joyful.com> license:        GPL-3 license-file:   LICENSE-tested-with:    GHC==7.10.3, GHC==8.0.2, GHC==8.2.1+tested-with:    GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.1 build-type:     Simple cabal-version:  >= 1.10 extra-source-files:@@ -38,7 +38,6 @@     hledger-web.1     hledger-web.info     hledger-web.txt-    messages/en.msg     README     static/css/bootstrap-datepicker.standalone.min.css     static/css/bootstrap-theme.css@@ -97,8 +96,16 @@     static/js/jquery.url.js     static/js/typeahead.bundle.js     static/js/typeahead.bundle.min.js+    templates/add-form.hamlet+    templates/balance-report.hamlet+    templates/chart.hamlet     templates/default-layout-wrapper.hamlet     templates/default-layout.hamlet+    templates/edit-form.hamlet+    templates/journal.hamlet+    templates/manage.hamlet+    templates/register.hamlet+    templates/upload-form.hamlet  source-repository head   type: git@@ -120,50 +127,52 @@   default: True  library+  hs-source-dirs:+      ./.   exposed-modules:-      Application-      Foundation-      Handler.AddForm-      Handler.Common-      Handler.JournalR-      Handler.RegisterR-      Handler.RootR-      Handler.SidebarR-      Handler.Utils       Hledger.Web+      Hledger.Web.Application+      Hledger.Web.Foundation+      Hledger.Web.Handler.AddR+      Hledger.Web.Handler.Common+      Hledger.Web.Handler.EditR+      Hledger.Web.Handler.JournalR+      Hledger.Web.Handler.RegisterR+      Hledger.Web.Handler.UploadR+      Hledger.Web.Import       Hledger.Web.Main+      Hledger.Web.Settings+      Hledger.Web.Settings.StaticFiles       Hledger.Web.WebOptions-      Import-      Settings-      Settings.Development-      Settings.StaticFiles+      Hledger.Web.Widget.AddForm+      Hledger.Web.Widget.Common   other-modules:       Paths_hledger_web-  ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans-  cpp-options: -DVERSION="1.9.2"+  ghc-options: -Wall -fwarn-tabs+  cpp-options: -DVERSION="1.10"   build-depends:       HUnit     , base >=4.8 && <4.12-    , base-compat >=0.8.1     , blaze-html     , blaze-markup     , bytestring+    , case-insensitive     , clientsession     , cmdargs >=0.10+    , conduit     , conduit-extra >=1.1     , data-default     , directory     , filepath     , hjsmin-    , hledger >=1.9.1 && <2.0-    , hledger-lib >=1.9.1 && <2.0+    , hledger >=1.10 && <1.11+    , hledger-lib >=1.10 && <1.11     , http-client     , http-conduit     , json-    , megaparsec >=5.0+    , megaparsec >=6.4.1     , mtl-    , parsec >=3-    , safe >=0.2+    , semigroups     , shakespeare >=2.0.2.2     , template-haskell     , text >=1.2@@ -178,10 +187,8 @@     , yesod-core >=1.4 && <1.7     , yesod-form >=1.4 && <1.7     , yesod-static >=1.4 && <1.7-  if (flag(dev)) || (flag(library-only))-    cpp-options: -DDEVELOPMENT-  if flag(dev)-    ghc-options: -O0+  if impl(ghc >=8)+    ghc-options: -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints   default-language: Haskell2010  executable hledger-web@@ -190,109 +197,15 @@       Paths_hledger_web   hs-source-dirs:       app-  ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans-  cpp-options: -DVERSION="1.9.2"+  ghc-options: -Wall -fwarn-tabs+  cpp-options: -DVERSION="1.10"   build-depends:-      HUnit-    , base >=4.8 && <4.12-    , base-compat >=0.8.1-    , blaze-html-    , blaze-markup-    , bytestring-    , clientsession-    , cmdargs >=0.10-    , conduit-extra >=1.1-    , data-default-    , directory-    , filepath-    , hjsmin-    , hledger >=1.9.1 && <2.0-    , hledger-lib >=1.9.1 && <2.0+      base     , hledger-web-    , http-client-    , http-conduit-    , json-    , megaparsec >=5.0-    , mtl-    , parsec >=3-    , safe >=0.2-    , shakespeare >=2.0.2.2-    , template-haskell-    , text >=1.2-    , time >=1.5-    , transformers-    , wai-    , wai-extra-    , wai-handler-launch >=1.3-    , warp-    , yaml-    , yesod >=1.4 && <1.7-    , yesod-core >=1.4 && <1.7-    , yesod-form >=1.4 && <1.7-    , yesod-static >=1.4 && <1.7-  if (flag(dev)) || (flag(library-only))-    cpp-options: -DDEVELOPMENT-  if flag(dev)-    ghc-options: -O0+  if impl(ghc >=8)+    ghc-options: -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints   if flag(library-only)     buildable: False   if flag(threaded)     ghc-options: -threaded-  default-language: Haskell2010--test-suite test-  type: exitcode-stdio-1.0-  main-is: main.hs-  other-modules:-      HomeTest-      TestImport-      Paths_hledger_web-  hs-source-dirs:-      tests-  ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans-  cpp-options: -DVERSION="1.9.2"-  build-depends:-      HUnit-    , base >=4.8 && <4.12-    , base-compat >=0.8.1-    , blaze-html-    , blaze-markup-    , bytestring-    , clientsession-    , cmdargs >=0.10-    , conduit-extra >=1.1-    , data-default-    , directory-    , filepath-    , hjsmin-    , hledger >=1.9.1 && <2.0-    , hledger-lib >=1.9.1 && <2.0-    , hledger-web-    , hspec-    , http-client-    , http-conduit-    , json-    , megaparsec >=5.0-    , mtl-    , parsec >=3-    , safe >=0.2-    , shakespeare >=2.0.2.2-    , template-haskell-    , text >=1.2-    , time >=1.5-    , transformers-    , wai-    , wai-extra-    , wai-handler-launch >=1.3-    , warp-    , yaml-    , yesod >=1.4 && <1.7-    , yesod-core >=1.4 && <1.7-    , yesod-form >=1.4 && <1.7-    , yesod-static >=1.4 && <1.7-    , yesod-test-  if (flag(dev)) || (flag(library-only))-    cpp-options: -DDEVELOPMENT-  if flag(dev)-    ghc-options: -O0   default-language: Haskell2010

@@ -3,8 +3,8 @@  File: hledger-web.info,  Node: Top,  Next: OPTIONS,  Up: (dir) -hledger-web(1) hledger-web 1.9.1-********************************+hledger-web(1) hledger-web 1.9.99+*********************************  hledger-web is hledger's web interface.  It starts a simple web application for browsing and adding transactions, and optionally opens@@ -209,7 +209,7 @@  Tag Table: Node: Top72-Node: OPTIONS3156-Ref: #options3241+Node: OPTIONS3158+Ref: #options3243  End Tag Table

@@ -248,4 +248,4 @@   -hledger-web 1.9.1                 April 2018                    hledger-web(1)+hledger-web 1.9.99                 June 2018                    hledger-web(1)

@@ -1,1 +0,0 @@-Hello: Hello

@@ -20,38 +20,7 @@ /*------------------------------------------------------------------------------------------*/ /* 4. typeahead styles */ -/*-.typeahead,-.tt-query, .tt-hint {-  width: 396px;-  height: 30px;-  padding: 8px 12px;-  font-size: 24px;-  line-height: 30px;-  border: 2px solid #ccc;-  -webkit-border-radius: 8px;-     -moz-border-radius: 8px;-          border-radius: 8px;-  outline: none;-}--.typeahead {-  background-color: #fff;-}--.typeahead:focus {-  border: 2px solid #0097cf;-}--.tt-query {-  -webkit-box-shadow: inset 0 1px 1px rgba(0, 0, 0, 0.075);-     -moz-box-shadow: inset 0 1px 1px rgba(0, 0, 0, 0.075);-          box-shadow: inset 0 1px 1px rgba(0, 0, 0, 0.075);-}--*/-.tt-hint {   color: #bbb; } @@ -70,9 +39,6 @@   max-height:300px; } -.tt-suggestions {-}- .tt-suggestion {   padding: 3px 20px;   font-size: 18px;@@ -82,7 +48,6 @@ .tt-suggestion.tt-cursor {   color: #fff;   background-color: #0097cf;- }  .tt-suggestion p {@@ -100,7 +65,7 @@  ul {     list-style-type: none;-	  padding: 0;+    padding: 0; }  #main-content {@@ -136,51 +101,37 @@  #sidebar-menu .main-menu a {     display: inline;-	  font-size: 16px;-	  font-weight: 500;-	  color: #2F2F2F;-	  padding: 4px 20px;+    font-size: 16px;+    font-weight: 500;+    color: #2F2F2F;+    padding: 4px 20px; }  #sidebar-menu .main-menu a:hover {-	  color: #11427D;-	  text-decoration: none;-	  background-color: transparent;+    color: #11427D;+    text-decoration: none;+    background-color: transparent; } -#sidebar-menu .main-menu .only{+#sidebar-menu .main-menu .only {     visibility: hidden;     padding: 1px; } -#sidebar-menu .main-menu tr:hover > td > div > .only {+#sidebar-menu .main-menu tr:hover .only {     visibility: visible; } -#sidebar-menu .main-menu .only:hover{-    border-left: none;-}-#sidebar-menu .main-menu .balance {-    float: right;-}--#sidebar-menu .main-menu .total {-    border-left: none;-    border-right: none;-    border-bottom: none;-    border-top: 1px solid black;-}--#sidebar-menu .main-menu .inacct {+#sidebar-menu .main-menu .inacct, #sidebar-menu .main-menu .inacct .acct-name {     font-weight: bold;-	  color: #11427D;+    color: #11427D;     background-color: #f9f9f9; }  #sidebar-menu .main-menu .amount {     float: right;     overflow-x:auto;-	  font-weight: 500 !important;+    font-weight: 500 !important; }  #sidebar-menu .main-menu .acct {@@ -188,7 +139,7 @@     vertical-align:bottom; } -.transactionsreport .nonhead {+.transactionsreport .posting td {     border: none !important; } @@ -200,24 +151,6 @@     whitespace: nowrap; } -#main-content {-   /*-    -webkit-transition: width 0.3s ease, margin 0.3s ease;-    -moz-transition: width 0.3s ease, margin 0.3s ease;-    -o-transition: width 0.3s ease, margin 0.3s ease;-    transition: width 0.3s ease, margin 0.3s ease;-*/-}--#sidebar-menu {-    /*-    -webkit-transition: width 0.3s ease, margin 0.3s ease,opacity 0.3s ease,height 1s ease 1s;-    -moz-transition: width 0.3s ease, margin 0.3s ease,opacity 0.3s ease,height 1s ease 1s;-    -o-transition: width 0.3s ease, margin 0.3s ease,opacity 0.3s ease,height 1s ease 1s;-    transition: width 0.3s ease, margin 0.3s ease,opacity 0.3s ease,height 1s ease 1s;-*/-}- .col-any-0 {     width:0 !important;     height:0 !important;@@ -227,10 +160,6 @@  .tgl-icon {     font-size:large;-}--#searchbar {-    width: 100% !important; }  @media screen and (max-width: 768px) {

@@ -4,9 +4,13 @@ // STARTUP  $(document).ready(function() {-  // cache the input element as a variable-  // for minor performance   benefits-  var dateEl = $('#dateWrap');+  // date picker+  // http://bootstrap-datepicker.readthedocs.io/en/latest/options.html+  var dateEl = $('#dateWrap').datepicker({+    showOnFocus: false,+    autoclose: true,+    format: 'yyyy-mm-dd'+  });;    // ensure add form always focuses its first field   $('#addmodal')@@ -18,36 +22,22 @@       dateEl.datepicker('hide');     }); -  // show add form if ?add=1-  if ($.url.param('add')) { addformShow(true); }--  // date picker-  // http://bootstrap-datepicker.readthedocs.io/en/latest/options.html-  dateEl.datepicker({-    showOnFocus: false,-    autoclose: true,-    format: 'yyyy-mm-dd'-  });--  // sidebar account hover handlers-  $('#sidebar td a').mouseenter(function(){ $(this).parent().addClass('mouseover'); });-  $('#sidebar td').mouseleave(function(){ $(this).removeClass('mouseover'); });-   // keyboard shortcuts   // 'body' seems to hold focus better than document in FF   $('body').bind('keydown', 'h',       function(){ $('#helpmodal').modal('toggle'); return false; });   $('body').bind('keydown', 'shift+/', function(){ $('#helpmodal').modal('toggle'); return false; });   $('body').bind('keydown', 'j',       function(){ location.href = document.hledgerWebBaseurl+'/journal'; return false; });   $('body').bind('keydown', 's',       function(){ sidebarToggle(); return false; });+  $('body').bind('keydown', 'e',       function(){ emptyAccountsToggle(); return false; });   $('body').bind('keydown', 'a',       function(){ addformShow(); return false; });   $('body').bind('keydown', 'n',       function(){ addformShow(); return false; });   $('body').bind('keydown', 'f',       function(){ $('#searchform input').focus(); return false; });+  $('body, #addform input, #addform select').bind('keydown', 'ctrl++',       addformAddPosting);   $('body, #addform input, #addform select').bind('keydown', 'ctrl+shift+=', addformAddPosting);   $('body, #addform input, #addform select').bind('keydown', 'ctrl+=',       addformAddPosting);   $('body, #addform input, #addform select').bind('keydown', 'ctrl+-',       addformDeletePosting);   $('.amount-input:last').keypress(addformAddPosting); -   // highlight the entry from the url hash   if (window.location.hash && $(window.location.hash)[0]) {     $(window.location.hash).addClass('highlighted');@@ -78,10 +68,9 @@         position: 'sw'       },       grid: {-        markings:-         function (axes) {+        markings: function () {           var now = Date.now();-          var markings = [+          return [             {               xaxis: { to: now }, // past               yaxis: { to: 0 },   // <0@@ -103,7 +92,6 @@               lineWidth:1             },           ];-          return markings;         },         hoverable: true,         autoHighlight: true,@@ -127,16 +115,17 @@ }  function registerChartClick(ev, pos, item) {-  if (item) {-    targetselector = '#'+item.series.data[item.dataIndex][5];-    $target = $(targetselector);-    if ($target.length) {-      window.location.hash = targetselector;-      $('html, body').animate({-        scrollTop: $target.offset().top-      }, 1000);-    }+  if (!item) {+    return;   }+  var targetselector = '#' + item.series.data[item.dataIndex][5];+  var $target = $(targetselector);+  if ($target.length) {+    window.location.hash = targetselector;+    $('html, body').animate({+      scrollTop: $target.offset().top+    }, 1000);+  } }  //----------------------------------------------------------------------@@ -174,59 +163,46 @@  // Insert another posting row in the add form. function addformAddPosting() {-  $('.amount-input:last').off('keypress');-  // do nothing if it's not currently visible-  if (!$('#addform').is(':visible')) return;-  // save a copy of last row-  var lastrow = $('#addform .form-group:last').clone();+  if (!$('#addform').is(':visible')) {+    return;+  } -  // replace the submit button with an amount field, clear and renumber it, add the keybindings-  var num = $('#addform .account-group').length;+  var prevLastRow = $('#addform .account-group:last');+  prevLastRow.off('keypress'); -  // insert the new last row-  $('#addform .account-postings').append(lastrow);-  // TODO: Enable typehead on dynamically created inputs+  // Clone the currently last row+  $('#addform .account-postings').append(prevLastRow.clone());+  var num = $('#addform .account-group').length; -  var $acctinput = $('.account-input:last');-  var $amntinput = $('.amount-input:last');   // clear and renumber the field, add keybindings-  $acctinput-    .val('')-    .prop('id','account'+(num+1))-    .prop('name','account'+(num+1))-    .prop('placeholder','Account '+(num+1));-  //lastrow.find('input') // not :last this time-  $acctinput-    .bind('keydown', 'ctrl+shift+=', addformAddPosting)-    .bind('keydown', 'ctrl+=', addformAddPosting)-    .bind('keydown', 'ctrl+-', addformDeletePosting);--  $amntinput+  // XXX Enable typehead on dynamically created inputs+  $('.amount-input:last')     .val('')-    .prop('id','amount'+(num+1))-    .prop('name','amount'+(num+1))-    .prop('placeholder','Amount '+(num+1))+    .prop('placeholder','Amount ' + num)     .keypress(addformAddPosting); -  $acctinput+  $('.account-input:last')+    .val('')+    .prop('placeholder', 'Account ' + num)+    .bind('keydown', 'ctrl++', addformAddPosting)     .bind('keydown', 'ctrl+shift+=', addformAddPosting)     .bind('keydown', 'ctrl+=', addformAddPosting)     .bind('keydown', 'ctrl+-', addformDeletePosting);- }  // Remove the add form's last posting row, if empty, keeping at least two. function addformDeletePosting() {-  var num = $('#addform .account-group').length;-  if (num <= 2) return;+  if ($('#addform .account-group').length <= 2) {+    return;+  }   // remember if the last row's field or button had focus   var focuslost =     $('.account-input:last').is(':focus')     || $('.amount-input:last').is(':focus');   // delete last row   $('#addform .account-group:last').remove();-  if(focuslost){-    focus($('account-input:last'));+  if (focuslost) {+    focus($('.account-input:last'));   }   // Rebind keypress   $('.amount-input:last').keypress(addformAddPosting);@@ -242,46 +218,7 @@   $.cookie('showsidebar', $('#sidebar-menu').hasClass('col-any-0') ? '0' : '1'); } -//-----------------------------------------------------------------------// MISC--function enableTypeahead($el, suggester) {-  return $el.typeahead(-    {-      highlight: true-    },-    {-      source: suggester.ttAdapter()-    }-  );+function emptyAccountsToggle() {+  $('.acct.empty').parent().toggleClass('hide');+  $.cookie('hideemptyaccts', $.cookie('hideemptyaccts') === '1' ? '0' : '1') }--// function journalSelect(ev) {-//   var textareas = $('textarea', $('form#editform'));-//   for (i=0; i<textareas.length; i++) {-//     textareas[i].style.display = 'none';-//     textareas[i].disabled = true;-//   }-//   var targ = getTarget(ev);-//   if (targ.value) {-//     var journalid = targ.value+'_textarea';-//     var textarea = document.getElementById(journalid);-//   }-//   else {-//     var textarea = textareas[0];-//   }-//   textarea.style.display = 'block';-//   textarea.disabled = false;-//   return true;-// }--// // Get the current event's target in a robust way.-// // http://www.quirksmode.org/js/events_properties.html-// function getTarget(ev) {-//   var targ;-//   if (!ev) var ev = window.event;-//   if (ev.target) targ = ev.target;-//   else if (ev.srcElement) targ = ev.srcElement;-//   if (targ.nodeType == 3) targ = targ.parentNode;-//   return targ;-// }

@@ -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 -)

@@ -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}

@@ -0,0 +1,59 @@+<label #register-chart-label style=""><br>+<div #register-chart style="height:150px; margin-bottom:1em; display:block;">+<script type=text/javascript>+ \$(document).ready(function() {+   var $chartdiv = $('#register-chart');+   if ($chartdiv.is(':visible')) {+     \$('#register-chart-label').text('#{charttitle}');+     var seriesData = [+      $forall (c,(_,items)) <- percommoditytxnreports+       /* we render each commodity using two series:+        * one with extra data points added to show a stepped balance line */+       {+        data: [+          $forall i <- reverse items+           [+            #{dayToJsTimestamp $ triDate i},+            #{simpleMixedAmountQuantity $ triCommodityBalance c i}+           ],+        ],+        label: '#{shownull $ T.unpack c}',+        color: #{colorForCommodity c},+        lines: {+          show: true,+          steps: true,+        },+        points: {+          show: false,+        },+        clickable: false,+        hoverable: false,+       },+       /* and one with the original data, showing one clickable, hoverable point per transaction */+       {+        data: [+          $forall i <- reverse items+           [+            #{dayToJsTimestamp $ triDate i},+            #{simpleMixedAmountQuantity $ triCommodityBalance c i},+            '#{showMixedAmountWithZeroCommodity $ triCommodityAmount c i}',+            '#{showMixedAmountWithZeroCommodity $ triCommodityBalance c i}',+            '#{concat $ intersperse "\\n" $ lines  $ show $ triOrigTransaction i}',+            #{tindex $ triOrigTransaction i}+           ],+          /* [] */+        ],+        label: '',+        color: #{colorForCommodity c},+        lines: {+          show: false,+        },+        points: {+          show: true,+        },+       },+     ]+     var plot = registerChart($chartdiv, seriesData);+     \$chartdiv.bind("plotclick", registerChartClick);+   };+ });

@@ -29,7 +29,7 @@             <div .row .row-offcanvas .row-offcanvas-left>               ^{pageBody pc}             <footer>-                #{extraCopyright $ appExtra $ settings master}+              #{extraCopyright $ appExtra $ settings master}          $maybe analytics <- extraAnalytics $ appExtra $ settings master             <script>@@ -47,61 +47,3 @@             <script>                 window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})         \<![endif]-->--        <div .modal.fade #helpmodal tabindex="-1" role="dialog" aria-labelledby="helpLabel" aria-hidden="true">-          <div .modal-dialog .modal-lg>-            <div .modal-content>-              <div .modal-header>-                <button type="button" .close data-dismiss="modal" aria-hidden="true">&times;-                <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:&lt;N</code>, <code>amt:&gt;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">&times;-                <h3 .modal-title #addLabel>Add a transaction-              <div .modal-body>-                $maybe m <- lastmsg-                  $if isPrefixOf "Errors" (renderHtml m)-                    <div #message>#{m}-                ^{addform staticRootUrl vd}

@@ -1,4 +1,81 @@-$maybe m <- lastmsg-  $if not $ isPrefixOf "Errors" (renderHtml m)-    <div #message>#{m}-^{widget}++<div#spacer .col-xs-2.#{topShowsm}.#{topShowmd}>+  <h1>+    <button .visible-xs.btn.btn-default type="button" data-toggle="offcanvas">+      <span .glyphicon.glyphicon-align-left.tgl-icon>++<div#topbar .col-md-8 .col-sm-8 .col-xs-10>+  <h1>#{takeFileName (journalFilePath j)}++$if elem CapView caps+  <div#sidebar-menu .sidebar-offcanvas.#{sideShowmd}.#{sideShowsm}>+    <table .main-menu .table>+      ^{accounts}++<div#main-content .col-xs-12.#{mainShowmd}.#{mainShowsm}>+  $maybe m <- msg+    <div #message .alert.alert-info>#{m}+  $if elem CapView caps+    <form#searchform.input-group method=GET>+      <input .form-control name=q value=#{q} placeholder="Search"+        title="Enter hledger search patterns to filter the data below">+      <div .input-group-btn>+        $if not (T.null q)+          <a href=@{here} .btn .btn-default title="Clear search terms">+            <span .glyphicon .glyphicon-remove-circle>+        <button .btn .btn-default type=submit title="Apply search terms">+          <span .glyphicon .glyphicon-search>+        $if elem CapManage caps+          <a href="@{ManageR}" .btn.btn-default title="Manage journal files">+            <span .glyphicon .glyphicon-wrench>+        <button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal"+           title="Show search and general help">+          <span .glyphicon .glyphicon-question-sign>+  ^{widget}++<div .modal.fade #helpmodal tabindex="-1" role="dialog" aria-labelledby="helpLabel" aria-hidden="true">+  <div .modal-dialog .modal-lg>+    <div .modal-content>+      <div .modal-header>+        <button type="button" .close data-dismiss="modal" aria-hidden="true">&times;+        <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:&lt;N</code>, <code>amt:&gt;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

@@ -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">

@@ -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>+            &nbsp;+            <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}

@@ -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

@@ -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}

@@ -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}

@@ -1,25 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module HomeTest-    ( homeSpecs-    ) where--import TestImport--homeSpecs :: Specs-homeSpecs =-  ydescribe "Some hledger-web tests" $--    yit "serves a reasonable-looking register page" $ do-      get RegisterR-      statusIs 200-      bodyContains "accounts"--      -- post "/" $ do-      --   addNonce-      --   fileByLabel "Choose a file" "tests/main.hs" "text/plain" -- talk about self-reference-      --   byLabel "What's on the file?" "Some Content"--      -- statusIs 200-      -- htmlCount ".message" 1-      -- htmlAllContain ".message" "Some Content"-      -- htmlAllContain ".message" "text/plain"

@@ -1,12 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module TestImport-    ( module Yesod.Test-    , module Foundation-    , Specs-    ) where--import Yesod.Test--import Foundation--type Specs = YesodSpec App

@@ -1,24 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Main where--import Import-import Yesod.Default.Config-import Yesod.Test-import Test.Hspec (hspec)-import Application (makeFoundation)-import Hledger.Web.WebOptions (defwebopts)--import HomeTest--main :: IO ()-main = do-    conf <- Yesod.Default.Config.loadConfig $ (configSettings Testing)-                    { csParseExtra = parseExtra-                    }-    foundation <- makeFoundation conf defwebopts-    hspec $ do-      yesodSpec foundation $ do-        homeSpecs