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.

hledger-web/.ghci

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

hledger-web/Application.hs

@@ -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
+        }

hledger-web/Foundation.hs

@@ -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

hledger-web/Handler/Handlers.hs

@@ -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
+       hassubs = not $ maybe False (null.asubs) $ ledgerAccount l acct
-       numpostings = length $ apostings $ 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"

hledger-web/Hledger/Web.hs

@@ -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.Main,
-                     module Hledger.Web.Settings.StaticFiles,
                      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.Main
-import Hledger.Web.Settings.StaticFiles
 
 tests_Hledger_Web :: Test
 tests_Hledger_Web = TestList
  [
- --  tests_Hledger_Web_Foundation
+ --  tests_Hledger_Web_Options
- -- ,tests_Hledger_Web_Application
+ -- ,tests_Hledger_Web_Main
- -- ,tests_Hledger_Web_EmbeddedFiles
- -- ,tests_Hledger_Web_Handlers
- -- ,tests_Hledger_Web_Settings
- -- ,tests_Hledger_Web_Settings_StaticFiles
  ]

hledger-web/Hledger/Web/Application.hs

@@ -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
-        }

hledger-web/Hledger/Web/Foundation.hs

@@ -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

hledger-web/Hledger/Web/Import.hs

@@ -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

hledger-web/Hledger/Web/Main.hs

@@ -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(..))
+-- yesod scaffold imports
-import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort)
+import Prelude              (IO)
-import Yesod.Default.Config
+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 (when)
-import Control.Monad
--- import Data.Maybe
 import Data.Text (pack)
-import System.Exit
+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)
+-- defaultMain (fromArgs parseExtra) makeApplication
---             => IO (AppConfig env extra)
+    app <- makeApplication (AppConfig {
---             -> (AppConfig env extra -> Logger -> IO Application)
---             -> IO ()
--- defaultMain load getApp = do
-    -- config <- fromArgs parseExtra
-    let config = 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

hledger-web/Hledger/Web/Options.hs

@@ -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

hledger-web/Hledger/Web/Settings/StaticFiles.hs

@@ -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)

hledger-web/Import.hs

@@ -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

hledger-web/Settings.hs

@@ -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.
+-- declared in the Foundation.hs file.
-module Hledger.Web.Settings
+module Settings where
-    ( widgetFile
-    , staticRoot
-    , staticDir
-    , Extra (..)
-    , parseExtra
-    , hamlet
-    , defport
-    , defbaseurl
-    , hledgerorgurl
-    , manualurl
-    ) 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 Control.Applicative
-import Language.Haskell.TH.Quote
+import Settings.Development
-import Prelude
+import Data.Default (def)
-import Text.Printf
+import Text.Hamlet
-import Text.Shakespeare.Text (st)
+
-import Yesod.Default.Config
+import Text.Printf (printf)
-import qualified Yesod.Default.Util
-import qualified Text.Hamlet (hamlet)
--- when available:
--- import Text.Hamlet (HamletSettings(..), hamletWithSettings, defaultHamletSettings, hamletRules)
 
 
 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
+-- To see how this value is used, see urlRenderOverride in Foundation.hs
-staticRoot :: AppConfig DefaultEnv a ->  Text
+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 = (if development then widgetFileReload
-widgetFile = Yesod.Default.Util.widgetFileReload
+                             else widgetFileNoReload)
-#else
+              widgetFileSettings
-widgetFile = Yesod.Default.Util.widgetFileNoReload
-#endif
 
 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}

hledger-web/Settings/Development.hs

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

hledger-web/Settings/StaticFiles.hs

@@ -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)

hledger-web/app/main.hs

@@ -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

hledger-web/config/keter.yaml

@@ -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

hledger-web/config/robots.txt

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

hledger-web/config/settings.yml

@@ -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

hledger-web/deploy/Procfile

@@ -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

hledger-web/devel.hs

@@ -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

hledger-web/hledger-web.cabal

@@ -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
+tested-with:    GHC==7.4.2
-cabal-version:  >= 1.6
+cabal-version:  >= 1.8
 build-type:     Simple
 extra-tmp-files:
 extra-source-files:
-                models
+                -- config/models
-                routes
+                -- 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
 
-    exposed-modules: 
+library
-                     Hledger.Web.Application
+    hs-source-dirs:  . app
+
+    exposed-modules: Application
+                     Foundation
+                     Import
+                     Settings
+                     Settings.StaticFiles
+                     Settings.Development
+                     Handler.Handlers
     other-modules:
                       Hledger.Web
-                     Hledger.Web.Foundation
+                      Hledger.Web.Main
-                     Hledger.Web.Import
                       Hledger.Web.Options
-                     Hledger.Web.Settings
-                     Hledger.Web.Settings.StaticFiles
-                     Hledger.Web.Handlers
 
-    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
+        cpp-options:   -DDEVELOPMENT
-        ghc-options:   -Wall -O0 -fno-warn-unused-do-bind
+        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.Main
-                     Hledger.Web.Application
-                     Hledger.Web.Import
                      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
+                   , text
-                   , transformers                  >= 0.2        && < 0.4
+                   , 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)
+test-suite test
-  --     cpp-options:   -DPRODUCTION
+    type:              exitcode-stdio-1.0
-  --     ghc-options:   -O2
+    main-is:           main.hs
-  -- else
+    hs-source-dirs:    tests
-  --     ghc-options:   -Wall
+    ghc-options:       -Wall
-  -- if flag(threaded)
+
-  --     ghc-options:   -threaded
+    build-depends: 
+                   base
+                 , hledger-web
+                 , yesod-test >= 0.3 && < 0.4
+                 , yesod-default
+                 , yesod-core

hledger-web/messages/en.msg

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

hledger-web/templates/default-layout-wrapper.hamlet

@@ -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]-->

hledger-web/templates/default-layout.hamlet

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

hledger-web/templates/homepage.hamlet

@@ -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>

hledger-web/templates/homepage.julius

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

hledger-web/templates/homepage.lucius

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

hledger-web/templates/normalize.lucius

@@ -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;
+}

hledger-web/tests/HomeTest.hs

@@ -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"

hledger-web/tests/TestImport.hs

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

hledger-web/tests/main.hs

@@ -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

hledger/Hledger/Cli/Balancesheet.hs

@@ -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

hledger/Hledger/Cli/Cashflow.hs

@@ -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

hledger/Hledger/Cli/Incomestatement.hs

@@ -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