web: bump version, upgrade to yesod 0.10

hledger-web/Hledger/Web.hs

@@ -6,6 +6,7 @@ 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,
@@ -17,6 +18,7 @@ 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

hledger-web/Hledger/Web/Application.hs

@@ -3,61 +3,64 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Hledger.Web.Application (
-               withApp
-              ,withDevelAppPort
-              )
+module Hledger.Web.Application
+    ( getApplication
+    , getApplicationDev
+    )
 where
 
-import Data.Dynamic (Dynamic, toDyn)
+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 Network.Wai.Middleware.Debug (debugHandle)
-import Yesod.Core hiding (AppConfig,loadConfig,appPort)
-import Yesod.Logger (makeLogger, flushLogger, Logger, logLazyText, logString)
-import Yesod.Static
 
 import Hledger.Web.Foundation
 import Hledger.Web.Handlers
 import Hledger.Web.Options
-import Hledger.Web.Settings
+import Hledger.Web.Settings (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
 
--- 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.
-withApp :: AppConfig -> Logger -> WebOpts -> (Application -> IO a) -> IO a
-withApp conf logger opts f = do
-#ifdef PRODUCTION
-    putStrLn $ "Production mode, using embedded web files"
-    let s = $(embed staticDir)
+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
-    putStrLn $ "Not in production mode, using web files from " ++ staticDir ++ "/"
-    s <- staticDevel staticDir
+    setLogger = toProduction logger -- by default the logger is set for development
+    logWare = logCallback (logBS setLogger)
 #endif
-    let a = App {settings=conf
-                ,getLogger=logger
-                ,getStatic=s
-                ,appOpts=opts
-                }
-    toWaiApp a >>= f
 
 -- for yesod devel
-withDevelAppPort :: Dynamic
-withDevelAppPort =
-    toDyn go
+getApplicationDev :: IO (Int, Application)
+getApplicationDev =
+    defaultDevelApp loader getApplication
   where
-    go :: ((Int, Application) -> IO ()) -> IO ()
-    go f = do
-        conf <- loadConfig Development
-        let port = appPort conf
-        logger <- makeLogger
-        logString logger $ "Devel application launched with default options, listening on port " ++ show port
-        withApp conf logger defwebopts $ \app -> f (port, debugHandle (logHandle logger) app)
-        flushLogger logger
-      where
-        logHandle logger msg = logLazyText logger msg >> flushLogger logger
+    loader = loadConfig (configSettings Development)
+        { csParseExtra = parseExtra
+        }
+
+-- #ifdef PRODUCTION
+--     putStrLn $ "Production mode, using embedded web files"
+--     let s = $(embed staticDir)
+-- #else
+--     putStrLn $ "Not in production mode, using web files from " ++ staticDir ++ "/"
+--     s <- staticDevel staticDir
+-- #endif
+

hledger-web/Hledger/Web/Foundation.hs

@@ -1,30 +1,30 @@
-{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-}
+
 module Hledger.Web.Foundation
     ( App (..)
-    , AppRoute (..)
+    , Route (..)
+    -- , AppMessage (..)
     , resourcesApp
     , Handler
     , Widget
-    , StaticRoute (..)
-    , lift
+    , module Yesod.Core
+    , module Hledger.Web.Settings
     , liftIO
     ) where
 
-import Control.Monad (unless)
+import Prelude
+import Yesod.Core hiding (Route)
+import Yesod.Default.Config
+import Yesod.Default.Util (addStaticContentExternal)
+import Yesod.Static
+import Yesod.Logger (Logger, logMsg, formatLogText)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Class (lift)
-import System.Directory
-import Text.Hamlet hiding (hamletFile)
 import Web.ClientSession (getKey)
-import Yesod.Core
-import Yesod.Logger (Logger, logLazyText)
-import Yesod.Static (Static, base64md5, StaticRoute(..))
-import qualified Data.ByteString.Lazy as L
-import qualified Data.Text as T
+import Text.Hamlet
 
 import Hledger.Web.Options
-import Hledger.Web.Settings
+import qualified Hledger.Web.Settings
+import Hledger.Web.Settings (Extra (..), widgetFile)
 import Hledger.Web.Settings.StaticFiles
 
 
@@ -33,7 +33,7 @@ import Hledger.Web.Settings.StaticFiles
 -- starts running, such as database connections. Every handler will have
 -- access to the data present here.
 data App = App
-    { settings :: Hledger.Web.Settings.AppConfig
+    { settings :: AppConfig DefaultEnv Extra
     , getLogger :: Logger
     , getStatic :: Static -- ^ Settings for static file serving.
 
@@ -41,6 +41,9 @@ data App = App
     -- ,appJournal :: Journal
     }
 
+-- 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://docs.yesodweb.com/book/web-routes-quasi/
@@ -65,14 +68,27 @@ mkYesodData "App" $(parseRoutesFile "routes")
 -- 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 = Hledger.Web.Settings.appRoot . settings
+    -- approot = Hledger.Web.Settings.appRoot . settings
+    approot = ApprootMaster $ appRoot . settings
 
     -- Place the session key file in the config folder
     encryptKey _ = fmap Just $ getKey "client_session_key.aes"
 
     defaultLayout widget = do
-        -- mmsg <- getMessage
+        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")
+
             widget
         --     addCassius $(cassiusFile "default-layout")
         -- hamletToRepHtml $(hamletFile "default-layout")
@@ -102,17 +118,13 @@ instance Yesod App where
     -- urlRenderOverride _ _ = Nothing
 
     messageLogger y loc level msg =
-      formatLogMessage loc level msg >>= logLazyText (getLogger y)
+      formatLogText (getLogger y) loc level msg >>= logMsg (getLogger y)
 
     -- 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 ext' _ content = do
-        let fn = base64md5 content ++ '.' : T.unpack ext'
-        let statictmp = Hledger.Web.Settings.staticDir ++ "/tmp/"
-        liftIO $ createDirectoryIfMissing True statictmp
-        let fn' = statictmp ++ fn
-        exists <- liftIO $ doesFileExist fn'
-        unless exists $ liftIO $ L.writeFile fn' content
-        return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])
+    addStaticContent = addStaticContentExternal (const $ Left ()) base64md5 Hledger.Web.Settings.staticDir (StaticR . flip StaticRoute [])
+
+    -- Place Javascript at bottom of the body tag so the rest of the page loads first
+    jsLoader _ = BottomOfBody

hledger-web/Hledger/Web/Handlers.hs

@@ -7,8 +7,9 @@ hledger-web's request handlers, and helpers.
 
 module Hledger.Web.Handlers where
 
+import Prelude
 import Control.Applicative ((<$>))
-import Data.Aeson
+-- import Data.Aeson
 import Data.ByteString (ByteString)
 import Data.Either (lefts,rights)
 import Data.List
@@ -25,7 +26,7 @@ import Text.Blaze (preEscapedString, toHtml)
 import Text.Hamlet hiding (hamletFile)
 import Text.Printf
 import Yesod.Core
-import Yesod.Json
+-- import Yesod.Json
 
 import Hledger hiding (today)
 import Hledger.Cli hiding (version)
@@ -34,14 +35,16 @@ import Hledger.Web.Options
 import Hledger.Web.Settings
 
 
-getFaviconR :: Handler ()
-getFaviconR = sendFile "image/x-icon" $ Hledger.Web.Settings.staticDir </> "favicon.ico"
+-- getFaviconR :: Handler ()
+-- getFaviconR = sendFile "image/x-icon" $ Hledger.Web.Settings.staticDir </> "favicon.ico"
 
-getRobotsR :: Handler RepPlain
-getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
+-- getRobotsR :: Handler RepPlain
+-- getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
 
 getRootR :: Handler RepHtml
-getRootR = redirect RedirectTemporary defaultroute where defaultroute = RegisterR
+getRootR = redirect defaultroute where defaultroute = RegisterR
+
+type AppRoute = Route App
 
 ----------------------------------------------------------------------
 -- main views:
@@ -165,6 +168,7 @@ getRegisterOnlyR = do
 
 ----------------------------------------------------------------------
 
+{-
 -- | A simple accounts view. This one is json-capable, returning the chart
 -- of accounts as json if the Accept header specifies json.
 getAccountsR :: Handler RepHtmlJson
@@ -183,6 +187,7 @@ getAccountsJsonR = do
   VD{..} <- getViewData
   let j' = filterJournalPostings2 m j
   jsonToRepJson $ jsonMap [("accounts", toJSON $ journalAccountNames j')]
+-}
 
 ----------------------------------------------------------------------
 -- view helpers
@@ -521,7 +526,7 @@ handleAdd = do
     -- setMessage $ toHtml $ (printf "Added transaction:\n%s" (show t') :: String)
     setMessage [$shamlet|<span>Added transaction:<small><pre>#{chomp $ show t'}</pre></small>|]
 
-  redirectParams RedirectTemporary RegisterR [("add","1")]
+  redirect (RegisterR, [("add","1")])
 
 chomp :: String -> String
 chomp = reverse . dropWhile (`elem` "\r\n") . reverse
@@ -548,7 +553,7 @@ handleEdit = do
   if not $ null errs
    then do
     setMessage $ toHtml (intercalate "; " errs :: String)
-    redirect RedirectTemporary JournalR
+    redirect JournalR
 
    else do
     -- try to avoid unnecessary backups or saving invalid data
@@ -559,24 +564,24 @@ handleEdit = do
     if not changed
      then do
        setMessage "No change"
-       redirect RedirectTemporary JournalR
+       redirect JournalR
      else do
       jE <- liftIO $ readJournal Nothing Nothing (Just journalpath) tnew
       either
        (\e -> do
           setMessage $ toHtml e
-          redirect RedirectTemporary JournalR)
+          redirect JournalR)
        (const $ do
           liftIO $ writeFileWithBackup journalpath tnew
           setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String)
-          redirect RedirectTemporary JournalR)
+          redirect JournalR)
        jE
 
 -- | Handle a post from the journal import form.
 handleImport :: Handler RepHtml
 handleImport = do
   setMessage "can't handle file upload yet"
-  redirect RedirectTemporary JournalR
+  redirect JournalR
   -- -- get form input values, or basic validation errors. E means an Either value.
   -- fileM <- runFormPost $ maybeFileInput "file"
   -- let fileE = maybe (Left "No file provided") Right fileM
@@ -584,11 +589,11 @@ handleImport = do
   -- case fileE of
   --  Left errs -> do
   --   setMessage errs
-  --   redirect RedirectTemporary JournalR
+  --   redirect JournalR
 
   --  Right s -> do
   --    setMessage s
-  --    redirect RedirectTemporary JournalR
+  --    redirect JournalR
 
 ----------------------------------------------------------------------
 -- | Other view components.

hledger-web/Hledger/Web/Import.hs

@@ -0,0 +1,19 @@
+module Hledger.Web.Import
+    ( module Prelude
+    , module Hledger.Web.Foundation
+    , (<>)
+    , 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)
+
+import Hledger.Web.Foundation
+
+infixr 5 <>
+(<>) :: Monoid m => m -> m -> m
+(<>) = mappend

hledger-web/Hledger/Web/Options.hs

@@ -5,6 +5,7 @@
 
 module Hledger.Web.Options
 where
+import Prelude
 import Data.Maybe
 import Distribution.PackageDescription.TH (packageVariable, package, pkgName, pkgVersion)
 import System.Console.CmdArgs

hledger-web/Hledger/Web/Settings.hs

@@ -7,17 +7,18 @@
 -- by overriding methods in the Yesod typeclass. That instance is
 -- declared in the hledger-web.hs file.
 module Hledger.Web.Settings
-    ( hamletFile
-    , cassiusFile
-    , juliusFile
-    , luciusFile
-    , widgetFile
+    ( widgetFile
     , staticRoot
     , staticDir
-    , loadConfig
-    , AppEnvironment(..)
-    , AppConfig(..)
+    , Extra (..)
+    , parseExtra
 
+    -- , hamletFile
+    -- , cassiusFile
+    -- , juliusFile
+    -- , luciusFile
+    -- , AppEnvironment(..)
+    -- , AppConfig(..)
     , defport
     , defbaseurl
     , hledgerorgurl
@@ -25,20 +26,26 @@ module Hledger.Web.Settings
 
     ) where
 
-import qualified Text.Hamlet as S
-import qualified Text.Cassius as S
-import qualified Text.Julius as S
-import qualified Text.Lucius as S
+import Prelude
+import Text.Shakespeare.Text (st)
+import Language.Haskell.TH.Syntax
+import Yesod.Default.Config
+import qualified Yesod.Default.Util
+import Data.Text (Text)
+import Data.Yaml
+import Control.Applicative
+
+-- import qualified Text.Hamlet as S
+-- import qualified Text.Cassius as S
+-- import qualified Text.Julius as S
+-- import qualified Text.Lucius as S
 import Text.Printf
 import qualified Text.Shakespeare.Text as S
 import Text.Shakespeare.Text (st)
-import Language.Haskell.TH.Syntax
 import Yesod.Widget (addWidget, addCassius, addJulius, addLucius, whamletFile)
 import Data.Monoid (mempty)
 import System.Directory (doesFileExist)
-import Data.Text (Text, pack)
-import Data.Object
-import qualified Data.Object.Yaml as YAML
+import Data.Text (pack)
 import Control.Monad (join)
 
 
@@ -54,54 +61,8 @@ defbaseurl :: Int -> String
 defbaseurl port = printf "http://localhost:%d" port
 
 
-data AppEnvironment = Test
-                    | Development
-                    | Staging
-                    | Production
-                    deriving (Eq, Show, Read, Enum, Bounded)
-
 -- | 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).
---
--- By convention these settings should be overwritten by any command line arguments.
--- See config/App.hs for command line arguments
--- Command line arguments provide some convenience but are also required for hosting situations where a setting is read from the environment (appPort on Heroku).
---
-data AppConfig = AppConfig {
-    appEnv :: AppEnvironment
-
-  , appPort :: Int
-
-    -- The base URL for your application. This will usually be different for
-    -- development and production. Yesod automatically constructs URLs for you,
-    -- so this value must be accurate to create valid links.
-    -- Please note that there is no trailing slash.
-    --
-    -- You probably want to change this! If your domain name was "yesod.com",
-    -- you would probably want it to be:
-    -- > "http://yesod.com"
-  , appRoot :: Text
-} deriving (Show)
-
-loadConfig :: AppEnvironment -> IO AppConfig
-loadConfig env = do
-    allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping
-    settings <- lookupMapping (show env) allSettings
-    hostS <- lookupScalar "host" settings
-    port <- fmap read $ lookupScalar "port" settings
-    return $ AppConfig {
-      appEnv = env
-    , appPort = port
-    , appRoot = pack $ hostS ++ addPort port
-    }
-    where
-        addPort :: Int -> String
-#ifdef PRODUCTION
-        addPort _ = ""
-#else
-        addPort p = ":" ++ (show p)
-#endif
-
 -- | 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
@@ -120,9 +81,27 @@ staticDir = "static"
 -- have to make a corresponding change here.
 --
 -- To see how this value is used, see urlRenderOverride in hledger-web.hs
-staticRoot :: AppConfig ->  Text
-staticRoot conf = [$st|#{appRoot conf}/static|]
+staticRoot :: AppConfig DefaultEnv a ->  Text
+staticRoot conf = [st|#{appRoot conf}/static|]
 
+widgetFile :: String -> Q Exp
+#if DEVELOPMENT
+widgetFile = Yesod.Default.Util.widgetFileReload
+#else
+widgetFile = Yesod.Default.Util.widgetFileNoReload
+#endif
+
+data Extra = Extra
+    { extraCopyright :: Text
+    , extraAnalytics :: Maybe Text -- ^ Google Analytics
+    }
+
+parseExtra :: DefaultEnv -> Object -> Parser Extra
+parseExtra _ o = Extra
+    <$> o .:  "copyright"
+    <*> o .:? "analytics"
+
+{-
 -- The rest of this file contains settings which rarely need changing by a
 -- user.
 
@@ -190,3 +169,4 @@ widgetFile x = do
     whenExists tofn f = do
         e <- qRunIO $ doesFileExist $ tofn x
         if e then f x else [|mempty|]
+-}

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

@@ -1,4 +1,4 @@
-{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, CPP #-}
 {-| 
 
 This module exports routes for all the files in the static directory at
@@ -11,8 +11,23 @@ This is a separate module to satisfy template haskell requirements.
 -}
 module Hledger.Web.Settings.StaticFiles where
 
+import Prelude (IO)
 import Yesod.Static
+import qualified Yesod.Static as Static
 
 import Hledger.Web.Settings (staticDir)
 
+-- | use this to create your static file serving site
+staticSite :: IO Static.Static
+staticSite =
+#ifdef DEVELOPMENT
+  Static.staticDevel staticDir
+#else
+  Static.static 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.
 $(staticFiles staticDir)

hledger-web/hledger-web.cabal

@@ -1,5 +1,5 @@
 name:           hledger-web
-version: 0.17.1
+version: 0.17.98
 category:       Finance
 synopsis:       A web interface for the hledger accounting tool.
 description:    
@@ -39,90 +39,128 @@ source-repository head
   type:     darcs
   location: http://joyful.com/repos/hledger
 
-Flag production
-    Description:   Build fully optimised and with web files embedded (not loaded from ./static/)
-    Default:       True
+-- Flag production
+--     Description:   Build fully optimised and with web files embedded (not loaded from ./static/)
+--     Default:       True
 
 flag threaded
-    Description:   Build with support for multithreaded execution
+    Description:   Build with support for multithreaded execution.
     Default:       True
 
-Flag devel
-    Description:   Build for auto-recompiling by "yesod devel"
+flag dev
+    Description:   Turn on development settings, like auto-reload templates.
     Default:       False
 
-executable hledger-web
-  main-is:        hledger-web.hs
-  if flag(devel)
-      Buildable: False
-  if flag(production)
-      cpp-options:   -DPRODUCTION
-      ghc-options:   -O2
-  else
-      ghc-options:   -Wall
-  if flag(threaded)
-      ghc-options:   -threaded
-  other-modules:
-                     Hledger.Web
-                     Hledger.Web.Foundation
-                     Hledger.Web.Application
-                     Hledger.Web.Options
-                     Hledger.Web.Settings
-                     Hledger.Web.Settings.StaticFiles
-                     Hledger.Web.Handlers
-  build-depends:
-                  hledger == 0.17
-                 ,hledger-lib == 0.17
-                 ,HUnit
-                 ,base >= 4 && < 5
-                 ,bytestring
-                 ,cabal-file-th
-                 ,cmdargs >= 0.9.1   && < 0.10
-                 ,directory
-                 ,filepath
-                 ,old-locale
-                 ,parsec
-                 ,regexpr >= 0.5.1
-                 ,safe >= 0.2
-                 ,text
-                 ,time
-                 ,io-storage >= 0.3 && < 0.4
-                 ,failure >= 0.1 && < 0.2
-                 ,file-embed == 0.0.*
-                 ,template-haskell >= 2.4 && < 2.8
-
-                 ,yesod == 0.9.4.1
-                 ,yesod-core
-                 ,yesod-form
-                 ,yesod-json
-                 ,yesod-static >= 0.3 && < 0.10
-                 ,aeson >= 0.3.2.13
-                 ,blaze-html
-                 ,clientsession
-                 ,data-object
-                 ,data-object-yaml
-                 ,hamlet
-                 ,shakespeare-css
-                 ,shakespeare-js
-                 ,shakespeare-text
-                 ,transformers
-                 ,wai < 1.0
-                 ,wai-extra < 1.0
-                 ,warp < 1.0
-                 ,http-enumerator < 0.7.3
-                 ,tls-extra < 0.4.3
+flag library-only
+    Description:   Build for use with "yesod devel"
+    Default:       False
 
 library
-    if flag(devel)
+    if flag(library-only)
         Buildable: True
     else
         Buildable: False
+
+    if flag(threaded)
+        ghc-options:   -threaded
+
     exposed-modules: 
                      Hledger.Web.Application
     other-modules:
                      Hledger.Web
                      Hledger.Web.Foundation
+                     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
+    cpp-options:   -DDEVELOPMENT
+
+    extensions: TemplateHaskell
+                QuasiQuotes
+                OverloadedStrings
+                NoImplicitPrelude
+                CPP
+                OverloadedStrings
+                MultiParamTypeClasses
+                TypeFamilies
+
+executable         hledger-web
+    if flag(library-only)
+        Buildable: False
+
+    if flag(dev)
+        cpp-options:   -DDEVELOPMENT
+        ghc-options:   -Wall -O0 -fno-warn-unused-do-bind
+    else
+        ghc-options:   -Wall -O2 -fno-warn-unused-do-bind
+
+    if flag(threaded)
+        ghc-options:   -threaded
+
+    extensions: TemplateHaskell
+                QuasiQuotes
+                OverloadedStrings
+                NoImplicitPrelude
+                CPP
+                OverloadedStrings
+                MultiParamTypeClasses
+                TypeFamilies
+
+    main-is:       hledger-web.hs
+
+    other-modules:
+                     Hledger.Web
+                     Hledger.Web.Foundation
+                     Hledger.Web.Application
+                     Hledger.Web.Import
+                     Hledger.Web.Options
+                     Hledger.Web.Settings
+                     Hledger.Web.Settings.StaticFiles
+                     Hledger.Web.Handlers
+
+    build-depends:
+                   hledger == 0.17
+                 , hledger-lib == 0.17
+
+                 , cabal-file-th
+                 , cmdargs >= 0.9.1   && < 0.10
+                 , directory
+                 , filepath
+                 , HUnit
+                 , old-locale
+                 , parsec
+                 , regexpr >= 0.5.1
+                 , safe >= 0.2
+                 , time
+                 , io-storage >= 0.3 && < 0.4
+                 , file-embed == 0.0.*
+
+                 , base                          >= 4          && < 5
+                 , blaze-html                    >= 0.4.3.1    && < 0.5
+                 , yesod-core                    >= 0.10       && < 0.11
+                 , yesod-static                  >= 0.10       && < 0.11
+                 , yesod-default                 >= 0.6        && < 0.7
+                 , clientsession                 >= 0.7.3      && < 0.8
+                 , bytestring                    >= 0.9        && < 0.10
+                 , text                          >= 0.11       && < 0.12
+                 , template-haskell
+                 , hamlet                        >= 0.10       && < 0.11
+                 , shakespeare-text              >= 0.10       && < 0.11
+                 , wai                           >= 1.1        && < 1.2
+                 , wai-extra                     >= 1.1        && < 1.2
+                 , transformers                  >= 0.2        && < 0.3
+                 , monad-control                 >= 0.3        && < 0.4
+                 , yaml                          >= 0.5        && < 0.6
+                 , warp                          >= 1.1.0.1    && < 1.2
+
+
+  -- if flag(production)
+  --     cpp-options:   -DPRODUCTION
+  --     ghc-options:   -O2
+  -- else
+  --     ghc-options:   -Wall
+  -- if flag(threaded)
+  --     ghc-options:   -threaded

hledger-web/hledger-web.hs

@@ -1,31 +1,32 @@
 {-# LANGUAGE CPP #-}
 {-|
+
 hledger-web - a hledger add-on providing a web interface.
-Copyright (c) 2007-2011 Simon Michael <simon@joyful.com>
+Copyright (c) 2007-2012 Simon Michael <simon@joyful.com>
 Released under GPL version 3 or later.
+
 -}
 
 module Main
 where
 
--- import Control.Concurrent (forkIO, threadDelay)
+import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort)
+import Yesod.Default.Config
+import Yesod.Default.Main   (defaultMain)
+import Yesod.Logger (Logger, defaultDevelopmentLogger) --, logString)
+
+import Prelude hiding (putStrLn)
+-- -- import Control.Concurrent (forkIO, threadDelay)
 import Control.Monad
-import Data.Maybe
+-- import Data.Maybe
 import Data.Text(pack)
-import Network.Wai.Handler.Warp (run)
 import System.Exit
 import System.IO.Storage (withStore, putValue)
 import Text.Printf
-#ifndef PRODUCTION
-import Network.Wai.Middleware.Debug (debugHandle)
-import Yesod.Logger (logString, logLazyText, flushLogger, makeLogger)
-#else
-import Yesod.Logger (makeLogger)
-#endif
 
 import Hledger
 import Hledger.Cli hiding (progname,prognameandversion)
-import Prelude hiding (putStrLn)
+import Hledger.Web.Settings (parseExtra)
 import Hledger.Utils.UTF8IOCompat (putStrLn)
 import Hledger.Web
 
@@ -74,61 +75,19 @@ server baseurl port opts j = do
   withStore "hledger" $ do
     putValue "hledger" "journal" j
 
-    -- yesod main
-    logger <- makeLogger
-    -- args   <- cmdArgs argConfig
-    -- env    <- getAppEnv args
-    let env = Development
-    -- c <- loadConfig env
-    -- let c' = if port_ opts /= 0
-    --         then c{ appPort = port args }
-    --         else c
-    let c = AppConfig {
-              appEnv = env
+-- 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 {
+              appEnv = Development
             , appPort = port_ opts
             , appRoot = pack baseurl
             }
-#if PRODUCTION
-    withApp c logger opts $ run (appPort c)
-#else
-    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
-#endif
-
--- data ArgConfig = ArgConfig
---     { environment :: String
---     , port        :: Int
---     } deriving (Show, Data, Typeable)
-
--- argConfig :: ArgConfig
--- argConfig = ArgConfig
---     { environment = def 
---         &= help ("application environment, one of: " ++ (foldl1 (\a b -> a ++ ", " ++ b) environments))
---         &= typ "ENVIRONMENT"
---     , port = def
---         &= typ "PORT"
---     }
-
--- environments :: [String]
--- environments = map ((map toLower) . show) ([minBound..maxBound] :: [AppEnvironment])
-
--- | retrieve the -e environment option
--- getAppEnv :: ArgConfig -> IO AppEnvironment
--- getAppEnv cfg = do
---     let e = if environment cfg /= ""
---             then environment cfg
---             else
--- #if PRODUCTION
---                 "production"
--- #else
---                 "development"
--- #endif
---     return $ read $ capitalize e
-
---     where
---         capitalize [] = []
---         capitalize (x:xs) = toUpper x : map toLower xs
+    logger <- defaultDevelopmentLogger
+    app <- getApplication config logger
+    runSettings defaultSettings
+        { settingsPort = appPort config
+        } app

hledger-web/routes

@@ -6,5 +6,5 @@
 /journal/entries JournalEntriesR GET POST
 /journal/edit    JournalEditR    GET POST
 /register        RegisterR       GET POST
-/accounts        AccountsR       GET
-/api/accounts    AccountsJsonR   GET
+-- /accounts        AccountsR       GET
+-- /api/accounts    AccountsJsonR   GET