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