web610: fixes

This commit is contained in:
Simon Michael 2010-07-10 14:31:46 +00:00
parent 8df720d07e
commit 069a70a7b4
2 changed files with 14 additions and 8 deletions

View File

@ -70,18 +70,20 @@ server opts args j =
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''
(jE, changed) <- io $ journalReloadIfChanged opts j'
let (j''', err) = either (\e -> (j',e)) (\j'' -> (j'',"")) jE
when (changed && null err) $ putValue "hledger" "journal" j'''
when (changed && not (null err)) $ printf "error while reading %s\n" (filepath j')
-- declare path-specific request handlers
let command :: [String] -> ([Opt] -> FilterSpec -> Journal -> String) -> AppUnit
command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) j''
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 "/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)
@ -99,8 +101,9 @@ reqParamUtf8 env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params
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>
(jE, _) <- io $ journalReloadIfChanged [] j
let (j'', _) = either (\e -> (j,e)) (\j' -> (j',"")) jE
hsp msgs $ const <div><% addform env %><pre><% f j'' %></pre></div>
-- | A loli directive to serve a string in pre tags within the hledger web
-- layout.

View File

@ -18,3 +18,6 @@ body { font-family: "helvetica","arial", "sans serif"; margin:0; }
#formheading { font-size:medium; font-weight:bold; }
.helprow td { padding-bottom:8px; }
#help {font-style: italic; font-size:smaller; }
/* for -fweb610 */
#hledgerorglink, #helplink { float:right; margin-left:1em; }