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

@@ -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"
 
 ----------------------------------------------------------------------
 

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

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
+-- | Hard-coded data directory path. This must be in your current dir when
--- when you run or compile hledger-web.
+-- you compile or run hledger-web.
 datadir :: FilePath
-datadir = ".hledger"
+datadir = "./.hledger/web/"
-
-staticdir :: FilePath
-staticdir = datadir ++ "/web"
-
-templatesdir :: FilePath
-templatesdir = datadir ++ "/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
+-- don't exist, they will give an error (at compile time). If PRODUCTION
--- mode, files are read once at compile time, otherwise repeatedly at runtime.
+-- 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
 
 ----------------------------------------------------------------------

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)
+import Hledger.Web.Files (createFilesIfMissing)
--- #ifdef MAKE
+import Hledger.Web.Settings (browserstartdelay, defhost, defport, datadir)
--- import Paths_hledger_web_make (getDataFileName)
--- #else
--- import Paths_hledger_web (getDataFileName)
--- #endif
 
 
 main :: IO ()
@@ -54,32 +48,37 @@ main = do
 -- | The web command.
 web :: [Opt] -> [String] -> Journal -> IO ()
 web opts args j = do
-  let host    = defhost
+  created <- createFilesIfMissing
-      port    = fromMaybe defport $ portFromOpts opts
+  if created
-      baseurl = fromMaybe (printf "http://%s:%d" host port) $ baseUrlFromOpts opts
+   then do
-  unless (Debug `elem` opts) $ forkIO (browser baseurl) >> return ()
+     putStrLn $ "Installing support files in "++datadir++" - done, please run again."
-  server baseurl port opts args j
+     exitFailure
-
+   else do
-browser :: String -> IO ()
+     putStrLn $ "Using support files in "++datadir
-browser baseurl = do
+     let host    = defhost
-  putStrLn "starting web browser"
+         port    = fromMaybe defport $ portFromOpts opts
-  threadDelay $ fromIntegral browserstartdelay
+         baseurl = fromMaybe (printf "http://%s:%d" host port) $ baseUrlFromOpts opts
-  openBrowserOn baseurl >> return ()
+     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 ()
+

hledger-web/Paths_hledger_web_make.hs

@@ -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

hledger-web/hledger-web.cabal

@@ -16,21 +16,21 @@ cabal-version:  >= 1.6
 build-type:     Simple
 data-dir:       .hledger
 data-files:
-                static/style.css
+                web/addform.hamlet
-                static/hledger.js
+                web/addformpostingfields.hamlet
-                static/jquery.js
+                web/combo_select.gif
-                static/jquery.url.js
+                web/default-layout.cassius
-                static/dhtmlxcommon.js
+                web/default-layout.hamlet
-                static/dhtmlxcombo.js
+                web/dhtmlxcombo.js
-                static/favicon.ico
+                web/dhtmlxcommon.js
-                static/combo_select.gif
+                web/favicon.ico
-                templates/addform.hamlet
+                web/hledger.js
-                templates/addformpostingfields.hamlet
+                web/homepage.cassius
-                templates/default-layout.cassius
+                web/homepage.hamlet
-                templates/default-layout.hamlet
+                web/homepage.julius
-                templates/homepage.cassius
+                web/jquery.js
-                templates/homepage.hamlet
+                web/jquery.url.js
-                templates/homepage.julius
+                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.*