{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}

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 Hledger.Cli.Commands.Print (print')
import System.Console.CmdArgs.Explicit
import Text.Printf

importmode :: Mode RawOpts
importmode = CommandHelpStr
-> [Flag RawOpts]
-> [(CommandHelpStr, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Import.txt")
  [[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"catchup"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"catchup") CommandHelpStr
"just mark all transactions as already imported"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"dry-run"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"dry-run") CommandHelpStr
"just show the transactions to be imported"
  ]
  [(CommandHelpStr, [Flag RawOpts])]
cligeneralflagsgroups1
  [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
$ CommandHelpStr -> Arg RawOpts
argsFlag CommandHelpStr
"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
  -- XXX could be helpful to show the last-seen date, and number of old transactions, too
  let
    inputfiles :: [CommandHelpStr]
inputfiles = CommandHelpStr -> RawOpts -> [CommandHelpStr]
listofstringopt CommandHelpStr
"args" RawOpts
rawopts
    inputstr :: CommandHelpStr
inputstr = CommandHelpStr -> [CommandHelpStr] -> CommandHelpStr
forall a. [a] -> [[a]] -> [a]
intercalate CommandHelpStr
", " ([CommandHelpStr] -> CommandHelpStr)
-> [CommandHelpStr] -> CommandHelpStr
forall a b. (a -> b) -> a -> b
$ (CommandHelpStr -> CommandHelpStr)
-> [CommandHelpStr] -> [CommandHelpStr]
forall a b. (a -> b) -> [a] -> [b]
map CommandHelpStr -> CommandHelpStr
quoteIfNeeded [CommandHelpStr]
inputfiles
    catchup :: Bool
catchup = CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"catchup" RawOpts
rawopts
    dryrun :: Bool
dryrun = CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"dry-run" RawOpts
rawopts
    combinedStyles :: Maybe (Map CommoditySymbol AmountStyle)
combinedStyles = 
      let
        maybeInputStyles :: Maybe (Map CommoditySymbol AmountStyle)
maybeInputStyles = BalancingOpts -> Maybe (Map CommoditySymbol AmountStyle)
commodity_styles_ (BalancingOpts -> Maybe (Map CommoditySymbol AmountStyle))
-> (InputOpts -> BalancingOpts)
-> InputOpts
-> Maybe (Map CommoditySymbol AmountStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> BalancingOpts
balancingopts_ (InputOpts -> Maybe (Map CommoditySymbol AmountStyle))
-> InputOpts -> Maybe (Map CommoditySymbol AmountStyle)
forall a b. (a -> b) -> a -> b
$ InputOpts
iopts
        inferredStyles :: Map CommoditySymbol AmountStyle
inferredStyles =  Journal -> Map CommoditySymbol AmountStyle
journalCommodityStyles Journal
j
      in
        case Maybe (Map CommoditySymbol AmountStyle)
maybeInputStyles of
          Maybe (Map CommoditySymbol AmountStyle)
Nothing -> Map CommoditySymbol AmountStyle
-> Maybe (Map CommoditySymbol AmountStyle)
forall a. a -> Maybe a
Just Map CommoditySymbol AmountStyle
inferredStyles
          Just Map CommoditySymbol AmountStyle
inputStyles -> 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
$ Map CommoditySymbol AmountStyle
inputStyles Map CommoditySymbol AmountStyle
-> Map CommoditySymbol AmountStyle
-> Map CommoditySymbol AmountStyle
forall a. Semigroup a => a -> a -> a
<> Map CommoditySymbol AmountStyle
inferredStyles

    iopts' :: InputOpts
iopts' = InputOpts
iopts{
      new_=True,  -- read only new transactions since last time
      new_save_=False,  -- defer saving .latest files until the end
      strict_=False,  -- defer strict checks until the end
      balancingopts_=defbalancingopts{commodity_styles_= combinedStyles}  -- use amount styles from both when balancing txns
      }

  case [CommandHelpStr]
inputfiles of
    [] -> CommandHelpStr -> IO ()
forall a. CommandHelpStr -> a
error' CommandHelpStr
"please provide one or more input files as arguments"  -- PARTIAL:
    [CommandHelpStr]
fs -> do
      Either CommandHelpStr (Journal, [LatestDatesForFile])
enewjandlatestdatesforfiles <- ExceptT CommandHelpStr IO (Journal, [LatestDatesForFile])
-> IO (Either CommandHelpStr (Journal, [LatestDatesForFile]))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CommandHelpStr IO (Journal, [LatestDatesForFile])
 -> IO (Either CommandHelpStr (Journal, [LatestDatesForFile])))
-> ExceptT CommandHelpStr IO (Journal, [LatestDatesForFile])
-> IO (Either CommandHelpStr (Journal, [LatestDatesForFile]))
forall a b. (a -> b) -> a -> b
$ InputOpts
-> [CommandHelpStr]
-> ExceptT CommandHelpStr IO (Journal, [LatestDatesForFile])
readJournalFilesAndLatestDates InputOpts
iopts' [CommandHelpStr]
fs
      case Either CommandHelpStr (Journal, [LatestDatesForFile])
enewjandlatestdatesforfiles of
        Left CommandHelpStr
err -> CommandHelpStr -> IO ()
forall a. CommandHelpStr -> a
error' CommandHelpStr
err
        Right (Journal
newj, [LatestDatesForFile]
latestdatesforfiles) ->
          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
            -- with --dry-run the output should be valid journal format, so messages have ; prepended
            [] -> do
              -- in this case, we vary the output depending on --dry-run, which is a bit awkward
              let semicolon :: CommandHelpStr
semicolon = if Bool
dryrun then CommandHelpStr
"; " else CommandHelpStr
"" :: String
              CommandHelpStr -> CommandHelpStr -> CommandHelpStr -> IO ()
forall r. PrintfType r => CommandHelpStr -> r
printf CommandHelpStr
"%sno new transactions found in %s\n\n" CommandHelpStr
semicolon CommandHelpStr
inputstr

            [Transaction]
newts | Bool
catchup ->
              if Bool
dryrun
                then CommandHelpStr -> Int -> IO ()
forall r. PrintfType r => CommandHelpStr -> r
printf CommandHelpStr
"--catchup would skip %d transactions (dry run)\n\n" ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
newts)
                else do
                  CommandHelpStr -> CommandHelpStr -> Int -> IO ()
forall r. PrintfType r => CommandHelpStr -> r
printf CommandHelpStr
"marked %s as caught up, skipping %d transactions\n\n" CommandHelpStr
inputstr ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
newts)
                  [LatestDatesForFile] -> IO ()
saveLatestDatesForFiles [LatestDatesForFile]
latestdatesforfiles

            [Transaction]
newts -> do
              if Bool
dryrun
              then do
                -- show txns to be imported
                CommandHelpStr -> Int -> CommandHelpStr -> IO ()
forall r. PrintfType r => CommandHelpStr -> r
printf CommandHelpStr
"; would import %d new transactions from %s:\n\n" ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
newts) CommandHelpStr
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

                -- then check the whole journal with them added, if in strict mode
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (InputOpts -> Bool
strict_ InputOpts
iopts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
strictChecks

              else do
                -- first check the whole journal with them added, if in strict mode
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (InputOpts -> Bool
strict_ InputOpts
iopts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
strictChecks

                -- then append the transactions to the main journal file.
                -- XXX This writes unix line endings (\n), some at least,
                -- even if the file uses dos line endings (\r\n), which could leave
                -- mixed line endings in the file. See also writeFileWithBackupIfChanged.
                (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  -- gets forced somehow.. (how ?)

                CommandHelpStr -> Int -> CommandHelpStr -> CommandHelpStr -> IO ()
forall r. PrintfType r => CommandHelpStr -> r
printf CommandHelpStr
"imported %d new transactions from %s to %s\n" ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
newts) CommandHelpStr
inputstr (Journal -> CommandHelpStr
journalFilePath Journal
j)

                -- and if we got this far, update each file's .latest file
                [LatestDatesForFile] -> IO ()
saveLatestDatesForFiles [LatestDatesForFile]
latestdatesforfiles

              where
                -- add the new transactions to the journal in memory and check the whole thing
                strictChecks :: IO ()
strictChecks = (CommandHelpStr -> IO ())
-> (() -> IO ()) -> Either CommandHelpStr () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CommandHelpStr -> IO ()
forall a. CommandHelpStr -> IO a
forall (m :: * -> *) a. MonadFail m => CommandHelpStr -> m a
fail () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CommandHelpStr () -> IO ())
-> Either CommandHelpStr () -> IO ()
forall a b. (a -> b) -> a -> b
$ Journal -> Either CommandHelpStr ()
journalStrictChecks Journal
j'
                  where j' :: Journal
j' = (Journal -> Transaction -> Journal)
-> Journal -> [Transaction] -> Journal
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Transaction -> Journal -> Journal)
-> Journal -> Transaction -> Journal
forall a b c. (a -> b -> c) -> b -> a -> c
flip Transaction -> Journal -> Journal
addTransaction) Journal
j [Transaction]
newts