hledger-web 0.24.1 → 0.25

raw patch · 23 files changed

+295/−383 lines, 23 filesdep +base-compatdep +yesod-formdep ~hledgerdep ~hledger-libdep ~hledger-webPVP ok

version bump matches the API change (PVP)

Dependencies added: base-compat, yesod-form

Dependency ranges changed: hledger, hledger-lib, hledger-web, time

API changes (from Hackage documentation)

Files

• Application.hs +1/−0
• CHANGES +20/−1
• Foundation.hs +35/−23
• Handler/AddForm.hs +124/−0
• Handler/Common.hs +45/−46
• Handler/JournalEditR.hs +0/−20
• Handler/JournalEntriesR.hs +0/−64
• Handler/JournalR.hs +3/−2
• Handler/Post.hs +0/−195
• Handler/RegisterR.hs +3/−2
• Handler/SidebarR.hs +1/−0
• Handler/Utils.hs +3/−1
• Hledger/Web/Main.hs +3/−0
• Hledger/Web/Options.hs +3/−0
• Import.hs +7/−2
• Settings.hs +3/−0
• Settings/Development.hs +1/−0
• Settings/StaticFiles.hs +1/−0
• config/routes +1/−3
• hledger-web.cabal +28/−16
• static/hledger.js +7/−6
• templates/default-layout-wrapper.hamlet +3/−0
• templates/default-layout.hamlet +3/−2

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP, OverloadedStrings, TemplateHaskell #-} module Application     ( makeApplication     , getApplicationDev

@@ -1,4 +1,23 @@-User-visible changes in hledger-web (see also hledger):+User-visible changes in hledger-web.+See also hledger's change log.+++0.25 (2015/4/7)++- GHC 7.10 compatibility (#239)++- fix the add form when there are included files (#234)++    NB to make this work, the add form now shows the full file path of+    the main and included journal files.++- improve add form validation (#223, #234)+    +    All add form errors are displayed as form errors, not internal+    server errors, and when there are errors the add form is redisplayed+    (form inputs are not preserved, currently).++- keep the add button right-aligned when pressing ctrl - on the add form  0.24.1 (2015/1/10) 

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, QuasiQuotes, TemplateHaskell, TypeFamilies #-} {-  Define the web application's foundation, in the usual Yesod style.@@ -8,7 +8,9 @@ module Foundation where  import Prelude+#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))+#endif import Data.IORef import Yesod import Yesod.Static@@ -25,6 +27,7 @@ import Settings (staticDir) import Text.Jasmine (minifym) #endif+import Text.Blaze.Html.Renderer.String (renderHtml) import Text.Hamlet (hamletFile)  import Hledger.Web.Options@@ -37,7 +40,6 @@ import Data.Maybe import Data.Text as Text (Text,pack,unpack) import Data.Time.Calendar-import System.FilePath (takeFileName) #if BLAZE_HTML_0_4 import Text.Blaze (preEscapedString) #else@@ -105,7 +107,8 @@      defaultLayout widget = do         master <- getYesod-        mmsg <- getMessage+        lastmsg <- getMessage+        vd@VD{..} <- getViewData          -- We break up the default layout into two components:         -- default-layout is the contents of the body tag, and@@ -141,7 +144,6 @@             $(widgetFile "default-layout")          staticRootUrl <- (staticRoot . settings) <$> getYesod-        vd@VD{..} <- getViewData         withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")      -- This is done to provide an optimization for serving static files from@@ -233,8 +235,9 @@ getViewData = do   app        <- getYesod   let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app-  (j, err)   <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}}-  msg        <- getMessageOr err+  (j, merr)  <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}}+  lastmsg    <- getLastMessage+  let msg = maybe lastmsg (Just . toHtml) merr   Just here  <- getCurrentRoute   today      <- liftIO getCurrentDay   q          <- getParameterOrNull "q"@@ -276,11 +279,10 @@       getParameterOrNull :: String -> Handler String       getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p) --- | Get the message set by the last request, or the newer message provided, if any.-getMessageOr :: Maybe String -> Handler (Maybe Html)-getMessageOr mnewmsg = do-  oldmsg <- getMessage-  return $ maybe oldmsg (Just . toHtml) mnewmsg+-- | 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 @@ -335,7 +337,7 @@      <table style="width:100%;">       <tr#descriptionrow>        <td>-        <input #date        .typeahead .form-control .input-lg type=text size=15 name=date placeholder="Date" value=#{date}>+        <input #date        .typeahead .form-control .input-lg type=text size=15 name=date placeholder="Date" value=#{defdate}>        <td>         <input #description .typeahead .form-control .input-lg type=text size=40 name=description placeholder="Description">    $forall n <- postingnums@@ -345,11 +347,12 @@      Tab in last field for <a .small href="#" onclick="addformAddPosting(); return false;">more</a> (or ctrl +, ctrl -) |]  where-  date = "today" :: String+  defdate = "today" :: String   dates = ["today","yesterday","tomorrow"] :: [String]   descriptions = sort $ nub $ map tdescription $ jtxns j   accts = sort $ journalAccountNamesUsed j-  listToJsonValueObjArrayStr as  = preEscapedString $ encode $ JSArray $ map (\a -> JSObject $ toJSObject [("value", showJSON a)]) as+  escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>" -- #236+  listToJsonValueObjArrayStr as  = preEscapedString $ escapeJSSpecialChars $ encode $ JSArray $ map (\a -> JSObject $ toJSObject [("value", showJSON a)]) as   numpostings = 4   postingnums = [1..numpostings]   postingfields :: ViewData -> Int -> HtmlUrl AppRoute@@ -370,22 +373,31 @@          |]        | otherwise = [hamlet|           <td #addbtncell style="text-align:right;">-           <input type=hidden name=action value=add>            <button type=submit .btn .btn-lg name=submit>add-           $if length files' > 1-            <br>to: ^{journalselect files'}+           $if length filepaths > 1+            <br>+            <span class="input-lg">to:+            ^{journalselect filepaths}          |]        where         amtvar = "amount" ++ show n         amtph = "Amount " ++ show n-        files' = [(takeFileName f,s) | (f,s) <- files j]+        filepaths = map fst $ files j             -- <button .btn style="font-size:18px;" type=submit title="Add this transaction">Add -journalselect :: [(FilePath,String)] -> HtmlUrl AppRoute-journalselect journalfiles = [hamlet|-<select id=journalselect name=journal onchange="/*journalSelect(event)*/">- $forall f <- journalfiles-  <option value=#{fst f}>#{fst f}+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;"> |] 

@@ -0,0 +1,124 @@+{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, QuasiQuotes, RecordWildCards #-}+-- | 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 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.Parsec (digit, eof, many1, string, runParser)++import Hledger.Utils+import Hledger.Data hiding (num)+import Hledger.Read+import Hledger.Cli hiding (num)+++-- 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 $ 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) $ T.unpack k+                    , isRight en+                    , let Right n = en+                    ]+            where paramnamep s = do {string s; n <- many1 digit; 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 (parsewith (accountnamep <* eof) . strip . T.unpack . snd) acctparams+          eamts  = map (runParser (amountp <* eof) nullctx "" . strip . T.unpack . 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=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,3 +1,4 @@+{-# LANGUAGE CPP, OverloadedStrings, QuasiQuotes, RecordWildCards #-} -- | Common page components and rendering helpers. -- For global page layout, see Application.hs. @@ -55,8 +56,6 @@ <nav class="navbar" role="navigation">  <div#topbar>   <h1>#{title}- $maybe m' <- msg-  <div#message>#{m'} |]   where     title = takeFileName $ journalFilePath j@@ -120,51 +119,51 @@  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 align=right>-    <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"+-- -- | 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 align=right>+--     <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-|]+-- -- | 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

@@ -1,20 +0,0 @@--- | /journal/edit handlers.--module Handler.JournalEditR where--import Import--import Handler.Common-import Handler.Post----- | The journal editform, no sidebar.-getJournalEditR :: Handler Html-getJournalEditR = do-  vd <- getViewData-  defaultLayout $ do-      setTitle "hledger-web journal edit form"-      toWidget $ editform vd--postJournalEditR :: Handler Html-postJournalEditR = handlePost

@@ -1,64 +0,0 @@--- | /journal/entries handlers.--module Handler.JournalEntriesR where--import Import--import Handler.Common-import Handler.Post-import Handler.Utils--import Hledger.Data-import Hledger.Query-import Hledger.Reports-import Hledger.Cli.Options-import Hledger.Web.Options----- | The journal entries view, with sidebar.-getJournalEntriesR :: Handler Html-getJournalEntriesR = do-  vd@VD{..} <- getViewData-  staticRootUrl <- (staticRoot . settings) <$> getYesod-  let-      sidecontent = sidebar vd-      title = "Journal entries" ++ if m /= Any then ", filtered" else "" :: String-      maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) Any $ filterJournalTransactions m j-  defaultLayout $ do-      setTitle "hledger-web journal"-      toWidget [hamlet|-^{topbar vd}-<div#content>- <div#sidebar>-  ^{sidecontent}- <div#main.journal>-  <div#maincontent>-   ^{searchform vd}-   <h2#contenttitle>#{title}-   ^{maincontent}-  ^{addform staticRootUrl vd}-  ^{editform vd}-  ^{importform}-|]--postJournalEntriesR :: Handler Html-postJournalEntriesR = handlePost---- | Render an "EntriesReport" as html for the journal entries view.-entriesReportAsHtml :: WebOpts -> ViewData -> EntriesReport -> HtmlUrl AppRoute-entriesReportAsHtml _ vd items = [hamlet|-<table.entriesreport>- $forall i <- numbered items-  ^{itemAsHtml vd i}- |]- where-   itemAsHtml :: ViewData -> (Int, EntriesReportItem) -> HtmlUrl AppRoute-   itemAsHtml _ (n, t) = [hamlet|-<tr.item.#{evenodd}>- <td.transaction>-  <pre>#{txn}- |]-     where-       evenodd = if even n then "even" else "odd" :: String-       txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse-

@@ -1,11 +1,12 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-} -- | /journal handlers.  module Handler.JournalR where  import Import +import Handler.AddForm import Handler.Common-import Handler.Post  import Hledger.Data import Hledger.Query@@ -38,7 +39,7 @@      |]  postJournalR :: Handler Html-postJournalR = handlePost+postJournalR = postAddForm  -- | Render a "TransactionsReport" as html for the formatted journal view. journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute

@@ -1,195 +0,0 @@--- | POST helpers.--module Handler.Post where--import Import--import Control.Applicative-import Data.Either (lefts,rights)-import Data.List (intercalate, sort)-import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free-import Data.Text (unpack)-import qualified Data.Text as T-import Text.Parsec (digit, eof, many1, string, runParser)-import Text.Printf (printf)--import Hledger.Utils-import Hledger.Data hiding (num)-import Hledger.Read-import Hledger.Cli hiding (num)----- | Handle a post from any of the edit forms.-handlePost :: Handler Html-handlePost = do-  action <- lookupPostParam  "action"-  case action of Just "add"    -> handleAdd-                 Just "edit"   -> handleEdit-                 Just "import" -> handleImport-                 _             -> invalidArgs ["invalid action"]---- | Handle a post from the transaction add form.-handleAdd :: Handler Html-handleAdd = do-  VD{..} <- getViewData-  -- gruesome adhoc form handling, port to yesod-form later-  mjournal <- lookupPostParam  "journal"-  mdate <- lookupPostParam  "date"-  mdesc <- lookupPostParam  "description"-  let edate = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . strip . unpack) mdate-      edesc = Right $ maybe "" unpack mdesc-      ejournal = maybe (Right $ journalFilePath j)-                       (\f -> let f' = unpack f in-                              if f' `elem` journalFilePaths j-                              then Right f'-                              else Left $ "unrecognised journal file path: " ++ f'-                              )-                       mjournal-      estrs = [edate, edesc, ejournal]-      (errs1, [date,desc,journalpath]) = (lefts estrs, rights estrs)-  (params,_) <- runRequestBody-  -- mtrace params-  let paramnamep s = do {string s; n <- many1 digit; eof; return (read n :: Int)}-      numberedParams s =-        reverse $ dropWhile (T.null . snd) $ reverse $ sort-        [ (n,v) | (k,v) <- params-                , let en = parsewith (paramnamep s) $ T.unpack k-                , isRight en-                , let Right n = en-                ]-      acctparams = numberedParams "account"-      amtparams  = numberedParams "amount"-      num = length acctparams-      paramErrs | map fst acctparams == [1..num] &&-                  map fst amtparams `elem` [[1..num], [1..num-1]] = []-                | otherwise = ["malformed account/amount parameters"]-      eaccts = map (parsewith (accountnamep <* eof) . strip . T.unpack . snd) acctparams-      eamts  = map (runParser (amountp <* eof) nullctx "" . strip . T.unpack . 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]-      -- if no errors so far, generate a transaction and balance it or get the error.-      errs = errs1 ++ if not (null paramErrs) then paramErrs else (acctErrs ++ amtErrs)-      et | not $ null errs = Left errs-         | otherwise = either (\e -> Left ["unbalanced postings: " ++ (L.head $ lines e)]) Right-                        (balanceTransaction Nothing $ nulltransaction {-                            tdate=parsedate date-                           ,tdescription=desc-                           ,tpostings=[nullposting{paccount=acct, pamount=Mixed [amt]} | (acct,amt) <- zip accts amts]-                           })-  -- display errors or add transaction-  case et of-   Left errs' -> do-    error $ show errs' -- XXX-    -- save current form values in session-    -- setMessage $ toHtml $ intercalate "; " errs-    setMessage [shamlet|-                 Errors:<br>-                 $forall e<-errs'-                  \#{e}<br>-               |]-   Right t -> do-    let t' = txnTieKnot t -- XXX move into balanceTransaction-    liftIO $ do ensureJournalFileExists journalpath-                appendToJournalFileOrStdout journalpath $ showTransaction t'-    setMessage [shamlet|<span>Transaction added.|]--  redirect (JournalR) -- , [("add","1")])---- personForm :: Html -> MForm Handler (FormResult Person, Widget)--- personForm extra = do---     (nameRes, nameView) <- mreq textField "this is not used" Nothing---     (ageRes, ageView) <- mreq intField "neither is this" Nothing---     let personRes = Person <$> nameRes <*> ageRes---     let widget = do---             toWidget---                 [lucius|---                     ##{fvId ageView} {---                         width: 3em;---                     }---                 |]---             [whamlet|---                 #{extra}---                 <p>---                     Hello, my name is #---                     ^{fvInput nameView}---                     \ and I am #---                     ^{fvInput ageView}---                     \ years old. #---                     <input type=submit value="Introduce myself">---             |]---     return (personRes, widget)------     ((res, widget), enctype) <- runFormGet personForm---     defaultLayout---         [whamlet|---             <p>Result: #{show res}---             <form enctype=#{enctype}>---                 ^{widget}---         |]---- | Handle a post from the journal edit form.-handleEdit :: Handler Html-handleEdit = do-  VD{..} <- getViewData-  -- get form input values, or validation errors.-  -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace-  mtext <- lookupPostParam "text"-  mjournal <- lookupPostParam "journal"-  let etext = maybe (Left "No value provided") (Right . unpack) mtext-      ejournal = maybe (Right $ journalFilePath j)-                       (\f -> let f' = unpack f in-                              if f' `elem` journalFilePaths j-                              then Right f'-                              else Left ("unrecognised journal file path"::String))-                       mjournal-      estrs = [etext, ejournal]-      errs = lefts estrs-      [text,journalpath] = rights estrs-  -- display errors or perform edit-  if not $ null errs-   then do-    setMessage $ toHtml (intercalate "; " errs :: String)-    redirect JournalR--   else do-    -- try to avoid unnecessary backups or saving invalid data-    filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath-    told <- liftIO $ readFileStrictly journalpath-    let tnew = filter (/= '\r') text-        changed = tnew /= told || filechanged'-    if not changed-     then do-       setMessage "No change"-       redirect JournalR-     else do-      jE <- liftIO $ readJournal Nothing Nothing True (Just journalpath) tnew-      either-       (\e -> do-          setMessage $ toHtml e-          redirect JournalR)-       (const $ do-          liftIO $ writeFileWithBackup journalpath tnew-          setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String)-          redirect JournalR)-       jE---- | Handle a post from the journal import form.-handleImport :: Handler Html-handleImport = do-  setMessage "can't handle file upload yet"-  redirect JournalR-  -- -- get form input values, or basic validation errors. E means an Either value.-  -- fileM <- runFormPost $ maybeFileInput "file"-  -- let fileE = maybe (Left "No file provided") Right fileM-  -- -- display errors or import transactions-  -- case fileE of-  --  Left errs -> do-  --   setMessage errs-  --   redirect JournalR--  --  Right s -> do-  --    setMessage s-  --    redirect JournalR-

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-} -- | /register handlers.  module Handler.RegisterR where@@ -8,8 +9,8 @@ import Data.Maybe import Safe +import Handler.AddForm import Handler.Common-import Handler.Post import Handler.Utils  import Hledger.Data@@ -40,7 +41,7 @@      |]  postRegisterR :: Handler Html-postRegisterR = handlePost+postRegisterR = postAddForm  -- Generate html for an account register, including a balance chart and transaction list. registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes, RecordWildCards #-} -- | /sidebar  module Handler.SidebarR where

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | Web handler utilities. More of these are in Foundation.hs, where -- they can be used in the default template. @@ -7,8 +8,9 @@ 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..]

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP, OverloadedStrings #-} {-|  hledger-web - a hledger add-on providing a web interface.@@ -19,7 +20,9 @@ import Network.Wai.Handler.Launch (runUrlPort) -- import Prelude hiding (putStrLn)+#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))+#endif import Control.Monad (when) import Data.Text (pack) import System.Exit (exitSuccess)

@@ -1,7 +1,10 @@+{-# LANGUAGE CPP #-} module Hledger.Web.Options where import Prelude+#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))+#endif import Data.Maybe import System.Console.CmdArgs import System.Console.CmdArgs.Explicit

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Import     ( module Import     ) where@@ -6,7 +7,9 @@                                                  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@@ -15,8 +18,10 @@ import           Settings.StaticFiles as Import  #if __GLASGOW_HASKELL__ >= 704-import           Data.Monoid          as Import-                                                 (Monoid (mappend, mempty, mconcat),+import           Data.Monoid          as Import (+#if !MIN_VERSION_base(4,8,0)+                                                 Monoid (mappend, mempty, mconcat),+#endif                                                  (<>)) #else import           Data.Monoid          as Import

@@ -1,3 +1,4 @@+{-# 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@@ -12,7 +13,9 @@ 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

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Settings.Development where  import Prelude

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} module Settings.StaticFiles where  import Prelude (IO, putStrLn, (++), (>>), return)

@@ -5,8 +5,6 @@ /journal         JournalR        GET POST /register        RegisterR       GET POST /sidebar         SidebarR        GET--- /journal/entries JournalEntriesR GET POST--- /journal/edit    JournalEditR    GET POST---+ -- /accounts        AccountsR       GET -- /api/accounts    AccountsJsonR   GET

@@ -1,5 +1,5 @@ name:           hledger-web-version: 0.24.1+version: 0.25 stability:      stable category:       Finance synopsis:       A web interface for the hledger accounting tool.@@ -110,9 +110,14 @@     Description:   Build for use with "yesod devel"     Default:       False +flag old-locale+  description: A compatibility flag, set automatically by cabal.+               If false then depend on time >= 1.5, +               if true then depend on time < 1.5 together with old-locale.+  default: False  library-    cpp-options:   -DVERSION="0.24.1"+    cpp-options:   -DVERSION="0.25"     if flag(dev) || flag(library-only)         cpp-options: -DDEVELOPMENT  @@ -141,11 +146,9 @@                      Settings                      Settings.StaticFiles                      Settings.Development+                     Handler.AddForm                      Handler.Common-                     Handler.JournalEditR-                     Handler.JournalEntriesR                      Handler.JournalR-                     Handler.Post                      Handler.RegisterR                      Handler.RootR                      Handler.SidebarR@@ -156,9 +159,10 @@                      Hledger.Web.Options                      -- Setup -- stops yesod devel complaining, requires build-depends: Cabal     build-depends:-                     hledger              == 0.24.*-                   , hledger-lib          == 0.24.*+                     hledger              == 0.25+                   , hledger-lib          == 0.25                    , base                 >= 4 && < 5+                   , base-compat          >= 0.5.0                    , blaze-html                    , blaze-markup                    , bytestring@@ -173,14 +177,12 @@                    , HUnit                    , network-conduit                    , conduit-extra-                   , old-locale                    , parsec               >= 3                    , regexpr              >= 0.5.1                    , safe                 >= 0.2                    , shakespeare          >= 2.0                    , template-haskell                    , text-                   , time                    , transformers                    , wai                    , wai-extra@@ -189,19 +191,24 @@                    , yaml                    , yesod                >= 1.4 && < 1.5                    , yesod-core+                   , yesod-form                    , yesod-static                    , json                    -- required by extra ghci utilities:                    -- , fsnotify                    -- , hsdev                    -- , mtl+  if flag(old-locale)+    build-depends: time < 1.5, old-locale+  else+    build-depends: time >= 1.5   executable         hledger-web     if flag(library-only)         Buildable: False -    cpp-options:   -DVERSION="0.24.1"+    cpp-options:   -DVERSION="0.25"     if flag(dev)         cpp-options: -DDEVELOPMENT @@ -226,10 +233,11 @@     main-is:         main.hs      build-depends:-                     hledger-lib          == 0.24.*-                   , hledger              == 0.24.*-                   , hledger-web          == 0.24.1+                     hledger-lib          == 0.25+                   , hledger              == 0.25+                   , hledger-web          == 0.25                    , base                 >= 4 && < 5+                   , base-compat          >= 0.5.0                    , blaze-html                    , blaze-markup                    , bytestring@@ -244,14 +252,12 @@                    , HUnit                    , network-conduit                    , conduit-extra-                   , old-locale                    , parsec               >= 3                    , regexpr              >= 0.5.1                    , safe                 >= 0.2                    , shakespeare          >= 2.0 && < 2.1                    , template-haskell                    , text-                   , time                    , transformers                    , wai                    , wai-extra@@ -260,12 +266,17 @@                    , yaml                    , yesod                >= 1.4 && < 1.5                    , yesod-core+                   , yesod-form                    , yesod-static                    , json                    -- required by extra ghci utilities:                    -- , fsnotify                    -- , hsdev                    -- , mtl+  if flag(old-locale)+    build-depends: time < 1.5, old-locale+  else+    build-depends: time >= 1.5  test-suite test     type:              exitcode-stdio-1.0@@ -274,8 +285,9 @@     hs-source-dirs:    tests     main-is:           main.hs     build-depends: -                     hledger-web          == 0.24.1+                     hledger-web          == 0.25                    , base+                   , base-compat          >= 0.5.0                    , hspec                    , yesod                    , yesod-test

@@ -6,7 +6,7 @@ $(document).ready(function() {    // show add form if ?add=1-  if ($.url.param('add')) { addformShow(); }+  if ($.url.param('add')) { addformShow(showmsg=true); }    // sidebar account hover handlers   $('#sidebar td a').mouseenter(function(){ $(this).parent().addClass('mouseover'); });@@ -126,8 +126,8 @@ //---------------------------------------------------------------------- // ADD FORM -function addformShow() {-  addformReset();+function addformShow(showmsg=false) {+  addformReset(showmsg);   $('#addmodal')     .on('shown.bs.modal', function (e) {       addformFocus();@@ -136,13 +136,14 @@ }  // Make sure the add form is empty and clean for display.-function addformReset() {+function addformReset(showmsg=false) {   if ($('form#addform').length > 0) {+    if (!showmsg) $('div#message').html('');     $('form#addform')[0].reset();-    $('input#date').val('today');     // reset typehead state (though not fetched completions)     $('.typeahead').typeahead('val', '');     $('.tt-dropdown-menu').hide();+    $('input#date').val('today');   } } @@ -242,7 +243,7 @@   focuslost = focuslost ||      $('#addform tr.posting:last > td:last input:last').is(':focus');   // replace new last row's amount field with the button-  $('#addform tr.posting:last > td:last').html(btn);+  $('#addform tr.posting:last > td:last').css('text-align','right').html(btn);   // if deleted row had focus, focus the new last row   if (focuslost) $('#addform tr.posting:last > td:first input:last').focus(); }

@@ -100,4 +100,7 @@                 <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,3 +1,4 @@-$maybe msg <- mmsg-    <div #message>#{msg}+$maybe m <- lastmsg+  $if not $ isPrefixOf "Errors" (renderHtml m)+    <div #message>#{m} ^{widget}