From 748420c970cccb36f6065904c9b18f017d186a66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Z=C3=A1rybnick=C3=BD?= Date: Sun, 3 Mar 2019 14:56:46 +0100 Subject: [PATCH 1/2] web: Support stdin journal - read once and edited in-memory --- hledger-lib/Hledger/Read.hs | 1 + hledger-web/Hledger/Web/Handler/AddR.hs | 23 ++++++++++++++-------- hledger-web/Hledger/Web/Handler/EditR.hs | 7 ++++++- hledger-web/Hledger/Web/Handler/UploadR.hs | 6 +++++- hledger-web/Hledger/Web/Widget/Common.hs | 7 ++++--- hledger/Hledger/Cli/Utils.hs | 1 + 6 files changed, 32 insertions(+), 13 deletions(-) diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 2536f0c8582..289be3366ea 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/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 diff --git a/hledger-web/Hledger/Web/Handler/AddR.hs b/hledger-web/Hledger/Web/Handler/AddR.hs index 5b74cb9835b..7122440b30e 100644 --- a/hledger-web/Hledger/Web/Handler/AddR.hs +++ b/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 diff --git a/hledger-web/Hledger/Web/Handler/EditR.hs b/hledger-web/Hledger/Web/Handler/EditR.hs index 8c9eed333f3..ea5be5659f6 100644 --- a/hledger-web/Hledger/Web/Handler/EditR.hs +++ b/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 diff --git a/hledger-web/Hledger/Web/Handler/UploadR.hs b/hledger-web/Hledger/Web/Handler/UploadR.hs index c7d02d67312..f2d63323cc3 100644 --- a/hledger-web/Hledger/Web/Handler/UploadR.hs +++ b/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 diff --git a/hledger-web/Hledger/Web/Widget/Common.hs b/hledger-web/Hledger/Web/Widget/Common.hs index 6646c724126..c7d020ce850 100644 --- a/hledger-web/Hledger/Web/Widget/Common.hs +++ b/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. diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index bdf996b71bb..a63b16ddca7 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/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) From 82642b4810cfacaf9be1a9044b7bf0012eec428a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Z=C3=A1rybnick=C3=BD?= Date: Sun, 3 Mar 2019 15:03:53 +0100 Subject: [PATCH 2/2] ui, web: Create journal on startup if it doesn't exist --- hledger-ui/Hledger/UI/Main.hs | 21 +++++++++++---------- hledger-web/Hledger/Web/Main.hs | 19 ++++++++++--------- 2 files changed, 21 insertions(+), 19 deletions(-) diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index e7415ab6767..2accdd58437 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -4,8 +4,9 @@ Copyright (c) 2007-2015 Simon Michael 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 diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 4b53216209d..54a0b18a99d 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/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