web: update for yesod 1.1.3

Build with latest yesod. Also reorganise to conform more closely with
yesod's standard scaffold layout to reduce upgrade effort.
This commit is contained in:
Simon Michael 2012-11-15 17:48:48 +00:00
parent 9786894bbb
commit cfbd8bb956
41 changed files with 5235 additions and 384 deletions

2
hledger-web/.ghci Normal file
View File

@ -0,0 +1,2 @@
:set -i.:config:dist/build/autogen
:set -XCPP -XTemplateHaskell -XQuasiQuotes -XTypeFamilies -XFlexibleContexts -XGADTs -XOverloadedStrings -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving -XEmptyDataDecls

View File

@ -0,0 +1,54 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application
( makeApplication
, getApplicationDev
, makeFoundation
) where
import Import
import Yesod.Default.Config
import Yesod.Default.Main
import Yesod.Default.Handlers
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
import Network.HTTP.Conduit (newManager, def)
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
-- import Handler.Home
import Handler.Handlers
import Hledger.Web.Options
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
-- comments there for more details.
mkYesodDispatch "App" resourcesApp
-- This function allocates resources (such as a database connection pool),
-- performs initialization and creates a WAI application. This is also the
-- place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do
foundation <- makeFoundation conf
app <- toWaiAppPlain foundation
return $ logWare app
where
logWare = if development then logStdoutDev
else logStdout
makeFoundation :: AppConfig DefaultEnv Extra -> IO App
makeFoundation conf = do
manager <- newManager def
s <- staticSite
return $ App conf s manager
defwebopts
-- for yesod devel
getApplicationDev :: IO (Int, Application)
getApplicationDev =
defaultDevelApp loader makeApplication
where
loader = loadConfig (configSettings Development)
{ csParseExtra = parseExtra
}

158
hledger-web/Foundation.hs Normal file
View File

@ -0,0 +1,158 @@
{-
Define the web application's foundation, in the usual Yesod style.
See a default Yesod app's comments for more details of each part.
-}
module Foundation where
import Prelude
import Yesod
import Yesod.Static
import Yesod.Default.Config
#ifndef DEVELOPMENT
import Yesod.Default.Util (addStaticContentExternal)
#endif
import Network.HTTP.Conduit (Manager)
-- import qualified Settings
import Settings.Development (development)
import Settings.StaticFiles
import Settings ({-widgetFile,-} Extra (..), staticDir)
#ifndef DEVELOPMENT
import Text.Jasmine (minifym)
#endif
import Web.ClientSession (getKey)
-- import Text.Hamlet (hamletFile)
import Hledger.Web.Options
-- import Hledger.Web.Settings
-- import Hledger.Web.Settings.StaticFiles
-- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data App = App
{ settings :: AppConfig DefaultEnv Extra
, getStatic :: Static -- ^ Settings for static file serving.
, httpManager :: Manager
--
, appOpts :: WebOpts
}
-- Set up i18n messages. See the message folder.
mkMessage "App" "messages" "en"
-- This is where we define all of the routes in our application. For a full
-- explanation of the syntax, please see:
-- http://www.yesodweb.com/book/handler
--
-- This function does three things:
--
-- * Creates the route datatype AppRoute. Every valid URL in your
-- application can be represented as a value of this type.
-- * Creates the associated type:
-- type instance Route App = AppRoute
-- * Creates the value resourcesApp which contains information on the
-- resources declared below. This is used in Handler.hs by the call to
-- mkYesodDispatch
--
-- What this function does *not* do is create a YesodSite instance for
-- App. Creating that instance requires all of the handler functions
-- for our application to be in scope. However, the handler functions
-- usually require access to the AppRoute datatype. Therefore, we
-- split these actions into two functions and place them in separate files.
mkYesodData "App" $(parseRoutesFile "config/routes")
-- | A convenience alias.
type AppRoute = Route App
type Form x = Html -> MForm App App (FormResult x, Widget)
-- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here.
instance Yesod App where
approot = ApprootMaster $ appRoot . settings
-- Store session data on the client in encrypted cookies,
-- default session idle timeout is 120 minutes
makeSessionBackend _ = do
key <- getKey "config/client_session_key.aes"
return . Just $ clientSessionBackend key 120
-- defaultLayout widget = do
-- master <- getYesod
-- mmsg <- getMessage
-- -- We break up the default layout into two components:
-- -- default-layout is the contents of the body tag, and
-- -- default-layout-wrapper is the entire page. Since the final
-- -- value passed to hamletToRepHtml cannot be a widget, this allows
-- -- you to use normal widget features in default-layout.
-- pc <- widgetToPageContent $ do
-- $(widgetFile "normalize")
-- addStylesheet $ StaticR css_bootstrap_css
-- $(widgetFile "default-layout")
-- hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet")
defaultLayout widget = do
pc <- widgetToPageContent $ do
widget
hamletToRepHtml [hamlet|
$doctype 5
<html>
<head>
<title>#{pageTitle pc}
^{pageHead pc}
<meta http-equiv=Content-Type content="text/html; charset=utf-8">
<script type=text/javascript src=@{StaticR jquery_js}>
<script type=text/javascript src=@{StaticR jquery_url_js}>
<script type=text/javascript src=@{StaticR jquery_flot_js}>
<!--[if lte IE 8]><script language="javascript" type="text/javascript" src="excanvas.min.js"></script><![endif]-->
<script type=text/javascript src=@{StaticR dhtmlxcommon_js}>
<script type=text/javascript src=@{StaticR dhtmlxcombo_js}>
<script type=text/javascript src=@{StaticR hledger_js}>
<link rel=stylesheet type=text/css media=all href=@{StaticR style_css}>
<body>
^{pageBody pc}
|]
-- -- This is done to provide an optimization for serving static files from
-- -- a separate domain. Please see the staticRoot setting in Settings.hs
-- urlRenderOverride y (StaticR s) =
-- Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s
-- urlRenderOverride _ _ = Nothing
#ifndef DEVELOPMENT
-- This function creates static content files in the static folder
-- and names them based on a hash of their content. This allows
-- expiration dates to be set far in the future without worry of
-- users receiving stale content.
addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])
#endif
-- Place Javascript at bottom of the body tag so the rest of the page loads first
jsLoader _ = BottomOfBody
-- What messages should be logged. The following includes all messages when
-- in development, and warnings and errors in production.
shouldLog _ _source level =
development || level == LevelWarn || level == LevelError
-- This instance is required to use forms. You can modify renderMessage to
-- achieve customized and internationalized form validation messages.
instance RenderMessage App FormMessage where
renderMessage _ _ = defaultFormMessage
-- | Get the 'Extra' value, used to hold data from the settings.yml file.
getExtra :: Handler Extra
getExtra = fmap (appExtra . settings) getYesod
-- Note: previous versions of the scaffolding included a deliver function to
-- send emails. Unfortunately, there are too many different options for us to
-- give a reasonable default. Instead, the information is available on the
-- wiki:
--
-- https://github.com/yesodweb/yesod/wiki/Sending-email

View File

@ -1,11 +1,11 @@
{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings, RecordWildCards, CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-
hledger-web's request handlers, and helpers.
-}
module Hledger.Web.Handlers
module Handler.Handlers
(
-- * GET handlers
getRootR,
@ -41,6 +41,7 @@ where
import Prelude
import Control.Applicative ((<$>))
import Control.Monad.IO.Class (liftIO)
import Data.Either (lefts,rights)
import Data.List
import Data.Maybe
@ -58,16 +59,17 @@ import Text.Blaze.Html (toHtml)
#else
import Text.Blaze (preEscapedString, toHtml)
#endif
import Text.Hamlet hiding (hamlet)
import Text.Hamlet -- hiding (hamlet)
import Text.Printf
import Yesod.Core
-- import Yesod.Json
import Foundation
import Settings
import Hledger hiding (is)
import Hledger.Cli hiding (version)
import Hledger.Web.Foundation
import Hledger.Web.Options
import Hledger.Web.Settings
-- routes:
-- /static StaticR Static getStatic
@ -106,7 +108,7 @@ getJournalR = do
maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
defaultLayout $ do
setTitle "hledger-web journal"
addWidget $ toWidget [hamlet|
toWidget [hamlet|
^{topbar vd}
<div#content>
<div#sidebar>
@ -131,7 +133,7 @@ getJournalEntriesR = do
maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) Any $ filterJournalTransactions m j
defaultLayout $ do
setTitle "hledger-web journal"
addWidget $ toWidget [hamlet|
toWidget [hamlet|
^{topbar vd}
<div#content>
<div#sidebar>
@ -152,7 +154,7 @@ getJournalEditR = do
vd <- getViewData
defaultLayout $ do
setTitle "hledger-web journal edit form"
addWidget $ toWidget $ editform vd
toWidget $ editform vd
-- -- | The journal entries view, no sidebar.
-- getJournalOnlyR :: Handler RepHtml
@ -160,7 +162,7 @@ getJournalEditR = do
-- vd@VD{..} <- getViewData
-- defaultLayout $ do
-- setTitle "hledger-web journal only"
-- addWidget $ toWidget $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
-- toWidget $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
-- | The main journal/account register view, with accounts sidebar.
getRegisterR :: Handler RepHtml
@ -177,7 +179,7 @@ getRegisterR = do
maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
defaultLayout $ do
setTitle "hledger-web register"
addWidget $ toWidget [hamlet|
toWidget [hamlet|
^{topbar vd}
<div#content>
<div#sidebar>
@ -198,7 +200,7 @@ getRegisterR = do
-- vd@VD{..} <- getViewData
-- defaultLayout $ do
-- setTitle "hledger-web register only"
-- addWidget $ toWidget $
-- 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
@ -211,7 +213,7 @@ getAccountsR = do
let j' = filterJournalPostings2 m j
html = do
setTitle "hledger-web accounts"
addWidget $ toWidget $ accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j'
toWidget $ accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j'
json = jsonMap [("accounts", toJSON $ journalAccountNames j')]
defaultLayoutJson html json
@ -288,11 +290,11 @@ accountsReportAsHtml _ vd@VD{..} (items',total) =
<a href="@?{acctsonlyquery}" title="Focus on this account and sub-accounts and hide others">-others -->
<td.balance align=right>#{mixedAmountAsHtml abal}
<td.numpostings align=right title="#{numpostings} transactions in this account">(#{numpostings})
|]
where
hassubs = not $ null $ ledgerSubAccounts l $ ledgerAccount l acct
numpostings = length $ apostings $ ledgerAccount l acct
hassubs = not $ maybe False (null.asubs) $ ledgerAccount l acct
-- <td.numpostings align=right title="#{numpostings} transactions in this account">(#{numpostings})
-- numpostings = maybe 0 (length.apostings) $ ledgerAccount l acct
depthclass = "depth"++show aindent
inacctclass = case inacctmatcher of
Just m' -> if m' `matchesAccount` acct then "inacct" else "notinacct"

View File

@ -3,33 +3,19 @@ Re-export the modules of the hledger-web program.
-}
module Hledger.Web (
module Hledger.Web.Foundation,
module Hledger.Web.Application,
module Hledger.Web.Handlers,
module Hledger.Web.Import,
module Hledger.Web.Options,
module Hledger.Web.Settings,
module Hledger.Web.Settings.StaticFiles,
module Hledger.Web.Main,
tests_Hledger_Web
)
where
import Test.HUnit
import Hledger.Web.Foundation
import Hledger.Web.Application
import Hledger.Web.Handlers
import Hledger.Web.Import
import Hledger.Web.Options
import Hledger.Web.Settings
import Hledger.Web.Settings.StaticFiles
import Hledger.Web.Main
tests_Hledger_Web :: Test
tests_Hledger_Web = TestList
[
-- tests_Hledger_Web_Foundation
-- ,tests_Hledger_Web_Application
-- ,tests_Hledger_Web_EmbeddedFiles
-- ,tests_Hledger_Web_Handlers
-- ,tests_Hledger_Web_Settings
-- ,tests_Hledger_Web_Settings_StaticFiles
-- tests_Hledger_Web_Options
-- ,tests_Hledger_Web_Main
]

View File

@ -1,58 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hledger.Web.Application
( getApplication
, getApplicationDev
)
where
import Prelude
import Yesod.Default.Config
import Yesod.Default.Main (defaultDevelApp)
import Yesod.Default.Handlers (getRobotsR)
#if DEVELOPMENT
import Yesod.Logger (Logger, logBS)
import Network.Wai.Middleware.RequestLogger (logCallbackDev)
#else
import Yesod.Logger (Logger, logBS, toProduction)
import Network.Wai.Middleware.RequestLogger (logCallback)
#endif
import Network.Wai (Application)
import Hledger.Web.Foundation
import Hledger.Web.Handlers
import Hledger.Web.Options
import Hledger.Web.Settings (Extra(..), parseExtra)
import Hledger.Web.Settings.StaticFiles (staticSite)
-- This line actually creates our YesodSite instance. It is the second half
-- of the call to mkYesodData which occurs in App.hs. Please see
-- the comments there for more details.
mkYesodDispatch "App" resourcesApp
getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application
getApplication conf logger = do
s <- staticSite
let foundation = App conf setLogger s defwebopts -- XXX
app <- toWaiAppPlain foundation
return $ logWare app
where
#ifdef DEVELOPMENT
logWare = logCallbackDev (logBS setLogger)
setLogger = logger
#else
setLogger = toProduction logger -- by default the logger is set for development
logWare = logCallback (logBS setLogger)
#endif
-- for yesod devel
getApplicationDev :: IO (Int, Application)
getApplicationDev =
defaultDevelApp loader getApplication
where
loader = loadConfig (configSettings Development)
{ csParseExtra = parseExtra
}

View File

@ -1,109 +0,0 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings, CPP #-}
{-
Define the web application's foundation, in the usual Yesod style.
See a default Yesod app's comments for more details of each part.
-}
module Hledger.Web.Foundation
( App (..)
, Route (..)
, AppRoute
-- , AppMessage (..)
, resourcesApp
, Handler
, Widget
, module Yesod.Core
, liftIO
) where
import Prelude
import Yesod.Core hiding (Route)
import Yesod.Default.Config
#ifndef DEVELOPMENT
import Yesod.Default.Util (addStaticContentExternal)
#endif
import Yesod.Static
import Yesod.Logger (Logger, logMsg, formatLogText)
import Control.Monad.IO.Class (liftIO)
import Hledger.Web.Options
import Hledger.Web.Settings
import Hledger.Web.Settings.StaticFiles
-- | The web application's configuration and data, available to all request handlers.
data App = App
{ settings :: AppConfig DefaultEnv Extra
, getLogger :: Logger
, getStatic :: Static -- ^ Settings for static file serving.
, appOpts :: WebOpts
-- , appJournal :: Journal
}
-- Set up i18n messages.
-- mkMessage "App" "messages" "en"
-- The web application's routes (urls).
mkYesodData "App" $(parseRoutesFile "routes")
-- | A convenience alias.
type AppRoute = Route App
-- More configuration, including the default page layout.
instance Yesod App where
-- approot = Hledger.Web.Settings.appRoot . settings
approot = ApprootMaster $ appRoot . settings
defaultLayout widget = do
-- master <- getYesod
-- mmsg <- getMessage
-- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and
-- default-layout-wrapper is the entire page. Since the final
-- value passed to hamletToRepHtml cannot be a widget, this allows
-- you to use normal widget features in default-layout.
-- pc <- widgetToPageContent $ do
-- $(widgetFile "normalize")
-- $(widgetFile "default-layout")
-- hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet")
pc <- widgetToPageContent $ do
widget
hamletToRepHtml [hamlet|
$doctype 5
<html>
<head>
<title>#{pageTitle pc}
^{pageHead pc}
<meta http-equiv=Content-Type content="text/html; charset=utf-8">
<script type=text/javascript src=@{StaticR jquery_js}>
<script type=text/javascript src=@{StaticR jquery_url_js}>
<script type=text/javascript src=@{StaticR jquery_flot_js}>
<!--[if lte IE 8]><script language="javascript" type="text/javascript" src="excanvas.min.js"></script><![endif]-->
<script type=text/javascript src=@{StaticR dhtmlxcommon_js}>
<script type=text/javascript src=@{StaticR dhtmlxcombo_js}>
<script type=text/javascript src=@{StaticR hledger_js}>
<link rel=stylesheet type=text/css media=all href=@{StaticR style_css}>
<body>
^{pageBody pc}
|]
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticroot setting in Settings.hs
-- urlRenderOverride y (StaticR s) =
-- Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s
-- urlRenderOverride _ _ = Nothing
messageLogger y loc level msg =
formatLogText (getLogger y) loc level msg >>= logMsg (getLogger y)
#ifndef DEVELOPMENT
-- This function creates static content files in the static folder
-- and names them based on a hash of their content. This allows
-- expiration dates to be set far in the future without worry of
-- users receiving stale content.
addStaticContent = addStaticContentExternal (const $ Left ()) base64md5 Hledger.Web.Settings.staticDir (StaticR . flip StaticRoute [])
#endif
-- Place Javascript at bottom of the body tag so the rest of the page loads first
jsLoader _ = BottomOfBody

View File

@ -1,16 +0,0 @@
module Hledger.Web.Import
( module Prelude
, (<>)
, Text
, module Data.Monoid
, module Control.Applicative
) where
import Prelude hiding (writeFile, readFile, putStrLn)
import Data.Monoid (Monoid (mappend, mempty, mconcat))
import Control.Applicative ((<$>), (<*>), pure)
import Data.Text (Text)
infixr 5 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend

View File

@ -1,4 +1,3 @@
{-# LANGUAGE CPP, OverloadedStrings #-}
{-|
hledger-web - a hledger add-on providing a web interface.
@ -7,28 +6,29 @@ Released under GPL version 3 or later.
-}
module Main
module Hledger.Web.Main
where
import Data.Conduit.Network (HostPreference(..))
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort)
import Yesod.Default.Config
-- yesod scaffold imports
import Prelude (IO)
import Yesod.Default.Config --(fromArgs)
-- import Yesod.Default.Main (defaultMain)
import Yesod.Logger ({- Logger,-} defaultDevelopmentLogger) --, logString)
import Settings -- (parseExtra)
import Application (makeApplication)
import Data.Conduit.Network (HostPreference(HostIPv4))
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort)
--
import Prelude hiding (putStrLn)
-- -- import Control.Concurrent (forkIO, threadDelay)
import Control.Monad
-- import Data.Maybe
import Data.Text(pack)
import System.Exit
import Control.Monad (when)
import Data.Text (pack)
import System.Exit (exitSuccess)
import System.IO.Storage (withStore, putValue)
import Text.Printf
import Hledger
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Utils.UTF8IOCompat (putStrLn)
import Hledger.Web hiding (opts,j)
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Web.Options
main :: IO ()
@ -42,7 +42,9 @@ runWith opts
| "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp webmode) >> exitSuccess
| "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
| "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
| otherwise = journalFilePathFromOpts (cliopts_ opts) >>= requireJournalFileExists >> withJournalDo' opts web
| otherwise = do
requireJournalFileExists =<< journalFilePathFromOpts (cliopts_ opts)
withJournalDo' opts web
withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO ()
withJournalDo' opts cmd = do
@ -63,7 +65,7 @@ web opts j = do
server :: String -> Int -> WebOpts -> Journal -> IO ()
server baseurl port opts j = do
printf "Starting http server on port %d with base url %s\n" port baseurl
_ <- printf "Starting http server on port %d with base url %s\n" port baseurl
-- let a = App{getStatic=static staticdir
-- ,appRoot=pack baseurl
-- ,appOpts=opts
@ -73,21 +75,14 @@ server baseurl port opts j = do
withStore "hledger" $ do
putValue "hledger" "journal" j
-- defaultMain :: (Show env, Read env)
-- => IO (AppConfig env extra)
-- -> (AppConfig env extra -> Logger -> IO Application)
-- -> IO ()
-- defaultMain load getApp = do
-- config <- fromArgs parseExtra
let config = AppConfig {
-- defaultMain (fromArgs parseExtra) makeApplication
app <- makeApplication (AppConfig {
appEnv = Development
, appPort = port_ opts
, appRoot = pack baseurl
, appHost = HostIPv4
, appExtra = Extra "" Nothing
}
logger <- defaultDevelopmentLogger
app <- getApplication config logger
})
runSettings defaultSettings
{ settingsPort = appPort config
{ settingsPort = port_ opts
} app

View File

@ -11,7 +11,7 @@ import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit
import Hledger.Cli hiding (progname,version,prognameandversion)
import Hledger.Web.Settings
import Settings
progname, version :: String
progname = "hledger-web"
@ -75,7 +75,7 @@ toWebOpts rawopts = do
checkWebOpts :: WebOpts -> IO WebOpts
checkWebOpts opts = do
checkCliOpts $ cliopts_ opts
_ <- checkCliOpts $ cliopts_ opts
return opts
getHledgerWebOpts :: IO WebOpts

View File

@ -1,37 +0,0 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, CPP, OverloadedStrings #-}
{-|
This module exports routes for all the files in the static directory at
compile time, allowing compile-time verification that referenced files
exist. However, any files added during run-time can't be accessed this
way; use their FilePath or URL to access them.
This is a separate module to satisfy template haskell requirements.
-}
module Hledger.Web.Settings.StaticFiles where
import System.IO
import Yesod.Static
import qualified Yesod.Static as Static
import Prelude
import Hledger.Web.Settings (staticDir)
-- | use this to create your static file serving site
staticSite :: IO Static.Static
staticSite = do
#ifdef DEVELOPMENT
putStrLn ("using web files from: " ++ staticDir ++ "/") >> hFlush stdout
Static.staticDevel staticDir
#else
putStrLn "using embedded web files" >> hFlush stdout
return $(Static.embed staticDir)
#endif
-- | This generates easy references to files in the static directory at compile time,
-- giving you compile-time verification that referenced files exist.
-- Warning: any files added to your static directory during run-time can't be
-- accessed this way. You'll have to use their FilePath or URL to access them.
$(publicFiles staticDir)

28
hledger-web/Import.hs Normal file
View File

@ -0,0 +1,28 @@
module Import
( module Import
) where
import Prelude as Import hiding (head, init, last,
readFile, tail, writeFile)
import Yesod as Import hiding (Route (..))
import Control.Applicative as Import (pure, (<$>), (<*>))
import Data.Text as Import (Text)
import Foundation as Import
import Settings as Import
import Settings.Development as Import
import Settings.StaticFiles as Import
#if __GLASGOW_HASKELL__ >= 704
import Data.Monoid as Import
(Monoid (mappend, mempty, mconcat),
(<>))
#else
import Data.Monoid as Import
(Monoid (mappend, mempty, mconcat))
infixr 5 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#endif

View File

@ -1,35 +1,23 @@
{-# LANGUAGE CPP, TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
-- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod
-- by overriding methods in the Yesod typeclass. That instance is
-- declared in the hledger-web.hs file.
module Hledger.Web.Settings
( widgetFile
, staticRoot
, staticDir
, Extra (..)
, parseExtra
, hamlet
, defport
, defbaseurl
, hledgerorgurl
, manualurl
) where
-- declared in the Foundation.hs file.
module Settings where
import Control.Applicative
import Prelude
import Text.Shakespeare.Text (st)
import Language.Haskell.TH.Syntax
import Yesod.Default.Config
import Yesod.Default.Util
import Data.Text (Text)
import Data.Yaml
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Quote
import Prelude
import Text.Printf
import Text.Shakespeare.Text (st)
import Yesod.Default.Config
import qualified Yesod.Default.Util
import qualified Text.Hamlet (hamlet)
-- when available:
-- import Text.Hamlet (HamletSettings(..), hamletWithSettings, defaultHamletSettings, hamletRules)
import Control.Applicative
import Settings.Development
import Data.Default (def)
import Text.Hamlet
import Text.Printf (printf)
hledgerorgurl, manualurl :: String
@ -44,8 +32,10 @@ defbaseurl :: Int -> String
defbaseurl port = printf "http://localhost:%d" port
-- | Dynamic per-environment configuration loaded from the YAML file Settings.yaml.
-- Use dynamic settings to avoid the need to re-compile the application (between staging and production environments).
-- Static setting below. Changing these requires a recompile
-- | The location of static files on your system. This is a file system
-- path. The default value works properly with your scaffolded site.
staticDir :: FilePath
@ -60,30 +50,36 @@ staticDir = "static"
-- please see:
-- http://code.google.com/speed/page-speed/docs/request.html#ServeFromCookielessDomain
--
-- If you change the resource pattern for StaticR in hledger-web.hs, you will
-- If you change the resource pattern for StaticR in Foundation.hs, you will
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in hledger-web.hs
staticRoot :: AppConfig DefaultEnv a -> Text
-- To see how this value is used, see urlRenderOverride in Foundation.hs
staticRoot :: AppConfig DefaultEnv x -> Text
staticRoot conf = [st|#{appRoot conf}/static|]
-- | Settings for 'widgetFile', such as which template languages to support and
-- default Hamlet settings.
widgetFileSettings :: WidgetFileSettings
widgetFileSettings = def
{ wfsHamletSettings = defaultHamletSettings
{ hamletNewlines = AlwaysNewlines
}
}
-- The rest of this file contains settings which rarely need changing by a
-- user.
widgetFile :: String -> Q Exp
#if DEVELOPMENT
widgetFile = Yesod.Default.Util.widgetFileReload
#else
widgetFile = Yesod.Default.Util.widgetFileNoReload
#endif
widgetFile = (if development then widgetFileReload
else widgetFileNoReload)
widgetFileSettings
data Extra = Extra
{ extraCopyright :: Text
, extraAnalytics :: Maybe Text -- ^ Google Analytics
}
} deriving Show
parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra _ o = Extra
<$> o .: "copyright"
<*> o .:? "analytics"
hamlet :: QuasiQuoter
hamlet = Text.Hamlet.hamlet
-- hamlet = hamletWithSettings hamletRules defaultHamletSettings{hamletNewlines=True}

View File

@ -0,0 +1,14 @@
module Settings.Development where
import Prelude
development :: Bool
development =
#if DEVELOPMENT
True
#else
False
#endif
production :: Bool
production = not development

View File

@ -0,0 +1,32 @@
module Settings.StaticFiles where
import Prelude (IO, putStrLn, (++), (>>), return)
import System.IO (stdout, hFlush)
import Yesod.Static
import qualified Yesod.Static as Static
import Settings (staticDir)
import Settings.Development
-- | use this to create your static file serving site
-- staticSite :: IO Static.Static
-- staticSite = if development then Static.staticDevel staticDir
-- else Static.static staticDir
--
-- | This generates easy references to files in the static directory at compile time,
-- giving you compile-time verification that referenced files exist.
-- Warning: any files added to your static directory during run-time can't be
-- accessed this way. You'll have to use their FilePath or URL to access them.
-- $(staticFiles Settings.staticDir)
staticSite :: IO Static.Static
staticSite =
if development
then (do
putStrLn ("using web files from: " ++ staticDir ++ "/") >> hFlush stdout
Static.staticDevel staticDir)
else (do
putStrLn "using embedded web files" >> hFlush stdout
return $(Static.embed staticDir))
$(publicFiles staticDir)

11
hledger-web/app/main.hs Normal file
View File

@ -0,0 +1,11 @@
import Prelude (IO)
-- import Yesod.Default.Config (fromArgs)
-- import Yesod.Default.Main (defaultMain)
-- import Settings (parseExtra)
-- import Application (makeApplication)
import qualified Hledger.Web.Main
main :: IO ()
-- main = defaultMain (fromArgs parseExtra) makeApplication
main = Hledger.Web.Main.main

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

View File

@ -0,0 +1,8 @@
exec: ../dist/build/hledger-web/hledger-web
args:
- production
host: <<HOST-NOT-SET>>
# Use the following to automatically copy your bundle upon creation via `yesod
# keter`. Uses `scp` internally, so you can set it to a remote destination
# copy-to: user@host:/opt/keter/incoming

View File

@ -0,0 +1 @@
User-agent: *

View File

@ -0,0 +1,19 @@
Default: &defaults
host: "*4" # any IPv4 host
port: 3000
approot: "http://localhost:3000"
copyright: Insert copyright statement here
#analytics: UA-YOURCODE
Development:
<<: *defaults
Testing:
<<: *defaults
Staging:
<<: *defaults
Production:
#approot: "http://www.example.com"
<<: *defaults

View File

@ -0,0 +1,90 @@
# Free deployment to Heroku.
#
# !! Warning: You must use a 64 bit machine to compile !!
#
# This could mean using a virtual machine. Give your VM as much memory as you can to speed up linking.
#
# Basic Yesod setup:
#
# * Move this file out of the deploy directory and into your root directory
#
# mv deploy/Procfile ./
#
# * Create an empty package.json
# echo '{ "name": "hledger-web", "version": "0.0.1", "dependencies": {} }' >> package.json
#
# Postgresql Yesod setup:
#
# * add dependencies on the "heroku", "aeson" and "unordered-containers" packages in your cabal file
#
# * add code in Application.hs to use the heroku package and load the connection parameters.
# The below works for Postgresql.
#
# import Data.HashMap.Strict as H
# import Data.Aeson.Types as AT
# #ifndef DEVELOPMENT
# import qualified Web.Heroku
# #endif
#
#
#
# makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO App
# makeFoundation conf setLogger = do
# manager <- newManager def
# s <- staticSite
# hconfig <- loadHerokuConfig
# dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf)
# (Database.Persist.Store.loadConfig . combineMappings hconfig) >>=
# Database.Persist.Store.applyEnv
# p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)
# Database.Persist.Store.runPool dbconf (runMigration migrateAll) p
# return $ App conf setLogger s p manager dbconf
#
# #ifndef DEVELOPMENT
# canonicalizeKey :: (Text, val) -> (Text, val)
# canonicalizeKey ("dbname", val) = ("database", val)
# canonicalizeKey pair = pair
#
# toMapping :: [(Text, Text)] -> AT.Value
# toMapping xs = AT.Object $ M.fromList $ map (\(key, val) -> (key, AT.String val)) xs
# #endif
#
# combineMappings :: AT.Value -> AT.Value -> AT.Value
# combineMappings (AT.Object m1) (AT.Object m2) = AT.Object $ m1 `M.union` m2
# combineMappings _ _ = error "Data.Object is not a Mapping."
#
# loadHerokuConfig :: IO AT.Value
# loadHerokuConfig = do
# #ifdef DEVELOPMENT
# return $ AT.Object M.empty
# #else
# Web.Heroku.dbConnParams >>= return . toMapping . map canonicalizeKey
# #endif
# Heroku setup:
# Find the Heroku guide. Roughly:
#
# * sign up for a heroku account and register your ssh key
# * create a new application on the *cedar* stack
#
# * make your Yesod project the git repository for that application
# * create a deploy branch
#
# git checkout -b deploy
#
# Repeat these steps to deploy:
# * add your web executable binary (referenced below) to the git repository
#
# git checkout deploy
# git add ./dist/build/hledger-web/hledger-web
# git commit -m deploy
#
# * push to Heroku
#
# git push heroku deploy:master
# Heroku configuration that runs your app
web: ./dist/build/hledger-web/hledger-web production -p $PORT

View File

@ -1,5 +1,5 @@
{-# LANGUAGE PackageImports #-}
import "hledger-web" Hledger.Web.Application (getApplicationDev)
import "hledger-web" Application (getApplicationDev)
import Network.Wai.Handler.Warp
(runSettings, defaultSettings, settingsPort)
import Control.Concurrent (forkIO)
@ -7,9 +7,6 @@ import System.Directory (doesFileExist, removeFile)
import System.Exit (exitSuccess)
import Control.Concurrent (threadDelay)
-- import Network.Wai.Middleware.Debug (debugHandle)
-- import Yesod.Logger (logString, logLazyText, flushLogger, makeLogger)
main :: IO ()
main = do
putStrLn "Starting devel application"
@ -22,15 +19,8 @@ main = do
loop :: IO ()
loop = do
threadDelay 100000
e <- doesFileExist "dist/devel-terminate"
e <- doesFileExist "yesod-devel/devel-terminate"
if e then terminateDevel else loop
terminateDevel :: IO ()
terminateDevel = exitSuccess
-- logString logger $ (show env) ++ " application launched, listening on port " ++ show (appPort c)
-- withApp c logger opts $ run (appPort c) . debugHandle (logHandle logger)
-- flushLogger logger
-- where
-- logHandle logger msg = logLazyText logger msg >> flushLogger logger

View File

@ -18,13 +18,13 @@ maintainer: Simon Michael <simon@joyful.com>
homepage: http://hledger.org
bug-reports: http://code.google.com/p/hledger/issues
stability: beta
tested-with: GHC==7.0, GHC==7.2, GHC==7.4.1
cabal-version: >= 1.6
tested-with: GHC==7.4.2
cabal-version: >= 1.8
build-type: Simple
extra-tmp-files:
extra-source-files:
models
routes
-- config/models
-- config/routes
static/style.css
static/hledger.js
static/jquery.js
@ -50,7 +50,8 @@ flag threaded
flag blaze_html_0_5
description: Use the newer 0.5 version of blaze-html and blaze-markup.
default: False
default: True
flag dev
Description: Turn on development settings, like auto-reload templates.
@ -60,44 +61,113 @@ flag library-only
Description: Build for use with "yesod devel"
Default: False
library
if flag(library-only)
Buildable: True
else
Buildable: False
hs-source-dirs: . app
exposed-modules:
Hledger.Web.Application
exposed-modules: Application
Foundation
Import
Settings
Settings.StaticFiles
Settings.Development
Handler.Handlers
other-modules:
Hledger.Web
Hledger.Web.Foundation
Hledger.Web.Import
Hledger.Web.Options
Hledger.Web.Settings
Hledger.Web.Settings.StaticFiles
Hledger.Web.Handlers
Hledger.Web
Hledger.Web.Main
Hledger.Web.Options
ghc-options: -Wall -O0 -fno-warn-unused-do-bind
-- ghc-options: -Wall -O0 -fno-warn-unused-do-bind
cpp-options: -DVERSION="0.19" -DDEVELOPMENT
-- if flag(library-only)
-- Buildable: True
-- else
-- Buildable: False
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT
ghc-options: -Wall -O0
else
ghc-options: -Wall -O2
extensions: TemplateHaskell
QuasiQuotes
OverloadedStrings
NoImplicitPrelude
CPP
OverloadedStrings
MultiParamTypeClasses
TypeFamilies
GADTs
GeneralizedNewtypeDeriving
FlexibleContexts
EmptyDataDecls
NoMonomorphismRestriction
build-depends: base >= 4 && < 5
-- , yesod-platform >= 1.1 && < 1.2
, yesod >= 1.1 && < 1.2
, yesod-core >= 1.1.2 && < 1.2
, yesod-static >= 1.1 && < 1.2
, yesod-default >= 1.1 && < 1.2
, yesod-form >= 1.1 && < 1.2
, clientsession >= 0.8 && < 0.9
, bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 0.12
, template-haskell
, hamlet >= 1.1 && < 1.2
, shakespeare-css >= 1.0 && < 1.1
, shakespeare-js >= 1.0 && < 1.1
, shakespeare-text >= 1.0 && < 1.1
, hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 0.4
, wai-extra >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9
, http-conduit >= 1.8 && < 1.9
, directory >= 1.1 && < 1.3
, warp >= 1.3 && < 1.4
, data-default
, hledger == 0.19
, hledger-lib == 0.19
, cmdargs >= 0.10 && < 0.11
, directory
, filepath
, HUnit
, io-storage >= 0.3 && < 0.4
, network-conduit
, old-locale
, parsec
, regexpr >= 0.5.1
, safe >= 0.2
, time
, transformers
, wai
, wai-extra
, warp
, yaml
if flag(blaze_html_0_5)
cpp-options: -DBLAZE_HTML_0_5
build-depends:
blaze-html >= 0.5 && < 0.6
, blaze-markup >= 0.5.1 && < 0.6
else
build-depends:
blaze-html >= 0.4 && < 0.5
executable hledger-web
cpp-options: -DVERSION="0.19"
if flag(library-only)
Buildable: False
if flag(dev)
cpp-options: -DVERSION="0.19" -DDEVELOPMENT
ghc-options: -Wall -O0 -fno-warn-unused-do-bind
cpp-options: -DDEVELOPMENT
ghc-options: -O0 -Wall -fno-warn-unused-do-bind
else
ghc-options: -Wall -O2 -fno-warn-unused-do-bind
ghc-options: -O2 -Wall -fno-warn-unused-do-bind
if flag(threaded)
ghc-options: -threaded
@ -111,20 +181,24 @@ executable hledger-web
MultiParamTypeClasses
TypeFamilies
main-is: hledger-web.hs
hs-source-dirs: . app
main-is: main.hs
other-modules:
Application
Foundation
Import
Settings
Settings.StaticFiles
Settings.Development
Handler.Handlers
Hledger.Web
Hledger.Web.Foundation
Hledger.Web.Application
Hledger.Web.Import
Hledger.Web.Main
Hledger.Web.Options
Hledger.Web.Settings
Hledger.Web.Settings.StaticFiles
Hledger.Web.Handlers
build-depends:
hledger == 0.19
hledger-web
, hledger == 0.19
, hledger-lib == 0.19
, base >= 4.3 && < 5
, cmdargs >= 0.10 && < 0.11
@ -138,7 +212,8 @@ executable hledger-web
, safe >= 0.2
, time
, yesod == 1.0.*
-- , yesod-platform == 1.1.*
, yesod >= 1.1.3 && < 1.2
, yesod-core
, yesod-default
, yesod-static
@ -147,12 +222,15 @@ executable hledger-web
, network-conduit
, shakespeare-text
, template-haskell
, text >= 0.11 && < 0.12
, transformers >= 0.2 && < 0.4
, text
, transformers
, wai
, wai-extra
, warp
, yaml
, hjsmin >= 0.1 && < 0.2
, http-conduit >= 1.8 && < 1.9
if flag(blaze_html_0_5)
cpp-options: -DBLAZE_HTML_0_5
build-depends:
@ -162,11 +240,40 @@ executable hledger-web
build-depends:
blaze-html >= 0.4 && < 0.5
build-depends:
-- base >= 4 && < 5
-- -- , yesod-platform >= 1.1 && < 1.2
-- , yesod >= 1.1 && < 1.2
-- , yesod-core >= 1.1.2 && < 1.2
-- , yesod-static >= 1.1 && < 1.2
-- , yesod-default >= 1.1 && < 1.2
-- , yesod-form >= 1.1 && < 1.2
-- , clientsession >= 0.8 && < 0.9
-- , bytestring >= 0.9 && < 0.11
-- , text >= 0.11 && < 0.12
-- , template-haskell
-- , hamlet >= 1.1 && < 1.2
-- , shakespeare-css >= 1.0 && < 1.1
-- , shakespeare-js >= 1.0 && < 1.1
-- , shakespeare-text >= 1.0 && < 1.1
-- , hjsmin >= 0.1 && < 0.2
-- , monad-control >= 0.3 && < 0.4
-- , wai-extra >= 1.3 && < 1.4
-- , yaml >= 0.8 && < 0.9
-- , http-conduit >= 1.8 && < 1.9
-- , directory >= 1.1 && < 1.3
-- , warp >= 1.3 && < 1.4
data-default
-- if flag(production)
-- cpp-options: -DPRODUCTION
-- ghc-options: -O2
-- else
-- ghc-options: -Wall
-- if flag(threaded)
-- ghc-options: -threaded
test-suite test
type: exitcode-stdio-1.0
main-is: main.hs
hs-source-dirs: tests
ghc-options: -Wall
build-depends:
base
, hledger-web
, yesod-test >= 0.3 && < 0.4
, yesod-default
, yesod-core

View File

@ -0,0 +1 @@
Hello: Hello

View File

3990
hledger-web/static/css/bootstrap.css vendored Normal file

File diff suppressed because it is too large Load Diff

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

View File

@ -0,0 +1,48 @@
$newline never
\<!doctype html>
\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
\<!--[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]-->
\<!--[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]-->
\<!--[if gt IE 8]><!-->
<html class="no-js" lang="en"> <!--<![endif]-->
<head>
<meta charset="UTF-8">
<title>#{pageTitle pc}
<meta name="description" content="">
<meta name="author" content="">
<meta name="viewport" content="width=device-width,initial-scale=1">
^{pageHead pc}
\<!--[if lt IE 9]>
\<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
\<![endif]-->
<script>
document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');
<body>
<div class="container">
<header>
<div id="main" role="main">
^{pageBody pc}
<footer>
#{extraCopyright $ appExtra $ settings master}
$maybe analytics <- extraAnalytics $ appExtra $ settings master
<script>
if(!window.location.href.match(/localhost/)){
window._gaq = [['_setAccount','#{analytics}'],['_trackPageview'],['_trackPageLoadTime']];
(function() {
\ var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
\ ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
\ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
})();
}
\<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->
\<!--[if lt IE 7 ]>
<script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">
<script>
window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})
\<![endif]-->

View File

@ -0,0 +1,3 @@
$maybe msg <- mmsg
<div #message>#{msg}
^{widget}

View File

@ -0,0 +1,38 @@
<h1>_{MsgHello}
<ol>
<li>Now that you have a working project you should use the #
\<a href="http://www.yesodweb.com/book/">Yesod book</a> to learn more. #
You can also use this scaffolded site to explore some basic concepts.
<li> This page was generated by the #{handlerName} handler in #
\<em>Handler/Home.hs</em>.
<li> The #{handlerName} handler is set to generate your site's home screen in Routes file #
<em>config/routes
<li> The HTML you are seeing now is actually composed by a number of <em>widgets</em>, #
most of them are brought together by the <em>defaultLayout</em> function which #
is defined in the <em>Foundation.hs</em> module, and used by <em>#{handlerName}</em>. #
All the files for templates and wigdets are in <em>templates</em>.
<li>
A Widget's Html, Css and Javascript are separated in three files with the #
\<em>.hamlet</em>, <em>.lucius</em> and <em>.julius</em> extensions.
<li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this.
<li #form>
This is an example trivial Form. Read the #
\<a href="http://www.yesodweb.com/book/forms">Forms chapter</a> #
on the yesod book to learn more about them.
$maybe (info,con) <- submission
<div .message>
Your file's type was <em>#{fileContentType info}</em>. You say it has: <em>#{con}</em>
<form method=post action=@{HomeR}#form enctype=#{formEnctype}>
^{formWidget}
<input type="submit" value="Send it!">
<li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a #
test suite that performs tests on this page. #
You can run your tests by doing: <pre>yesod test</pre>

View File

@ -0,0 +1 @@
document.getElementById("#{aDomId}").innerHTML = "This text was added by the Javascript part of the homepage widget.";

View File

@ -0,0 +1,6 @@
h1 {
text-align: center
}
h2##{aDomId} {
color: #990
}

View File

@ -0,0 +1,439 @@
/*! normalize.css 2011-08-12T17:28 UTC · http://github.com/necolas/normalize.css */
/* =============================================================================
HTML5 display definitions
========================================================================== */
/*
* Corrects block display not defined in IE6/7/8/9 & FF3
*/
article,
aside,
details,
figcaption,
figure,
footer,
header,
hgroup,
nav,
section {
display: block;
}
/*
* Corrects inline-block display not defined in IE6/7/8/9 & FF3
*/
audio,
canvas,
video {
display: inline-block;
*display: inline;
*zoom: 1;
}
/*
* Prevents modern browsers from displaying 'audio' without controls
*/
audio:not([controls]) {
display: none;
}
/*
* Addresses styling for 'hidden' attribute not present in IE7/8/9, FF3, S4
* Known issue: no IE6 support
*/
[hidden] {
display: none;
}
/* =============================================================================
Base
========================================================================== */
/*
* 1. Corrects text resizing oddly in IE6/7 when body font-size is set using em units
* http://clagnut.com/blog/348/#c790
* 2. Keeps page centred in all browsers regardless of content height
* 3. Prevents iOS text size adjust after orientation change, without disabling user zoom
* www.456bereastreet.com/archive/201012/controlling_text_size_in_safari_for_ios_without_disabling_user_zoom/
*/
html {
font-size: 100%; /* 1 */
overflow-y: scroll; /* 2 */
-webkit-text-size-adjust: 100%; /* 3 */
-ms-text-size-adjust: 100%; /* 3 */
}
/*
* Addresses margins handled incorrectly in IE6/7
*/
body {
margin: 0;
}
/*
* Addresses font-family inconsistency between 'textarea' and other form elements.
*/
body,
button,
input,
select,
textarea {
font-family: sans-serif;
}
/* =============================================================================
Links
========================================================================== */
a {
color: #00e;
}
a:visited {
color: #551a8b;
}
/*
* Addresses outline displayed oddly in Chrome
*/
a:focus {
outline: thin dotted;
}
/*
* Improves readability when focused and also mouse hovered in all browsers
* people.opera.com/patrickl/experiments/keyboard/test
*/
a:hover,
a:active {
outline: 0;
}
/* =============================================================================
Typography
========================================================================== */
/*
* Addresses styling not present in IE7/8/9, S5, Chrome
*/
abbr[title] {
border-bottom: 1px dotted;
}
/*
* Addresses style set to 'bolder' in FF3/4, S4/5, Chrome
*/
b,
strong {
font-weight: bold;
}
blockquote {
margin: 1em 40px;
}
/*
* Addresses styling not present in S5, Chrome
*/
dfn {
font-style: italic;
}
/*
* Addresses styling not present in IE6/7/8/9
*/
mark {
background: #ff0;
color: #000;
}
/*
* Corrects font family set oddly in IE6, S4/5, Chrome
* en.wikipedia.org/wiki/User:Davidgothberg/Test59
*/
pre,
code,
kbd,
samp {
font-family: monospace, serif;
_font-family: 'courier new', monospace;
font-size: 1em;
}
/*
* Improves readability of pre-formatted text in all browsers
*/
pre {
white-space: pre;
white-space: pre-wrap;
word-wrap: break-word;
}
/*
* 1. Addresses CSS quotes not supported in IE6/7
* 2. Addresses quote property not supported in S4
*/
/* 1 */
q {
quotes: none;
}
/* 2 */
q:before,
q:after {
content: '';
content: none;
}
small {
font-size: 75%;
}
/*
* Prevents sub and sup affecting line-height in all browsers
* gist.github.com/413930
*/
sub,
sup {
font-size: 75%;
line-height: 0;
position: relative;
vertical-align: baseline;
}
sup {
top: -0.5em;
}
sub {
bottom: -0.25em;
}
/* =============================================================================
Lists
========================================================================== */
ul,
ol {
margin: 1em 0;
padding: 0 0 0 40px;
}
dd {
margin: 0 0 0 40px;
}
nav ul,
nav ol {
list-style: none;
list-style-image: none;
}
/* =============================================================================
Embedded content
========================================================================== */
/*
* 1. Removes border when inside 'a' element in IE6/7/8/9
* 2. Improves image quality when scaled in IE7
* code.flickr.com/blog/2008/11/12/on-ui-quality-the-little-things-client-side-image-resizing/
*/
img {
border: 0; /* 1 */
-ms-interpolation-mode: bicubic; /* 2 */
}
/*
* Corrects overflow displayed oddly in IE9
*/
svg:not(:root) {
overflow: hidden;
}
/* =============================================================================
Figures
========================================================================== */
/*
* Addresses margin not present in IE6/7/8/9, S5, O11
*/
figure {
margin: 0;
}
/* =============================================================================
Forms
========================================================================== */
/*
* Corrects margin displayed oddly in IE6/7
*/
form {
margin: 0;
}
/*
* Define consistent margin and padding
*/
fieldset {
margin: 0 2px;
padding: 0.35em 0.625em 0.75em;
}
/*
* 1. Corrects color not being inherited in IE6/7/8/9
* 2. Corrects alignment displayed oddly in IE6/7
*/
legend {
border: 0; /* 1 */
*margin-left: -7px; /* 2 */
}
/*
* 1. Corrects font size not being inherited in all browsers
* 2. Addresses margins set differently in IE6/7, F3/4, S5, Chrome
* 3. Improves appearance and consistency in all browsers
*/
button,
input,
select,
textarea {
font-size: 100%; /* 1 */
margin: 0; /* 2 */
vertical-align: baseline; /* 3 */
*vertical-align: middle; /* 3 */
}
/*
* 1. Addresses FF3/4 setting line-height using !important in the UA stylesheet
* 2. Corrects inner spacing displayed oddly in IE6/7
*/
button,
input {
line-height: normal; /* 1 */
*overflow: visible; /* 2 */
}
/*
* Corrects overlap and whitespace issue for buttons and inputs in IE6/7
* Known issue: reintroduces inner spacing
*/
table button,
table input {
*overflow: auto;
}
/*
* 1. Improves usability and consistency of cursor style between image-type 'input' and others
* 2. Corrects inability to style clickable 'input' types in iOS
*/
button,
html input[type="button"],
input[type="reset"],
input[type="submit"] {
cursor: pointer; /* 1 */
-webkit-appearance: button; /* 2 */
}
/*
* 1. Addresses box sizing set to content-box in IE8/9
* 2. Addresses excess padding in IE8/9
*/
input[type="checkbox"],
input[type="radio"] {
box-sizing: border-box; /* 1 */
padding: 0; /* 2 */
}
/*
* 1. Addresses appearance set to searchfield in S5, Chrome
* 2. Addresses box sizing set to border-box in S5, Chrome (include -moz to future-proof)
*/
input[type="search"] {
-webkit-appearance: textfield; /* 1 */
-moz-box-sizing: content-box;
-webkit-box-sizing: content-box; /* 2 */
box-sizing: content-box;
}
/*
* Corrects inner padding displayed oddly in S5, Chrome on OSX
*/
input[type="search"]::-webkit-search-decoration {
-webkit-appearance: none;
}
/*
* Corrects inner padding and border displayed oddly in FF3/4
* www.sitepen.com/blog/2008/05/14/the-devils-in-the-details-fixing-dojos-toolbar-buttons/
*/
button::-moz-focus-inner,
input::-moz-focus-inner {
border: 0;
padding: 0;
}
/*
* 1. Removes default vertical scrollbar in IE6/7/8/9
* 2. Improves readability and alignment in all browsers
*/
textarea {
overflow: auto; /* 1 */
vertical-align: top; /* 2 */
}
/* =============================================================================
Tables
========================================================================== */
/*
* Remove most spacing between table cells
*/
table {
border-collapse: collapse;
border-spacing: 0;
}

View File

@ -0,0 +1,24 @@
{-# LANGUAGE OverloadedStrings #-}
module HomeTest
( homeSpecs
) where
import TestImport
homeSpecs :: Specs
homeSpecs =
describe "These are some example tests" $
it "loads the index and checks it looks right" $ do
get_ "/"
statusIs 200
htmlAllContain "h1" "Hello"
post "/" $ do
addNonce
fileByLabel "Choose a file" "tests/main.hs" "text/plain" -- talk about self-reference
byLabel "What's on the file?" "Some Content"
statusIs 200
htmlCount ".message" 1
htmlAllContain ".message" "Some Content"
htmlAllContain ".message" "text/plain"

View File

@ -0,0 +1,9 @@
{-# LANGUAGE OverloadedStrings #-}
module TestImport
( module Yesod.Test
, Specs
) where
import Yesod.Test
type Specs = SpecsConn ()

19
hledger-web/tests/main.hs Normal file
View File

@ -0,0 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
import Import
import Yesod.Default.Config
import Yesod.Test
import Application (makeFoundation)
import HomeTest
main :: IO ()
main = do
conf <- loadConfig $ (configSettings Testing) { csParseExtra = parseExtra }
foundation <- makeFoundation conf
app <- toWaiAppPlain foundation
runTests app (error "No database available") homeSpecs

View File

@ -32,15 +32,15 @@ balancesheet CliOpts{reportopts_=ropts} j = do
LT.putStr $ [lt|Balance Sheet
Assets:
#{unlines $ accountsReportAsText ropts assetreport}
-{unlines $ accountsReportAsText ropts assetreport}
Liabilities:
#{unlines $ accountsReportAsText ropts liabilityreport}
-{unlines $ accountsReportAsText ropts liabilityreport}
Equity:
#{unlines $ accountsReportAsText ropts equityreport}
-{unlines $ accountsReportAsText ropts equityreport}
Total:
--------------------
#{padleft 20 $ showMixedAmountWithoutPrice total}
-{padleft 20 $ showMixedAmountWithoutPrice total}
|]
withoutBeginDate :: ReportOpts -> ReportOpts

View File

@ -36,11 +36,11 @@ cashflow CliOpts{reportopts_=ropts} j = do
LT.putStr $ [lt|Cashflow Statement
Cash flows:
#{unlines $ accountsReportAsText ropts cashreport}
-{unlines $ accountsReportAsText ropts cashreport}
Total:
--------------------
#{padleft 20 $ showMixedAmountWithoutPrice total}
-{padleft 20 $ showMixedAmountWithoutPrice total}
|]
withoutBeginDate :: ReportOpts -> ReportOpts

View File

@ -29,13 +29,13 @@ incomestatement CliOpts{reportopts_=ropts} j = do
LT.putStr $ [lt|Income Statement
Revenues:
#{unlines $ accountsReportAsText ropts incomereport}
-{unlines $ accountsReportAsText ropts incomereport}
Expenses:
#{unlines $ accountsReportAsText ropts expensereport}
-{unlines $ accountsReportAsText ropts expensereport}
Total:
--------------------
#{padleft 20 $ showMixedAmountWithoutPrice total}
-{padleft 20 $ showMixedAmountWithoutPrice total}
|]
tests_Hledger_Cli_Incomestatement :: Test