{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Data.PeriodicTransaction (
runPeriodicTransaction
, checkPeriodicTransactionStartDate
)
where
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import qualified Data.Text as T
import Text.Printf
import Hledger.Data.Types
import Hledger.Data.Dates
import Hledger.Data.Amount
import Hledger.Data.Posting (post, commentAddTagNextLine)
import Hledger.Data.Transaction
import Hledger.Utils.UTF8IOCompat (error')
import Hledger.Utils.Debug
_ptgen :: [Char] -> IO ()
_ptgen str :: [Char]
str = do
let
t :: Text
t = [Char] -> Text
T.pack [Char]
str
(i :: Interval
i,s :: DateSpan
s) = Day -> Text -> (Interval, DateSpan)
parsePeriodExpr' Day
nulldate Text
t
case Interval -> DateSpan -> Text -> Maybe [Char]
checkPeriodicTransactionStartDate Interval
i DateSpan
s Text
t of
Just e :: [Char]
e -> [Char] -> IO ()
forall a. [Char] -> a
error' [Char]
e
Nothing ->
(Transaction -> IO ()) -> [Transaction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> IO ()
putStr ([Char] -> IO ())
-> (Transaction -> [Char]) -> Transaction -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Char]
showTransaction) ([Transaction] -> IO ()) -> [Transaction] -> IO ()
forall a b. (a -> b) -> a -> b
$
PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction
PeriodicTransaction
nullperiodictransaction{ ptperiodexpr :: Text
ptperiodexpr=Text
t , ptspan :: DateSpan
ptspan=DateSpan
s, ptinterval :: Interval
ptinterval=Interval
i, ptpostings :: [Posting]
ptpostings=["a" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd 1] }
DateSpan
nulldatespan
_ptgenspan :: [Char] -> DateSpan -> IO ()
_ptgenspan str :: [Char]
str span :: DateSpan
span = do
let
t :: Text
t = [Char] -> Text
T.pack [Char]
str
(i :: Interval
i,s :: DateSpan
s) = Day -> Text -> (Interval, DateSpan)
parsePeriodExpr' Day
nulldate Text
t
case Interval -> DateSpan -> Text -> Maybe [Char]
checkPeriodicTransactionStartDate Interval
i DateSpan
s Text
t of
Just e :: [Char]
e -> [Char] -> IO ()
forall a. [Char] -> a
error' [Char]
e
Nothing ->
(Transaction -> IO ()) -> [Transaction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> IO ()
putStr ([Char] -> IO ())
-> (Transaction -> [Char]) -> Transaction -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Char]
showTransaction) ([Transaction] -> IO ()) -> [Transaction] -> IO ()
forall a b. (a -> b) -> a -> b
$
PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction
PeriodicTransaction
nullperiodictransaction{ ptperiodexpr :: Text
ptperiodexpr=Text
t , ptspan :: DateSpan
ptspan=DateSpan
s, ptinterval :: Interval
ptinterval=Interval
i, ptpostings :: [Posting]
ptpostings=["a" Text -> Amount -> Posting
`post` DecimalRaw Integer -> Amount
usd 1] }
DateSpan
span
instance Show PeriodicTransaction where
show :: PeriodicTransaction -> [Char]
show PeriodicTransaction{..} =
[Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> ShowS
forall r. PrintfType r => [Char] -> r
printf "PeriodicTransactionPP {%s, %s, %s, %s, %s, %s, %s, %s, %s}"
("ptperiodexpr=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
ptperiodexpr)
("ptinterval=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Interval -> [Char]
forall a. Show a => a -> [Char]
show Interval
ptinterval)
("ptspan=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (DateSpan -> [Char]
forall a. Show a => a -> [Char]
show DateSpan
ptspan))
("ptstatus=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show (Status -> [Char]
forall a. Show a => a -> [Char]
show Status
ptstatus))
("ptcode=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
ptcode)
("ptdescription=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
ptdescription)
("ptcomment=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
ptcomment)
("pttags=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Tag] -> [Char]
forall a. Show a => a -> [Char]
show [Tag]
pttags)
("ptpostings=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Posting] -> [Char]
forall a. Show a => a -> [Char]
show [Posting]
ptpostings)
runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction PeriodicTransaction{..} requestedspan :: DateSpan
requestedspan =
[ Transaction
t{tdate :: Day
tdate=Day
d} | (DateSpan (Just d :: Day
d) _) <- [DateSpan]
alltxnspans, DateSpan -> Day -> Bool
spanContainsDate DateSpan
requestedspan Day
d ]
where
t :: Transaction
t = Transaction
nulltransaction{
tstatus :: Status
tstatus = Status
ptstatus
,tcode :: Text
tcode = Text
ptcode
,tdescription :: Text
tdescription = Text
ptdescription
,tcomment :: Text
tcomment = Text
ptcomment
Text -> Tag -> Text
`commentAddTagNextLine` ("generated-transaction",Text
period)
,ttags :: [Tag]
ttags = ("_generated-transaction",Text
period) Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
:
("generated-transaction" ,Text
period) Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
:
[Tag]
pttags
,tpostings :: [Posting]
tpostings = [Posting]
ptpostings
}
period :: Text
period = "~ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ptperiodexpr
alltxnspans :: [DateSpan]
alltxnspans = [Char] -> [DateSpan] -> [DateSpan]
forall a. Show a => [Char] -> a -> a
dbg3 "alltxnspans" ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Interval
ptinterval Interval -> DateSpan -> [DateSpan]
`splitSpan` (DateSpan -> DateSpan -> DateSpan
spanDefaultsFrom DateSpan
ptspan DateSpan
requestedspan)
checkPeriodicTransactionStartDate :: Interval -> DateSpan -> T.Text -> Maybe String
checkPeriodicTransactionStartDate :: Interval -> DateSpan -> Text -> Maybe [Char]
checkPeriodicTransactionStartDate i :: Interval
i s :: DateSpan
s periodexpr :: Text
periodexpr =
case (Interval
i, DateSpan -> Maybe Day
spanStart DateSpan
s) of
(Weeks _, Just d :: Day
d) -> Day -> [Char] -> Maybe [Char]
checkStart Day
d "week"
(Months _, Just d :: Day
d) -> Day -> [Char] -> Maybe [Char]
checkStart Day
d "month"
(Quarters _, Just d :: Day
d) -> Day -> [Char] -> Maybe [Char]
checkStart Day
d "quarter"
(Years _, Just d :: Day
d) -> Day -> [Char] -> Maybe [Char]
checkStart Day
d "year"
_ -> Maybe [Char]
forall a. Maybe a
Nothing
where
checkStart :: Day -> [Char] -> Maybe [Char]
checkStart d :: Day
d x :: [Char]
x =
let firstDate :: Day
firstDate = Day -> SmartDate -> Day
fixSmartDate Day
d ("","this",[Char]
x)
in
if Day
d Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Day
firstDate
then Maybe [Char]
forall a. Maybe a
Nothing
else [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$
"Unable to generate transactions according to "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
forall a. Show a => a -> [Char]
show (Text -> [Char]
T.unpack Text
periodexpr)
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++" because "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Day -> [Char]
forall a. Show a => a -> [Char]
show Day
d[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++" is not a first day of the "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
x