diff --git a/hledger-web/Hledger/Web/Foundation.hs b/hledger-web/Hledger/Web/Foundation.hs index 15e360b1b..20534f536 100644 --- a/hledger-web/Hledger/Web/Foundation.hs +++ b/hledger-web/Hledger/Web/Foundation.hs @@ -1,8 +1,15 @@ {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings #-} +{- + +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 @@ -26,46 +33,25 @@ import qualified Hledger.Web.Settings import Hledger.Web.Settings (Extra (..)) 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. +-- | 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 + , appOpts :: WebOpts + -- , appJournal :: Journal } --- Set up i18n messages. See the message folder. +-- Set up i18n messages. -- 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/ --- --- 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. +-- The web application's routes (urls). 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. +-- | 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 diff --git a/hledger-web/Hledger/Web/Handlers.hs b/hledger-web/Hledger/Web/Handlers.hs index 4be351c6e..ad9807074 100644 --- a/hledger-web/Hledger/Web/Handlers.hs +++ b/hledger-web/Hledger/Web/Handlers.hs @@ -5,7 +5,39 @@ hledger-web's request handlers, and helpers. -} -module Hledger.Web.Handlers where +module Hledger.Web.Handlers +( + -- * GET handlers + getRootR, + getJournalR, + getJournalEntriesR, + getJournalEditR, + getRegisterR, + -- ** helpers + -- sidebar, + -- accountsReportAsHtml, + -- accountQuery, + -- accountOnlyQuery, + -- accountUrl, + -- entriesReportAsHtml, + -- journalTransactionsReportAsHtml, + -- registerReportHtml, + -- registerItemsHtml, + -- registerChartHtml, + -- stringIfLongerThan, + -- numberTransactionsReportItems, + -- mixedAmountAsHtml, + -- * POST handlers + postJournalR, + postJournalEntriesR, + postJournalEditR, + postRegisterR, + -- * Common page components + -- * Utilities + ViewData(..), + nullviewdata, +) +where import Prelude import Control.Applicative ((<$>)) @@ -32,21 +64,24 @@ import Hledger.Web.Foundation import Hledger.Web.Options import Hledger.Web.Settings +-- routes: +-- /static StaticR Static getStatic +-- -- /favicon.ico FaviconR GET +-- /robots.txt RobotsR GET +-- / RootR GET +-- /journal JournalR GET POST +-- /journal/entries JournalEntriesR GET POST +-- /journal/edit JournalEditR GET POST +-- /register RegisterR GET POST +-- -- /accounts AccountsR GET +-- -- /api/accounts AccountsJsonR GET --- getFaviconR :: Handler () --- getFaviconR = sendFile "image/x-icon" $ Hledger.Web.Settings.staticDir "favicon.ico" - --- getRobotsR :: Handler RepPlain --- getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString) +---------------------------------------------------------------------- +-- GET handlers getRootR :: Handler RepHtml getRootR = redirect defaultroute where defaultroute = RegisterR -type AppRoute = Route App - ----------------------------------------------------------------------- --- main views: - -- | The formatted journal view, with sidebar. getJournalR :: Handler RepHtml getJournalR = do @@ -81,14 +116,6 @@ getJournalR = do ^{importform} |] --- | The journal editform, no sidebar. -getJournalEditR :: Handler RepHtml -getJournalEditR = do - vd <- getViewData - defaultLayout $ do - setTitle "hledger-web journal edit form" - addHamlet $ editform vd - -- | The journal entries view, with sidebar. getJournalEntriesR :: Handler RepHtml getJournalEntriesR = do @@ -114,15 +141,21 @@ getJournalEntriesR = do ^{importform} |] --- | The journal entries view, no sidebar. -getJournalOnlyR :: Handler RepHtml -getJournalOnlyR = do - vd@VD{..} <- getViewData +-- | The journal editform, no sidebar. +getJournalEditR :: Handler RepHtml +getJournalEditR = do + vd <- getViewData defaultLayout $ do - setTitle "hledger-web journal only" - addHamlet $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j + setTitle "hledger-web journal edit form" + addHamlet $ editform vd ----------------------------------------------------------------------- +-- -- | The journal entries view, no sidebar. +-- getJournalOnlyR :: Handler RepHtml +-- getJournalOnlyR = do +-- vd@VD{..} <- getViewData +-- defaultLayout $ do +-- setTitle "hledger-web journal only" +-- addHamlet $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j -- | The main journal/account register view, with accounts sidebar. getRegisterR :: Handler RepHtml @@ -154,17 +187,15 @@ getRegisterR = do ^{importform} |] --- | The register view, no sidebar. -getRegisterOnlyR :: Handler RepHtml -getRegisterOnlyR = do - vd@VD{..} <- getViewData - defaultLayout $ do - setTitle "hledger-web register only" - addHamlet $ - 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 - ----------------------------------------------------------------------- +-- -- | The register view, no sidebar. +-- getRegisterOnlyR :: Handler RepHtml +-- getRegisterOnlyR = do +-- vd@VD{..} <- getViewData +-- defaultLayout $ do +-- setTitle "hledger-web register only" +-- addHamlet $ +-- 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 {- -- | A simple accounts view. This one is json-capable, returning the chart @@ -187,14 +218,13 @@ getAccountsJsonR = do jsonToRepJson $ jsonMap [("accounts", toJSON $ journalAccountNames j')] -} ----------------------------------------------------------------------- --- view helpers +-- helpers -- | Render the sidebar used on most views. sidebar :: ViewData -> HtmlUrl AppRoute sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j --- | Render a "AccountsReport" as HTML. +-- | Render an "AccountsReport" as html. accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> HtmlUrl AppRoute accountsReportAsHtml _ vd@VD{..} (items',total) = [hamlet| @@ -275,7 +305,7 @@ accountOnlyQuery a = "inacctonly:" ++ quoteIfSpaced a -- (accountNameToAccountRe accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)]) accountUrl r a = (r, [("q", pack $ accountQuery a)]) --- | Render a "EntriesReport" as HTML for the journal entries view. +-- | Render an "EntriesReport" as html for the journal entries view. entriesReportAsHtml :: WebOpts -> ViewData -> EntriesReport -> HtmlUrl AppRoute entriesReportAsHtml _ vd items = [hamlet| @@ -293,7 +323,7 @@ entriesReportAsHtml _ vd items = [hamlet| evenodd = if even n then "even" else "odd" :: String txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse --- | Render an "TransactionsReport" as HTML for the formatted journal view. +-- | Render a "TransactionsReport" as html for the formatted journal view. journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute journalTransactionsReportAsHtml _ vd (_,items) = [hamlet| String -> String -stringIfLongerThan n s = if length s > n then s else "" +-- stringIfLongerThan :: Int -> String -> String +-- stringIfLongerThan n s = if length s > n then s else "" numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)] numberTransactionsReportItems [] = [] @@ -447,7 +477,7 @@ mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "
" $ lines $ _ -> "positive amount" ------------------------------------------------------------------------------- --- post handlers +-- POST handlers postJournalR :: Handler RepHtml postJournalR = handlePost @@ -600,7 +630,7 @@ handleImport = do -- redirect JournalR ---------------------------------------------------------------------- --- | Other view components. +-- Common page components. -- | Global toolbar/heading area. topbar :: ViewData -> HtmlUrl AppRoute @@ -618,23 +648,23 @@ $maybe m' <- msg 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| -#{s} -|] - where u' = (dest, if null q then [] else [("q", pack q)]) - style | dest == here = "navlinkcurrent" - | otherwise = "navlink" :: Text +-- -- | Navigation link, preserving parameters and possibly highlighted. +-- navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute +-- navlink VD{..} s dest title = [hamlet| +-- #{s} +-- |] +-- 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| -edit -\ | # -add -import transactions -|] +-- -- | Links to the various journal editing forms. +-- editlinks :: HtmlUrl AppRoute +-- editlinks = [hamlet| +-- edit +-- \ | # +-- add +-- import transactions +-- |] -- | Link to a topic in the manual. helplink :: String -> String -> HtmlUrl AppRoute @@ -845,7 +875,7 @@ nulltemplate :: HtmlUrl AppRoute nulltemplate = [hamlet||] ---------------------------------------------------------------------- --- utilities +-- Utilities -- | A bundle of data useful for hledger-web request handlers and templates. data ViewData = VD {