From 2f2e500eae04322384b22a10cea31742e7f66753 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 10 Jul 2010 13:58:35 +0000 Subject: [PATCH] rename -fweb to -fweb610 and -fwebyesod to -fweb, misc cabal and docs cleanups --- Hledger/Cli/Commands/All.hs | 30 +- Hledger/Cli/Commands/Web.hs | 522 +++++++++++++++---------------- Hledger/Cli/Commands/Web610.hs | 313 ++++++++++++++++++ Hledger/Cli/Commands/WebYesod.hs | 299 ------------------ Hledger/Cli/Main.hs | 2 +- Hledger/Cli/Options.hs | 8 +- Hledger/Cli/Version.hs | 4 +- MANUAL.markdown | 95 +++--- Makefile | 4 +- hledger-lib/hledger-lib.cabal | 5 +- hledger.cabal | 93 ++---- 11 files changed, 673 insertions(+), 702 deletions(-) create mode 100644 Hledger/Cli/Commands/Web610.hs delete mode 100644 Hledger/Cli/Commands/WebYesod.hs diff --git a/Hledger/Cli/Commands/All.hs b/Hledger/Cli/Commands/All.hs index 0d5140c48..cc9f4f720 100644 --- a/Hledger/Cli/Commands/All.hs +++ b/Hledger/Cli/Commands/All.hs @@ -15,16 +15,16 @@ module Hledger.Cli.Commands.All ( module Hledger.Cli.Commands.Print, module Hledger.Cli.Commands.Register, module Hledger.Cli.Commands.Stats, +#ifdef CHART + module Hledger.Cli.Commands.Chart, +#endif #ifdef VTY module Hledger.Cli.Commands.Vty, #endif #if defined(WEB) module Hledger.Cli.Commands.Web, -#elif defined(WEBYESOD) - module Hledger.Cli.Commands.WebYesod, -#endif -#ifdef CHART - module Hledger.Cli.Commands.Chart, +#elif defined(WEB610) + module Hledger.Cli.Commands.Web610, #endif tests_Hledger_Commands ) @@ -36,16 +36,16 @@ import Hledger.Cli.Commands.Histogram import Hledger.Cli.Commands.Print import Hledger.Cli.Commands.Register import Hledger.Cli.Commands.Stats +#ifdef CHART +import Hledger.Cli.Commands.Chart +#endif #ifdef VTY import Hledger.Cli.Commands.Vty #endif #if defined(WEB) import Hledger.Cli.Commands.Web -#elif defined(WEBYESOD) -import Hledger.Cli.Commands.WebYesod -#endif -#ifdef CHART -import Hledger.Cli.Commands.Chart +#elif defined(WEB610) +import Hledger.Cli.Commands.Web610 #endif import Test.HUnit (Test(TestList)) @@ -60,14 +60,14 @@ tests_Hledger_Commands = TestList ,Hledger.Cli.Commands.Register.tests_Register -- ,Hledger.Cli.Commands.Stats.tests_Stats ] +-- #ifdef CHART +-- ,Hledger.Cli.Commands.Chart.tests_Chart +-- #endif -- #ifdef VTY -- ,Hledger.Cli.Commands.Vty.tests_Vty -- #endif -- #if defined(WEB) -- ,Hledger.Cli.Commands.Web.tests_Web --- #elif defined(WEBYESOD) --- ,Hledger.Cli.Commands.WebYesod.tests_Web --- #endif --- #ifdef CHART --- ,Hledger.Cli.Commands.Chart.tests_Chart +-- #elif defined(WEB610) +-- ,Hledger.Cli.Commands.Web610.tests_Web -- #endif diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index e4f19163b..a93c7e274 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/Hledger/Cli/Commands/Web.hs @@ -1,313 +1,299 @@ -{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} -{-# OPTIONS_GHC -F -pgmFtrhsx #-} +{-# LANGUAGE CPP, TypeFamilies, QuasiQuotes, TemplateHaskell #-} {-| A web-based UI. -} module Hledger.Cli.Commands.Web 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 Control.Concurrent -- (forkIO) +import Data.Either +import Network.Wai.Handler.SimpleServer (run) +import System.FilePath (()) import System.IO.Storage (withStore, putValue, getValue) +import Text.Hamlet 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 Yesod 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.Cli.Options hiding (value) +import Hledger.Cli.Utils 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 +defhost = "localhost" +defport = 5000 +browserstartdelay = 100000 -- microseconds +hledgerurl = "http://hledger.org" +manualurl = hledgerurl++"/MANUAL.html" web :: [Opt] -> [String] -> Journal -> IO () web opts args j = do - unless (Debug `elem` opts) $ forkIO browser >> return () - server opts args j + let host = fromMaybe defhost $ hostFromOpts opts + port = fromMaybe defport $ portFromOpts opts + url = printf "http://%s:%d" host port :: String + unless (Debug `elem` opts) $ forkIO (browser url) >> return () + server url port opts args j -browser :: IO () -browser = putStrLn "starting web browser" >> threadDelay browserdelay >> openBrowserOn homeurl >> return () +browser :: String -> IO () +browser url = putStrLn "starting web browser" >> threadDelay browserstartdelay >> openBrowserOn url >> 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" - (changed, j'') <- io $ journalReloadIfChanged opts j' - when changed $ putValue "hledger" "journal" 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" $ ledgerpage [] 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 +server :: String -> Int -> [Opt] -> [String] -> Journal -> IO () +server url port opts args j = do + printf "starting web server at %s\n" url + fp <- getDataFileName "web" + let app = HledgerWebApp{ + appOpts=opts + ,appArgs=args + ,appJournal=j + ,appWebdir=fp + ,appRoot=url + } + withStore "hledger" $ do -- IO () + putValue "hledger" "journal" j + toWaiApp app >>= run port -getenv = ask -response = update -redirect u c = response $ Hack.Contrib.Response.redirect u c +data HledgerWebApp = HledgerWebApp { + appOpts::[Opt] + ,appArgs::[String] + ,appJournal::Journal + ,appWebdir::FilePath + ,appRoot::String + } -reqParamUtf8 :: Hack.Env -> String -> [String] -reqParamUtf8 env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params env +instance Yesod HledgerWebApp where approot = appRoot -ledgerpage :: [String] -> Journal -> (Journal -> String) -> AppUnit -ledgerpage msgs j f = do - env <- getenv - (_, j') <- io $ journalReloadIfChanged [] j - hsp msgs $ const
<% addform env %>
<% f j' %>
+mkYesod "HledgerWebApp" [$parseRoutes| +/ IndexPage GET +/transactions TransactionsPage GET POST +/register RegisterPage GET +/balance BalancePage GET +/style.css StyleCss GET +/params ParamsDebug GET +|] --- | 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 
<% s %>
+getParamsDebug = do + r <- getRequest + return $ RepHtml $ toContent $ show $ reqGetParams r --- | 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 = ("\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 +getIndexPage :: Handler HledgerWebApp () +getIndexPage = redirect RedirectTemporary TransactionsPage --- htmlToHsp :: Html -> HSP XML --- htmlToHsp h = return $ cdata $ showHtml h +getStyleCss :: Handler HledgerWebApp RepPlain +getStyleCss = do + app <- getYesod + let dir = appWebdir app + s <- liftIO $ readFile $ dir "style.css" + header "Content-Type" "text/css" + return $ RepPlain $ toContent s --- views +getTransactionsPage :: Handler HledgerWebApp RepHtml +getTransactionsPage = withLatestJournalRender (const showTransactions) -hledgerpage :: Hack.Env -> [String] -> String -> HSP XML -> HSP XML -hledgerpage env msgs title content = - - - - - <% title %> - - - <% navbar env %> -
<% intercalate ", " msgs %>
-
<% content %>
- - +getRegisterPage :: Handler HledgerWebApp RepHtml +getRegisterPage = withLatestJournalRender showRegisterReport -navbar :: Hack.Env -> HSP XML -navbar env = - +getBalancePage :: Handler HledgerWebApp RepHtml +getBalancePage = withLatestJournalRender showBalanceReport -getParamOrNull p = (decodeString . fromMaybe "") `fmap` getParam p +withLatestJournalRender :: ([Opt] -> FilterSpec -> Journal -> String) -> Handler HledgerWebApp RepHtml +withLatestJournalRender reportfn = do + app <- getYesod + params <- getParams + t <- liftIO $ getCurrentLocalTime + let head' x = if null x then "" else head x + as = head' $ params "a" + ps = head' $ params "p" + opts = appOpts app ++ [Period ps] + args = appArgs app ++ [as] + fspec = optsToFilterSpec opts args t + -- reload journal if changed + j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" + (changed, j') <- liftIO $ journalReloadIfChanged opts j + when changed $ liftIO $ putValue "hledger" "journal" j' + -- run the specified report using this request's params + let s = reportfn opts fspec j' + -- render the standard template + req <- getRequest + msg <- getMessage + Just here <- getRoute + hamletToRepHtml $ template here req msg as ps "hledger" s -navlinks :: Hack.Env -> HSP XML -navlinks _ = do - a <- getParamOrNull "a" - p <- getParamOrNull "p" - let addparams=(++(printf "?a=%s&p=%s" a p)) - link s = <% s %> - +template :: HledgerWebAppRoutes + -> Request -> Maybe (Html ()) -> String -> String + -> String -> String -> Hamlet HledgerWebAppRoutes +template here req msg as ps title content = [$hamlet| +!!! +%html + %head + %title $string.title$ + %meta!http-equiv=Content-Type!content=$string.metacontent$ + %link!rel=stylesheet!type=text/css!href=@stylesheet@!media=all + %body + ^navbar'^ + #messages $m$ + ^addform'^ + #content + %pre $string.content$ +|] + where m = fromMaybe (string "") msg + navbar' = navbar here req as ps + addform' = addform req as ps + stylesheet = StyleCss + metacontent = "text/html; charset=utf-8" -searchform :: Hack.Env -> HSP XML -searchform env = do - a <- getParamOrNull "a" - p <- getParamOrNull "p" - let resetlink | null a && null p = - | otherwise = <% nbsp %>reset - where u = dropWhile (=='/') $ Hack.Contrib.Request.path env -
- <% nbsp %>search for:<% nbsp %><% help "filter-patterns" - %><% nbsp %><% nbsp %>in reporting period:<% nbsp %><% help "period-expressions" - %> - <% resetlink %> -
+navbar :: HledgerWebAppRoutes -> Request -> String -> String -> Hamlet HledgerWebAppRoutes +navbar here req as ps = [$hamlet| + #navbar + %a#hledgerorglink!href=$string.hledgerurl$ hledger.org + ^navlinks'^ + ^searchform'^ + %a#helplink!href=$string.manualurl$ help +|] + where navlinks' = navlinks req as ps + searchform' = searchform here as ps -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 -
-
-
- - - - - <% transactionfields 1 env %> - <% transactionfields 2 env %> - -
- Date: <% help "dates" %><% nbsp %> - Description: <% nbsp %> -
<% help "file-format" %>
-
-
-
-
+navlinks :: Request -> String -> String -> Hamlet HledgerWebAppRoutes +navlinks _ as ps = [$hamlet| + #navlinks + ^transactionslink^ | $ + ^registerlink^ | $ + ^balancelink^ +|] + where + transactionslink = navlink "transactions" TransactionsPage + registerlink = navlink "register" RegisterPage + balancelink = navlink "balance" BalancePage + navlink s dest = [$hamlet|%a.navlink!href=@?u@ $string.s$|] + where u = (dest, [("a", as), ("p", ps)]) -help :: String -> HSP XML -help topic = ? - where u = printf "http://hledger.org/MANUAL.html%s" l :: String - l | null topic = "" - | otherwise = '#':topic +searchform :: HledgerWebAppRoutes -> String -> String -> Hamlet HledgerWebAppRoutes +searchform here a p = [$hamlet| + %form#searchform!action=$string.action$ + search for: $ + %input!name=a!size=20!value=$string.a$ + ^ahelp^ $ + in reporting period: $ + %input!name=p!size=20!value=$string.p$ + ^phelp^ $ + %input!name=submit!type=submit!value=filter!style=display:none; + ^resetlink^ +|] + where + action="" + ahelp = helplink "filter-patterns" + phelp = helplink "period-expressions" + resetlink + | null a && null p = [$hamlet||] + | otherwise = [$hamlet|%span#resetlink $ + %a!href=@here@ reset|] -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 - - - <% nbsp %><% nbsp %> - Account: <% nbsp %> - Amount: <% nbsp %> - - - where - numbered = (++ show n) - acctvar = numbered "acct" - amtvar = numbered "amt" +helplink topic = [$hamlet|%a!href=$string.u$ ?|] + where u = manualurl ++ if null topic then "" else '#':topic -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' +addform :: Request -> String -> String -> Hamlet HledgerWebAppRoutes +addform _ _ _ = [$hamlet| + %form#addform!action=$string.action$!method=POST + %table!border=0 + %tr + %td + Date: + %input!size=15!name=date!value=$string.date$ + ^datehelp^ $ + Description: + %input!size=35!name=desc!value=$string.desc$ $ + ^transactionfields1^ + ^transactionfields2^ + %tr#addbuttonrow + %td + %input!type=submit!value=$string.addlabel$ + ^addhelp^ +
+|] + where + datehelp = helplink "dates" + addlabel = "add transaction" + addhelp = helplink "file-format" + action="" + date = "" + desc = "" + transactionfields1 = transactionfields 1 + transactionfields2 = transactionfields 2 - handle :: LocalTime -> Failing Transaction -> AppUnit - handle _ (Failure errs) = hsp errs addform - handle ti (Success t) = do - io $ journalAddTransaction j t >>= journalReload - ledgerpage [msg] j (showTransactions (optsToFilterSpec [] [] ti)) - where msg = printf "Added transaction:\n%s" (show t) +-- transactionfields :: Int -> Hamlet String +transactionfields n = [$hamlet| + %tr + %td +    + Account: + %input!size=35!name=$string.acctvar$!value=$string.acct$ +   + Amount: + %input!size=15!name=$string.amtvar$!value=$string.amt$ $ +|] + where + acct = "" + amt = "" + numbered = (++ show n) + acctvar = numbered "acct" + amtvar = numbered "amt" + +postTransactionsPage :: Handler HledgerWebApp RepPlain +postTransactionsPage = do + today <- liftIO getCurrentDay + -- get form input values, or basic validation errors. E means an Either value. + dateE <- runFormPost $ catchFormError $ notEmpty $ required $ input "date" + descE <- runFormPost $ catchFormError $ required $ input "desc" + acct1E <- runFormPost $ catchFormError $ notEmpty $ required $ input "acct1" + amt1E <- runFormPost $ catchFormError $ required $ input "amt1" + acct2E <- runFormPost $ catchFormError $ notEmpty $ required $ input "acct2" + amt2E <- runFormPost $ catchFormError $ required $ input "amt2" + -- supply defaults and parse date and amounts, or get errors. + let dateE' = either Left (either (\e -> Left [("date", showDateParseError e)]) Right . fixSmartDateStrEither today) dateE + amt1E' = either Left (either (const (Right missingamt)) Right . parse someamount "") amt1E -- XXX missingamt only when missing/empty + amt2E' = either Left (either (const (Right missingamt)) Right . parse someamount "") amt2E + strEs = [dateE', descE, acct1E, acct2E] + amtEs = [amt1E', amt2E'] + errs = lefts strEs ++ lefts amtEs + [date,desc,acct1,acct2] = rights strEs + [amt1,amt2] = rights amtEs + -- if no errors so far, generate a transaction and balance it or get the error. + tE | not $ null errs = Left errs + | otherwise = either (\e -> Left [[("unbalanced postings", head $ lines e)]]) Right + (balanceTransaction $ nulltransaction { + tdate=parsedate date + ,teffectivedate=Nothing + ,tstatus=False + ,tcode="" + ,tdescription=desc + ,tcomment="" + ,tpostings=[ + Posting False acct1 amt1 "" RegularPosting Nothing + ,Posting False acct2 amt2 "" RegularPosting Nothing + ] + ,tpreceding_comment_lines="" + }) + -- display errors or add transaction + case tE of + Left errs -> do + -- save current form values in session + setMessage $ string $ intercalate ", " $ map (intercalate ", " . map (\(a,b) -> a++": "++b)) errs + redirect RedirectTemporary TransactionsPage + + Right t -> do + let t' = txnTieKnot t -- XXX move into balanceTransaction + j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" + -- j' <- liftIO $ journalAddTransaction j t' >>= journalReload + -- liftIO $ putValue "hledger" "journal" j' + liftIO $ journalAddTransaction j t' + setMessage $ string $ printf "Added transaction:\n%s" (show t') + redirect RedirectTemporary TransactionsPage -nbsp :: XML -nbsp = cdata " " diff --git a/Hledger/Cli/Commands/Web610.hs b/Hledger/Cli/Commands/Web610.hs new file mode 100644 index 000000000..04473d668 --- /dev/null +++ b/Hledger/Cli/Commands/Web610.hs @@ -0,0 +1,313 @@ +{-# 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" + (changed, j'') <- io $ journalReloadIfChanged opts j' + when changed $ putValue "hledger" "journal" 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" $ ledgerpage [] 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 + +ledgerpage :: [String] -> Journal -> (Journal -> String) -> AppUnit +ledgerpage msgs j f = do + env <- getenv + (_, j') <- io $ journalReloadIfChanged [] j + hsp msgs $ const
<% addform env %>
<% f j' %>
+ +-- | 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 
<% s %>
+ +-- | 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 = ("\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 = + + + + + <% title %> + + + <% navbar env %> +
<% intercalate ", " msgs %>
+
<% content %>
+ + + +navbar :: Hack.Env -> HSP XML +navbar env = + + +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 = <% s %> + + +searchform :: Hack.Env -> HSP XML +searchform env = do + a <- getParamOrNull "a" + p <- getParamOrNull "p" + let resetlink | null a && null p = + | otherwise = <% nbsp %>reset + where u = dropWhile (=='/') $ Hack.Contrib.Request.path env +
+ <% nbsp %>search for:<% nbsp %><% help "filter-patterns" + %><% nbsp %><% nbsp %>in reporting period:<% nbsp %><% help "period-expressions" + %> + <% resetlink %> +
+ +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 +
+
+
+ + + + + <% transactionfields 1 env %> + <% transactionfields 2 env %> + +
+ Date: <% help "dates" %><% nbsp %> + Description: <% nbsp %> +
<% help "file-format" %>
+
+
+
+
+ +help :: String -> HSP XML +help topic = ? + 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 + + + <% nbsp %><% nbsp %> + Account: <% nbsp %> + Amount: <% nbsp %> + + + 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 + ledgerpage [msg] j (showTransactions (optsToFilterSpec [] [] ti)) + where msg = printf "Added transaction:\n%s" (show t) + +nbsp :: XML +nbsp = cdata " " diff --git a/Hledger/Cli/Commands/WebYesod.hs b/Hledger/Cli/Commands/WebYesod.hs deleted file mode 100644 index b14bae729..000000000 --- a/Hledger/Cli/Commands/WebYesod.hs +++ /dev/null @@ -1,299 +0,0 @@ -{-# LANGUAGE CPP, TypeFamilies, QuasiQuotes, TemplateHaskell #-} -{-| -A web-based UI. --} - -module Hledger.Cli.Commands.WebYesod -where -import Control.Concurrent -- (forkIO) -import Data.Either -import Network.Wai.Handler.SimpleServer (run) -import System.FilePath (()) -import System.IO.Storage (withStore, putValue, getValue) -import Text.Hamlet -import Text.ParserCombinators.Parsec (parse) -import Yesod - -import Hledger.Cli.Commands.Add (journalAddTransaction) -import Hledger.Cli.Commands.Balance -import Hledger.Cli.Commands.Print -import Hledger.Cli.Commands.Register -import Hledger.Cli.Options hiding (value) -import Hledger.Cli.Utils -import Hledger.Data -import Hledger.Read.Journal (someamount) -#ifdef MAKE -import Paths_hledger_make (getDataFileName) -#else -import Paths_hledger (getDataFileName) -#endif - - -defhost = "localhost" -defport = 5000 -browserstartdelay = 100000 -- microseconds -hledgerurl = "http://hledger.org" -manualurl = hledgerurl++"/MANUAL.html" - -web :: [Opt] -> [String] -> Journal -> IO () -web opts args j = do - let host = fromMaybe defhost $ hostFromOpts opts - port = fromMaybe defport $ portFromOpts opts - url = printf "http://%s:%d" host port :: String - unless (Debug `elem` opts) $ forkIO (browser url) >> return () - server url port opts args j - -browser :: String -> IO () -browser url = putStrLn "starting web browser" >> threadDelay browserstartdelay >> openBrowserOn url >> return () - -server :: String -> Int -> [Opt] -> [String] -> Journal -> IO () -server url port opts args j = do - printf "starting web server at %s\n" url - fp <- getDataFileName "web" - let app = HledgerWebApp{ - appOpts=opts - ,appArgs=args - ,appJournal=j - ,appWebdir=fp - ,appRoot=url - } - withStore "hledger" $ do -- IO () - putValue "hledger" "journal" j - toWaiApp app >>= run port - -data HledgerWebApp = HledgerWebApp { - appOpts::[Opt] - ,appArgs::[String] - ,appJournal::Journal - ,appWebdir::FilePath - ,appRoot::String - } - -instance Yesod HledgerWebApp where approot = appRoot - -mkYesod "HledgerWebApp" [$parseRoutes| -/ IndexPage GET -/transactions TransactionsPage GET POST -/register RegisterPage GET -/balance BalancePage GET -/style.css StyleCss GET -/params ParamsDebug GET -|] - -getParamsDebug = do - r <- getRequest - return $ RepHtml $ toContent $ show $ reqGetParams r - -getIndexPage :: Handler HledgerWebApp () -getIndexPage = redirect RedirectTemporary TransactionsPage - -getStyleCss :: Handler HledgerWebApp RepPlain -getStyleCss = do - app <- getYesod - let dir = appWebdir app - s <- liftIO $ readFile $ dir "style.css" - header "Content-Type" "text/css" - return $ RepPlain $ toContent s - -getTransactionsPage :: Handler HledgerWebApp RepHtml -getTransactionsPage = withLatestJournalRender (const showTransactions) - -getRegisterPage :: Handler HledgerWebApp RepHtml -getRegisterPage = withLatestJournalRender showRegisterReport - -getBalancePage :: Handler HledgerWebApp RepHtml -getBalancePage = withLatestJournalRender showBalanceReport - -withLatestJournalRender :: ([Opt] -> FilterSpec -> Journal -> String) -> Handler HledgerWebApp RepHtml -withLatestJournalRender reportfn = do - app <- getYesod - params <- getParams - t <- liftIO $ getCurrentLocalTime - let head' x = if null x then "" else head x - as = head' $ params "a" - ps = head' $ params "p" - opts = appOpts app ++ [Period ps] - args = appArgs app ++ [as] - fspec = optsToFilterSpec opts args t - -- reload journal if changed - j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" - (changed, j') <- liftIO $ journalReloadIfChanged opts j - when changed $ liftIO $ putValue "hledger" "journal" j' - -- run the specified report using this request's params - let s = reportfn opts fspec j' - -- render the standard template - req <- getRequest - msg <- getMessage - Just here <- getRoute - hamletToRepHtml $ template here req msg as ps "hledger" s - -template :: HledgerWebAppRoutes - -> Request -> Maybe (Html ()) -> String -> String - -> String -> String -> Hamlet HledgerWebAppRoutes -template here req msg as ps title content = [$hamlet| -!!! -%html - %head - %title $string.title$ - %meta!http-equiv=Content-Type!content=$string.metacontent$ - %link!rel=stylesheet!type=text/css!href=@stylesheet@!media=all - %body - ^navbar'^ - #messages $m$ - ^addform'^ - #content - %pre $string.content$ -|] - where m = fromMaybe (string "") msg - navbar' = navbar here req as ps - addform' = addform req as ps - stylesheet = StyleCss - metacontent = "text/html; charset=utf-8" - -navbar :: HledgerWebAppRoutes -> Request -> String -> String -> Hamlet HledgerWebAppRoutes -navbar here req as ps = [$hamlet| - #navbar - %a#hledgerorglink!href=$string.hledgerurl$ hledger.org - ^navlinks'^ - ^searchform'^ - %a#helplink!href=$string.manualurl$ help -|] - where navlinks' = navlinks req as ps - searchform' = searchform here as ps - -navlinks :: Request -> String -> String -> Hamlet HledgerWebAppRoutes -navlinks _ as ps = [$hamlet| - #navlinks - ^transactionslink^ | $ - ^registerlink^ | $ - ^balancelink^ -|] - where - transactionslink = navlink "transactions" TransactionsPage - registerlink = navlink "register" RegisterPage - balancelink = navlink "balance" BalancePage - navlink s dest = [$hamlet|%a.navlink!href=@?u@ $string.s$|] - where u = (dest, [("a", as), ("p", ps)]) - -searchform :: HledgerWebAppRoutes -> String -> String -> Hamlet HledgerWebAppRoutes -searchform here a p = [$hamlet| - %form#searchform!action=$string.action$ - search for: $ - %input!name=a!size=20!value=$string.a$ - ^ahelp^ $ - in reporting period: $ - %input!name=p!size=20!value=$string.p$ - ^phelp^ $ - %input!name=submit!type=submit!value=filter!style=display:none; - ^resetlink^ -|] - where - action="" - ahelp = helplink "filter-patterns" - phelp = helplink "period-expressions" - resetlink - | null a && null p = [$hamlet||] - | otherwise = [$hamlet|%span#resetlink $ - %a!href=@here@ reset|] - -helplink topic = [$hamlet|%a!href=$string.u$ ?|] - where u = manualurl ++ if null topic then "" else '#':topic - -addform :: Request -> String -> String -> Hamlet HledgerWebAppRoutes -addform _ _ _ = [$hamlet| - %form#addform!action=$string.action$!method=POST - %table!border=0 - %tr - %td - Date: - %input!size=15!name=date!value=$string.date$ - ^datehelp^ $ - Description: - %input!size=35!name=desc!value=$string.desc$ $ - ^transactionfields1^ - ^transactionfields2^ - %tr#addbuttonrow - %td - %input!type=submit!value=$string.addlabel$ - ^addhelp^ -
-|] - where - datehelp = helplink "dates" - addlabel = "add transaction" - addhelp = helplink "file-format" - action="" - date = "" - desc = "" - transactionfields1 = transactionfields 1 - transactionfields2 = transactionfields 2 - --- transactionfields :: Int -> Hamlet String -transactionfields n = [$hamlet| - %tr - %td -    - Account: - %input!size=35!name=$string.acctvar$!value=$string.acct$ -   - Amount: - %input!size=15!name=$string.amtvar$!value=$string.amt$ $ -|] - where - acct = "" - amt = "" - numbered = (++ show n) - acctvar = numbered "acct" - amtvar = numbered "amt" - -postTransactionsPage :: Handler HledgerWebApp RepPlain -postTransactionsPage = do - today <- liftIO getCurrentDay - -- get form input values, or basic validation errors. E means an Either value. - dateE <- runFormPost $ catchFormError $ notEmpty $ required $ input "date" - descE <- runFormPost $ catchFormError $ required $ input "desc" - acct1E <- runFormPost $ catchFormError $ notEmpty $ required $ input "acct1" - amt1E <- runFormPost $ catchFormError $ required $ input "amt1" - acct2E <- runFormPost $ catchFormError $ notEmpty $ required $ input "acct2" - amt2E <- runFormPost $ catchFormError $ required $ input "amt2" - -- supply defaults and parse date and amounts, or get errors. - let dateE' = either Left (either (\e -> Left [("date", showDateParseError e)]) Right . fixSmartDateStrEither today) dateE - amt1E' = either Left (either (const (Right missingamt)) Right . parse someamount "") amt1E -- XXX missingamt only when missing/empty - amt2E' = either Left (either (const (Right missingamt)) Right . parse someamount "") amt2E - strEs = [dateE', descE, acct1E, acct2E] - amtEs = [amt1E', amt2E'] - errs = lefts strEs ++ lefts amtEs - [date,desc,acct1,acct2] = rights strEs - [amt1,amt2] = rights amtEs - -- if no errors so far, generate a transaction and balance it or get the error. - tE | not $ null errs = Left errs - | otherwise = either (\e -> Left [[("unbalanced postings", head $ lines e)]]) Right - (balanceTransaction $ nulltransaction { - tdate=parsedate date - ,teffectivedate=Nothing - ,tstatus=False - ,tcode="" - ,tdescription=desc - ,tcomment="" - ,tpostings=[ - Posting False acct1 amt1 "" RegularPosting Nothing - ,Posting False acct2 amt2 "" RegularPosting Nothing - ] - ,tpreceding_comment_lines="" - }) - -- display errors or add transaction - case tE of - Left errs -> do - -- save current form values in session - setMessage $ string $ intercalate ", " $ map (intercalate ", " . map (\(a,b) -> a++": "++b)) errs - redirect RedirectTemporary TransactionsPage - - Right t -> do - let t' = txnTieKnot t -- XXX move into balanceTransaction - j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" - -- j' <- liftIO $ journalAddTransaction j t' >>= journalReload - -- liftIO $ putValue "hledger" "journal" j' - liftIO $ journalAddTransaction j t' - setMessage $ string $ printf "Added transaction:\n%s" (show t') - redirect RedirectTemporary TransactionsPage - diff --git a/Hledger/Cli/Main.hs b/Hledger/Cli/Main.hs index 166d5931b..56afae2ea 100644 --- a/Hledger/Cli/Main.hs +++ b/Hledger/Cli/Main.hs @@ -70,7 +70,7 @@ main = do #ifdef VTY | cmd `isPrefixOf` "vty" = withJournalDo opts args cmd vty #endif -#if defined(WEB) || defined(WEBYESOD) +#if defined(WEB) || defined(WEB610) | cmd `isPrefixOf` "web" = withJournalDo opts args cmd web #endif #ifdef CHART diff --git a/Hledger/Cli/Options.hs b/Hledger/Cli/Options.hs index 77788466e..062552f70 100644 --- a/Hledger/Cli/Options.hs +++ b/Hledger/Cli/Options.hs @@ -38,7 +38,7 @@ usagehdr = #ifdef VTY " vty - run a simple curses-style UI\n" ++ #endif -#if defined(WEB) || defined(WEBYESOD) +#if defined(WEB) || defined(WEB610) " web - run a simple web-based UI\n" ++ #endif #ifdef CHART @@ -81,7 +81,7 @@ options = [ ,Option "M" ["monthly"] (NoArg MonthlyOpt) "register report: show monthly summary" ,Option "Q" ["quarterly"] (NoArg QuarterlyOpt) "register report: show quarterly summary" ,Option "Y" ["yearly"] (NoArg YearlyOpt) "register report: show yearly summary" -#if defined(WEB) || defined(WEBYESOD) +#ifdef WEB ,Option "" ["host"] (ReqArg Host "HOST") "web: use hostname HOST rather than localhost" ,Option "" ["port"] (ReqArg Port "N") "web: use tcp port N rather than 5000" #endif @@ -119,7 +119,7 @@ data Opt = MonthlyOpt | QuarterlyOpt | YearlyOpt | -#if defined(WEB) || defined(WEBYESOD) +#ifdef WEB Host {value::String} | Port {value::String} | #endif @@ -224,7 +224,7 @@ displayExprFromOpts opts = listtomaybe $ optValuesForConstructor Display opts listtomaybe [] = Nothing listtomaybe vs = Just $ last vs -#if defined(WEB) || defined(WEBYESOD) +#ifdef WEB -- | Get the value of the (last) host option, if any. hostFromOpts :: [Opt] -> Maybe String hostFromOpts opts = listtomaybe $ optValuesForConstructor Host opts diff --git a/Hledger/Cli/Version.hs b/Hledger/Cli/Version.hs index 13582b08b..e8277eee9 100644 --- a/Hledger/Cli/Version.hs +++ b/Hledger/Cli/Version.hs @@ -70,8 +70,8 @@ configflags = tail ["" ,"vty" #endif #if defined(WEB) - ,"web (using loli/hsp/simpleserver)" -#elif defined(WEBYESOD) ,"web (using yesod/hamlet/simpleserver)" +#elif defined(WEB610) + ,"web (using loli/hsp/simpleserver)" #endif ] diff --git a/MANUAL.markdown b/MANUAL.markdown index 88b06ce10..d215d33ec 100644 --- a/MANUAL.markdown +++ b/MANUAL.markdown @@ -68,17 +68,21 @@ with the cabal-install tool: extra features (if you're new to cabal, I recommend you get the basic install working first, then add these one at a time): - - `-fvty` - builds the [vty](#vty) command. (Not available on microsoft - windows.) - - - `-fweb` - builds the [web](#web) command (works with ghc 6.10). - - - `-fwebyesod` - builds a newer version of the [web](#web) command (requires ghc 6.12). - - - `-fchart` builds the [chart](#chart) command. This requires - additional GTK/GHC integration libraries (on ubuntu: `apt-get - install libghc6-gtk-dev`) and possibly other things - see the + - `-fchart` builds the [chart](#chart) command, enabling simple + balance pie chart generation. This requires additional GTK/GHC + integration libraries (on ubuntu: `apt-get install libghc6-gtk-dev`) + and possibly other things - see the [gtk2hs install docs](http://code.haskell.org/gtk2hs/INSTALL). + At present this add a lot of build complexity for not much gain. + + - `-fvty` - builds the [vty](#vty) command, enabling a basic + curses-style user interface. This does not work on microsoft + windows, unless possibly with cygwin. + + - `-fweb` - builds the [web](#web) command, enabling a web-based user + interface (requires ghc 6.12). If you are stuck with ghc 6.10, you + can use `-fweb610` instead, to build an older version of the + [web](#web) command. If you have any trouble, proceed at once to [Troubleshooting](#troubleshooting) for help! @@ -115,7 +119,7 @@ on: hledger histogram # transactions per day, or other interval hledger add # add some new transactions to the ledger file hledger vty # curses ui, if installed with -fvty - hledger web # web ui, if installed with -fweb or -fwebyesod + hledger web # web ui, if installed with -fweb or -fweb610 hledger chart # make a balance chart, if installed with -fchart You'll find more examples below. @@ -280,8 +284,6 @@ Examples: ##### chart -(optional feature) - The chart command saves a pie chart of your top account balances to an image file (usually "hledger.png", or use -o/--output FILE). You can adjust the image resolution with --size=WIDTHxHEIGHT, and the number of @@ -303,6 +305,8 @@ Examples: $ hledger chart ^expenses -o balance.png --size 1000x600 --items 20 $ for m in 01 02 03 04 05 06 07 08 09 10 11 12; do hledger -p 2009/$m chart ^expenses --depth 2 -o expenses-2009$m.png --size 400x300; done +This is an optional feature; see [installing](#installing). + ##### histogram The histogram command displays a quick bar chart showing transaction @@ -323,8 +327,6 @@ Examples: ##### vty -(optional feature) - The vty command starts hledger's curses (full-screen, text) user interface, which allows interactive navigation of the print/register/balance reports. This lets you browse around your numbers and get quick insights @@ -335,6 +337,8 @@ Examples: $ hledger vty $ hledger vty -BE food +This is an optional feature; see [installing](#installing). + #### Modifying commands The following commands can alter your ledger file. @@ -350,32 +354,25 @@ $ hledger add $ hledger add accounts:personal:bob ##### web -(optional feature) - The web command starts hledger's web interface, and tries to open a web -browser to view it (if this fails, you'll have to visit the indicated url -yourself.) The web ui combines the features of the print, register, -balance and add commands. +browser to view it. (If this fails, you'll have to manually visit the url +it displays.) The web interface combines the features of the print, +register, balance and add commands, and adds a general edit command. -Note there are two alternate implementations of the web command - the old -one, built with `-fweb`: +This is an optional feature. Note there is also an older implementation of +the web command which does not provide edit. See [installing](#installing). + +Examples: $ hledger web - -and the new one, built with `-fwebyesod`, which you run in the same way: - - $ hledger web - -We will assume the latter in the rest of these docs. Some more examples: - $ hledger web -E -B p 'this year' $ hledger web --base-url http://this.vhost.com --port 5010 --debug -f my.journal -The new web ui adds an edit command. Warning: this is the first hledger -feature which can alter your existing journal data. You can edit, or -ERASE, the (top-level) journal file through the web ui. There is no access -control. A numbered backup of the file will be saved at each edit, in -normal circumstances (eg if file permissions allow, disk is not full, etc.) +About the edit command: warning, this is the first hledger feature which +can alter your existing journal data. You can edit, or erase, the journal +file through the web ui. There is no access control. A numbered backup of +the file will be saved at each edit, in normal circumstances (eg if file +permissions allow, disk is not full, etc.) #### Other commands @@ -884,8 +881,8 @@ sailing. Here are some known issues and things to try: - **Did you cabal update ?** If you didn't already, ``cabal update`` and try again. -- **Do you have a new enough version of GHC ?** As of 2010, 6.10 and 6.12 - are supported, 6.8 might or might not work. +- **Do you have a new enough version of GHC ?** hledger supports GHC 6.10 + and 6.12. Building with the `-fweb` flag requires 6.12 or greater. - **Do you have a new enough version of cabal-install ?** Recent versions tend to be better at resolving dependencies. The error @@ -894,11 +891,12 @@ sailing. Here are some known issues and things to try: $ cabal update $ cabal install cabal-install + $ cabal clean then try installing hledger again. - **Could not run trhsx.** - You are installing with `-fweb`, which needs to run the ``trhsx`` executable. + You are installing with `-fweb610`, which needs to run the ``trhsx`` executable. It is installed by the hsx package in ~/.cabal/bin, which needs to be in your path. @@ -921,10 +919,14 @@ sailing. Here are some known issues and things to try: you are probably on a mac with macports libraries installed, causing [this issue](http://hackage.haskell.org/trac/ghc/ticket/4068). - To work around, add this --extra-lib-dirs flag: + To work around temporarily, add this --extra-lib-dirs flag: $ cabal install hledger --extra-lib-dirs=/usr/lib + or permanently, add this to ~/.cabal/config: + + extra-lib-dirs: /usr/lib + - **A ghc: panic! (the 'impossible' happened)** might be [this issue](http://hackage.haskell.org/trac/ghc/ticket/3862) @@ -949,16 +951,13 @@ sailing. Here are some known issues and things to try: Look for the cause of the failure near the end of the output. If it's not apparent, try again with `-v2` or `-v3` for more verbose output. -- **cabal fails to reconcile dependencies.** - This could be related to your GHC version: hledger requires at least GHC - 6.10 and `-fwebyesod` requires 6.12 or greater. - - Also, it's possible for cabal to get confused, eg if you have - installed/updated many cabal package versions or GHC itself. You can - sometimes work around this by using cabal install's `--constraint` - option. Another (drastic) way is to purge all unnecessary package - versions by removing (or renaming) ~/.ghc, then trying cabal install - again. +- **cabal fails to resolve dependencies.** + It's possible for cabal to get confused, eg if you have + installed/updated many cabal package versions or GHC itself. You can + sometimes work around this by using cabal install's `--constraint` + option. Another (drastic) way is to purge all unnecessary package + versions by removing (or renaming) ~/.ghc, then trying cabal install + again. #### Usage issues diff --git a/Makefile b/Makefile index 6087d5eeb..0f9699eca 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,8 @@ # hledger project makefile # optional features described in MANUAL, comment out if you don't have the libs -#OPTFLAGS=-DCHART -DVTY -DWEBHAPPSTACK -OPTFLAGS=-DVTY -DWEB +#OPTFLAGS=-DCHART -DVTY -DWEB +OPTFLAGS=-DWEB #OPTFLAGS= # command to run during "make ci" diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 5987a3a34..5070b7ef3 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -25,6 +25,8 @@ build-type: Simple -- sample.timelog library + -- should set patchlevel here as in Makefile + cpp-options: -DPATCHLEVEL=0 exposed-modules: Hledger.Data Hledger.Data.Account @@ -58,9 +60,6 @@ library ,utf8-string >= 0.3 ,HUnit - -- should set patchlevel here as in Makefile - cpp-options: -DPATCHLEVEL=0 - -- source-repository head -- type: darcs -- location: http://joyful.com/repos/hledger diff --git a/hledger.cabal b/hledger.cabal index e60f5a6b8..0caef1874 100644 --- a/hledger.cabal +++ b/hledger.cabal @@ -18,7 +18,7 @@ maintainer: Simon Michael homepage: http://hledger.org bug-reports: http://code.google.com/p/hledger/issues stability: experimental -tested-with: GHC==6.10 +tested-with: GHC==6.10, GHC==6.12 cabal-version: >= 1.2 build-type: Custom data-dir: data @@ -35,24 +35,26 @@ extra-source-files: data/sample.timelog data/sample.rules +flag chart + description: enable simple balance pie chart generation + default: False + flag vty - description: enable the curses ui + description: enable the curses-style ui default: False flag web - description: enable the web ui (using loli/hsp/simpleserver, works with ghc 6.10) - default: False - -flag webyesod description: enable the web ui (using yesod/hamlet/simpleserver, requires ghc 6.12) default: False -flag chart - description: enable the pie chart generation +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 + cpp-options: -DPATCHLEVEL=0 other-modules: Paths_hledger Hledger.Cli.Main @@ -87,8 +89,12 @@ executable hledger ,time ,utf8-string >= 0.3 - -- should set patchlevel here as in Makefile - cpp-options: -DPATCHLEVEL=0 + if flag(chart) + cpp-options: -DCHART + other-modules:Hledger.Cli.Commands.Chart + build-depends: + Chart >= 0.11 + ,colour if flag(vty) cpp-options: -DVTY @@ -99,6 +105,18 @@ executable hledger if flag(web) cpp-options: -DWEB other-modules:Hledger.Cli.Commands.Web + build-depends: + bytestring >= 0.9.1 && < 0.9.2 + ,blaze-html >= 0.1.1 && < 0.2 + ,hamlet >= 0.3.1 && < 0.4 + ,io-storage >= 0.3 && < 0.4 + ,wai >= 0.1 && < 0.2 + ,wai-extra >= 0.1 && < 0.2 + ,yesod >= 0.3.1 && < 0.4 + + if flag(web610) + cpp-options: -DWEB610 + other-modules:Hledger.Cli.Commands.Web610 build-depends: hsp ,hsx @@ -111,27 +129,13 @@ executable hledger ,HTTP >= 4000.0 ,applicative-extras - if flag(webyesod) - cpp-options: -DWEBYESOD - other-modules:Hledger.Cli.Commands.WebYesod - build-depends: - bytestring >= 0.9.1 && < 0.9.2 - ,blaze-html >= 0.1.1 && < 0.2 - ,hamlet >= 0.3.1 && < 0.4 - ,io-storage >= 0.3 && < 0.4 - ,wai >= 0.1 && < 0.2 - ,wai-extra >= 0.1 && < 0.2 - ,yesod >= 0.3.1 && < 0.4 - - if flag(chart) - cpp-options: -DCHART - other-modules:Hledger.Cli.Commands.Chart - build-depends: - Chart >= 0.11 - ,colour - +-- modules and dependencies below should be as above, except +-- chart, vty, web etc. are not presently exposed as library functions library + -- should set patchlevel here as in Makefile + cpp-options: -DPATCHLEVEL=0 exposed-modules: + Paths_hledger Hledger.Cli.Main Hledger.Cli.Options Hledger.Cli.Tests @@ -164,37 +168,6 @@ library ,time ,utf8-string >= 0.3 - -- should set patchlevel here as in Makefile - cpp-options: -DPATCHLEVEL=0 - - if flag(vty) - cpp-options: -DVTY - exposed-modules:Hledger.Cli.Commands.Vty - build-depends: - vty >= 4.0.0.1 - - if flag(web) - cpp-options: -DWEB - exposed-modules:Hledger.Cli.Commands.Web - build-depends: - hsp - ,hsx - ,xhtml >= 3000.2 - ,loli - ,io-storage - ,hack-contrib - ,hack - ,hack-handler-simpleserver - ,HTTP >= 4000.0 - ,applicative-extras - - if flag(chart) - cpp-options: -DCHART - exposed-modules:Hledger.Cli.Commands.Chart - build-depends: - Chart >= 0.11 - ,colour - -- source-repository head -- type: darcs -- location: http://joyful.com/repos/hledger