installing: drop -fweb610 flag

Hledger/Cli/Commands/All.hs

@@ -23,8 +23,6 @@ module Hledger.Cli.Commands.All (
 #endif
 #if defined(WEB)
                      module Hledger.Cli.Commands.Web,
-#elif defined(WEB610)
-                     module Hledger.Cli.Commands.Web610,
 #endif
                      tests_Hledger_Commands
               )
@@ -44,8 +42,6 @@ import Hledger.Cli.Commands.Vty
 #endif
 #if defined(WEB)
 import Hledger.Cli.Commands.Web
-#elif defined(WEB610)
-import Hledger.Cli.Commands.Web610
 #endif
 import Test.HUnit (Test(TestList))
 
@@ -68,6 +64,4 @@ tests_Hledger_Commands = TestList
 -- #endif
 -- #if defined(WEB)
 --     ,Hledger.Cli.Commands.Web.tests_Web
--- #elif defined(WEB610)
---     ,Hledger.Cli.Commands.Web610.tests_Web
 -- #endif

Hledger/Cli/Commands/Web610.hs

@@ -1,316 +0,0 @@
-{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
-{-# OPTIONS_GHC -F -pgmFtrhsx #-}
-{-| 
-A web-based UI.
--}
-
-module Hledger.Cli.Commands.Web610
-where
-import Codec.Binary.UTF8.String (decodeString)
-import Control.Applicative.Error (Failing(Success,Failure))
-import Control.Concurrent
-import Control.Monad.Reader (ask)
-import Data.IORef (newIORef, atomicModifyIORef)
-import System.IO.Storage (withStore, putValue, getValue)
-import Text.ParserCombinators.Parsec (parse)
-
-import Hack.Contrib.Constants (_TextHtmlUTF8)
-import Hack.Contrib.Response (set_content_type)
-import qualified Hack (Env, http)
-import qualified Hack.Contrib.Request (inputs, params, path)
-import qualified Hack.Contrib.Response (redirect)
-import Hack.Handler.SimpleServer (run)
-
-import Network.Loli (loli, io, get, post, html, text, public)
-import Network.Loli.Type (AppUnit)
-import Network.Loli.Utils (update)
-
-import HSP hiding (Request,catch)
-import qualified HSP (Request(..))
-
-import Hledger.Cli.Commands.Add (journalAddTransaction)
-import Hledger.Cli.Commands.Balance
-import Hledger.Cli.Commands.Histogram
-import Hledger.Cli.Commands.Print
-import Hledger.Cli.Commands.Register
-import Hledger.Data
-import Hledger.Read.Journal (someamount)
-import Hledger.Cli.Options hiding (value)
-#ifdef MAKE
-import Paths_hledger_make (getDataFileName)
-#else
-import Paths_hledger (getDataFileName)
-#endif
-import Hledger.Cli.Utils
-
-
-tcpport = 5000 :: Int
-homeurl = printf "http://localhost:%d/" tcpport
-browserdelay = 100000 -- microseconds
-
-web :: [Opt] -> [String] -> Journal -> IO ()
-web opts args j = do
-  unless (Debug `elem` opts) $ forkIO browser >> return ()
-  server opts args j
-
-browser :: IO ()
-browser = putStrLn "starting web browser" >> threadDelay browserdelay >> openBrowserOn homeurl >> return ()
-
-server :: [Opt] -> [String] -> Journal -> IO ()
-server opts args j =
-  -- server initialisation
-  withStore "hledger" $ do -- IO ()
-    printf "starting web server on port %d\n" tcpport
-    t <- getCurrentLocalTime
-    webfiles <- getDataFileName "web"
-    putValue "hledger" "journal" j
-    run tcpport $            -- (Env -> IO Response) -> IO ()
-      \env -> do -- IO Response
-       -- general request handler
-       let opts' = opts ++ [Period $ unwords $ map decodeString $ reqParamUtf8 env "p"]
-           args' = args ++ map decodeString (reqParamUtf8 env "a")
-       j' <- fromJust `fmap` getValue "hledger" "journal"
-       (jE, changed) <- io $ journalReloadIfChanged opts j'
-       let (j''', err) = either (\e -> (j',e)) (\j'' -> (j'',"")) jE
-       when (changed && null err) $ putValue "hledger" "journal" j'''
-       when (changed && not (null err)) $ printf "error while reading %s\n" (filepath j')
-       -- declare path-specific request handlers
-       let command :: [String] -> ([Opt] -> FilterSpec -> Journal -> String) -> AppUnit
-           command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) j'''
-       (loli $                                               -- State Loli () -> (Env -> IO Response)
-         do
-          get  "/balance"   $ command [] showBalanceReport  -- String -> ReaderT Env (StateT Response IO) () -> State Loli ()
-          get  "/register"  $ command [] showRegisterReport
-          get  "/histogram" $ command [] showHistogram
-          get  "/transactions"   $ journalpage [] j''' (showTransactions (optsToFilterSpec opts' args' t))
-          post "/transactions"   $ handleAddform j'''
-          get  "/env"       $ getenv >>= (text . show)
-          get  "/params"    $ getenv >>= (text . show . Hack.Contrib.Request.params)
-          get  "/inputs"    $ getenv >>= (text . show . Hack.Contrib.Request.inputs)
-          public (Just webfiles) ["/style.css"]
-          get  "/"          $ redirect ("transactions") Nothing
-          ) env
-
-getenv = ask
-response = update
-redirect u c = response $ Hack.Contrib.Response.redirect u c
-
-reqParamUtf8 :: Hack.Env -> String -> [String]
-reqParamUtf8 env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params env
-
-journalpage :: [String] -> Journal -> (Journal -> String) -> AppUnit
-journalpage msgs j f = do
-  env <- getenv
-  (jE, _) <- io $ journalReloadIfChanged [] j
-  let (j'', _) = either (\e -> (j,e)) (\j' -> (j',"")) jE
-  hsp msgs $ const <div><% addform env %><pre><% f j'' %></pre></div>
-
--- | A loli directive to serve a string in pre tags within the hledger web
--- layout.
-string :: [String] -> String -> AppUnit
-string msgs s = hsp msgs $ const <pre><% s %></pre>
-
--- | A loli directive to serve a hsp template wrapped in the hledger web
--- layout. The hack environment is passed in to every hsp template as an
--- argument, since I don't see how to get it within the hsp monad.
--- A list of messages is also passed, eg for form errors.
-hsp :: [String] -> (Hack.Env -> HSP XML) -> AppUnit
-hsp msgs f = do
-  env <- getenv
-  let contenthsp = f env
-      pagehsp = hledgerpage env msgs title contenthsp
-  html =<< (io $ do
-              hspenv <- hackEnvToHspEnv env
-              (_,xml) <- runHSP html4Strict pagehsp hspenv
-              return $ addDoctype $ renderAsHTML xml)
-  response $ set_content_type _TextHtmlUTF8
-    where
-      title = ""
-      addDoctype = ("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">\n" ++)
-      hackEnvToHspEnv :: Hack.Env -> IO HSPEnv
-      hackEnvToHspEnv env = do
-          x <- newIORef 0
-          let req = HSP.Request (reqParamUtf8 env) (Hack.http env)
-              num = NumberGen (atomicModifyIORef x (\a -> (a+1,a)))
-          return $ HSPEnv req num
-
--- htmlToHsp :: Html -> HSP XML
--- htmlToHsp h = return $ cdata $ showHtml h
-
--- views
-
-hledgerpage :: Hack.Env -> [String] -> String -> HSP XML -> HSP XML
-hledgerpage env msgs title content =
-    <html>
-      <head>
-        <meta http-equiv = "Content-Type" content = "text/html; charset=utf-8" />
-        <link rel="stylesheet" type="text/css" href="/style.css" media="all" />
-        <title><% title %></title>
-      </head>
-      <body>
-        <% navbar env %>
-        <div id="messages"><% intercalate ", " msgs %></div>
-        <div id="content"><% content %></div>
-      </body>
-    </html>
-
-navbar :: Hack.Env -> HSP XML
-navbar env =
-    <div id="navbar">
-      <a href="http://hledger.org" id="hledgerorglink">hledger.org</a>
-      <% navlinks env %>
-      <% searchform env %>
-      <a href="http://hledger.org/MANUAL.html" id="helplink">help</a>
-    </div>
-
-getParamOrNull p = (decodeString . fromMaybe "") `fmap` getParam p
-
-navlinks :: Hack.Env -> HSP XML
-navlinks _ = do
-   a <- getParamOrNull "a"
-   p <- getParamOrNull "p"
-   let addparams=(++(printf "?a=%s&p=%s" a p))
-       link s = <a href=(addparams s) class="navlink"><% s %></a>
-   <div id="navlinks">
-     <% link "transactions" %> |
-     <% link "register" %> |
-     <% link "balance" %>
-    </div>
-
-searchform :: Hack.Env -> HSP XML
-searchform env = do
-   a <- getParamOrNull "a"
-   p <- getParamOrNull "p"
-   let resetlink | null a && null p = <span></span>
-                 | otherwise = <span id="resetlink"><% nbsp %><a href=u>reset</a></span>
-                 where u = dropWhile (=='/') $ Hack.Contrib.Request.path env
-   <form action="" id="searchform">
-      <% nbsp %>search for:<% nbsp %><input name="a" size="20" value=a
-      /><% help "filter-patterns"
-      %><% nbsp %><% nbsp %>in reporting period:<% nbsp %><input name="p" size="20" value=p
-      /><% help "period-expressions"
-      %><input type="submit" name="submit" value="filter" style="display:none" />
-      <% resetlink %>
-    </form>
-
-addform :: Hack.Env -> HSP XML
-addform env = do
-  today <- io $ liftM showDate $ getCurrentDay
-  let inputs = Hack.Contrib.Request.inputs env
-      date  = decodeString $ fromMaybe today $ lookup "date"  inputs
-      desc  = decodeString $ fromMaybe "" $ lookup "desc"  inputs
-  <div>
-   <div id="addform">
-   <form action="" method="POST">
-    <table border="0">
-      <tr>
-        <td>
-          Date: <input size="15" name="date" value=date /><% help "dates" %><% nbsp %>
-          Description: <input size="35" name="desc" value=desc /><% nbsp %>
-        </td>
-      </tr>
-      <% transactionfields 1 env %>
-      <% transactionfields 2 env %>
-      <tr id="addbuttonrow"><td><input type="submit" value="add transaction" 
-      /><% help "file-format" %></td></tr>
-    </table>
-   </form>
-   </div>
-   <br clear="all" />
-   </div>
-
-help :: String -> HSP XML
-help topic = <a href=u>?</a>
-    where u = printf "http://hledger.org/MANUAL.html%s" l :: String
-          l | null topic = ""
-            | otherwise = '#':topic
-
-transactionfields :: Int -> Hack.Env -> HSP XML
-transactionfields n env = do
-  let inputs = Hack.Contrib.Request.inputs env
-      acct = decodeString $ fromMaybe "" $ lookup acctvar inputs
-      amt  = decodeString $ fromMaybe "" $ lookup amtvar  inputs
-  <tr>
-    <td>
-    <% nbsp %><% nbsp %>
-      Account: <input size="35" name=acctvar value=acct /><% nbsp %>
-      Amount: <input size="15" name=amtvar value=amt /><% nbsp %>
-    </td>
-   </tr>
-    where
-      numbered = (++ show n)
-      acctvar = numbered "acct"
-      amtvar = numbered "amt"
-
-handleAddform :: Journal -> AppUnit
-handleAddform j = do
-  env <- getenv
-  d <- io getCurrentDay
-  t <- io getCurrentLocalTime
-  handle t $ validate env d
-  where
-    validate :: Hack.Env -> Day -> Failing Transaction
-    validate env today =
-        let inputs = Hack.Contrib.Request.inputs env
-            date  = decodeString $ fromMaybe "today" $ lookup "date"  inputs
-            desc  = decodeString $ fromMaybe "" $ lookup "desc"  inputs
-            acct1 = decodeString $ fromMaybe "" $ lookup "acct1" inputs
-            amt1  = decodeString $ fromMaybe "" $ lookup "amt1"  inputs
-            acct2 = decodeString $ fromMaybe "" $ lookup "acct2" inputs
-            amt2  = decodeString $ fromMaybe "" $ lookup "amt2"  inputs
-            validateDate ""  = ["missing date"]
-            validateDate _   = []
-            validateDesc ""  = ["missing description"]
-            validateDesc _   = []
-            validateAcct1 "" = ["missing account 1"]
-            validateAcct1 _  = []
-            validateAmt1 ""  = ["missing amount 1"]
-            validateAmt1 _   = []
-            validateAcct2 "" = ["missing account 2"]
-            validateAcct2 _  = []
-            validateAmt2 _   = []
-            amt1' = either (const missingamt) id $ parse someamount "" amt1
-            amt2' = either (const missingamt) id $ parse someamount "" amt2
-            (date', dateparseerr) = case fixSmartDateStrEither today date of
-                                      Right d -> (d, [])
-                                      Left e -> ("1900/01/01", [showDateParseError e])
-            t = Transaction {
-                            tdate = parsedate date' -- date' must be parseable
-                           ,teffectivedate=Nothing
-                           ,tstatus=False
-                           ,tcode=""
-                           ,tdescription=desc
-                           ,tcomment=""
-                           ,tpostings=[
-                             Posting False acct1 amt1' "" RegularPosting (Just t')
-                            ,Posting False acct2 amt2' "" RegularPosting (Just t')
-                            ]
-                           ,tpreceding_comment_lines=""
-                           }
-            (t', balanceerr) = case balanceTransaction t of
-                           Right t'' -> (t'', [])
-                           Left e -> (t, [head $ lines e]) -- show just the error not the transaction
-            errs = concat [
-                    validateDate date
-                   ,dateparseerr
-                   ,validateDesc desc
-                   ,validateAcct1 acct1
-                   ,validateAmt1 amt1
-                   ,validateAcct2 acct2
-                   ,validateAmt2 amt2
-                   ,balanceerr
-                   ]
-        in
-        case null errs of
-          False -> Failure errs
-          True  -> Success t'
-
-    handle :: LocalTime -> Failing Transaction -> AppUnit
-    handle _ (Failure errs) = hsp errs addform
-    handle ti (Success t)   = do
-                    io $ journalAddTransaction j t >>= journalReload
-                    journalpage [msg] j (showTransactions (optsToFilterSpec [] [] ti))
-       where msg = printf "Added transaction:\n%s" (show t)
-
-nbsp :: XML
-nbsp = cdata "&nbsp;"

Hledger/Cli/Main.hs

@@ -39,7 +39,7 @@ See "Hledger.Data.Ledger" for more examples.
 -}
 
 module Hledger.Cli.Main where
-#if defined(WEB) || defined(WEB610)
+#if defined(WEB)
 import System.Info (os)
 #endif
 #if __GLASGOW_HASKELL__ <= 610
@@ -76,7 +76,7 @@ main = do
 #ifdef VTY
        | cmd `isPrefixOf` "vty"       = withJournalDo opts args cmd vty
 #endif
-#if defined(WEB) || defined(WEB610)
+#if defined(WEB)
        | cmd `isPrefixOf` "web"       = withJournalDo opts args cmd web
 #endif
 #ifdef CHART
@@ -86,7 +86,7 @@ main = do
        | otherwise                    = putStr help1
 
 -- in a web-enabled build on windows, run the web ui by default
-#if defined(WEB) || defined(WEB610)
+#if defined(WEB)
       defaultcmd | os=="mingw32" = Just web
                  | otherwise = Nothing
 #else

Hledger/Cli/Options.hs

@@ -42,10 +42,10 @@ help1 =
   " (DISABLED, install with -fvty)\n" ++
 #endif
   "  web       - run a simple web-based UI" ++
-#if defined(WEB) || defined(WEB610)
+#if defined(WEB)
   "\n" ++
 #else
-  " (DISABLED, install with -fweb or -fweb610)\n" ++
+  " (DISABLED, install with -fweb)\n" ++
 #endif
   "  chart     - generate balances pie charts" ++
 #ifdef CHART

Hledger/Cli/Version.hs

@@ -70,8 +70,6 @@ configflags   = tail [""
   ,"vty"
 #endif
 #if defined(WEB)
-  ,"web (using yesod/hamlet/simpleserver)"
+  ,"web"
-#elif defined(WEB610)
-  ,"web (using loli/hsp/simpleserver)"
 #endif
  ]

Makefile

@@ -535,7 +535,6 @@ setversion: $(VERSIONSENSITIVEFILES)
 
 Hledger/Cli/Version.hs: $(VERSIONFILE)
 	perl -p -e "s/(^version *= *)\".*?\"/\1\"$(VERSION3)\"/" -i $@
-# XXX also touch manually when switching between cabal install -fweb and -fweb610
 
 hledger.cabal: $(VERSIONFILE)
 	perl -p -e "s/(^ *version:) *.*/\1 $(VERSION)/" -i $@

hledger.cabal

@@ -53,10 +53,6 @@ flag web
   description: enable the web ui (using yesod/hamlet/simpleserver, requires ghc 6.12)
   default:     False
 
-flag web610
-  description: enable the web ui (using loli/hsp/simpleserver, works with ghc 6.10)
-  default:     False
-
 executable hledger
   main-is:        hledger.hs
   -- should set patchlevel here as in Makefile
@@ -118,21 +114,6 @@ executable hledger
                  ,data-object >= 0.3.1.2 && < 0.4
                  ,failure >= 0.1 && < 0.2
 
-  if flag(web610)
-    cpp-options: -DWEB610
-    other-modules:Hledger.Cli.Commands.Web610
-    build-depends:
-                  hsp
-                 ,hsx
-                 ,xhtml >= 3000.2
-                 ,loli
-                 ,io-storage
-                 ,hack-contrib
-                 ,hack
-                 ,hack-handler-simpleserver
-                 ,HTTP >= 4000.0
-                 ,applicative-extras
-
 -- modules and dependencies below should be as above, except
 -- chart, vty, web etc. are not presently exposed as library functions
 library