diff --git a/hledger-web/Hledger/Web/App.hs b/hledger-web/Hledger/Web/App.hs index 84efbd3b4..76e4c9c3e 100644 --- a/hledger-web/Hledger/Web/App.hs +++ b/hledger-web/Hledger/Web/App.hs @@ -41,7 +41,7 @@ import Hledger.Web.Settings ( -- withConnectionPool -- , runConnectionPool -- , staticroot - staticdir + datadir , hamletFile , cassiusFile -- , juliusFile @@ -126,7 +126,7 @@ instance Yesod App where urlRenderOverride _ _ = Nothing -- addStaticContent ext' _ content = do -- let fn = base64md5 content ++ '.' : ext' - -- let statictmp = staticdir ++ "/tmp/" + -- let statictmp = datadir ++ "/tmp/" -- liftIO $ createDirectoryIfMissing True statictmp -- liftIO $ L.writeFile (statictmp ++ fn) content -- return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], []) @@ -475,7 +475,7 @@ hdstringlist ss = HDList [ [([], hdstring s)] | s <- ss ] ---------------------------------------------------------------------- getFaviconR :: Handler () -getFaviconR = sendFile "image/x-icon" $ staticdir "favicon.ico" +getFaviconR = sendFile "image/x-icon" $ datadir "favicon.ico" ---------------------------------------------------------------------- diff --git a/hledger-web/Hledger/Web/Files.hs b/hledger-web/Hledger/Web/Files.hs new file mode 100644 index 000000000..72d671d37 --- /dev/null +++ b/hledger-web/Hledger/Web/Files.hs @@ -0,0 +1,44 @@ +{-# 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. + +-} +module Hledger.Web.Files + ( + files + ,createFilesIfMissing + ) +where +import Control.Monad +import qualified Data.ByteString as B +import Data.FileEmbed (embedDir) +import System.Directory + +import Hledger.Web.Settings (datadir) + + +-- | An embedded copy of all files below the the hledger-web data +-- directory (@.hledger/web/@) at compile time, as (FilePath,ByteString) +-- pairs. +files :: [(FilePath, B.ByteString)] +files = $(embedDir datadir) + +-- | If the hledger-web data directory (@.hledger/web/@) does not exist in +-- the current directory, create and fill it with the web app support +-- files (templates, stylesheets, images etc.) Returns True if the +-- directory was missing. +createFilesIfMissing :: IO Bool +createFilesIfMissing = do + exists <- doesDirectoryExist datadir + if exists + then return False + else do + createDirectoryIfMissing True datadir + setCurrentDirectory datadir + forM_ files $ \(f,d) -> B.writeFile f d + return True diff --git a/hledger-web/Hledger/Web/Settings.hs b/hledger-web/Hledger/Web/Settings.hs index 691d9ab2e..af8991a34 100644 --- a/hledger-web/Hledger/Web/Settings.hs +++ b/hledger-web/Hledger/Web/Settings.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} module Hledger.Web.Settings - ( hamletFile + ( + hamletFile , cassiusFile , juliusFile -- , connStr @@ -10,9 +11,6 @@ module Hledger.Web.Settings , approot , staticroot , datadir - , staticdir - , templatesdir - , defhost , defport , browserstartdelay @@ -27,12 +25,12 @@ module Hledger.Web.Settings , robots_txt ) where -import System.FilePath (()) -import Text.Printf (printf) -import qualified Text.Hamlet as H -import qualified Text.Cassius as H -import qualified Text.Julius as H 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 @@ -76,40 +74,35 @@ robots_txt = "User-agent: *" -- filesystem ---------------------------------------------------------------------- --- XXX hard-coded data directory path. This must be in your current dir --- when you run or compile hledger-web. +-- | Hard-coded data directory path. This must be in your current dir when +-- you compile or run hledger-web. datadir :: FilePath -datadir = ".hledger" - -staticdir :: FilePath -staticdir = datadir ++ "/web" - -templatesdir :: FilePath -templatesdir = datadir ++ "/web" +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). In production --- mode, files are read once at compile time, otherwise repeatedly at runtime. +-- 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 $ templatesdir (x ++ ".hamlet") +hamletFile x = H.hamletFile $ datadir (x ++ ".hamlet") #else -hamletFile x = H.hamletFileDebug $ templatesdir (x ++ ".hamlet") +hamletFile x = H.hamletFileDebug $ datadir (x ++ ".hamlet") #endif cassiusFile :: FilePath -> Q Exp #ifdef PRODUCTION -cassiusFile x = H.cassiusFile $ templatesdir (x ++ ".cassius") +cassiusFile x = H.cassiusFile $ datadir (x ++ ".cassius") #else -cassiusFile x = H.cassiusFileDebug $ templatesdir (x ++ ".cassius") +cassiusFile x = H.cassiusFileDebug $ datadir (x ++ ".cassius") #endif juliusFile :: FilePath -> Q Exp #ifdef PRODUCTION -juliusFile x = H.juliusFile $ templatesdir (x ++ ".julius") +juliusFile x = H.juliusFile $ datadir (x ++ ".julius") #else -juliusFile x = H.juliusFileDebug $ templatesdir (x ++ ".julius") +juliusFile x = H.juliusFileDebug $ datadir (x ++ ".julius") #endif ---------------------------------------------------------------------- diff --git a/hledger-web/Main.hs b/hledger-web/Main.hs index b923fb7bf..c3a437ca2 100644 --- a/hledger-web/Main.hs +++ b/hledger-web/Main.hs @@ -12,25 +12,19 @@ import Prelude hiding (putStr, putStrLn) import System.IO.UTF8 (putStr, putStrLn) #endif import Control.Concurrent (forkIO, threadDelay) --- import System.FilePath (()) -import System.IO.Storage (withStore, putValue,) - import Network.Wai.Handler.SimpleServer (run) +import System.Exit (exitFailure) -- , exitWith, ExitCode(ExitSuccess)) -- base 3 compatible +import System.IO.Storage (withStore, putValue,) import Yesod.Content (typeByExt) import Yesod.Helpers.Static (fileLookupDir) import Hledger.Cli.Options --- import Hledger.Cli.Tests import Hledger.Cli.Utils (withJournalDo, openBrowserOn) import Hledger.Cli.Version (versionmsg) --, binaryfilename) import Hledger.Data import Hledger.Web.App (App(..), withApp) -import Hledger.Web.Settings (browserstartdelay, defhost, defport, datadir, staticdir) --- #ifdef MAKE --- import Paths_hledger_web_make (getDataFileName) --- #else --- import Paths_hledger_web (getDataFileName) --- #endif +import Hledger.Web.Files (createFilesIfMissing) +import Hledger.Web.Settings (browserstartdelay, defhost, defport, datadir) main :: IO () @@ -54,32 +48,37 @@ main = do -- | The web command. web :: [Opt] -> [String] -> Journal -> IO () web opts args j = do - 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 - putStrLn "starting web browser" - threadDelay $ fromIntegral browserstartdelay - openBrowserOn baseurl >> return () + 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 web server on port %d with base url %s\n" port baseurl + printf "Starting http server on port %d with base url %s\n" port baseurl withStore "hledger" $ do putValue "hledger" "journal" j - -- dir <- getDataFileName "" - -- let staticdir = dir "static" withApp App{ -- appConnPool=Nothing appRoot=baseurl ,appDataDir=datadir - ,appStatic=fileLookupDir staticdir $ typeByExt -- ++[("hamlet","text/plain")] + ,appStatic=fileLookupDir datadir $ typeByExt -- ++[("hamlet","text/plain")] ,appOpts=opts ,appArgs=args ,appJournal=j } $ run port +browser :: String -> IO () +browser baseurl = do + threadDelay $ fromIntegral browserstartdelay + putStrLn "Attempting to start a web browser" + openBrowserOn baseurl >> return () + diff --git a/hledger-web/Paths_hledger_web_make.hs b/hledger-web/Paths_hledger_web_make.hs deleted file mode 100644 index 14b2e68b6..000000000 --- a/hledger-web/Paths_hledger_web_make.hs +++ /dev/null @@ -1,5 +0,0 @@ --- stub version of cabal's Paths_hledger_web.hs used when not building with cabal --- assumes "data" dir is in current directory -module Paths_hledger_web_make where -import System.FilePath.Posix (()) -getDataFileName path = return $ "data" path diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index d9d503b71..b79eef574 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -16,21 +16,21 @@ cabal-version: >= 1.6 build-type: Simple data-dir: .hledger data-files: - static/style.css - static/hledger.js - static/jquery.js - static/jquery.url.js - static/dhtmlxcommon.js - static/dhtmlxcombo.js - static/favicon.ico - static/combo_select.gif - templates/addform.hamlet - templates/addformpostingfields.hamlet - templates/default-layout.cassius - templates/default-layout.hamlet - templates/homepage.cassius - templates/homepage.hamlet - templates/homepage.julius + web/addform.hamlet + web/addformpostingfields.hamlet + web/combo_select.gif + web/default-layout.cassius + web/default-layout.hamlet + web/dhtmlxcombo.js + web/dhtmlxcommon.js + web/favicon.ico + web/hledger.js + web/homepage.cassius + web/homepage.hamlet + web/homepage.julius + web/jquery.js + web/jquery.url.js + web/style.css extra-tmp-files: extra-source-files: @@ -39,25 +39,27 @@ source-repository head location: http://joyful.com/repos/hledger Flag production - Description: Build in production mode, which reads templates only once at startup. + Description: Build in production mode, which reads template files only once at startup. Default: False executable hledger-web main-is: Main.hs ghc-options: -threaded -W if flag(production) - cpp-options: -DPRODUCTION + cpp-options: -DPRODUCTION other-modules: Hledger.Web.App + Hledger.Web.Files Hledger.Web.Settings build-depends: hledger == 0.13 ,hledger-lib == 0.13 -- ,HUnit ,base >= 3 && < 5 + ,bytestring -- ,containers -- ,csv - -- ,directory + ,directory ,filepath -- ,mtl -- ,old-locale @@ -77,5 +79,6 @@ executable hledger-web ,failure >= 0.1 && < 0.2 -- ,persistent == 0.2.* -- ,persistent-sqlite == 0.2.* - ,template-haskell == 2.4.* + ,template-haskell >= 2.4 && < 2.6 ,wai-extra == 0.2.* + ,file-embed == 0.0.*