{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|

Utilities for top-level modules and ghci. See also Hledger.Read and
Hledger.Utils.

-}

module Hledger.Cli.Utils
    (
     unsupportedOutputFormatError,
     withJournalDo,
     writeOutput,
     writeOutputLazyText,
     journalTransform,
     journalReload,
     journalReloadIfChanged,
     journalFileIsNewer,
     openBrowserOn,
     writeFileWithBackup,
     writeFileWithBackupIfChanged,
     readFileStrictly,
     pivotByOpts,
     anonymiseByOpts,
     journalSimilarTransaction,
     tests_Cli_Utils,
    )
where
import Control.Exception as C

import Data.List
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import Data.Time (Day)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Safe (readMay, headMay)
import System.Console.CmdArgs
import System.Directory (getModificationTime, getDirectoryContents, copyFile, doesFileExist)
import System.Exit
import System.FilePath ((</>), splitFileName, takeDirectory)
import System.Info (os)
import System.Process (readProcessWithExitCode)
import Text.Printf
import Text.Regex.TDFA ((=~))

import Hledger.Cli.CliOptions
import Hledger.Cli.Anon
import Hledger.Data
import Hledger.Read
import Hledger.Reports
import Hledger.Utils
import Control.Monad (when)

-- | Standard error message for a bad output format specified with -O/-o.
unsupportedOutputFormatError :: String -> String
unsupportedOutputFormatError :: [Char] -> [Char]
unsupportedOutputFormatError [Char]
fmt = [Char]
"Sorry, output format \""[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
fmt[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\" is unrecognised or not yet supported for this kind of report."

-- | Parse the user's specified journal file(s) as a Journal, maybe apply some
-- transformations according to options, and run a hledger command with it.
-- Or, throw an error.
withJournalDo :: CliOpts -> (Journal -> IO a) -> IO a
withJournalDo :: forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts Journal -> IO a
cmd = do
  -- We kludgily read the file before parsing to grab the full text, unless
  -- it's stdin, or it doesn't exist and we are adding. We read it strictly
  -- to let the add command work.
  [[Char]]
journalpaths <- CliOpts -> IO [[Char]]
journalFilePathFromOpts CliOpts
opts
  Either [Char] Journal
files <- InputOpts -> [[Char]] -> IO (Either [Char] Journal)
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) [[Char]]
journalpaths
  let transformed :: Either [Char] Journal
transformed = CliOpts -> Journal -> Journal
journalTransform CliOpts
opts (Journal -> Journal)
-> Either [Char] Journal -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] Journal
files
  ([Char] -> IO a)
-> (Journal -> IO a) -> Either [Char] Journal -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IO a
forall a. [Char] -> a
error' Journal -> IO a
cmd Either [Char] Journal
transformed  -- PARTIAL:

-- | Apply some extra post-parse transformations to the journal, if
-- specified by options. These happen after journal validation, but
-- before report calculation. They include:
--
-- - adding forecast transactions (--forecast)
-- - pivoting account names (--pivot)
-- - anonymising (--anonymise).
--
-- This will return an error message if the query in any auto posting rule fails
-- to parse, or the generated transactions are not balanced.
journalTransform :: CliOpts -> Journal -> Journal
journalTransform :: CliOpts -> Journal -> Journal
journalTransform CliOpts
opts =
    CliOpts -> Journal -> Journal
anonymiseByOpts CliOpts
opts
  -- - converting amounts to market value (--value)
  -- . journalApplyValue ropts
  (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> Journal -> Journal
pivotByOpts CliOpts
opts

-- | Apply the pivot transformation on a journal, if option is present.
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts CliOpts
opts =
  case [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"pivot" (RawOpts -> Maybe [Char])
-> (CliOpts -> RawOpts) -> CliOpts -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> RawOpts
rawopts_ (CliOpts -> Maybe [Char]) -> CliOpts -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ CliOpts
opts of
    Just [Char]
tag -> Text -> Journal -> Journal
journalPivot (Text -> Journal -> Journal) -> Text -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
tag
    Maybe [Char]
Nothing  -> Journal -> Journal
forall a. a -> a
id

-- | Apply the anonymisation transformation on a journal, if option is present
anonymiseByOpts :: CliOpts -> Journal -> Journal
anonymiseByOpts :: CliOpts -> Journal -> Journal
anonymiseByOpts CliOpts
opts =
  if InputOpts -> Bool
anon_ (InputOpts -> Bool) -> (CliOpts -> InputOpts) -> CliOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> InputOpts
inputopts_ (CliOpts -> Bool) -> CliOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts
opts
      then Journal -> Journal
forall a. Anon a => a -> a
anon
      else Journal -> Journal
forall a. a -> a
id

-- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten.
writeOutput :: CliOpts -> String -> IO ()
writeOutput :: CliOpts -> [Char] -> IO ()
writeOutput CliOpts
opts [Char]
s = do
  Maybe [Char]
f <- CliOpts -> IO (Maybe [Char])
outputFileFromOpts CliOpts
opts
  (([Char] -> IO ())
-> ([Char] -> [Char] -> IO ()) -> Maybe [Char] -> [Char] -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char] -> IO ()
putStr [Char] -> [Char] -> IO ()
writeFile Maybe [Char]
f) [Char]
s

-- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten. This function operates on Lazy
-- Text values.
writeOutputLazyText :: CliOpts -> TL.Text -> IO ()
writeOutputLazyText :: CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts Text
s = do
  Maybe [Char]
f <- CliOpts -> IO (Maybe [Char])
outputFileFromOpts CliOpts
opts
  ((Text -> IO ())
-> ([Char] -> Text -> IO ()) -> Maybe [Char] -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
TL.putStr [Char] -> Text -> IO ()
TL.writeFile Maybe [Char]
f) Text
s

-- -- | Get a journal from the given string and options, or throw an error.
-- readJournal :: CliOpts -> String -> IO Journal
-- readJournal opts s = readJournal def Nothing s >>= either error' return

-- | Re-read the option-specified journal file(s), but only if any of
-- them has changed since last read. (If the file is standard input,
-- this will either do nothing or give an error, not tested yet).
-- Returns a journal or error message, and a flag indicating whether
-- it was re-read or not.  Like withJournalDo and journalReload, reads
-- the full journal, without filtering.
journalReloadIfChanged :: CliOpts -> Day -> Journal -> IO (Either String Journal, Bool)
journalReloadIfChanged :: CliOpts -> Day -> Journal -> IO (Either [Char] Journal, Bool)
journalReloadIfChanged CliOpts
opts Day
_d Journal
j = do
  let maybeChangedFilename :: [Char] -> IO (Maybe [Char])
maybeChangedFilename [Char]
f = do Bool
newer <- Journal -> [Char] -> IO Bool
journalFileIsNewer Journal
j [Char]
f
                                  Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ if Bool
newer then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
f else Maybe [Char]
forall a. Maybe a
Nothing
  [[Char]]
changedfiles <- [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Char]] -> [[Char]]) -> IO [Maybe [Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([Char] -> IO (Maybe [Char])) -> [[Char]] -> IO [Maybe [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO (Maybe [Char])
maybeChangedFilename (Journal -> [[Char]]
journalFilePaths Journal
j)
  if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
changedfiles
   then do
     -- XXX not sure why we use cmdarg's verbosity here, but keep it for now
     Bool
verbose <- IO Bool
isLoud
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
verbose Bool -> Bool -> Bool
|| Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s has changed, reloading\n" ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
changedfiles)
     Either [Char] Journal
ej <- CliOpts -> IO (Either [Char] Journal)
journalReload CliOpts
opts
     (Either [Char] Journal, Bool) -> IO (Either [Char] Journal, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] Journal
ej, Bool
True)
   else
     (Either [Char] Journal, Bool) -> IO (Either [Char] Journal, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal -> Either [Char] Journal
forall a b. b -> Either a b
Right Journal
j, Bool
False)

-- | Re-read the journal file(s) specified by options, applying any
-- transformations specified by options. Or return an error string.
-- Reads the full journal, without filtering.
journalReload :: CliOpts -> IO (Either String Journal)
journalReload :: CliOpts -> IO (Either [Char] Journal)
journalReload CliOpts
opts = do
  [[Char]]
journalpaths <- [Char] -> [[Char]] -> [[Char]]
forall a. Show a => [Char] -> a -> a
dbg6 [Char]
"reloading files" ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CliOpts -> IO [[Char]]
journalFilePathFromOpts CliOpts
opts
  Either [Char] Journal
files <- InputOpts -> [[Char]] -> IO (Either [Char] Journal)
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) [[Char]]
journalpaths
  Either [Char] Journal -> IO (Either [Char] Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] Journal -> IO (Either [Char] Journal))
-> Either [Char] Journal -> IO (Either [Char] Journal)
forall a b. (a -> b) -> a -> b
$ CliOpts -> Journal -> Journal
journalTransform CliOpts
opts (Journal -> Journal)
-> Either [Char] Journal -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] Journal
files

-- | Has the specified file changed since the journal was last read ?
-- Typically this is one of the journal's journalFilePaths. These are
-- not always real files, so the file's existence is tested first;
-- for non-files the answer is always no.
journalFileIsNewer :: Journal -> FilePath -> IO Bool
journalFileIsNewer :: Journal -> [Char] -> IO Bool
journalFileIsNewer Journal{jlastreadtime :: Journal -> POSIXTime
jlastreadtime=POSIXTime
tread} [Char]
f = do
  Maybe POSIXTime
mtmod <- [Char] -> IO (Maybe POSIXTime)
maybeFileModificationTime [Char]
f
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
    case Maybe POSIXTime
mtmod of
      Just POSIXTime
tmod -> POSIXTime
tmod POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
tread
      Maybe POSIXTime
Nothing   -> Bool
False

-- | Get the last modified time of the specified file, if it exists.
maybeFileModificationTime :: FilePath -> IO (Maybe POSIXTime)
maybeFileModificationTime :: [Char] -> IO (Maybe POSIXTime)
maybeFileModificationTime [Char]
f = do
  Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
f
  if Bool
exists
  then do
    UTCTime
utc <- [Char] -> IO UTCTime
getModificationTime [Char]
f
    Maybe POSIXTime -> IO (Maybe POSIXTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe POSIXTime -> IO (Maybe POSIXTime))
-> (POSIXTime -> Maybe POSIXTime)
-> POSIXTime
-> IO (Maybe POSIXTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
Just (POSIXTime -> IO (Maybe POSIXTime))
-> POSIXTime -> IO (Maybe POSIXTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc
  else
    Maybe POSIXTime -> IO (Maybe POSIXTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe POSIXTime
forall a. Maybe a
Nothing

-- | Attempt to open a web browser on the given url, all platforms.
openBrowserOn :: String -> IO ExitCode
openBrowserOn :: [Char] -> IO ExitCode
openBrowserOn [Char]
u = [[Char]] -> [Char] -> IO ExitCode
trybrowsers [[Char]]
browsers [Char]
u
    where
      trybrowsers :: [[Char]] -> [Char] -> IO ExitCode
trybrowsers ([Char]
b:[[Char]]
bs) [Char]
u = do
        (ExitCode
e,[Char]
_,[Char]
_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
b [[Char]
u] [Char]
""
        case ExitCode
e of
          ExitCode
ExitSuccess -> ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
          ExitFailure Int
_ -> [[Char]] -> [Char] -> IO ExitCode
trybrowsers [[Char]]
bs [Char]
u
      trybrowsers [] [Char]
u = do
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"Could not start a web browser (tried: %s)" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
browsers
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"Please open your browser and visit %s" [Char]
u
        ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
127
      browsers :: [[Char]]
browsers | [Char]
os[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"darwin"  = [[Char]
"open"]
               | [Char]
os[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"mingw32" = [[Char]
"c:/Program Files/Mozilla Firefox/firefox.exe"]
               | Bool
otherwise     = [[Char]
"sensible-browser",[Char]
"gnome-www-browser",[Char]
"firefox"]
    -- jeffz: write a ffi binding for it using the Win32 package as a basis
    -- start by adding System/Win32/Shell.hsc and follow the style of any
    -- other module in that directory for types, headers, error handling and
    -- what not.
    -- ::ShellExecute(NULL, "open", "www.somepage.com", NULL, NULL, SW_SHOWNORMAL);

-- | Back up this file with a (incrementing) numbered suffix then
-- overwrite it with this new text, or give an error, but only if the text
-- is different from the current file contents, and return a flag
-- indicating whether we did anything.
--
-- The given text should have unix line endings (\n); the existing
-- file content will be normalised to unix line endings before
-- comparing the two. If the file is overwritten, the new file will
-- have the current system's native line endings (\n on unix, \r\n on
-- windows). This could be different from the file's previous line
-- endings, if working with a DOS file on unix or vice-versa.
--
writeFileWithBackupIfChanged :: FilePath -> T.Text -> IO Bool
writeFileWithBackupIfChanged :: [Char] -> Text -> IO Bool
writeFileWithBackupIfChanged [Char]
f Text
t = do
  Text
s <- [Char] -> IO Text
readFilePortably [Char]
f
  if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else [Char] -> IO ()
backUpFile [Char]
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Text -> IO ()
T.writeFile [Char]
f Text
t IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Back up this file with a (incrementing) numbered suffix, then
-- overwrite it with this new text, or give an error.
writeFileWithBackup :: FilePath -> String -> IO ()
writeFileWithBackup :: [Char] -> [Char] -> IO ()
writeFileWithBackup [Char]
f [Char]
t = [Char] -> IO ()
backUpFile [Char]
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> [Char] -> IO ()
writeFile [Char]
f [Char]
t

readFileStrictly :: FilePath -> IO T.Text
readFileStrictly :: [Char] -> IO Text
readFileStrictly [Char]
f = [Char] -> IO Text
readFilePortably [Char]
f IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
s -> Int -> IO Int
forall a. a -> IO a
C.evaluate (Text -> Int
T.length Text
s) IO Int -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

-- | Back up this file with a (incrementing) numbered suffix, or give an error.
backUpFile :: FilePath -> IO ()
backUpFile :: [Char] -> IO ()
backUpFile [Char]
fp = do
  [[Char]]
fs <- [Char] -> IO [[Char]]
safeGetDirectoryContents ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeDirectory ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
fp
  let ([Char]
d,[Char]
f) = [Char] -> ([Char], [Char])
splitFileName [Char]
fp
      versions :: [Int]
versions = ([Char] -> Maybe Int) -> [[Char]] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Char]
f [Char] -> [Char] -> Maybe Int
`backupNumber`) [[Char]]
fs
      next :: Int
next = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
versions) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      f' :: [Char]
f' = [Char] -> [Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s.%d" [Char]
f Int
next
  [Char] -> [Char] -> IO ()
copyFile [Char]
fp ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
f')

safeGetDirectoryContents :: FilePath -> IO [FilePath]
safeGetDirectoryContents :: [Char] -> IO [[Char]]
safeGetDirectoryContents [Char]
"" = [Char] -> IO [[Char]]
getDirectoryContents [Char]
"."
safeGetDirectoryContents [Char]
fp = [Char] -> IO [[Char]]
getDirectoryContents [Char]
fp

-- | Does the second file represent a backup of the first, and if so which version is it ?
-- XXX nasty regex types intruding, add a simpler api to Hledger.Utils.Regex
backupNumber :: FilePath -> FilePath -> Maybe Int
backupNumber :: [Char] -> [Char] -> Maybe Int
backupNumber [Char]
f [Char]
g = case [Char]
g [Char] -> [Char] -> ([Char], [Char], [Char], [[Char]])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ ([Char]
"^" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\.([0-9]+)$") of
                        ([Char]
_::FilePath, [Char]
_::FilePath, [Char]
_::FilePath, [[Char]
ext::FilePath]) -> [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay [Char]
ext
                        ([Char], [Char], [Char], [[Char]])
_ -> Maybe Int
forall a. Maybe a
Nothing

-- Identify the closest recent match for this description in past transactions.
-- If the options specify a query, only matched transactions are considered.
journalSimilarTransaction :: CliOpts -> Journal -> T.Text -> Maybe Transaction
journalSimilarTransaction :: CliOpts -> Journal -> Text -> Maybe Transaction
journalSimilarTransaction CliOpts
cliopts Journal
j Text
desc = Maybe Transaction
mbestmatch
  where
    mbestmatch :: Maybe Transaction
mbestmatch = (Double, Transaction) -> Transaction
forall a b. (a, b) -> b
snd ((Double, Transaction) -> Transaction)
-> Maybe (Double, Transaction) -> Maybe Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Transaction)] -> Maybe (Double, Transaction)
forall a. [a] -> Maybe a
headMay [(Double, Transaction)]
bestmatches
    bestmatches :: [(Double, Transaction)]
bestmatches =
      ([(Double, Transaction)] -> [Char])
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a. Show a => (a -> [Char]) -> a -> a
dbg1With ([[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> ([(Double, Transaction)] -> [[Char]])
-> [(Double, Transaction)]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"similar transactions:"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:) ([[Char]] -> [[Char]])
-> ([(Double, Transaction)] -> [[Char]])
-> [(Double, Transaction)]
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Transaction) -> [Char])
-> [(Double, Transaction)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Double
score,Transaction{Integer
[Tag]
[Posting]
Maybe Day
(SourcePos, SourcePos)
Text
Status
Day
tindex :: Transaction -> Integer
tprecedingcomment :: Transaction -> Text
tsourcepos :: Transaction -> (SourcePos, SourcePos)
tdate :: Transaction -> Day
tdate2 :: Transaction -> Maybe Day
tstatus :: Transaction -> Status
tcode :: Transaction -> Text
tdescription :: Transaction -> Text
tcomment :: Transaction -> Text
ttags :: Transaction -> [Tag]
tpostings :: Transaction -> [Posting]
tpostings :: [Posting]
ttags :: [Tag]
tcomment :: Text
tdescription :: Text
tcode :: Text
tstatus :: Status
tdate2 :: Maybe Day
tdate :: Day
tsourcepos :: (SourcePos, SourcePos)
tprecedingcomment :: Text
tindex :: Integer
..}) -> [Char] -> Double -> [Char] -> Text -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%0.3f %s %s" Double
score (Day -> [Char]
forall a. Show a => a -> [Char]
show Day
tdate) Text
tdescription)) ([(Double, Transaction)] -> [(Double, Transaction)])
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a b. (a -> b) -> a -> b
$
      Journal -> Query -> Text -> Int -> [(Double, Transaction)]
journalTransactionsSimilarTo Journal
j Query
q Text
desc Int
10
    q :: Query
q = ReportOpts -> Query
queryFromFlags (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> ReportOpts) -> ReportSpec -> ReportOpts
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
cliopts

tests_Cli_Utils :: TestTree
tests_Cli_Utils = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Utils" [

  --  testGroup "journalApplyValue" [
  --    -- Print the time required to convert one of the sample journals' amounts to value.
  --    -- Pretty clunky, but working.
  --    -- XXX sample.journal has no price records, but is always present.
  --    -- Change to eg examples/5000x1000x10.journal to make this useful.
  --    testCase "time" $ do
  --      ej <- io $ readJournalFile definputopts "examples/3000x1000x10.journal"
  --      case ej of
  --        Left e  -> crash $ T.pack e
  --        Right j -> do
  --          (t,_) <- io $ timeItT $ do
  --            -- Enable -V, and ensure the valuation date is later than
  --            -- all prices for consistent timing.
  --            let ropts = defreportopts{
  --              value_=True,
  --              period_=PeriodTo $ fromGregorian 3000 01 01
  --              }
  --            j' <- journalApplyValue ropts j
  --            sum (journalAmounts j') `seq` return ()
  --          io $ printf "[%.3fs] " t
  --          ok
  -- ]

 ]