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.Static
import Yesod.Logger (Logger, logMsg, formatLogText) import Yesod.Logger (Logger, logMsg, formatLogText)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Web.ClientSession (getKey)
import Hledger.Web.Options import Hledger.Web.Options
import Hledger.Web.Settings import Hledger.Web.Settings
@ -56,9 +55,6 @@ instance Yesod App where
-- approot = Hledger.Web.Settings.appRoot . settings -- approot = Hledger.Web.Settings.appRoot . settings
approot = ApprootMaster $ 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 defaultLayout widget = do
-- master <- getYesod -- master <- getYesod
-- mmsg <- getMessage -- mmsg <- getMessage
@ -74,7 +70,7 @@ instance Yesod App where
pc <- widgetToPageContent $ do pc <- widgetToPageContent $ do
widget widget
hamletToRepHtml [hamlet| hamletToRepHtml [hamlet|
!!! $doctype 5
<html <html
<head <head
<title>#{pageTitle pc} <title>#{pageTitle pc}

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

@ -58,7 +58,7 @@ import Text.Printf
import Yesod.Core import Yesod.Core
-- import Yesod.Json -- import Yesod.Json
import Hledger hiding (today) import Hledger hiding (is)
import Hledger.Cli hiding (version) import Hledger.Cli hiding (version)
import Hledger.Web.Foundation import Hledger.Web.Foundation
import Hledger.Web.Options import Hledger.Web.Options
@ -94,14 +94,14 @@ getJournalR = do
-- showlastcolumn = if injournal && not filtering then False else True -- showlastcolumn = if injournal && not filtering then False else True
title = case inacct of title = case inacct of
Nothing -> "Journal"++s2 Nothing -> "Journal"++s2
Just (a,subs) -> "Transactions in "++a++s1++s2 Just (a,inclsubs) -> "Transactions in "++a++s1++s2
where s1 = if subs then " (and subaccounts)" else "" where s1 = if inclsubs then " (and subaccounts)" else ""
where where
s2 = if filtering then ", filtered" else "" s2 = if filtering then ", filtered" else ""
maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
defaultLayout $ do defaultLayout $ do
setTitle "hledger-web journal" setTitle "hledger-web journal"
addHamlet [hamlet| addWidget $ toWidget [hamlet|
^{topbar vd} ^{topbar vd}
<div#content <div#content
<div#sidebar <div#sidebar
@ -123,10 +123,10 @@ getJournalEntriesR = do
let let
sidecontent = sidebar vd sidecontent = sidebar vd
title = "Journal entries" ++ if m /= Any then ", filtered" else "" :: String 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 defaultLayout $ do
setTitle "hledger-web journal" setTitle "hledger-web journal"
addHamlet [hamlet| addWidget $ toWidget [hamlet|
^{topbar vd} ^{topbar vd}
<div#content <div#content
<div#sidebar <div#sidebar
@ -147,7 +147,7 @@ getJournalEditR = do
vd <- getViewData vd <- getViewData
defaultLayout $ do defaultLayout $ do
setTitle "hledger-web journal edit form" setTitle "hledger-web journal edit form"
addHamlet $ editform vd addWidget $ toWidget $ editform vd
-- -- | The journal entries view, no sidebar. -- -- | The journal entries view, no sidebar.
-- getJournalOnlyR :: Handler RepHtml -- getJournalOnlyR :: Handler RepHtml
@ -155,7 +155,7 @@ getJournalEditR = do
-- vd@VD{..} <- getViewData -- vd@VD{..} <- getViewData
-- defaultLayout $ do -- defaultLayout $ do
-- setTitle "hledger-web journal only" -- 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. -- | The main journal/account register view, with accounts sidebar.
getRegisterR :: Handler RepHtml getRegisterR :: Handler RepHtml
@ -166,13 +166,13 @@ getRegisterR = do
filtering = m /= Any filtering = m /= Any
title = "Transactions in "++a++s1++s2 title = "Transactions in "++a++s1++s2
where where
(a,subs) = fromMaybe ("all accounts",False) $ inAccount qopts (a,inclsubs) = fromMaybe ("all accounts",False) $ inAccount qopts
s1 = if subs then " (and subaccounts)" else "" s1 = if inclsubs then " (and subaccounts)" else ""
s2 = if filtering then ", filtered" else "" s2 = if filtering then ", filtered" else ""
maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
defaultLayout $ do defaultLayout $ do
setTitle "hledger-web register" setTitle "hledger-web register"
addHamlet [hamlet| addWidget $ toWidget [hamlet|
^{topbar vd} ^{topbar vd}
<div#content <div#content
<div#sidebar <div#sidebar
@ -193,7 +193,7 @@ getRegisterR = do
-- vd@VD{..} <- getViewData -- vd@VD{..} <- getViewData
-- defaultLayout $ do -- defaultLayout $ do
-- setTitle "hledger-web register only" -- setTitle "hledger-web register only"
-- addHamlet $ -- addWidget $ toWidget $
-- case inAccountQuery qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m m' -- 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 -- Nothing -> registerReportHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
@ -206,7 +206,7 @@ getAccountsR = do
let j' = filterJournalPostings2 m j let j' = filterJournalPostings2 m j
html = do html = do
setTitle "hledger-web accounts" 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')] json = jsonMap [("accounts", toJSON $ journalAccountNames j')]
defaultLayoutJson html json defaultLayoutJson html json
@ -222,7 +222,7 @@ getAccountsJsonR = do
-- | Render the sidebar used on most views. -- | Render the sidebar used on most views.
sidebar :: ViewData -> HtmlUrl AppRoute 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. -- | Render an "AccountsReport" as html.
accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> HtmlUrl AppRoute accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> HtmlUrl AppRoute
@ -264,7 +264,7 @@ accountsReportAsHtml _ vd@VD{..} (items',total) =
<td> <td>
|] |]
where where
l = journalToLedger nullfilterspec j l = journalToLedger Any j
inacctmatcher = inAccountQuery qopts inacctmatcher = inAccountQuery qopts
allaccts = isNothing inacctmatcher allaccts = isNothing inacctmatcher
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher 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 acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M
acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M 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 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) journalE = maybe (Right $ journalFilePath j)
(\f -> let f' = unpack f in (\f -> let f' = unpack f in
if f' `elem` journalFilePaths j 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 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 Hledger.Web.Handlers
build-depends: build-depends:
hledger == 0.18 hledger == 0.18
, hledger-lib == 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 , yesod == 1.0.*
, cmdargs >= 0.9.1 && < 0.10 , yesod-core
, directory , yesod-default
, filepath , yesod-static
, HUnit , blaze-html
, old-locale , clientsession
, parsec , hamlet
, regexpr >= 0.5.1 , network-conduit
, safe >= 0.2 , shakespeare-text
, time , template-haskell
, io-storage >= 0.3 && < 0.4 , text >= 0.11 && < 0.12
, file-embed == 0.0.* , transformers >= 0.2 && < 0.4
, wai
, base >= 4 && < 5 , wai-extra
, blaze-html >= 0.4.3.1 && < 0.5 , warp
, yesod-core >= 0.10 && < 0.11 , yaml
, 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
-- if flag(production) -- if flag(production)

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

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