web: Post -> AddForm; drop/comment more old stuff

hledger-web/Handler/AddForm.hs

@@ -1,6 +1,6 @@
 -- | POST helpers.
 
-module Handler.Post where
+module Handler.AddForm where
 
 import Import
 
@@ -10,6 +10,7 @@ import Data.List (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 Data.Time.Calendar
 import Text.Parsec (digit, eof, many1, string, runParser)
 
 import Hledger.Utils
@@ -18,20 +19,11 @@ 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
+postAddForm :: Handler Html
-handleAdd = do
+postAddForm = do
   VD{..} <- getViewData
-  -- XXX gruesome form handling, port to yesod-form later
+  -- XXX gruesome form handling, port to yesod-form. cf #234
   mjournalpath <- lookupPostParam  "journal"
   mdate <- lookupPostParam  "date"
   mdesc <- lookupPostParam  "description"
@@ -46,7 +38,9 @@ handleAdd = do
                               )
                        mjournalpath
       estrs = [edate, edesc, ejournalpath]
-      (errs1, [date,desc,journalpath]) = (lefts estrs, rights estrs)
+      (errs1, [date, desc, journalpath]) = case (lefts estrs, rights estrs) of
+        ([], [_,_,_]) -> ([], rights estrs)
+        _             -> (lefts estrs, [error "",error "",error ""]) -- RHS won't be used
   (params,_) <- runRequestBody
   -- mtrace params
   let paramnamep s = do {string s; n <- many1 digit; eof; return (read n :: Int)}
@@ -97,37 +91,32 @@ handleAdd = do
 
   redirect (JournalR) -- , [("add","1")])
 
--- personForm :: Html -> MForm Handler (FormResult Person, Widget)
+-- -- | Handle a post from the journal edit form.
--- personForm extra = do
+-- handleEdit :: Handler Html
---     (nameRes, nameView) <- mreq textField "this is not used" Nothing
+-- handleEdit = do
---     (ageRes, ageView) <- mreq intField "neither is this" Nothing
+--   VD{..} <- getViewData
---     let personRes = Person <$> nameRes <*> ageRes
+--   -- get form input values, or validation errors.
---     let widget = do
+--   -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace
---             toWidget
+--   mtext <- lookupPostParam "text"
---                 [lucius|
+--   mtrace "--------------------------"
---                     ##{fvId ageView} {
+--   mtrace (journalFilePaths j)
---                         width: 3em;
+--   mjournalpath <- lookupPostParam "journal"
---                     }
+--   let etext = maybe (Left "No value provided") (Right . unpack) mtext
---                 |]
+--       ejournalpath = maybe
---             [whamlet|
+--                        (Right $ journalFilePath j)
---                 #{extra}
+--                        (\f -> let f' = unpack f in
---                 <p>
+--                               if f' `elem` dbg0 "paths2" (journalFilePaths j)
---                     Hello, my name is #
+--                               then Right f'
---                     ^{fvInput nameView}
+--                               else Left ("unrecognised journal file path"::String))
---                     \ and I am #
+--                        mjournalpath
---                     ^{fvInput ageView}
+--       estrs = [etext, ejournalpath]
---                     \ years old. #
+--       errs = lefts estrs
---                     <input type=submit value="Introduce myself">
+--       [text,journalpath] = rights estrs
---             |]
+--   -- display errors or perform edit
---     return (personRes, widget)
+--   if not $ null errs
---
+--    then do
---     ((res, widget), enctype) <- runFormGet personForm
+--     setMessage $ toHtml (intercalate "; " errs :: String)
---     defaultLayout
+--     redirect JournalR
---         [whamlet|
---             <p>Result: #{show res}
---             <form enctype=#{enctype}>
---                 ^{widget}
---         |]
 
 -- -- | Handle a post from the journal edit form.
 -- handleEdit :: Handler Html

hledger-web/Handler/Common.hs

@@ -120,51 +120,51 @@ searchform VD{..} = [hamlet|
  where
   filtering = not $ null q
 
--- | Edit journal form.
+-- -- | Edit journal form.
-editform :: ViewData -> HtmlUrl AppRoute
+-- editform :: ViewData -> HtmlUrl AppRoute
-editform VD{..} = [hamlet|
+-- editform VD{..} = [hamlet|
-<form#editform method=POST style=display:none;>
+-- <form#editform method=POST style=display:none;>
- <h2#contenttitle>#{title}>
+--  <h2#contenttitle>#{title}>
- <table.form>
+--  <table.form>
-  $if manyfiles
+--   $if manyfiles
-   <tr>
+--    <tr>
-    <td colspan=2>
+--     <td colspan=2>
-     Editing ^{journalselect $ files j}
+--      Editing ^{journalselect $ files j}
-  <tr>
+--   <tr>
-   <td colspan=2>
+--    <td colspan=2>
-    <!-- XXX textarea ids are unquoted journal file paths here, not valid html -->
+--     <!-- XXX textarea ids are unquoted journal file paths here, not valid html -->
-    $forall f <- files j
+--     $forall f <- files j
-     <textarea id=#{fst f}_textarea name=text rows=25 cols=80 style=display:none; disabled=disabled>
+--      <textarea id=#{fst f}_textarea name=text rows=25 cols=80 style=display:none; disabled=disabled>
-      \#{snd f}
+--       \#{snd f}
-  <tr#addbuttonrow>
+--   <tr#addbuttonrow>
-   <td>
+--    <td>
-    <span.help>^{formathelp}
+--     <span.help>^{formathelp}
-   <td align=right>
+--    <td align=right>
-    <span.help>
+--     <span.help>
-     Are you sure ? This will overwrite the journal. #
+--      Are you sure ? This will overwrite the journal. #
-    <input type=hidden name=action value=edit>
+--     <input type=hidden name=action value=edit>
-    <input type=submit name=submit value="save journal">
+--     <input type=submit name=submit value="save journal">
-    \ or #
+--     \ or #
-    <a href="#" onclick="return editformToggle(event)">cancel
+--     <a href="#" onclick="return editformToggle(event)">cancel
-|]
+-- |]
-  where
+--   where
-    title = "Edit journal" :: String
+--     title = "Edit journal" :: String
-    manyfiles = length (files j) > 1
+--     manyfiles = length (files j) > 1
-    formathelp = helplink "file-format" "file format help"
+--     formathelp = helplink "file-format" "file format help"
 
--- | Import journal form.
+-- -- | Import journal form.
-importform :: HtmlUrl AppRoute
+-- importform :: HtmlUrl AppRoute
-importform = [hamlet|
+-- importform = [hamlet|
-<form#importform method=POST style=display:none;>
+-- <form#importform method=POST style=display:none;>
- <table.form>
+--  <table.form>
-  <tr>
+--   <tr>
-   <td>
+--    <td>
-    <input type=file name=file>
+--     <input type=file name=file>
-    <input type=hidden name=action value=import>
+--     <input type=hidden name=action value=import>
-    <input type=submit name=submit value="import from file">
+--     <input type=submit name=submit value="import from file">
-    \ or #
+--     \ or #
-    <a href="#" onclick="return importformToggle(event)">cancel
+--     <a href="#" onclick="return importformToggle(event)">cancel
-|]
+-- |]
 
 -- | Link to a topic in the manual.
 helplink :: String -> String -> HtmlUrl AppRoute

hledger-web/Handler/JournalEditR.hs

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

hledger-web/Handler/JournalR.hs

@@ -4,8 +4,8 @@ module Handler.JournalR where
 
 import Import
 
+import Handler.AddForm
 import Handler.Common
-import Handler.Post
 
 import Hledger.Data
 import Hledger.Query
@@ -38,7 +38,7 @@ getJournalR = do
      |]
 
 postJournalR :: Handler Html
-postJournalR = handlePost
+postJournalR = postAddForm
 
 -- | Render a "TransactionsReport" as html for the formatted journal view.
 journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute

hledger-web/Handler/RegisterR.hs

@@ -8,8 +8,8 @@ import Data.List
 import Data.Maybe
 import Safe
 
+import Handler.AddForm
 import Handler.Common
-import Handler.Post
 import Handler.Utils
 
 import Hledger.Data
@@ -40,7 +40,7 @@ getRegisterR = do
      |]
 
 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

hledger-web/config/routes

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

hledger-web/hledger-web.cabal

@@ -141,10 +141,9 @@ library
                      Settings
                      Settings.StaticFiles
                      Settings.Development
+                     Handler.AddForm
                      Handler.Common
-                     Handler.JournalEditR
                      Handler.JournalR
-                     Handler.Post
                      Handler.RegisterR
                      Handler.RootR
                      Handler.SidebarR