{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Import (
importmode
,importcmd
)
where
import Control.Monad
import Data.List
import qualified Data.Text.IO as T
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Add (journalAddTransaction)
import System.Console.CmdArgs.Explicit
import Text.Printf
importmode :: Mode RawOpts
importmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Import.txt")
[[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"catchup"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"catchup") CommandDoc
"just mark all transactions as already imported"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"dry-run"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"dry-run") CommandDoc
"just show the transactions to be imported"
]
[(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
[Flag RawOpts]
hiddenflags
([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"FILE [...]")
importcmd :: CliOpts -> Journal -> IO ()
importcmd opts :: CliOpts
opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts,inputopts_ :: CliOpts -> InputOpts
inputopts_=InputOpts
iopts} Journal
j = do
let
inputfiles :: [CommandDoc]
inputfiles = CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"args" RawOpts
rawopts
inputstr :: CommandDoc
inputstr = CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate CommandDoc
", " ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ (CommandDoc -> CommandDoc) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> CommandDoc
quoteIfNeeded [CommandDoc]
inputfiles
catchup :: Bool
catchup = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"catchup" RawOpts
rawopts
dryrun :: Bool
dryrun = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"dry-run" RawOpts
rawopts
iopts' :: InputOpts
iopts' = InputOpts
iopts{new_ :: Bool
new_=Bool
True, new_save_ :: Bool
new_save_=Bool -> Bool
not Bool
dryrun, balancingopts_ :: BalancingOpts
balancingopts_=BalancingOpts
balancingOpts{commodity_styles_ :: Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_=Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle)
forall a. a -> Maybe a
Just (Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle))
-> Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle)
forall a b. (a -> b) -> a -> b
$ Journal -> Map CommoditySymbol AmountStyle
journalCommodityStyles Journal
j}}
case [CommandDoc]
inputfiles of
[] -> CommandDoc -> IO ()
forall a. CommandDoc -> a
error' CommandDoc
"please provide one or more input files as arguments"
[CommandDoc]
fs -> do
Either CommandDoc Journal
enewj <- InputOpts -> [CommandDoc] -> IO (Either CommandDoc Journal)
readJournalFiles InputOpts
iopts' [CommandDoc]
fs
case Either CommandDoc Journal
enewj of
Left CommandDoc
e -> CommandDoc -> IO ()
forall a. CommandDoc -> a
error' CommandDoc
e
Right Journal
newj ->
case (Transaction -> Day) -> [Transaction] -> [Transaction]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Transaction -> Day
tdate ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
newj of
[] -> do
let semicolon :: CommandDoc
semicolon = if Bool
dryrun then CommandDoc
"; " else CommandDoc
"" :: String
CommandDoc -> CommandDoc -> CommandDoc -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%sno new transactions found in %s\n\n" CommandDoc
semicolon CommandDoc
inputstr
[Transaction]
newts | Bool
dryrun -> do
CommandDoc -> Int -> CommandDoc -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"; would import %d new transactions from %s:\n\n" ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
newts) CommandDoc
inputstr
(Transaction -> IO ()) -> [Transaction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (CommoditySymbol -> IO ()
T.putStr (CommoditySymbol -> IO ())
-> (Transaction -> CommoditySymbol) -> Transaction -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> CommoditySymbol
showTransaction) [Transaction]
newts
[Transaction]
newts | Bool
catchup -> do
CommandDoc -> CommandDoc -> Int -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"marked %s as caught up, skipping %d unimported transactions\n\n" CommandDoc
inputstr ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
newts)
[Transaction]
newts -> do
(Journal -> Transaction -> IO Journal)
-> Journal -> [Transaction] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (Journal -> CliOpts -> Transaction -> IO Journal
`journalAddTransaction` CliOpts
opts) Journal
j [Transaction]
newts
CommandDoc -> Int -> CommandDoc -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"imported %d new transactions from %s\n" ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
newts) CommandDoc
inputstr