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

    A 'PeriodicTransaction' is a rule describing recurring transactions.

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

    #if !(MIN_VERSION_base(4,11,0))
    import Data.Semigroup ((<>))
    #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

    -- $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 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  -- PARTIAL:
        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  -- PARTIAL:
        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

    --deriving instance Show PeriodicTransaction
    -- for better pretty-printing:
    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)

    -- 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'
    --
    -- 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>
    --
    -- >>> _ptgen ""
    -- *** Exception: failed to parse...
    -- ...
    --
    -- >>> _ptgen "weekly from 2017"
    -- *** Exception: Unable to generate transactions according to "weekly from 2017" because 2017-01-01 is not a first day of the Week
    --
    -- >>> _ptgen "monthly from 2017/5/4"
    -- *** Exception: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the Month
    --
    -- >>> _ptgen "every quarter from 2017/1/2"
    -- *** Exception: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the Quarter
    --
    -- >>> _ptgen "yearly from 2017/1/14"
    -- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the Year
    --
    -- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03))
    -- []
    --
    -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ fromGregorian 2020 01 01) (Just $ fromGregorian 2020 02 01))
    --
    -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ fromGregorian 2020 02 01) (Just $ 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 $ fromGregorian 2018 01 01) (Just $ 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 $ fromGregorian 2018 01 02) (Just $ fromGregorian 2018 01 05))
    -- 2018-01-04
    --     ; generated-transaction: ~ every 3 days from 2018
    --     a           $1.00
    -- <BLANKLINE>

    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
        -- All spans described by this periodic transaction, where spanStart is event date.
        -- If transaction does not have start/end date, we set them to start/end of requested span,
        -- to avoid generating (infinitely) many events.
        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)

    -- | 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 -> 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 -> SmartInterval -> Maybe [Char]
    checkStart Day
    d SmartInterval
    Week
        (Months _,   Just d :: Day
    d) -> Day -> SmartInterval -> Maybe [Char]
    checkStart Day
    d SmartInterval
    Month
        (Quarters _, Just d :: Day
    d) -> Day -> SmartInterval -> Maybe [Char]
    checkStart Day
    d SmartInterval
    Quarter
        (Years _,    Just d :: Day
    d) -> Day -> SmartInterval -> Maybe [Char]
    checkStart Day
    d SmartInterval
    Year
        _                    -> Maybe [Char]
    forall a. Maybe a
    Nothing
        where
          checkStart :: Day -> SmartInterval -> Maybe [Char]
    checkStart d :: Day
    d x :: SmartInterval
    x =
            let firstDate :: Day
    firstDate = Day -> SmartDate -> Day
    fixSmartDate Day
    d (SmartDate -> Day) -> SmartDate -> Day
    forall a b. (a -> b) -> a -> b
    $ SmartSequence -> SmartInterval -> SmartDate
    SmartRelative SmartSequence
    This 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
    $
              "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]
    ++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