Support stdin journal (web), create journal file if not exists (ui, web)

hledger-lib/Hledger/Read.hs

@@ -129,6 +129,7 @@ requireJournalFileExists f = do
 
 -- | Ensure there is a journal file at the given path, creating an empty one if needed.
 ensureJournalFileExists :: FilePath -> IO ()
+ensureJournalFileExists "-" = return ()
 ensureJournalFileExists f = do
   exists <- doesFileExist f
   when (not exists) $ do

hledger-ui/Hledger/UI/Main.hs

@@ -4,8 +4,9 @@ Copyright (c) 2007-2015 Simon Michael <simon@joyful.com>
 Released under GPL version 3 or later.
 -}
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Hledger.UI.Main where
 
@@ -30,6 +31,7 @@ import System.Exit
 import System.Directory
 import System.FilePath
 import System.FSNotify
+import Text.Printf (printf)
 import Brick
 
 #if MIN_VERSION_brick(0,16,0)
@@ -66,15 +68,14 @@ main = do
         { inputopts_ = (inputopts_ copts) { auto_ = True }
         , reportopts_ = (reportopts_ copts) { forecast_ = True }
         }
-
-  -- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
-  run $ opts { cliopts_ = copts' }
-    where
-      run opts
-        | "help"            `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeUsage uimode) >> exitSuccess
-        | "version"         `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
-        | "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
-        | otherwise                                                = withJournalDo (cliopts_ opts) (runBrickUi opts)
+  when (debug_ copts' > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
+  if
+    | "help"            `inRawOpts` rawopts_ copts' -> putStr (showModeUsage uimode) >> exitSuccess
+    | "version"         `inRawOpts` rawopts_ copts' -> putStrLn prognameandversion >> exitSuccess
+    | "binary-filename" `inRawOpts` rawopts_ copts' -> putStrLn (binaryfilename progname)
+    | otherwise -> do
+        mapM_ ensureJournalFileExists =<< journalFilePathFromOpts copts'
+        withJournalDo copts' (runBrickUi $ opts { cliopts_ = copts' })
 
 runBrickUi :: UIOpts -> Journal -> IO ()
 runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=ropts}} j = do

hledger-web/Hledger/Web/Handler/AddR.hs

@@ -11,13 +11,14 @@ module Hledger.Web.Handler.AddR
   ) where
 
 import Data.Aeson.Types (Result(..))
+import Data.IORef (writeIORef)
 import qualified Data.Text as T
 import Network.HTTP.Types.Status (status400)
 import Text.Blaze.Html (preEscapedToHtml)
 import Yesod
 
 import Hledger
-import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout, journalAddTransaction)
+import Hledger.Cli.Commands.Add (journalAddTransaction)
 import Hledger.Web.Import
 import Hledger.Web.Json ()
 import Hledger.Web.WebOptions (WebOpts(..))
@@ -28,17 +29,20 @@ getAddR = postAddR
 
 postAddR :: Handler ()
 postAddR = do
-  VD{caps, j, today} <- getViewData
+  VD { opts, caps, j, today } <- getViewData
+  App { appJournal } <- getYesod
   when (CapAdd `notElem` caps) (permissionDenied "Missing the 'add' capability")
 
   ((res, view), enctype) <- runFormPost $ addForm j today
   case res of
     FormSuccess res' -> do
-      let t = txnTieKnot res'
       -- XXX(?) move into balanceTransaction
-      liftIO $ ensureJournalFileExists (journalFilePath j)
-      -- XXX why not journalAddTransaction ?
-      liftIO $ appendToJournalFileOrStdout (journalFilePath j) (showTransaction t)
+      let t = txnTieKnot res'
+      liftIO $ do
+        ensureJournalFileExists (journalFilePath j)
+        j' <- journalAddTransaction j (cliopts_ opts) t
+        -- explicitly write to IORef for journals read from stdin
+        writeIORef appJournal j'
       setMessage "Transaction added."
       redirect JournalR
     FormMissing -> showForm view enctype
@@ -59,11 +63,14 @@ postAddR = do
 putAddR :: Handler RepJson
 putAddR = do
   VD{caps, j, opts} <- getViewData
+  App { appJournal } <- getYesod
   when (CapAdd `notElem` caps) (permissionDenied "Missing the 'add' capability")
 
   (r :: Result Transaction) <- parseCheckJsonBody
   case r of
     Error err -> sendStatusJSON status400 ("could not parse json: " ++ err ::String)
     Success t -> do
-      void $ liftIO $ journalAddTransaction j (cliopts_ opts) t
-      sendResponseCreated TransactionsR 
+      j' <- liftIO $ journalAddTransaction j (cliopts_ opts) t
+      -- explicitly write to IORef for journals read from stdin
+      liftIO $ writeIORef appJournal j'
+      sendResponseCreated TransactionsR

hledger-web/Hledger/Web/Handler/EditR.hs

@@ -10,6 +10,8 @@ module Hledger.Web.Handler.EditR
   , postEditR
   ) where
 
+import Data.IORef (writeIORef)
+
 import Hledger.Web.Import
 import Hledger.Web.Widget.Common
        (fromFormSuccess, helplink, journalFile404, writeValidJournal)
@@ -28,6 +30,7 @@ getEditR = postEditR
 postEditR :: FilePath -> Handler ()
 postEditR f = do
   VD {caps, j} <- getViewData
+  App { appJournal } <- getYesod
   when (CapManage `notElem` caps) (permissionDenied "Missing the 'manage' capability")
 
   (f', txt) <- journalFile404 f j
@@ -37,7 +40,9 @@ postEditR f = do
     Left e -> do
       setMessage $ "Failed to load journal: " <> toHtml e
       showForm view enctype
-    Right () -> do
+    Right j' -> do
+      -- explicitly write to IORef for journals read from stdin
+      liftIO $ writeIORef appJournal j'
       setMessage $ "Saved journal " <> toHtml f <> "\n"
       redirect JournalR
   where

hledger-web/Hledger/Web/Handler/UploadR.hs

@@ -12,6 +12,7 @@ module Hledger.Web.Handler.UploadR
 import qualified Data.ByteString.Lazy as BL
 import Data.Conduit (connect)
 import Data.Conduit.Binary (sinkLbs)
+import Data.IORef (writeIORef)
 import qualified Data.Text.Encoding as TE
 
 import Hledger.Web.Import
@@ -32,6 +33,7 @@ getUploadR = postUploadR
 postUploadR :: FilePath -> Handler ()
 postUploadR f = do
   VD {caps, j} <- getViewData
+  App { appJournal } <- getYesod
   when (CapManage `notElem` caps) (permissionDenied "Missing the 'manage' capability")
 
   (f', _) <- journalFile404 f j
@@ -53,7 +55,9 @@ postUploadR f = do
     Left e -> do
       setMessage $ "Failed to load journal: " <> toHtml e
       showForm view enctype
-    Right () -> do
+    Right j' -> do
+      -- explicitly write to IORef for journals read from stdin
+      liftIO $ writeIORef appJournal j'
       setMessage $ "File " <> toHtml f <> " uploaded successfully"
       redirect JournalR
   where

hledger-web/Hledger/Web/Main.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-|
 
@@ -33,8 +34,15 @@ import Hledger.Web.WebOptions
 hledgerWebMain :: IO ()
 hledgerWebMain = do
   opts <- getHledgerWebOpts
-  when (debug_ (cliopts_ opts) > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
-  runWith opts
+  let copts = cliopts_ opts
+  when (debug_ copts > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
+  if
+    | "help"            `inRawOpts` rawopts_ copts -> putStr (showModeUsage webmode) >> exitSuccess
+    | "version"         `inRawOpts` rawopts_ copts -> putStrLn prognameandversion >> exitSuccess
+    | "binary-filename" `inRawOpts` rawopts_ copts -> putStrLn (binaryfilename progname)
+    | otherwise -> do
+        mapM_ ensureJournalFileExists =<< journalFilePathFromOpts copts
+        withJournalDo copts (web opts)
 
 hledgerWebDev :: IO (Int, Application)
 hledgerWebDev =
@@ -44,13 +52,6 @@ hledgerWebDev =
       Yesod.Default.Config.loadConfig
         (configSettings Development) {csParseExtra = parseExtra}
 
-runWith :: WebOpts -> IO ()
-runWith opts
-  | "help"            `inRawOpts` rawopts_ (cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess
-  | "version"         `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
-  | "binary-filename" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn (binaryfilename progname)
-  | otherwise = withJournalDo (cliopts_ opts) (web opts)
-
 -- | The web command.
 web :: WebOpts -> Journal -> IO ()
 web opts j = do

hledger-web/Hledger/Web/Widget/Common.hs

@@ -48,13 +48,14 @@ fromFormSuccess h FormMissing = h
 fromFormSuccess h (FormFailure _) = h
 fromFormSuccess _ (FormSuccess a) = pure a
 
-writeValidJournal :: MonadHandler m => FilePath -> Text -> m (Either String ())
+writeValidJournal :: MonadHandler m => FilePath -> Text -> m (Either String Journal)
+writeValidJournal "-" txt = liftIO (readJournal def Nothing txt)
 writeValidJournal f txt =
   liftIO (readJournal def (Just f) txt) >>= \case
     Left e -> return (Left e)
-    Right _ -> do
+    Right j -> do
       _ <- liftIO (writeFileWithBackupIfChanged f txt)
-      return (Right ())
+      return (Right j)
 
 
 -- | Link to a topic in the manual.

hledger/Hledger/Cli/Utils.hs

@@ -219,6 +219,7 @@ journalFileIsNewer j@Journal{jlastreadtime=tread} = do
 -- | Has the specified file (presumably one of journal's data files)
 -- changed since journal was last read ?
 journalSpecifiedFileIsNewer :: Journal -> FilePath -> IO Bool
+journalSpecifiedFileIsNewer _ "-" = return False
 journalSpecifiedFileIsNewer Journal{jlastreadtime=tread} f = do
   tmod <- fileModificationTime f
   return $ diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)