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

web: update for yesod 1.0

Browse Source
This commit is contained in:
Simon Michael 2012-05-29 02:53:33 +00:00
parent 8f94ae3de4
commit f35b961c86
5 changed files with 50 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
hledger-web/Hledger/Web/Foundation.hs
View File

@ -27,7 +27,6 @@ import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Static
import Yesod.Logger (Logger, logMsg, formatLogText)
import Control.Monad.IO.Class (liftIO)
import Web.ClientSession (getKey)
import Hledger.Web.Options
import Hledger.Web.Settings
@ -56,9 +55,6 @@ instance Yesod App where
-- approot = Hledger.Web.Settings.appRoot . settings
approot = ApprootMaster $ appRoot . settings
-- Place the session key file in the config folder
encryptKey _ = fmap Just $ getKey "client_session_key.aes"
defaultLayout widget = do
-- master <- getYesod
-- mmsg <- getMessage
@ -74,7 +70,7 @@ instance Yesod App where
pc <- widgetToPageContent $ do
widget
hamletToRepHtml [hamlet|
!!!
$doctype 5
<html
<head
<title>#{pageTitle pc}

32
hledger-web/Hledger/Web/Handlers.hs
View File

@ -58,7 +58,7 @@ import Text.Printf
import Yesod.Core
-- import Yesod.Json
import Hledger hiding (today)
import Hledger hiding (is)
import Hledger.Cli hiding (version)
import Hledger.Web.Foundation
import Hledger.Web.Options
@ -94,14 +94,14 @@ getJournalR = do
-- showlastcolumn = if injournal && not filtering then False else True
title = case inacct of
Nothing -> "Journal"++s2
Just (a,subs) -> "Transactions in "++a++s1++s2
where s1 = if subs then " (and subaccounts)" else ""
Just (a,inclsubs) -> "Transactions in "++a++s1++s2
where s1 = if inclsubs then " (and subaccounts)" else ""
where
s2 = if filtering then ", filtered" else ""
maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
defaultLayout $ do
setTitle "hledger-web journal"
addHamlet [hamlet|
addWidget $ toWidget [hamlet|
^{topbar vd}
<div#content
<div#sidebar
@ -123,10 +123,10 @@ getJournalEntriesR = do
let
sidecontent = sidebar vd
title = "Journal entries" ++ if m /= Any then ", filtered" else "" :: String
maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) Any $ filterJournalTransactions m j
defaultLayout $ do
setTitle "hledger-web journal"
addHamlet [hamlet|
addWidget $ toWidget [hamlet|
^{topbar vd}
<div#content
<div#sidebar
@ -147,7 +147,7 @@ getJournalEditR = do
vd <- getViewData
defaultLayout $ do
setTitle "hledger-web journal edit form"
addHamlet $ editform vd
addWidget $ toWidget $ editform vd
-- -- | The journal entries view, no sidebar.
-- getJournalOnlyR :: Handler RepHtml
@ -155,7 +155,7 @@ getJournalEditR = do
-- vd@VD{..} <- getViewData
-- defaultLayout $ do
-- setTitle "hledger-web journal only"
-- addHamlet $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
-- addWidget $ toWidget $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
-- | The main journal/account register view, with accounts sidebar.
getRegisterR :: Handler RepHtml
@ -166,13 +166,13 @@ getRegisterR = do
filtering = m /= Any
title = "Transactions in "++a++s1++s2
where
(a,subs) = fromMaybe ("all accounts",False) $ inAccount qopts
s1 = if subs then " (and subaccounts)" else ""
(a,inclsubs) = fromMaybe ("all accounts",False) $ inAccount qopts
s1 = if inclsubs then " (and subaccounts)" else ""
s2 = if filtering then ", filtered" else ""
maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
defaultLayout $ do
setTitle "hledger-web register"
addHamlet [hamlet|
addWidget $ toWidget [hamlet|
^{topbar vd}
<div#content
<div#sidebar
@ -193,7 +193,7 @@ getRegisterR = do
-- vd@VD{..} <- getViewData
-- defaultLayout $ do
-- setTitle "hledger-web register only"
-- addHamlet $
-- addWidget $ toWidget $
-- case inAccountQuery qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m m'
-- Nothing -> registerReportHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
@ -206,7 +206,7 @@ getAccountsR = do
let j' = filterJournalPostings2 m j
html = do
setTitle "hledger-web accounts"
addHamlet $ accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j'
addWidget $ toWidget $ accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j'
json = jsonMap [("accounts", toJSON $ journalAccountNames j')]
defaultLayoutJson html json
@ -222,7 +222,7 @@ getAccountsJsonR = do
-- | Render the sidebar used on most views.
sidebar :: ViewData -> HtmlUrl AppRoute
sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j
sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport (reportopts_ $ cliopts_ opts) am j
-- | Render an "AccountsReport" as html.
accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> HtmlUrl AppRoute
@ -264,7 +264,7 @@ accountsReportAsHtml _ vd@VD{..} (items',total) =
<td>
|]
where
l = journalToLedger nullfilterspec j
l = journalToLedger Any j
inacctmatcher = inAccountQuery qopts
allaccts = isNothing inacctmatcher
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
@ -519,7 +519,7 @@ handleAdd = do
acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M
acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M
amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amount . unpack) amt1M
amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amount . unpack) amt2M
amt2E = maybe (Right missingmixedamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amount . unpack) amt2M
journalE = maybe (Right $ journalFilePath j)
(\f -> let f' = unpack f in
if f' `elem` journalFilePaths j

2
hledger-web/Hledger/Web/Settings/StaticFiles.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, CPP #-}
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, CPP, OverloadedStrings #-}
{-|
This module exports routes for all the files in the static directory at

62
hledger-web/hledger-web.cabal
View File

@ -122,39 +122,37 @@ executable hledger-web
Hledger.Web.Handlers
build-depends:
hledger == 0.18
, hledger-lib == 0.18
hledger == 0.18
, hledger-lib == 0.18
, base >= 4 && < 5
, cabal-file-th
, cmdargs >= 0.9.1 && < 0.10
, directory
, filepath
, HUnit
, io-storage >= 0.3 && < 0.4
, old-locale
, parsec
, regexpr >= 0.5.1
, safe >= 0.2
, time
, cabal-file-th
, cmdargs >= 0.9.1 && < 0.10
, directory
, filepath
, HUnit
, old-locale
, parsec
, regexpr >= 0.5.1
, safe >= 0.2
, time
, io-storage >= 0.3 && < 0.4
, file-embed == 0.0.*
, base >= 4 && < 5
, blaze-html >= 0.4.3.1 && < 0.5
, yesod-core >= 0.10 && < 0.11
, yesod-static >= 0.10 && < 0.11
, yesod-default >= 0.6 && < 0.7
, clientsession >= 0.7.3 && < 0.8
, bytestring >= 0.9 && < 0.10
, text >= 0.11 && < 0.12
, template-haskell
, hamlet >= 0.10 && < 0.11
, shakespeare-text >= 0.10 && < 0.12
, wai >= 1.1 && < 1.2
, wai-extra >= 1.1 && < 1.2
, transformers >= 0.2 && < 0.3
, monad-control >= 0.3 && < 0.4
, yaml >= 0.5 && < 0.6
, warp >= 1.1.0.1 && < 1.2
, yesod == 1.0.*
, yesod-core
, yesod-default
, yesod-static
, blaze-html
, clientsession
, hamlet
, network-conduit
, shakespeare-text
, template-haskell
, text >= 0.11 && < 0.12
, transformers >= 0.2 && < 0.4
, wai
, wai-extra
, warp
, yaml
-- if flag(production)

2
hledger-web/hledger-web.hs
View File

@ -10,6 +10,7 @@ Released under GPL version 3 or later.
module Main
where
import Data.Conduit.Network (HostPreference(..))
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort)
import Yesod.Default.Config
-- import Yesod.Default.Main (defaultMain)
@ -82,6 +83,7 @@ server baseurl port opts j = do
appEnv = Development
, appPort = port_ opts
, appRoot = pack baseurl
, appHost = HostIPv4
, appExtra = Extra "" Nothing
}
logger <- defaultDevelopmentLogger