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

    A 'PeriodicTransaction' is a rule describing recurring transactions.

    -}
    module Hledger.Data.PeriodicTransaction (
        runPeriodicTransaction
      , checkPeriodicTransactionStartDate
    )
    where

    import Data.Function ((&))
    import Data.Maybe (isNothing)
    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

    -- $setup
    -- >>> :set -XOverloadedStrings
    -- >>> import Hledger.Data.Posting
    -- >>> import Hledger.Data.Journal

    -- doctest helper, too much hassle to define in the comment
    -- XXX duplicates some logic in periodictransactionp
    _ptgen :: [Char] -> IO ()
    _ptgen [Char]
    str = do
      let
        t :: AccountName
    t = [Char] -> AccountName
    T.pack [Char]
    str
        (Interval
    i,DateSpan
    s) = Day -> AccountName -> (Interval, DateSpan)
    parsePeriodExpr' Day
    nulldate AccountName
    t
      (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
    $
        Bool -> PeriodicTransaction -> DateSpan -> [Transaction]
    runPeriodicTransaction Bool
    True
          PeriodicTransaction
    nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
          DateSpan
    nulldatespan

    _ptgenspan :: [Char] -> DateSpan -> IO ()
    _ptgenspan [Char]
    str DateSpan
    spn = do
      let
        t :: AccountName
    t = [Char] -> AccountName
    T.pack [Char]
    str
        (Interval
    i,DateSpan
    s) = Day -> AccountName -> (Interval, DateSpan)
    parsePeriodExpr' Day
    nulldate AccountName
    t
      (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
    $
        Bool -> PeriodicTransaction -> DateSpan -> [Transaction]
    runPeriodicTransaction Bool
    True
          PeriodicTransaction
    nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
          DateSpan
    spn

    --deriving instance Show PeriodicTransaction
    -- for better pretty-printing:
    instance Show PeriodicTransaction where
      show :: PeriodicTransaction -> [Char]
    show PeriodicTransaction{[Tag]
    [Posting]
    (SourcePos, SourcePos)
    AccountName
    Status
    Interval
    DateSpan
    ptperiodexpr :: PeriodicTransaction -> AccountName
    ptspan :: PeriodicTransaction -> DateSpan
    ptinterval :: PeriodicTransaction -> Interval
    ptpostings :: PeriodicTransaction -> [Posting]
    ptperiodexpr :: AccountName
    ptinterval :: Interval
    ptspan :: DateSpan
    ptsourcepos :: (SourcePos, SourcePos)
    ptstatus :: Status
    ptcode :: AccountName
    ptdescription :: AccountName
    ptcomment :: AccountName
    pttags :: [Tag]
    ptpostings :: [Posting]
    ptsourcepos :: PeriodicTransaction -> (SourcePos, SourcePos)
    ptstatus :: PeriodicTransaction -> Status
    ptcode :: PeriodicTransaction -> AccountName
    ptdescription :: PeriodicTransaction -> AccountName
    ptcomment :: PeriodicTransaction -> AccountName
    pttags :: PeriodicTransaction -> [Tag]
    ..} =
        [Char]
    -> [Char]
    -> [Char]
    -> [Char]
    -> [Char]
    -> [Char]
    -> [Char]
    -> [Char]
    -> [Char]
    -> [Char]
    -> ShowS
    forall r. PrintfType r => [Char] -> r
    printf [Char]
    "PeriodicTransactionPP {%s, %s, %s, %s, %s, %s, %s, %s, %s, %s}"
          -- Warning, be careful to keep these synced ^ v
          ([Char]
    "ptperiodexpr=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ AccountName -> [Char]
    forall a. Show a => a -> [Char]
    show AccountName
    ptperiodexpr)
          ([Char]
    "ptinterval=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Interval -> [Char]
    forall a. Show a => a -> [Char]
    show Interval
    ptinterval)
          ([Char]
    "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))
          ([Char]
    "ptsourcepos=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (SourcePos, SourcePos) -> [Char]
    forall a. Show a => a -> [Char]
    show (SourcePos, SourcePos)
    ptsourcepos)
          ([Char]
    "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))
          ([Char]
    "ptcode=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ AccountName -> [Char]
    forall a. Show a => a -> [Char]
    show AccountName
    ptcode)
          ([Char]
    "ptdescription=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ AccountName -> [Char]
    forall a. Show a => a -> [Char]
    show AccountName
    ptdescription)
          ([Char]
    "ptcomment=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ AccountName -> [Char]
    forall a. Show a => a -> [Char]
    show AccountName
    ptcomment)
          ([Char]
    "pttags=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Tag] -> [Char]
    forall a. Show a => a -> [Char]
    show [Tag]
    pttags)
          ([Char]
    "ptpostings=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Posting] -> [Char]
    forall a. Show a => a -> [Char]
    show [Posting]
    ptpostings)

    -- A basic human-readable rendering.
    --showPeriodicTransaction t = "~ " ++ T.unpack (ptperiodexpr t) ++ "\n" ++ unlines (map show (ptpostings t))

    --nullperiodictransaction is defined in Types.hs

    -- | Generate transactions from 'PeriodicTransaction' within a 'DateSpan'.
    -- This should be a closed span with both start and end dates specified;
    -- an open ended span will generate no transactions.
    --
    -- Note that new transactions require 'txnTieKnot' post-processing.
    -- The new transactions will have three tags added:
    -- - a recur:PERIODICEXPR tag whose value is the generating periodic expression
    -- - a generated-transaction: tag
    -- - a hidden _generated-transaction: tag which does not appear in the comment.
    --
    -- >>> import Data.Time (fromGregorian)
    -- >>> _ptgen "monthly from 2017/1 to 2017/4"
    -- 2017-01-01
    --     ; generated-transaction: ~ monthly from 2017/1 to 2017/4
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-02-01
    --     ; generated-transaction: ~ monthly from 2017/1 to 2017/4
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-03-01
    --     ; generated-transaction: ~ monthly from 2017/1 to 2017/4
    --     a           $1.00
    -- <BLANKLINE>
    --
    -- >>> _ptgen "monthly from 2017/1 to 2017/5"
    -- 2017-01-01
    --     ; generated-transaction: ~ monthly from 2017/1 to 2017/5
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-02-01
    --     ; generated-transaction: ~ monthly from 2017/1 to 2017/5
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-03-01
    --     ; generated-transaction: ~ monthly from 2017/1 to 2017/5
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-04-01
    --     ; generated-transaction: ~ monthly from 2017/1 to 2017/5
    --     a           $1.00
    -- <BLANKLINE>
    --
    -- >>> _ptgen "every 2nd day of month from 2017/02 to 2017/04"
    -- 2017-01-02
    --     ; generated-transaction: ~ every 2nd day of month from 2017/02 to 2017/04
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-02-02
    --     ; generated-transaction: ~ every 2nd day of month from 2017/02 to 2017/04
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-03-02
    --     ; generated-transaction: ~ every 2nd day of month from 2017/02 to 2017/04
    --     a           $1.00
    -- <BLANKLINE>
    --
    -- >>> _ptgen "every 30th day of month from 2017/1 to 2017/5"
    -- 2016-12-30
    --     ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-01-30
    --     ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-02-28
    --     ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-03-30
    --     ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-04-30
    --     ; generated-transaction: ~ every 30th day of month from 2017/1 to 2017/5
    --     a           $1.00
    -- <BLANKLINE>
    --
    -- >>> _ptgen "every 2nd Thursday of month from 2017/1 to 2017/4"
    -- 2016-12-08
    --     ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-01-12
    --     ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-02-09
    --     ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-03-09
    --     ; generated-transaction: ~ every 2nd Thursday of month from 2017/1 to 2017/4
    --     a           $1.00
    -- <BLANKLINE>
    --
    -- >>> _ptgen "every nov 29th from 2017 to 2019"
    -- 2016-11-29
    --     ; generated-transaction: ~ every nov 29th from 2017 to 2019
    --     a           $1.00
    -- <BLANKLINE>
    -- 2017-11-29
    --     ; generated-transaction: ~ every nov 29th from 2017 to 2019
    --     a           $1.00
    -- <BLANKLINE>
    -- 2018-11-29
    --     ; generated-transaction: ~ every nov 29th from 2017 to 2019
    --     a           $1.00
    -- <BLANKLINE>
    --
    -- >>> _ptgen "2017/1"
    -- 2017-01-01
    --     ; generated-transaction: ~ 2017/1
    --     a           $1.00
    -- <BLANKLINE>
    --
    -- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction True (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03))
    -- []
    --
    -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ Flex $ fromGregorian 2020 01 01) (Just $ Flex $ fromGregorian 2020 02 01))
    --
    -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ Flex $ fromGregorian 2020 02 01) (Just $ Flex $ fromGregorian 2020 03 01))
    -- 2020-02-01
    --     ; generated-transaction: ~ every 3 months from 2019-05
    --     a           $1.00
    -- <BLANKLINE>
    -- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 05))
    -- 2018-01-01
    --     ; generated-transaction: ~ every 3 days from 2018
    --     a           $1.00
    -- <BLANKLINE>
    -- 2018-01-04
    --     ; generated-transaction: ~ every 3 days from 2018
    --     a           $1.00
    -- <BLANKLINE>
    -- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ Flex $ fromGregorian 2018 01 02) (Just $ Flex $ fromGregorian 2018 01 05))
    -- 2018-01-04
    --     ; generated-transaction: ~ every 3 days from 2018
    --     a           $1.00
    -- <BLANKLINE>

    runPeriodicTransaction :: Bool -> PeriodicTransaction -> DateSpan -> [Transaction]
    runPeriodicTransaction :: Bool -> PeriodicTransaction -> DateSpan -> [Transaction]
    runPeriodicTransaction Bool
    verbosetags PeriodicTransaction{[Tag]
    [Posting]
    (SourcePos, SourcePos)
    AccountName
    Status
    Interval
    DateSpan
    ptperiodexpr :: PeriodicTransaction -> AccountName
    ptspan :: PeriodicTransaction -> DateSpan
    ptinterval :: PeriodicTransaction -> Interval
    ptpostings :: PeriodicTransaction -> [Posting]
    ptsourcepos :: PeriodicTransaction -> (SourcePos, SourcePos)
    ptstatus :: PeriodicTransaction -> Status
    ptcode :: PeriodicTransaction -> AccountName
    ptdescription :: PeriodicTransaction -> AccountName
    ptcomment :: PeriodicTransaction -> AccountName
    pttags :: PeriodicTransaction -> [Tag]
    ptperiodexpr :: AccountName
    ptinterval :: Interval
    ptspan :: DateSpan
    ptsourcepos :: (SourcePos, SourcePos)
    ptstatus :: Status
    ptcode :: AccountName
    ptdescription :: AccountName
    ptcomment :: AccountName
    pttags :: [Tag]
    ptpostings :: [Posting]
    ..} DateSpan
    requestedspan =
        [ Transaction
    t{tdate=d} | (DateSpan (Just EFDay
    efd) Maybe EFDay
    _) <- [DateSpan]
    alltxnspans, let d :: Day
    d = EFDay -> Day
    fromEFDay EFDay
    efd, DateSpan -> Day -> Bool
    spanContainsDate DateSpan
    requestedspan Day
    d ]
      where
        t :: Transaction
    t = Transaction
    nulltransaction{
               tsourcepos   = ptsourcepos
              ,tstatus      = ptstatus
              ,tcode        = ptcode
              ,tdescription = ptdescription
              ,tcomment     = ptcomment &
                (if verbosetags then (`commentAddTagNextLine` ("generated-transaction",period)) else id)
              ,ttags        = pttags &
                (("_generated-transaction",period) :) &
                (if verbosetags then (("generated-transaction" ,period) :) else id)
              ,tpostings    = ptpostings
              }
        period :: AccountName
    period = AccountName
    "~ " AccountName -> AccountName -> AccountName
    forall a. Semigroup a => a -> a -> a
    <> AccountName
    ptperiodexpr
        -- All the date spans described by this periodic transaction rule.
        alltxnspans :: [DateSpan]
    alltxnspans = Bool -> Interval -> DateSpan -> [DateSpan]
    splitSpan Bool
    adjust Interval
    ptinterval DateSpan
    span'
          where
            -- If the PT does not specify  start or end dates, we take them from the requestedspan.
            span' :: DateSpan
    span' = DateSpan
    ptspan DateSpan -> DateSpan -> DateSpan
    `spanDefaultsFrom` DateSpan
    requestedspan
            -- Unless the PT specified a start date explicitly, we will adjust the start date to the previous interval boundary.
            adjust :: Bool
    adjust = Maybe Day -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe Day -> Bool) -> Maybe Day -> Bool
    forall a b. (a -> b) -> a -> b
    $ DateSpan -> Maybe Day
    spanStart DateSpan
    span'

    -- | Check that this date span begins at a boundary of this interval,
    -- or return an explanatory error message including the provided period expression
    -- (from which the span and interval are derived).
    checkPeriodicTransactionStartDate :: Interval -> DateSpan -> T.Text -> Maybe String
    checkPeriodicTransactionStartDate :: Interval -> DateSpan -> AccountName -> Maybe [Char]
    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 [Char]
    checkStart Day
    d SmartInterval
    Week
        (Months Int
    _,   Just Day
    d) -> Day -> SmartInterval -> Maybe [Char]
    checkStart Day
    d SmartInterval
    Month
        (Quarters Int
    _, Just Day
    d) -> Day -> SmartInterval -> Maybe [Char]
    checkStart Day
    d SmartInterval
    Quarter
        (Years Int
    _,    Just Day
    d) -> Day -> SmartInterval -> Maybe [Char]
    checkStart Day
    d SmartInterval
    Year
        (Interval, Maybe Day)
    _                    -> Maybe [Char]
    forall a. Maybe a
    Nothing
        where
          checkStart :: Day -> SmartInterval -> Maybe [Char]
    checkStart Day
    d SmartInterval
    x =
            let firstDate :: Day
    firstDate = EFDay -> Day
    fromEFDay (EFDay -> Day) -> EFDay -> Day
    forall a b. (a -> b) -> a -> b
    $ Day -> SmartDate -> EFDay
    fixSmartDate Day
    d (SmartDate -> EFDay) -> SmartDate -> EFDay
    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 [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
    $
              [Char]
    "Unable to generate transactions according to "[Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ShowS
    forall a. Show a => a -> [Char]
    show (AccountName -> [Char]
    T.unpack AccountName
    periodexpr)
              [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " 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]
    ++[Char]
    " is not a first day of the "[Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++SmartInterval -> [Char]
    forall a. Show a => a -> [Char]
    show SmartInterval
    x

    ---- | What is the interval of this 'PeriodicTransaction's period expression, if it can be parsed ?
    --periodTransactionInterval :: PeriodicTransaction -> Maybe Interval
    --periodTransactionInterval pt =
    --  let
    --    expr = ptperiodexpr pt
    --    err  = error' $ "Current date cannot be referenced in " ++ show (T.unpack expr)
    --  in
    --    case parsePeriodExpr err expr of
    --      Left _      -> Nothing
    --      Right (i,_) -> Just i