web: officially drop GHC 6.12 support, fix build warnings with 7.0, 7.2, 7.4

2012-03-29 23:24:48 +00:00 · 2012-03-29 23:24:48 +00:00 · 2912a11929
commit 2912a11929
parent 7f3b990394
8 changed files with 89 additions and 177 deletions
--- a/hledger-web/Hledger/Web/Application.hs
+++ b/hledger-web/Hledger/Web/Application.hs
@ -24,7 +24,7 @@ import Network.Wai (Application)
 import Hledger.Web.Foundation
 import Hledger.Web.Handlers
 import Hledger.Web.Options
-import Hledger.Web.Settings (parseExtra)
+import Hledger.Web.Settings (Extra(..), parseExtra)
 import Hledger.Web.Settings.StaticFiles (staticSite)

 -- This line actually creates our YesodSite instance. It is the second half
--- a/hledger-web/Hledger/Web/Foundation.hs
+++ b/hledger-web/Hledger/Web/Foundation.hs
@ -8,7 +8,6 @@ module Hledger.Web.Foundation
    , Handler
    , Widget
    , module Yesod.Core
-    , module Hledger.Web.Settings
    , liftIO
    ) where

@ -24,7 +23,7 @@ import Text.Hamlet

 import Hledger.Web.Options
 import qualified Hledger.Web.Settings
-import Hledger.Web.Settings (Extra (..), widgetFile)
+import Hledger.Web.Settings (Extra (..))
 import Hledger.Web.Settings.StaticFiles


@ -75,8 +74,8 @@ instance Yesod App where
    encryptKey _ = fmap Just $ getKey "client_session_key.aes"

    defaultLayout widget = do
-        master <- getYesod
-        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
@ -88,7 +87,7 @@ instance Yesod App where
        -- hamletToRepHtml $(hamletFile "templates/default-layout-wrapper.hamlet")
        pc <- widgetToPageContent $ do
          widget
-        hamletToRepHtml [$hamlet|
+        hamletToRepHtml [hamlet|
 !!!
 <html
 <head
--- a/hledger-web/Hledger/Web/Handlers.hs
+++ b/hledger-web/Hledger/Web/Handlers.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings, RecordWildCards  #-}
+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings, RecordWildCards #-}
 {-

 hledger-web's request handlers, and helpers.
@ -9,8 +9,6 @@ module Hledger.Web.Handlers where

 import Prelude
 import Control.Applicative ((<$>))
-- import Data.Aeson
-import Data.ByteString (ByteString)
 import Data.Either (lefts,rights)
 import Data.List
 import Data.Maybe
@ -19,7 +17,7 @@ import qualified Data.Text (null)
 import Data.Time.Calendar
 import Data.Time.Clock
 import Data.Time.Format
-import System.FilePath (takeFileName, (</>))
+import System.FilePath (takeFileName)
 import System.IO.Storage (putValue, getValue)
 import System.Locale (defaultTimeLocale)
 import Text.Blaze (preEscapedString, toHtml)
@ -28,7 +26,7 @@ import Text.Printf
 import Yesod.Core
 -- import Yesod.Json

-import Hledger hiding (today)
+import Hledger hiding (today,subs,is,d)
 import Hledger.Cli hiding (version)
 import Hledger.Web.Foundation
 import Hledger.Web.Options
@ -60,15 +58,15 @@ getJournalR = do
      filtering = m /= Any
      -- showlastcolumn = if injournal && not filtering then False else True
      title = case inacct of
-                Nothing       -> "Journal"++filter
-                Just (a,subs) -> "Transactions in "++a++andsubs++filter
-                                  where andsubs = if subs then " (and subaccounts)" else ""
+                Nothing       -> "Journal"++s2
+                Just (a,subs) -> "Transactions in "++a++s1++s2
+                                  where s1 = if subs then " (and subaccounts)" else ""
                where
-                  filter = if filtering then ", filtered" else ""
+                  s2 = if filtering then ", filtered" else ""
      maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
  defaultLayout $ do
      setTitle "hledger-web journal"
-      addHamlet [$hamlet|
+      addHamlet [hamlet|
 ^{topbar vd}
 <div#content
 <div#sidebar
@ -101,7 +99,7 @@ getJournalEntriesR = do
      maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j
  defaultLayout $ do
      setTitle "hledger-web journal"
-      addHamlet [$hamlet|
+      addHamlet [hamlet|
 ^{topbar vd}
 <div#content
 <div#sidebar
@ -133,15 +131,15 @@ getRegisterR = do
  let sidecontent = sidebar vd
      -- injournal = isNothing inacct
      filtering = m /= Any
-      title = "Transactions in "++a++andsubs++filter
+      title = "Transactions in "++a++s1++s2
               where
                 (a,subs) = fromMaybe ("all accounts",False) $ inAccount qopts
-                 andsubs = if subs then " (and subaccounts)" else ""
-                 filter = if filtering then ", filtered" else ""
+                 s1 = if subs then " (and subaccounts)" else ""
+                 s2 = if filtering then ", filtered" else ""
      maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
  defaultLayout $ do
      setTitle "hledger-web register"
-      addHamlet [$hamlet|
+      addHamlet [hamlet|
 ^{topbar vd}
 <div#content
 <div#sidebar
@ -199,7 +197,7 @@ sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport2 (reportopts_
 -- | Render a "AccountsReport" as HTML.
 accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> HtmlUrl AppRoute
 accountsReportAsHtml _ vd@VD{..} (items',total) =
- [$hamlet|
+ [hamlet|
 <div#accountsheading
 <a#accounts-toggle-link.togglelink href="#" title="Toggle sidebar">[+]
 <div#accounts
@ -241,7 +239,7 @@ accountsReportAsHtml _ vd@VD{..} (items',total) =
   allaccts = isNothing inacctmatcher
   items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
   itemAsHtml :: ViewData -> AccountsReportItem -> HtmlUrl AppRoute
-   itemAsHtml _ (acct, adisplay, aindent, abal) = [$hamlet|
+   itemAsHtml _ (acct, adisplay, aindent, abal) = [hamlet|
 <tr.item.#{inacctclass}
 <td.account.#{depthclass}
  #{indent}
@ -262,7 +260,7 @@ accountsReportAsHtml _ vd@VD{..} (items',total) =
       numpostings = length $ apostings $ ledgerAccount l acct
       depthclass = "depth"++show aindent
       inacctclass = case inacctmatcher of
-                       Just m -> if m `matchesAccount` acct then "inacct" else "notinacct"
+                       Just m' -> if m' `matchesAccount` acct then "inacct" else "notinacct"
                       Nothing -> "" :: String
       indent = preEscapedString $ concat $ replicate (2 * (1+aindent)) "&nbsp;"
       acctquery = (RegisterR, [("q", pack $ accountQuery acct)])
@ -274,19 +272,19 @@ accountQuery a = "inacct:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
 accountOnlyQuery :: AccountName -> String
 accountOnlyQuery a = "inacctonly:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)

-- accountUrl :: AppRoute -> AccountName -> (AppRoute,[(String,ByteString)])
-accountUrl r a = (r, [("q",pack $ accountQuery a)])
+accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)])
+accountUrl r a = (r, [("q", pack $ accountQuery a)])

 -- | Render a "EntriesReport" as HTML for the journal entries view.
 entriesReportAsHtml :: WebOpts -> ViewData -> EntriesReport -> HtmlUrl AppRoute
-entriesReportAsHtml _ vd items = [$hamlet|
+entriesReportAsHtml _ vd items = [hamlet|
 <table.journalreport>
 $forall i <- numbered items
  ^{itemAsHtml vd i}
 |]
 where
   itemAsHtml :: ViewData -> (Int, EntriesReportItem) -> HtmlUrl AppRoute
-   itemAsHtml _ (n, t) = [$hamlet|
+   itemAsHtml _ (n, t) = [hamlet|
 <tr.item.#{evenodd}>
 <td.transaction>
  <pre>#{txn}
@ -297,7 +295,7 @@ entriesReportAsHtml _ vd items = [$hamlet|

 -- | Render an "TransactionsReport" as HTML for the formatted journal view.
 journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
-journalTransactionsReportAsHtml _ vd (_,items) = [$hamlet|
+journalTransactionsReportAsHtml _ vd (_,items) = [hamlet|
 <table.journalreport
 <tr.headings
  <th.date align=left>Date
@ -310,19 +308,19 @@ journalTransactionsReportAsHtml _ vd (_,items) = [$hamlet|
 where
 -- .#{datetransition}
   itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
-   itemAsHtml VD{..} (n, _, _, _, (t, _, split, _, amt, _)) = [$hamlet|
+   itemAsHtml VD{..} (n, _, _, _, (t, _, split, _, amt, _)) = [hamlet|
 <tr.item.#{evenodd}.#{firstposting}
 <td.date>#{date}
 <td.description colspan=2 title="#{show t}">#{elideRight 60 desc}
 <td.amount align=right>
  $if showamt
   #{mixedAmountAsHtml amt}
-$forall p <- tpostings t
+$forall p' <- tpostings t
  <tr.item.#{evenodd}.posting
   <td.date
   <td.description
-   <td.account>&nbsp;<a href="@?{accountUrl here $ paccount p}" title="Show transactions in #{paccount p}">#{elideRight 40 $ paccount p}
-   <td.amount align=right>#{mixedAmountAsHtml $ pamount p}
+   <td.account>&nbsp;<a href="@?{accountUrl here $ paccount p'}" title="Show transactions in #{paccount p'}">#{elideRight 40 $ paccount p'}
+   <td.amount align=right>#{mixedAmountAsHtml $ pamount p'}
 |]
     where
       evenodd = if even n then "even" else "odd" :: String
@ -335,14 +333,14 @@ $forall p <- tpostings t

 -- Generate html for an account register, including a balance chart and transaction list.
 registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
-registerReportHtml opts vd r@(_,items) = [$hamlet|
+registerReportHtml opts vd r@(_,items) = [hamlet|
 ^{registerChartHtml items}
 ^{registerItemsHtml opts vd r}
 |]

 -- Generate html for a transaction list from an "TransactionsReport".
 registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
-registerItemsHtml _ vd (balancelabel,items) = [$hamlet|
+registerItemsHtml _ vd (balancelabel,items) = [hamlet|
 <table.registerreport
 <tr.headings
  <th.date align=left>Date
@ -360,7 +358,7 @@ registerItemsHtml _ vd (balancelabel,items) = [$hamlet|
   -- inacct = inAccount qopts
   -- filtering = m /= Any
   itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
-   itemAsHtml VD{..} (n, newd, newm, _, (t, _, split, acct, amt, bal)) = [$hamlet|
+   itemAsHtml VD{..} (n, newd, newm, _, (t, _, split, acct, amt, bal)) = [hamlet|
 <tr.item.#{evenodd}.#{firstposting}.#{datetransition}
 <td.date>#{date}
 <td.description title="#{show t}">#{elideRight 30 desc}
@ -374,12 +372,12 @@ registerItemsHtml _ vd (balancelabel,items) = [$hamlet|
  $if showamt
   #{mixedAmountAsHtml amt}
 <td.balance align=right>#{mixedAmountAsHtml bal}
-$forall p <- tpostings t
+$forall p' <- tpostings t
 <tr.item.#{evenodd}.posting style=#{postingsdisplaystyle}
   <td.date
   <td.description
-   <td.account>&nbsp;<a href="@?{accountUrl here $ paccount p}" title="Show transactions in #{paccount p}">#{elideRight 40 $ paccount p}
-   <td.amount align=right>#{mixedAmountAsHtml $ pamount p}
+   <td.account>&nbsp;<a href="@?{accountUrl here $ paccount p'}" title="Show transactions in #{paccount p'}">#{elideRight 40 $ paccount p'}
+   <td.amount align=right>#{mixedAmountAsHtml $ pamount p'}
   <td.balance align=right>
 |]
     where
@ -394,10 +392,15 @@ $forall p <- tpostings t

 -- | Generate javascript/html for a register balance line chart based on
 -- the provided "TransactionsReportItem"s.
+               -- registerChartHtml :: forall t (t1 :: * -> *) t2 t3 t4 t5.
+               --                      Data.Foldable.Foldable t1 =>
+               --                      t1 (Transaction, t2, t3, t4, t5, MixedAmount)
+               --                      -> t -> Text.Blaze.Internal.HtmlM ()
+registerChartHtml :: [TransactionsReportItem] -> HtmlUrl AppRoute
 registerChartHtml items =
 -- have to make sure plot is not called when our container (maincontent)
 -- is hidden, eg with add form toggled
- [$hamlet|
+ [hamlet|
 <script type=text/javascript>
 if (document.getElementById('maincontent').style.display != 'none')
  \$(document).ready(function() {
@ -425,7 +428,7 @@ stringIfLongerThan n s = if length s > n then s else ""

 numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
 numberTransactionsReportItems [] = []
-numberTransactionsReportItems is = number 0 nulldate is
+numberTransactionsReportItems items = number 0 nulldate items
  where
    number :: Int -> Day -> [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
    number _ _ [] = []
@ -437,6 +440,7 @@ numberTransactionsReportItems is = number 0 nulldate is
          (dy,dm,_) = toGregorian d
          (prevdy,prevdm,_) = toGregorian prevd

+mixedAmountAsHtml :: MixedAmount -> Html
 mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $ show b
    where addclass = printf "<span class=\"%s\">%s</span>" (c :: String)
          c = case isNegativeMixedAmount b of Just True -> "negative amount"
@ -511,12 +515,12 @@ handleAdd = do
                          })
  -- display errors or add transaction
  case tE of
-   Left errs -> do
+   Left errs' -> do
    -- save current form values in session
    -- setMessage $ toHtml $ intercalate "; " errs
-    setMessage [$shamlet|
+    setMessage [shamlet|
                 Errors:<br>
-                 $forall e<-errs
+                 $forall e<-errs'
                  #{e}<br>
               |]
   Right t -> do
@ -524,7 +528,7 @@ handleAdd = do
    liftIO $ do ensureJournalFileExists journalpath
                appendToJournalFileOrStdout journalpath $ showTransaction t'
    -- setMessage $ toHtml $ (printf "Added transaction:\n%s" (show t') :: String)
-    setMessage [$shamlet|<span>Added transaction:<small><pre>#{chomp $ show t'}</pre></small>|]
+    setMessage [shamlet|<span>Added transaction:<small><pre>#{chomp $ show t'}</pre></small>|]

  redirect (RegisterR, [("add","1")])

@ -600,7 +604,7 @@ handleImport = do

 -- | Global toolbar/heading area.
 topbar :: ViewData -> HtmlUrl AppRoute
-topbar VD{..} = [$hamlet|
+topbar VD{..} = [hamlet|
 <div#topbar
 <a.topleftlink href=#{hledgerorgurl} title="More about hledger"
  hledger-web
@ -608,24 +612,24 @@ topbar VD{..} = [$hamlet|
  #{version}
 <a.toprightlink href=#{manualurl} target=hledgerhelp title="User manual">manual
 <h1>#{title}
-$maybe m <- msg
- <div#message>#{m}
+$maybe m' <- msg
+ <div#message>#{m'}
 |]
  where
    title = takeFileName $ journalFilePath j

 -- | Navigation link, preserving parameters and possibly highlighted.
 navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute
-navlink VD{..} s dest title = [$hamlet|
-<a##{s}link.#{style} href=@?{u} title="#{title}">#{s}
+navlink VD{..} s dest title = [hamlet|
+<a##{s}link.#{style} href=@?{u'} title="#{title}">#{s}
 |]
-  where u = (dest, if null q then [] else [("q", pack q)])
+  where u' = (dest, if null q then [] else [("q", pack q)])
        style | dest == here = "navlinkcurrent"
              | otherwise    = "navlink" :: Text

 -- | Links to the various journal editing forms.
 editlinks :: HtmlUrl AppRoute
-editlinks = [$hamlet|
+editlinks = [hamlet|
 <a#editformlink href="#" onclick="return editformToggle(event)" title="Toggle journal edit form">edit
 \ | #
 <a#addformlink href="#" onclick="return addformToggle(event)" title="Toggle transaction add form">add
@ -634,14 +638,14 @@ editlinks = [$hamlet|

 -- | Link to a topic in the manual.
 helplink :: String -> String -> HtmlUrl AppRoute
-helplink topic label = [$hamlet|
+helplink topic label = [hamlet|
 <a href=#{u} target=hledgerhelp>#{label}
 |]
    where u = manualurl ++ if null topic then "" else '#':topic

 -- | Search form for entering custom queries to filter journal data.
 searchform :: ViewData -> HtmlUrl AppRoute
-searchform VD{..} = [$hamlet|
+searchform VD{..} = [hamlet|
 <div#searchformdiv
 <form#searchform.form method=GET
  <table
@ -682,7 +686,7 @@ searchform VD{..} = [$hamlet|

 -- | Add transaction form.
 addform :: ViewData -> HtmlUrl AppRoute
-addform vd@VD{..} = [$hamlet|
+addform vd@VD{..} = [hamlet|
 <script type=text/javascript>
 \$(document).ready(function() {
    /* dhtmlxcombo setup */
@ -743,7 +747,8 @@ addform vd@VD{..} = [$hamlet|
  date = "today" :: String
  descriptions = sort $ nub $ map tdescription $ jtxns j
  manyfiles = (length $ files j) > 1
-  postingfields VD{..} n = [$hamlet|
+  postingfields :: ViewData -> Int -> HtmlUrl AppRoute
+  postingfields _ n = [hamlet|
 <tr#postingrow
 <td align=right>#{acctlabel}:
 <td
@ -762,14 +767,14 @@ addform vd@VD{..} = [$hamlet|
 |]
   where
    shouldselect a = n == 2 && maybe False ((a==).fst) (inAccount qopts)
-    numbered = (++ show n)
-    acctvar = numbered "account"
-    amtvar = numbered "amount"
+    withnumber = (++ show n)
+    acctvar = withnumber "account"
+    amtvar = withnumber "amount"
    acctnames = sort $ journalAccountNamesUsed j
    (acctlabel, accthelp, amtfield, amthelp)
       | n == 1     = ("To account"
                     ,"eg: expenses:food"
-                     ,[$hamlet|
+                     ,[hamlet|
 <td style=padding-left:1em;
 Amount:
 <td
@ -785,7 +790,7 @@ addform vd@VD{..} = [$hamlet|

 -- | Edit journal form.
 editform :: ViewData -> HtmlUrl AppRoute
-editform VD{..} = [$hamlet|
+editform VD{..} = [hamlet|
 <form#editform method=POST style=display:none;
 <h2#contenttitle>#{title}
 <table.form
@ -817,7 +822,7 @@ editform VD{..} = [$hamlet|

 -- | Import journal form.
 importform :: HtmlUrl AppRoute
-importform = [$hamlet|
+importform = [hamlet|
 <form#importform method=POST style=display:none;
 <table.form
  <tr
@ -830,14 +835,14 @@ importform = [$hamlet|
 |]

 journalselect :: [(FilePath,String)] -> HtmlUrl AppRoute
-journalselect journalfiles = [$hamlet|
+journalselect journalfiles = [hamlet|
 <select id=journalselect name=journal onchange="editformJournalSelect(event)"
 $forall f <- journalfiles
  <option value=#{fst f}>#{fst f}
 |]

 nulltemplate :: HtmlUrl AppRoute
-nulltemplate = [$hamlet||]
+nulltemplate = [hamlet||]

 ----------------------------------------------------------------------
 -- utilities
@ -925,6 +930,7 @@ getMessageOr mnewmsg = do
  oldmsg <- getMessage
  return $ maybe oldmsg (Just . toHtml) mnewmsg

+numbered :: [a] -> [(Int,a)]
 numbered = zip [1..]

 dayToJsTimestamp :: Day -> Integer
--- a/hledger-web/Hledger/Web/Import.hs
+++ b/hledger-web/Hledger/Web/Import.hs
@ -1,6 +1,5 @@
 module Hledger.Web.Import
    ( module Prelude
-    , module Hledger.Web.Foundation
    , (<>)
    , Text
    , module Data.Monoid
@ -12,8 +11,6 @@ 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
--- a/hledger-web/Hledger/Web/Options.hs
+++ b/hledger-web/Hledger/Web/Options.hs
@ -22,15 +22,19 @@ version  = ""
 progname = $(packageVariable (pkgName . package))
 version  = $(packageVariable (pkgVersion . package))
 #endif
+prognameandversion :: String
 prognameandversion = progname ++ " " ++ version :: String

+defbaseurlexample :: String
 defbaseurlexample = (reverse $ drop 4 $ reverse $ defbaseurl defport) ++ "PORT"

+webflags :: [Flag [([Char], [Char])]]
 webflags = [
  flagReq ["base-url"]  (\s opts -> Right $ setopt "base-url" s opts) "URL" ("set the base url (default: "++defbaseurlexample++")")
 ,flagReq ["port"]  (\s opts -> Right $ setopt "port" s opts) "PORT" ("listen on this tcp port (default: "++show defport++")")
 ]
 
+webmode :: Mode [([Char], [Char])]
 webmode =  (mode "hledger-web" [("command","web")]
            "start serving the hledger web interface"
            mainargsflag []){
@ -51,6 +55,7 @@ data WebOpts = WebOpts {
    ,cliopts_  :: CliOpts
 } deriving (Show)

+defwebopts :: WebOpts
 defwebopts = WebOpts
    def
    def
--- a/hledger-web/Hledger/Web/Settings.hs
+++ b/hledger-web/Hledger/Web/Settings.hs
@ -1,6 +1,4 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE TemplateHaskell, QuasiQuotes  #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# 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
@ -12,41 +10,21 @@ module Hledger.Web.Settings
    , staticDir
    , Extra (..)
    , parseExtra
-
-    -- , hamletFile
-    -- , cassiusFile
-    -- , juliusFile
-    -- , luciusFile
-    -- , AppEnvironment(..)
-    -- , AppConfig(..)
    , defport
    , defbaseurl
    , hledgerorgurl
    , manualurl
-
    ) where

-import Prelude
-import Text.Shakespeare.Text (st)
-import Language.Haskell.TH.Syntax
-import Yesod.Default.Config
-import qualified Yesod.Default.Util
+import Control.Applicative
 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 Language.Haskell.TH.Syntax
+import Prelude
 import Text.Printf
-import qualified Text.Shakespeare.Text as S
 import Text.Shakespeare.Text (st)
-import Yesod.Widget (addWidget, addCassius, addJulius, addLucius, whamletFile)
-import Data.Monoid (mempty)
-import System.Directory (doesFileExist)
-import Data.Text (pack)
-import Control.Monad (join)
+import Yesod.Default.Config
+import qualified Yesod.Default.Util


 hledgerorgurl, manualurl :: String
@ -100,73 +78,3 @@ 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.
-
-- The following functions are used for calling HTML, CSS,
-- Javascript, and plain text templates from your Haskell code. During development,
-- the "Debug" versions of these functions are used so that changes to
-- the templates are immediately reflected in an already running
-- application. When making a production compile, the non-debug version
-- is used for increased performance.
--
-- You can see an example of how to call these functions in Handler/Root.hs
--
-- Note: due to polymorphic Hamlet templates, hamletFileDebug is no longer
-- used; to get the same auto-loading effect, it is recommended that you
-- use the devel server.
-
-- | expects a root folder for each type, e.g: hamlet/ lucius/ julius/
-globFile :: String -> String -> FilePath
-- globFile kind x = kind ++ "/" ++ x ++ "." ++ kind
-globFile kind x = "templates/" ++ x ++ "." ++ kind
-
-hamletFile :: FilePath -> Q Exp
-hamletFile = S.hamletFile . globFile "hamlet"
-
-cassiusFile :: FilePath -> Q Exp
-cassiusFile =
-#ifdef PRODUCTION
-  S.cassiusFile . globFile "cassius"
-#else
-  S.cassiusFileDebug . globFile "cassius"
-#endif
-
-luciusFile :: FilePath -> Q Exp
-luciusFile =
-#ifdef PRODUCTION
-  S.luciusFile . globFile "lucius"
-#else
-  S.luciusFileDebug . globFile "lucius"
-#endif
-
-juliusFile :: FilePath -> Q Exp
-juliusFile =
-#ifdef PRODUCTION
-  S.juliusFile . globFile "julius"
-#else
-  S.juliusFileDebug . globFile "julius"
-#endif
-
-textFile :: FilePath -> Q Exp
-textFile =
-#ifdef PRODUCTION
-  S.textFile . globFile "text"
-#else
-  S.textFileDebug . globFile "text"
-#endif
-
-widgetFile :: FilePath -> Q Exp
-widgetFile x = do
-    let h = whenExists (globFile "hamlet")  (whamletFile . globFile "hamlet")
-    let c = whenExists (globFile "cassius") cassiusFile
-    let j = whenExists (globFile "julius")  juliusFile
-    let l = whenExists (globFile "lucius")  luciusFile
-    [|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|]
-  where
-    whenExists tofn f = do
-        e <- qRunIO $ doesFileExist $ tofn x
-        if e then f x else [|mempty|]
-}
--- a/hledger-web/Hledger/Web/Settings/StaticFiles.hs
+++ b/hledger-web/Hledger/Web/Settings/StaticFiles.hs
@ -11,7 +11,6 @@ This is a separate module to satisfy template haskell requirements.
 -}
 module Hledger.Web.Settings.StaticFiles where

-import Prelude (IO)
 import System.IO
 import Yesod.Static
 import qualified Yesod.Static as Static
--- a/hledger-web/hledger-web.hs
+++ b/hledger-web/hledger-web.hs
@ -12,8 +12,8 @@ where

 import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort)
 import Yesod.Default.Config
-import Yesod.Default.Main   (defaultMain)
-import Yesod.Logger (Logger, defaultDevelopmentLogger) --, logString)
+-- import Yesod.Default.Main   (defaultMain)
+import Yesod.Logger ({- Logger,-} defaultDevelopmentLogger) --, logString)

 import Prelude hiding (putStrLn)
 -- -- import Control.Concurrent (forkIO, threadDelay)
@ -26,9 +26,8 @@ import Text.Printf

 import Hledger
 import Hledger.Cli hiding (progname,prognameandversion)
-import Hledger.Web.Settings (parseExtra)
 import Hledger.Utils.UTF8IOCompat (putStrLn)
-import Hledger.Web
+import Hledger.Web hiding (opts,j)


 main :: IO ()
@ -38,13 +37,11 @@ main = do
  runWith opts

 runWith :: WebOpts -> IO ()
-runWith opts = run opts
-    where
-      run 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) >>= ensureJournalFileExists >> withJournalDo' opts web
+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) >>= ensureJournalFileExists >> withJournalDo' opts web

 withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO ()
 withJournalDo' opts cmd = do
@ -85,6 +82,7 @@ server baseurl port opts j = do
              appEnv = Development
            , appPort = port_ opts
            , appRoot = pack baseurl
+            , appExtra = Extra "" Nothing
            }
    logger <- defaultDevelopmentLogger
    app <- getApplication config logger