rename -fweb to -fweb610 and -fwebyesod to -fweb, misc cabal and docs cleanups
This commit is contained in:
Simon Michael
parent
a52c467941
commit
2f2e500eae
@ -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
|
||||
|
||||
@ -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 <div><% addform env %><pre><% f j' %></pre></div>
|
||||
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 <pre><% s %></pre>
|
||||
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 = ("<!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
|
||||
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 =
|
||||
<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>
|
||||
getRegisterPage :: Handler HledgerWebApp RepHtml
|
||||
getRegisterPage = withLatestJournalRender showRegisterReport
|
||||
|
||||
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>
|
||||
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 = <a href=(addparams s) class="navlink"><% s %></a>
|
||||
<div id="navlinks">
|
||||
<% link "transactions" %> |
|
||||
<% link "register" %> |
|
||||
<% link "balance" %>
|
||||
</div>
|
||||
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 = <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>
|
||||
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
|
||||
<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>
|
||||
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 = <a href=u>?</a>
|
||||
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
|
||||
<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"
|
||||
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^
|
||||
<br clear="all" />
|
||||
|]
|
||||
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 " "
|
||||
|
||||
313
Hledger/Cli/Commands/Web610.hs
Normal file
313
Hledger/Cli/Commands/Web610.hs
Normal file
@ -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 <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
|
||||
ledgerpage [msg] j (showTransactions (optsToFilterSpec [] [] ti))
|
||||
where msg = printf "Added transaction:\n%s" (show t)
|
||||
|
||||
nbsp :: XML
|
||||
nbsp = cdata " "
|
||||
@ -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^
|
||||
<br clear="all" />
|
||||
|]
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
]
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
4
Makefile
4
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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -18,7 +18,7 @@ maintainer: Simon Michael <simon@joyful.com>
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user