slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: more yesod 0.8 migration; adopt the scaffolding app's layout, slightly simplified

Browse Source
This commit is contained in:
Simon Michael 2011-05-24 04:27:37 +00:00
parent 274d072c4d
commit dc6c3dec76
32 changed files with 803 additions and 957 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
hledger-web/.hledger/unused/addform.hamlet
View File

@ -1,47 +0,0 @@
%script!type=text/javascript
$$(document).ready(function() {
/* dhtmlxcombo setup */
window.dhx_globalImgPath="../static/";
var desccombo = new dhtmlXCombo("description");
var acct1combo = new dhtmlXCombo("account1");
var acct2combo = new dhtmlXCombo("account2");
desccombo.enableFilteringMode(true);
acct1combo.enableFilteringMode(true);
acct2combo.enableFilteringMode(true);
desccombo.setSize(300);
acct1combo.setSize(300);
acct2combo.setSize(300);
});
%form#addform!method=POST;
%table.form
%tr
%td!colspan=4
%table
%tr#descriptionrow
%td
Date:
%td
%input.textinput!size=15!name=date!value=$date$
%td!style=padding-left:1em;
Description:
%td
%select!id=description!name=description
%option
$forall descriptions d
%option!value=$d$ $d$
%tr.helprow
%td
%td
.help $datehelp$ $
%td
%td
.help $deschelp$
$postingfields1$
$postingfields2$
%tr#addbuttonrow
%td!colspan=4
%input!type=hidden!name=action!value=add
%input!type=submit!name=submit!value="add transaction"
$if manyfiles
\ to: ^journalselect.files^

15
hledger-web/.hledger/unused/addformpostingfields.hamlet
View File

@ -1,15 +0,0 @@
%tr#postingrow
%td!align=right $acctlabel$:
%td
%select!id=$acctvar$!name=$acctvar$
%option
$forall acctnames a
%option!value=$a$ $a$
$amtfield$
%tr.helprow
%td
%td
.help $accthelp$
%td
%td
.help $amthelp$

9
hledger-web/.hledger/unused/default-layout.hamlet
View File

@ -1,9 +0,0 @@
!!!
%html
%head
%title $pageTitle.pc$
^pageHead.pc^
%body
$maybe mmsg msg
#message $msg$
^pageBody.pc^

6
hledger-web/.hledger/unused/homepage.cassius
View File

@ -1,6 +0,0 @@
body
font-family: sans-serif
h1
text-align: center
h2#$h2id$
color: red

12
hledger-web/.hledger/unused/homepage.hamlet
View File

@ -1,12 +0,0 @@
%h1 Hello
%h2#$h2id$ You do not have Javascript enabled.
$maybe mu u
%p
You are logged in as $userIdent.snd.u$. $
%a!href=@AuthR.LogoutR@ Logout
\.
$nothing
%p
You are not logged in. $
%a!href=@AuthR.LoginR@ Login now
\.

3
hledger-web/.hledger/unused/homepage.julius
View File

@ -1,3 +0,0 @@
window.onload = function(){
document.getElementById("%h2id%").innerHTML = "<i>Added from JavaScript.</i>";
}

BIN
hledger-web/.hledger/web/favicon.ico
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.1 KiB

0
hledger-web/.hledger/web/combo_select.gif → hledger-web/.hledger/web/static/combo_select.gif
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 309 B

After

Width:  |  Height:  |  Size: 309 B

0
hledger-web/.hledger/web/dhtmlxcombo.js → hledger-web/.hledger/web/static/dhtmlxcombo.js
View File

0
hledger-web/.hledger/web/dhtmlxcommon.js → hledger-web/.hledger/web/static/dhtmlxcommon.js
View File

BIN
hledger-web/.hledger/web/static/favicon.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

0
hledger-web/.hledger/web/hledger.js → hledger-web/.hledger/web/static/hledger.js
View File

0
hledger-web/.hledger/web/jquery.js → hledger-web/.hledger/web/static/jquery.js vendored
View File

0
hledger-web/.hledger/web/jquery.url.js → hledger-web/.hledger/web/static/jquery.url.js
View File

7
hledger-web/.hledger/web/style.css → hledger-web/.hledger/web/static/style.css
View File

@ -1,3 +1,10 @@
/* LOCAL:
hledger-web executables built in this repo will include these local styles
when generating the web support files
*/
body { border-top: thin solid red; }
/* END LOCAL */
/* hledger web ui styles */
/*------------------------------------------------------------------------------------------*/

0
hledger-web/.hledger/unused/default-layout.cassius → hledger-web/.hledger/web/templates/default-layout.cassius
View File

9
hledger-web/.hledger/web/templates/default-layout.hamlet Normal file
View File

@ -0,0 +1,9 @@
!!!
<html
<head
<title>#{pageTitle pc}
^{pageHead pc}
<body
$maybe msg <- mmsg
<div #message>#{msg}
^{pageBody pc}

4
hledger-web/.hledger/web/templates/homepage.cassius Normal file
View File

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

2
hledger-web/.hledger/web/templates/homepage.hamlet Normal file
View File

@ -0,0 +1,2 @@
<h1>Hello
<h2 ##{h2id}>You could have Javascript enabled.

3
hledger-web/.hledger/web/templates/homepage.julius Normal file
View File

@ -0,0 +1,3 @@
window.onload = function(){
document.getElementById("#{h2id}").innerHTML = "<i>Added from JavaScript.</i>";
}

100
hledger-web/App.hs Normal file
View File

@ -0,0 +1,100 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
module App
( App (..)
, AppRoute (..)
, resourcesApp
, Handler
, Widget
, module Yesod.Core
, module Settings
, StaticRoute (..)
, lift
, liftIO
) where
import Yesod.Core
import Yesod.Helpers.Static
import qualified Settings
import System.Directory
import qualified Data.ByteString.Lazy as L
import Settings (hamletFile, cassiusFile, juliusFile, widgetFile)
import Control.Monad (unless)
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import Hledger.Cli.Options (Opt)
import Hledger.Data (Journal)
-- | 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
{getStatic :: Static -- ^ Settings for static file serving.
,appRoot :: T.Text
,appOpts :: [Opt]
,appArgs :: [String]
,appJournal :: Journal
}
-- | A useful synonym; most of the handler functions in your application
-- will need to be of this type.
type Handler = GHandler App App
-- | A useful synonym; most of the widgets functions in your application
-- will need to be of this type.
type Widget = GWidget App App
-- 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 Controller.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 "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 = appRoot
defaultLayout widget = do
mmsg <- getMessage
pc <- widgetToPageContent $ do
widget
addCassius $(Settings.cassiusFile "default-layout")
hamletToRepHtml $(Settings.hamletFile "default-layout")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticroot setting in Settings.hs
-- urlRenderOverride a (StaticR s) =
-- Just $ uncurry (joinPath a Settings.staticroot) $ renderRoute s
-- urlRenderOverride _ _ = Nothing
-- 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 = 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] [], [])

56
hledger-web/Controller.hs Normal file
View File

@ -0,0 +1,56 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Controller
( withApp
, withDevelApp
) where
import App
import Settings
import Yesod.Helpers.Static
import Data.ByteString (ByteString)
import Network.Wai (Application)
import Data.Dynamic (Dynamic, toDyn)
import System.FilePath ((</>))
-- Import all relevant handler modules here.
import Handlers
import Hledger.Data (nulljournal)
-- 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
-- Some default handlers that ship with the Yesod site template. You will
-- very rarely need to modify this.
getFaviconR :: Handler ()
getFaviconR = sendFile "image/x-icon" $ Settings.staticdir </> "favicon.ico"
getRobotsR :: Handler RepPlain
getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString)
-- 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 :: App -> (Application -> IO a) -> IO a
withApp a f = do
toWaiApp a >>= f
-- where
-- s = static Settings.staticdir
withDevelApp :: Dynamic
-- withDevelApp = undefined
withDevelApp = toDyn (withApp a :: (Application -> IO ()) -> IO ())
where a = App{
getStatic=static Settings.staticdir
,appRoot=Settings.defapproot
,appOpts=[]
,appArgs=[]
,appJournal=nulljournal
}

20
hledger-web/Hledger/Web/Files.hs → hledger-web/EmbeddedFiles.hs
View File

@ -1,14 +1,14 @@
{-# LANGUAGE TemplateHaskell #-}
{-|
Support files used by the web app are embedded here at compile time via
template haskell magic. This allows us minimise deployment hassle by
recreating them on the filesystem when needed (since hamlet can not use
the embedded files directly.) Installing on the filesystem has the added
benefit of making them easily customisable.
Support files (static files and templates) used by the web app are
embedded in this module at compile time. Since hamlet can not use the
embedded files directly, we also provide a way to write them out to the
filesystem at startup, when needed. This simplifies installation for
end-users, and customisation too.
-}
module Hledger.Web.Files
module EmbeddedFiles
(
files
,createFilesIfMissing
@ -18,9 +18,9 @@ import Control.Monad
import qualified Data.ByteString as B
import Data.FileEmbed (embedDir)
import System.Directory
import System.FilePath
import Hledger.Web.Settings (datadir)
import Settings (datadir)
-- | An embedded copy of all files below the the hledger-web data
-- directory (@.hledger/web/@) at compile time, as (FilePath,ByteString)
@ -40,5 +40,7 @@ createFilesIfMissing = do
else do
createDirectoryIfMissing True datadir
setCurrentDirectory datadir
forM_ files $ \(f,d) -> B.writeFile f d
forM_ files $ \(f,d) -> do
createDirectoryIfMissing True $ takeDirectory f
B.writeFile f d
return True

867
hledger-web/Hledger/Web/App.hs → hledger-web/Handlers.hs
View File

File diff suppressed because it is too large Load Diff

100
hledger-web/Hledger/Web/Main.hs
View File

@ -1,100 +0,0 @@
{-# LANGUAGE CPP #-}
{-|
hledger-web - a hledger add-on providing a web interface.
Copyright (c) 2007-2011 Simon Michael <simon@joyful.com>
Released under GPL version 3 or later.
-}
module Hledger.Web.Main where
import Control.Concurrent (forkIO, threadDelay)
import Data.Text(pack)
import System.Exit (exitFailure)
import System.IO.Storage (withStore, putValue,)
import System.Console.GetOpt
import Yesod
import Yesod.Helpers.Static
import Hledger.Cli.Options
import Hledger.Cli.Utils (withJournalDo, openBrowserOn)
import Hledger.Cli.Version (progversionstr, binaryfilename)
import Hledger.Data
import Prelude hiding (putStr, putStrLn)
import Hledger.Data.UTF8 (putStr, putStrLn)
import Hledger.Web.App (App(..))
import Hledger.Web.Files (createFilesIfMissing)
import Hledger.Web.Settings (browserstartdelay, defhost, defport, datadir)
progname_web = progname_cli ++ "-web"
options_web :: [OptDescr Opt]
options_web = [
Option "" ["base-url"] (ReqArg BaseUrl "URL") "use this base url (default http://localhost:PORT)"
,Option "" ["port"] (ReqArg Port "N") "serve on tcp port N (default 5000)"
]
usage_preamble_web =
"Usage: hledger-web [OPTIONS] [PATTERNS]\n" ++
"\n" ++
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
"starts a web ui server. Also attempts to start a web browser (unless --debug).\n" ++
"\n"
usage_options_web = usageInfo "hledger-web options:" options_web ++ "\n"
usage_web = concat [
usage_preamble_web
,usage_options_web
,usage_options_cli
,usage_postscript_cli
]
main :: IO ()
main = do
(opts, args) <- parseArgumentsWith $ options_cli++options_web
run opts args
where
run opts args
| Help `elem` opts = putStr usage_web
| Version `elem` opts = putStrLn $ progversionstr progname_web
| BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_web
| otherwise = withJournalDo opts args "web" web
-- | The web command.
web :: [Opt] -> [String] -> Journal -> IO ()
web opts args j = do
created <- createFilesIfMissing
if created
then do
putStrLn $ "Installing support files in "++datadir++" - done, please run again."
exitFailure
else do
putStrLn $ "Using support files in "++datadir
let host = defhost
port = fromMaybe defport $ portFromOpts opts
baseurl = fromMaybe (printf "http://%s:%d" host port) $ baseUrlFromOpts opts
unless (Debug `elem` opts) $ forkIO (browser baseurl) >> return ()
server baseurl port opts args j
server :: String -> Int -> [Opt] -> [String] -> Journal -> IO ()
server baseurl port opts args j = do
printf "Starting http server on port %d with base url %s\n" port baseurl
withStore "hledger" $ do
putValue "hledger" "journal" j
warpDebug port $ App{
-- appConnPool=Nothing
appRoot=pack baseurl
,appDataDir=datadir
,appStaticSettings=static datadir
,appOpts=opts
,appArgs=args
,appJournal=j
}
browser :: String -> IO ()
browser baseurl = do
threadDelay $ fromIntegral browserstartdelay
putStrLn "Attempting to start a web browser"
openBrowserOn baseurl >> return ()

128
hledger-web/Hledger/Web/Settings.hs
View File

@ -1,128 +0,0 @@
{-# LANGUAGE CPP, OverloadedStrings #-}
module Hledger.Web.Settings
(
hamletFile
, cassiusFile
, juliusFile
-- , connStr
-- , ConnectionPool
-- , withConnectionPool
-- , runConnectionPool
, approot
, staticroot
, datadir
, defhost
, defport
, browserstartdelay
, hledgerorgurl
, manualurl
, style_css
, hledger_js
, jquery_js
, jquery_url_js
, dhtmlxcommon_js
, dhtmlxcombo_js
, robots_txt
) where
import Language.Haskell.TH.Syntax
import System.FilePath ((</>))
import qualified Text.Cassius as H
import qualified Text.Hamlet as H
import qualified Text.Julius as H
import Text.Printf (printf)
-- import Database.Persist.Sqlite
-- import Yesod (MonadCatchIO)
import Yesod.Helpers.Static
browserstartdelay = 100000 -- microseconds
----------------------------------------------------------------------
-- urls
----------------------------------------------------------------------
hledgerorgurl, manualurl :: String
hledgerorgurl = "http://hledger.org"
manualurl = hledgerorgurl++"/MANUAL.html"
defhost = "localhost" :: String
defport = 5000
approot :: String
#ifdef PRODUCTION
approot = printf "http://%s:%d" defhost (defport :: Int) :: String
#else
approot = printf "http://%s:%d" defhost (defport :: Int) :: String
#endif
staticroot :: String
staticroot = approot ++ "/static"
-- Some static routes we can refer to by name, without hard-coded filesystem location.
style_css = StaticRoute ["style.css"] []
hledger_js = StaticRoute ["hledger.js"] []
jquery_js = StaticRoute ["jquery.js"] []
jquery_url_js = StaticRoute ["jquery.url.js"] []
dhtmlxcommon_js = StaticRoute ["dhtmlxcommon.js"] []
dhtmlxcombo_js = StaticRoute ["dhtmlxcombo.js"] []
-- Content for /robots.txt
robots_txt = "User-agent: *"
----------------------------------------------------------------------
-- filesystem
----------------------------------------------------------------------
-- | Hard-coded data directory path. This must be in your current dir when
-- you compile. At run time it's also required but we'll auto-create it.
datadir :: FilePath
datadir = "./.hledger/web/"
-- The following are compile-time macros. If the file paths they point to
-- don't exist, they will give an error (at compile time). If PRODUCTION
-- is defined, files are read only once at (startup?) time, otherwise
-- repeatedly at run time.
hamletFile :: FilePath -> Q Exp
#ifdef PRODUCTION
hamletFile x = H.hamletFile $ datadir </> (x ++ ".hamlet")
#else
hamletFile x = H.hamletFileDebug $ datadir </> (x ++ ".hamlet")
#endif
cassiusFile :: FilePath -> Q Exp
#ifdef PRODUCTION
cassiusFile x = H.cassiusFile $ datadir </> (x ++ ".cassius")
#else
cassiusFile x = H.cassiusFileDebug $ datadir </> (x ++ ".cassius")
#endif
juliusFile :: FilePath -> Q Exp
#ifdef PRODUCTION
juliusFile x = H.juliusFile $ datadir </> (x ++ ".julius")
#else
juliusFile x = H.juliusFileDebug $ datadir </> (x ++ ".julius")
#endif
----------------------------------------------------------------------
-- database
----------------------------------------------------------------------
-- connStr :: String
-- #ifdef PRODUCTION
-- connStr = "production.db3"
-- #else
-- connStr = "debug.db3"
-- #endif
-- connectionCount :: Int
-- connectionCount = 10
-- withConnectionPool :: MonadCatchIO m => (ConnectionPool -> m a) -> m a
-- withConnectionPool = withSqlitePool connStr connectionCount
-- runConnectionPool :: MonadCatchIO m => SqlPersist m a -> ConnectionPool -> m a
-- runConnectionPool = runSqlPool

147
hledger-web/Settings.hs Normal file
View File

@ -0,0 +1,147 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
-- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod
-- by overriding methods in the Yesod typeclass. That instance is
-- declared in the hledger-web.hs file.
module Settings
( hamletFile
, cassiusFile
, juliusFile
, luciusFile
, widgetFile
, datadir
, staticdir
, defhost
, defport
, defapproot
-- , staticroot
-- , browserstartdelay
, hledgerorgurl
, manualurl
) where
import Data.Monoid (mempty) --, mappend)
import Data.Text (Text,pack)
import Language.Haskell.TH.Syntax
import System.Directory (doesFileExist)
import Text.Printf (printf)
import qualified Text.Hamlet as H
import qualified Text.Cassius as H
import qualified Text.Julius as H
import qualified Text.Lucius as H
import Yesod.Widget (addWidget, addCassius, addJulius, addLucius)
-- browserstartdelay = 100000 -- microseconds
hledgerorgurl, manualurl :: String
hledgerorgurl = "http://hledger.org"
manualurl = hledgerorgurl++"/MANUAL.html"
-- | The default TCP port to listen on. May be overridden with --port.
defport :: Int
defport = 5000
defhost :: String
defhost = "localhost"
-- | The default 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.
-- For hledger-web this is usually overridden with --base-url.
defapproot :: Text
defapproot = pack $ printf "http://%s:%d" defhost defport
-- #ifdef PRODUCTION
-- #else
-- #endif
-- | Hard-coded data directory path. This must be in your current dir when
-- you compile. At run time it's also required but we'll auto-create it.
datadir :: FilePath
datadir = "./.hledger/web/"
-- | 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
staticdir = datadir++"static"
-- | The base URL for your static files. As you can see by the default
-- value, this can simply be "static" appended to your application root.
-- A powerful optimization can be serving static files from a separate
-- domain name. This allows you to use a web server optimized for static
-- files, more easily set expires and cache values, and avoid possibly
-- costly transference of cookies on static files. For more information,
-- 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
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in hledger-web.hs
-- staticroot :: Text
-- staticroot = defapproot `mappend` "/static"
-- The rest of this file contains settings which rarely need changing by a
-- user.
-- The following three functions are used for calling HTML, CSS and
-- Javascript 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.
toHamletFile, toCassiusFile, toJuliusFile, toLuciusFile :: String -> FilePath
toHamletFile x = datadir++"templates/" ++ x ++ ".hamlet"
toCassiusFile x = datadir++"templates/" ++ x ++ ".cassius"
toJuliusFile x = datadir++"templates/" ++ x ++ ".julius"
toLuciusFile x = datadir++"templates/" ++ x ++ ".lucius"
hamletFile :: FilePath -> Q Exp
hamletFile = H.hamletFile . toHamletFile
cassiusFile :: FilePath -> Q Exp
#ifdef PRODUCTION
cassiusFile = H.cassiusFile . toCassiusFile
#else
cassiusFile = H.cassiusFileDebug . toCassiusFile
#endif
luciusFile :: FilePath -> Q Exp
#ifdef PRODUCTION
luciusFile = H.luciusFile . toLuciusFile
#else
luciusFile = H.luciusFileDebug . toLuciusFile
#endif
juliusFile :: FilePath -> Q Exp
#ifdef PRODUCTION
juliusFile = H.juliusFile . toJuliusFile
#else
juliusFile = H.juliusFileDebug . toJuliusFile
#endif
widgetFile :: FilePath -> Q Exp
widgetFile x = do
let h = unlessExists toHamletFile hamletFile
let c = unlessExists toCassiusFile cassiusFile
let j = unlessExists toJuliusFile juliusFile
let l = unlessExists toLuciusFile luciusFile
[|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|]
where
unlessExists tofn f = do
e <- qRunIO $ doesFileExist $ tofn x
if e then f x else [|mempty|]

18
hledger-web/StaticFiles.hs Normal file
View File

@ -0,0 +1,18 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-|
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 StaticFiles where
import Yesod.Helpers.Static
import Settings (staticdir)
$(staticFiles staticdir)

87
hledger-web/hledger-web.cabal
View File

@ -1,5 +1,5 @@
name: hledger-web
version: 0.14
version: 0.14.98
category: Finance
synopsis: A web interface for the hledger accounting tool.
description:
@ -37,21 +37,31 @@ Flag production
Description: Build in production mode, which reads template files only once at startup.
Default: False
Flag devel
Description: Build for use with "yesod devel"
Default: False
executable hledger-web
main-is: hledger-web.hs
ghc-options: -threaded -W
-- hs-source-dirs: ., config
if flag(devel)
Buildable: False
if flag(production)
cpp-options: -DPRODUCTION
ghc-options: -Wall -threaded -O2
else
ghc-options: -W -threaded
other-modules:
Hledger.Web.Main
Hledger.Web.App
Hledger.Web.Files
Hledger.Web.Settings
App
EmbeddedFiles
Settings
StaticFiles
Handlers
build-depends:
hledger == 0.14
hledger == 0.14.98
,hledger-lib == 0.14
-- ,HUnit
,base >= 3 && < 5
,base >= 4 && < 5
,bytestring
-- ,containers
-- ,csv
@ -65,15 +75,66 @@ executable hledger-web
-- ,regexpr >= 0.5.1
,safe >= 0.2
-- ,split == 0.1.*
,text
-- ,time
-- ,utf8-string >= 0.3.5 && < 0.4
,io-storage >= 0.3 && < 0.4
,yesod >= 0.8 && < 0.9
-- ,convertible-text >= 0.3.0.1 && < 0.4
-- ,data-object >= 0.3.1.2 && < 0.4
,failure >= 0.1 && < 0.2
-- ,persistent == 0.2.*
-- ,persistent-sqlite == 0.2.*
,template-haskell >= 2.4 && < 2.6
,wai-extra == 0.4.*
,file-embed == 0.0.*
,template-haskell >= 2.4 && < 2.6
-- ,yesod >= 0.8 && < 0.9
,yesod-core >= 0.8 && < 0.9
,yesod-static
,hamlet == 0.8.*
,transformers
,wai
,wai-extra == 0.4.*
,warp
-- , blaze-builder
-- , web-routes
library
if flag(devel)
Buildable: True
else
Buildable: False
exposed-modules:
Controller
other-modules:
App
EmbeddedFiles
Settings
StaticFiles
Handlers
-- executable hledger-web
-- if flag(devel)
-- Buildable: False
-- if flag(production)
-- cpp-options: -DPRODUCTION
-- ghc-options: -Wall -threaded -O2
-- else
-- ghc-options: -Wall -threaded
-- main-is: config/hledger-web.hs
-- hs-source-dirs: ., config
-- build-depends: base >= 4 && < 5
-- , yesod-core >= 0.8 && < 0.9
-- , yesod-static
-- , wai-extra
-- , directory
-- , bytestring
-- , text
-- , template-haskell
-- , hamlet
-- , web-routes
-- , transformers
-- , wai
-- , warp
-- , blaze-builder

111
hledger-web/hledger-web.hs
View File

@ -1,2 +1,109 @@
#!/usr/bin/env runhaskell
import Hledger.Web.Main (main)
{-# LANGUAGE CPP #-}
{-|
hledger-web - a hledger add-on providing a web interface.
Copyright (c) 2007-2011 Simon Michael <simon@joyful.com>
Released under GPL version 3 or later.
-}
module Main
where
import Controller (withApp)
import Network.Wai.Handler.Warp (run)
#if PRODUCTION
#else
import Network.Wai.Middleware.Debug (debug)
#endif
import Prelude hiding (putStr, putStrLn)
-- import Control.Concurrent (forkIO, threadDelay)
import Data.Text(pack)
import System.Exit (exitFailure)
import System.IO.Storage (withStore, putValue,)
import System.Console.GetOpt
import Yesod.Helpers.Static
import Hledger.Cli.Options
import Hledger.Cli.Utils (withJournalDo) --, openBrowserOn)
import Hledger.Cli.Version (progversionstr, binaryfilename)
import Hledger.Data
import Hledger.Data.UTF8 (putStr, putStrLn)
import App
import EmbeddedFiles (createFilesIfMissing)
import Settings (defhost, defport, datadir, staticdir) -- , browserstartdelay)
progname_web = progname_cli ++ "-web"
options_web :: [OptDescr Opt]
options_web = [
Option "" ["base-url"] (ReqArg BaseUrl "URL") "use this base url (default http://localhost:PORT)"
,Option "" ["port"] (ReqArg Port "N") "serve on tcp port N (default 5000)"
]
usage_preamble_web =
"Usage: hledger-web [OPTIONS] [PATTERNS]\n" ++
"\n" ++
"Reads your ~/.journal file, or another specified by $LEDGER or -f, and\n" ++
"starts a web ui server. Also attempts to start a web browser (unless --debug).\n" ++
"\n"
usage_options_web = usageInfo "hledger-web options:" options_web ++ "\n"
usage_web = concat [
usage_preamble_web
,usage_options_web
,usage_options_cli
,usage_postscript_cli
]
main :: IO ()
main = do
(opts, args) <- parseArgumentsWith $ options_cli++options_web
run opts args
where
run opts args
| Help `elem` opts = putStr usage_web
| Version `elem` opts = putStrLn $ progversionstr progname_web
| BinaryFilename `elem` opts = putStrLn $ binaryfilename progname_web
| otherwise = withJournalDo opts args "web" web
-- | The web command.
web :: [Opt] -> [String] -> Journal -> IO ()
web opts args j = do
created <- createFilesIfMissing
if created
then do
putStrLn $ "Installing support files in "++datadir++" - done, please run again."
exitFailure
else do
putStrLn $ "Using support files in "++datadir
let host = defhost
port = fromMaybe defport $ portFromOpts opts
baseurl = fromMaybe (printf "http://%s:%d" host port) $ baseUrlFromOpts opts
-- unless (Debug `elem` opts) $ forkIO (browser baseurl) >> return ()
server baseurl port opts args j
-- browser :: String -> IO ()
-- browser baseurl = do
-- threadDelay $ fromIntegral browserstartdelay
-- putStrLn "Attempting to start a web browser"
-- openBrowserOn baseurl >> return ()
server :: String -> Int -> [Opt] -> [String] -> Journal -> IO ()
server baseurl port opts args j = do
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
,appArgs=args
,appJournal=j
}
withStore "hledger" $ do
putValue "hledger" "journal" j
#if PRODUCTION
withApp a (run port)
#else
withApp a (run port . debug)
#endif

0
hledger-web/models Normal file
View File

7
hledger-web/routes Normal file
View File

@ -0,0 +1,7 @@
/static StaticR Static getStatic
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/ RootR GET
/accounts AccountsOnlyR GET
/journal JournalR GET
/register RegisterR GET