slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web610: fixes

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Hledger/Cli/Commands/Web610.hs
View File

@ -70,18 +70,20 @@ server opts args j =
let opts' = opts ++ [Period $ unwords $ map decodeString $ reqParamUtf8 env "p"] let opts' = opts ++ [Period $ unwords $ map decodeString $ reqParamUtf8 env "p"]
args' = args ++ map decodeString (reqParamUtf8 env "a") args' = args ++ map decodeString (reqParamUtf8 env "a")
j' <- fromJust `fmap` getValue "hledger" "journal" j' <- fromJust `fmap` getValue "hledger" "journal"
(changed, j'') <- io $ journalReloadIfChanged opts j' (jE, changed) <- io $ journalReloadIfChanged opts j'
when changed $ putValue "hledger" "journal" 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 -- declare path-specific request handlers
let command :: [String] -> ([Opt] -> FilterSpec -> Journal -> String) -> AppUnit 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) (loli $ -- State Loli () -> (Env -> IO Response)
do do
get "/balance" $ command [] showBalanceReport -- String -> ReaderT Env (StateT Response IO) () -> State Loli () get "/balance" $ command [] showBalanceReport -- String -> ReaderT Env (StateT Response IO) () -> State Loli ()
get "/register" $ command [] showRegisterReport get "/register" $ command [] showRegisterReport
get "/histogram" $ command [] showHistogram get "/histogram" $ command [] showHistogram
get "/transactions" $ ledgerpage [] j'' (showTransactions (optsToFilterSpec opts' args' t)) get "/transactions" $ ledgerpage [] j''' (showTransactions (optsToFilterSpec opts' args' t))
post "/transactions" $ handleAddform j'' post "/transactions" $ handleAddform j'''
get "/env" $ getenv >>= (text . show) get "/env" $ getenv >>= (text . show)
get "/params" $ getenv >>= (text . show . Hack.Contrib.Request.params) get "/params" $ getenv >>= (text . show . Hack.Contrib.Request.params)
get "/inputs" $ getenv >>= (text . show . Hack.Contrib.Request.inputs) 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 :: [String] -> Journal -> (Journal -> String) -> AppUnit
ledgerpage msgs j f = do ledgerpage msgs j f = do
env <- getenv env <- getenv
(_, j') <- io $ journalReloadIfChanged [] j (jE, _) <- io $ journalReloadIfChanged [] j
hsp msgs $ const <div><% addform env %><pre><% f j' %></pre></div> 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 -- | A loli directive to serve a string in pre tags within the hledger web
-- layout. -- layout.

5
data/web/style.css
View File

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