From b5e1c42cc4f428d8426665446d3d1c65f3e27ec9 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 18 Nov 2010 00:53:41 +0000 Subject: [PATCH] web: auto-create all required support files in ./.hledger/web at startup This is a compromise to ease deployment and satisfy hamlet's requirements. See the Hledger.Web.Files module for more info. Currently we exit after creating the missing files since they are not created early enough for hamlet. --- hledger-web/Hledger/Web/App.hs | 6 ++-- hledger-web/Hledger/Web/Files.hs | 44 ++++++++++++++++++++++++ hledger-web/Hledger/Web/Settings.hs | 45 +++++++++++------------- hledger-web/Main.hs | 49 +++++++++++++-------------- hledger-web/Paths_hledger_web_make.hs | 5 --- hledger-web/hledger-web.cabal | 41 +++++++++++----------- 6 files changed, 112 insertions(+), 78 deletions(-) create mode 100644 hledger-web/Hledger/Web/Files.hs delete mode 100644 hledger-web/Paths_hledger_web_make.hs 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.*