    {-|

    A 'TimeclockEntry' is a clock-in, clock-out, or other directive in a timeclock
    file (see timeclock.el or the command-line version). These can be
    converted to 'Transactions' and queried like a ledger.

    -}

    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE StandaloneDeriving #-}

    module Hledger.Data.Timeclock (
       timeclockToTransactions
      ,timeclockToTransactionsOld
      ,tests_Timeclock
    )
    where

    import Data.List (partition, sortBy, uncons)
    import Data.Maybe (fromMaybe)
    import Data.Text qualified as T
    import Data.Time.Calendar (addDays)
    import Data.Time.Clock (addUTCTime, getCurrentTime)
    import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
    import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), getCurrentTimeZone,
                                localTimeToUTC, midnight, utc, utcToLocalTime)
    import Text.Printf (printf)

    import Hledger.Utils
    import Hledger.Data.Types
    import Hledger.Data.Dates
    import Hledger.Data.Amount
    import Hledger.Data.Posting

    -- detailed output for debugging
    -- deriving instance Show TimeclockEntry

    -- compact output
    instance Show TimeclockEntry where
      show :: TimeclockEntry -> String
    show TimeclockEntry
    t = String -> String -> String -> Text -> Text -> String
    forall r. PrintfType r => String -> r
    printf String
    "%s %s %s  %s" (TimeclockCode -> String
    forall a. Show a => a -> String
    show (TimeclockCode -> String) -> TimeclockCode -> String
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> TimeclockCode
    tlcode TimeclockEntry
    t) (LocalTime -> String
    forall a. Show a => a -> String
    show (LocalTime -> String) -> LocalTime -> String
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    t) (TimeclockEntry -> Text
    tlaccount TimeclockEntry
    t) (TimeclockEntry -> Text
    tldescription TimeclockEntry
    t)

    instance Show TimeclockCode where
      show :: TimeclockCode -> String
    show TimeclockCode
    SetBalance = String
    "b"
      show TimeclockCode
    SetRequiredHours = String
    "h"
      show TimeclockCode
    In = String
    "i"
      show TimeclockCode
    Out = String
    "o"
      show TimeclockCode
    FinalOut = String
    "O"

    instance Read TimeclockCode where
      readsPrec :: Int -> ReadS TimeclockCode
    readsPrec Int
    _ (Char
    'b':String
    xs) = [(TimeclockCode
    SetBalance, String
    xs)]
      readsPrec Int
    _ (Char
    'h':String
    xs) = [(TimeclockCode
    SetRequiredHours, String
    xs)]
      readsPrec Int
    _ (Char
    'i':String
    xs) = [(TimeclockCode
    In, String
    xs)]
      readsPrec Int
    _ (Char
    'o':String
    xs) = [(TimeclockCode
    Out, String
    xs)]
      readsPrec Int
    _ (Char
    'O':String
    xs) = [(TimeclockCode
    FinalOut, String
    xs)]
      readsPrec Int
    _ String
    _ = []

    data Session = Session {
      Session -> TimeclockEntry
    in' :: TimeclockEntry,
      Session -> TimeclockEntry
    out :: TimeclockEntry
    } deriving Int -> Session -> String -> String
    [Session] -> String -> String
    Session -> String
    (Int -> Session -> String -> String)
    -> (Session -> String)
    -> ([Session] -> String -> String)
    -> Show Session
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Session -> String -> String
    showsPrec :: Int -> Session -> String -> String
    $cshow :: Session -> String
    show :: Session -> String
    $cshowList :: [Session] -> String -> String
    showList :: [Session] -> String -> String
    Show

    data Sessions = Sessions {
      Sessions -> [Session]
    completed :: [Session],
      Sessions -> [TimeclockEntry]
    active :: [TimeclockEntry]
    } deriving Int -> Sessions -> String -> String
    [Sessions] -> String -> String
    Sessions -> String
    (Int -> Sessions -> String -> String)
    -> (Sessions -> String)
    -> ([Sessions] -> String -> String)
    -> Show Sessions
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Sessions -> String -> String
    showsPrec :: Int -> Sessions -> String -> String
    $cshow :: Sessions -> String
    show :: Sessions -> String
    $cshowList :: [Sessions] -> String -> String
    showList :: [Sessions] -> String -> String
    Show

    -- | Convert timeclock entries to journal transactions.
    -- This is the old version from hledger <1.43, now enabled by --old-timeclock.
    -- It requires strictly alternating clock-in and clock-entries.
    -- It was documented as allowing only one clocked-in session at a time,
    -- but in fact it allows concurrent sessions, even with the same account name.
    --
    -- Entries must be a strict alternation of in and out, beginning with in.
    -- When there is no clockout, one is added with the provided current time.
    -- Sessions crossing midnight are split into days to give accurate per-day totals.
    -- If entries are not in the expected in/out order, an error is raised.
    --
    timeclockToTransactionsOld :: LocalTime -> [TimeclockEntry] -> [Transaction]
    timeclockToTransactionsOld :: LocalTime -> [TimeclockEntry] -> [Transaction]
    timeclockToTransactionsOld LocalTime
    _ [] = []
    timeclockToTransactionsOld LocalTime
    now [TimeclockEntry
    i]
      | TimeclockEntry -> TimeclockCode
    tlcode TimeclockEntry
    i TimeclockCode -> TimeclockCode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TimeclockCode
    In = TimeclockCode -> TimeclockEntry -> [Transaction]
    forall a. TimeclockCode -> TimeclockEntry -> a
    errorExpectedCodeButGot TimeclockCode
    In TimeclockEntry
    i
      | Day
    odate Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    > Day
    idate = Bool -> TimeclockEntry -> TimeclockEntry -> Transaction
    entryFromTimeclockInOut Bool
    True TimeclockEntry
    i TimeclockEntry
    o' Transaction -> [Transaction] -> [Transaction]
    forall a. a -> [a] -> [a]
    : LocalTime -> [TimeclockEntry] -> [Transaction]
    timeclockToTransactionsOld LocalTime
    now [TimeclockEntry
    i',TimeclockEntry
    o]
      | Bool
    otherwise = [Bool -> TimeclockEntry -> TimeclockEntry -> Transaction
    entryFromTimeclockInOut Bool
    True TimeclockEntry
    i TimeclockEntry
    o]
      where
        o :: TimeclockEntry
    o = SourcePos
    -> TimeclockCode
    -> LocalTime
    -> Text
    -> Text
    -> Text
    -> [Tag]
    -> TimeclockEntry
    TimeclockEntry (TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    i) TimeclockCode
    Out LocalTime
    end Text
    "" Text
    "" Text
    "" []
        end :: LocalTime
    end = if LocalTime
    itime LocalTime -> LocalTime -> Bool
    forall a. Ord a => a -> a -> Bool
    > LocalTime
    now then LocalTime
    itime else LocalTime
    now
        (LocalTime
    itime,LocalTime
    otime) = (TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    i,TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    o)
        (Day
    idate,Day
    odate) = (LocalTime -> Day
    localDay LocalTime
    itime,LocalTime -> Day
    localDay LocalTime
    otime)
        o' :: TimeclockEntry
    o' = TimeclockEntry
    o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}
        i' :: TimeclockEntry
    i' = TimeclockEntry
    i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}}
    timeclockToTransactionsOld LocalTime
    now (TimeclockEntry
    i:TimeclockEntry
    o:[TimeclockEntry]
    rest)
      | TimeclockEntry -> TimeclockCode
    tlcode TimeclockEntry
    i TimeclockCode -> TimeclockCode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TimeclockCode
    In  = TimeclockCode -> TimeclockEntry -> [Transaction]
    forall a. TimeclockCode -> TimeclockEntry -> a
    errorExpectedCodeButGot TimeclockCode
    In TimeclockEntry
    i
      | TimeclockEntry -> TimeclockCode
    tlcode TimeclockEntry
    o TimeclockCode -> TimeclockCode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TimeclockCode
    Out = TimeclockCode -> TimeclockEntry -> [Transaction]
    forall a. TimeclockCode -> TimeclockEntry -> a
    errorExpectedCodeButGot TimeclockCode
    Out TimeclockEntry
    o
      | Day
    odate Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    > Day
    idate   = Bool -> TimeclockEntry -> TimeclockEntry -> Transaction
    entryFromTimeclockInOut Bool
    True TimeclockEntry
    i TimeclockEntry
    o' Transaction -> [Transaction] -> [Transaction]
    forall a. a -> [a] -> [a]
    : LocalTime -> [TimeclockEntry] -> [Transaction]
    timeclockToTransactionsOld LocalTime
    now (TimeclockEntry
    i'TimeclockEntry -> [TimeclockEntry] -> [TimeclockEntry]
    forall a. a -> [a] -> [a]
    :TimeclockEntry
    oTimeclockEntry -> [TimeclockEntry] -> [TimeclockEntry]
    forall a. a -> [a] -> [a]
    :[TimeclockEntry]
    rest)
      | Bool
    otherwise       = Bool -> TimeclockEntry -> TimeclockEntry -> Transaction
    entryFromTimeclockInOut Bool
    True TimeclockEntry
    i TimeclockEntry
    o Transaction -> [Transaction] -> [Transaction]
    forall a. a -> [a] -> [a]
    : LocalTime -> [TimeclockEntry] -> [Transaction]
    timeclockToTransactionsOld LocalTime
    now [TimeclockEntry]
    rest
      where
        (LocalTime
    itime,LocalTime
    otime) = (TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    i,TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    o)
        (Day
    idate,Day
    odate) = (LocalTime -> Day
    localDay LocalTime
    itime,LocalTime -> Day
    localDay LocalTime
    otime)
        o' :: TimeclockEntry
    o' = TimeclockEntry
    o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}
        i' :: TimeclockEntry
    i' = TimeclockEntry
    i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}}
    {- HLINT ignore timeclockToTransactionsOld -}

    -- | Convert timeclock entries to journal transactions.
    -- This is the new, default version added in hledger 1.43 and improved in 1.50.
    -- It allows concurrent clocked-in sessions (though not with the same account name),
    -- and clock-in/clock-out entries in any order.
    --
    -- Entries are processed in parse order.
    -- Sessions crossing midnight are split into days to give accurate per-day totals.
    -- At the end, any sessions with no clockout get an implicit clockout with the provided "now" time.
    -- If any entries cannot be paired as expected, an error is raised.
    --
    timeclockToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
    timeclockToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
    timeclockToTransactions LocalTime
    now [TimeclockEntry]
    entries0 = [Transaction]
    transactions
      where
        -- don't sort by time, it messes things up; just reverse to get the parsed order
        entries :: [TimeclockEntry]
    entries = String -> [TimeclockEntry] -> [TimeclockEntry]
    forall a. Show a => String -> a -> a
    dbg7 String
    "timeclock entries" ([TimeclockEntry] -> [TimeclockEntry])
    -> [TimeclockEntry] -> [TimeclockEntry]
    forall a b. (a -> b) -> a -> b
    $ [TimeclockEntry] -> [TimeclockEntry]
    forall a. [a] -> [a]
    reverse [TimeclockEntry]
    entries0
        sessions :: Sessions
    sessions = String -> Sessions -> Sessions
    forall a. Show a => String -> a -> a
    dbg6 String
    "sessions" (Sessions -> Sessions) -> Sessions -> Sessions
    forall a b. (a -> b) -> a -> b
    $ [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
    pairClockEntries [TimeclockEntry]
    entries [] []
        transactionsFromSession :: Session -> Transaction
    transactionsFromSession Session
    s = Bool -> TimeclockEntry -> TimeclockEntry -> Transaction
    entryFromTimeclockInOut Bool
    False (Session -> TimeclockEntry
    in' Session
    s) (Session -> TimeclockEntry
    out Session
    s)
        -- If any "in" sessions are in the future, then set their out time to the initial time
        outtime :: TimeclockEntry -> LocalTime
    outtime TimeclockEntry
    te = LocalTime -> LocalTime -> LocalTime
    forall a. Ord a => a -> a -> a
    max LocalTime
    now (TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    te)
        createout :: TimeclockEntry -> TimeclockEntry
    createout TimeclockEntry
    te = SourcePos
    -> TimeclockCode
    -> LocalTime
    -> Text
    -> Text
    -> Text
    -> [Tag]
    -> TimeclockEntry
    TimeclockEntry (TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    te) TimeclockCode
    Out (TimeclockEntry -> LocalTime
    outtime TimeclockEntry
    te) (TimeclockEntry -> Text
    tlaccount TimeclockEntry
    te) Text
    "" Text
    "" []
        outs :: [TimeclockEntry]
    outs = (TimeclockEntry -> TimeclockEntry)
    -> [TimeclockEntry] -> [TimeclockEntry]
    forall a b. (a -> b) -> [a] -> [b]
    map TimeclockEntry -> TimeclockEntry
    createout (Sessions -> [TimeclockEntry]
    active Sessions
    sessions)
        stillopen :: Sessions
    stillopen = String -> Sessions -> Sessions
    forall a. Show a => String -> a -> a
    dbg6 String
    "stillopen" (Sessions -> Sessions) -> Sessions -> Sessions
    forall a b. (a -> b) -> a -> b
    $ [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
    pairClockEntries ((Sessions -> [TimeclockEntry]
    active Sessions
    sessions) [TimeclockEntry] -> [TimeclockEntry] -> [TimeclockEntry]
    forall a. Semigroup a => a -> a -> a
    <> [TimeclockEntry]
    outs) [] []
        transactions :: [Transaction]
    transactions = (Session -> Transaction) -> [Session] -> [Transaction]
    forall a b. (a -> b) -> [a] -> [b]
    map Session -> Transaction
    transactionsFromSession ([Session] -> [Transaction]) -> [Session] -> [Transaction]
    forall a b. (a -> b) -> a -> b
    $ (Session -> Session -> Ordering) -> [Session] -> [Session]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (\Session
    s1 Session
    s2 -> TimeclockEntry -> TimeclockEntry -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Session -> TimeclockEntry
    in' Session
    s1) (Session -> TimeclockEntry
    in' Session
    s2)) (Sessions -> [Session]
    completed Sessions
    sessions [Session] -> [Session] -> [Session]
    forall a. [a] -> [a] -> [a]
    ++ Sessions -> [Session]
    completed Sessions
    stillopen)

        -- | Assuming that entries have been sorted, we go through each time log entry.
        -- We collect all of the "i" in the list "actives," and each time we encounter
        -- an "o," we look for the corresponding "i" in actives.
        -- If we cannot find it, then it is an error (since the list is sorted).
        -- If the "o" is recorded on a different day than the "i" then we close the
        -- active entry at the end of its day, replace it in the active list
        -- with a start at midnight on the next day, and try again.
        -- This raises an error if any outs cannot be paired with an in.
        pairClockEntries :: [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
        pairClockEntries :: [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
    pairClockEntries [] [TimeclockEntry]
    actives [Session]
    sessions1 = Sessions {completed :: [Session]
    completed = [Session]
    sessions1, active :: [TimeclockEntry]
    active = [TimeclockEntry]
    actives}
        pairClockEntries (TimeclockEntry
    entry:[TimeclockEntry]
    es) [TimeclockEntry]
    actives [Session]
    sessions1
          | TimeclockEntry -> TimeclockCode
    tlcode TimeclockEntry
    entry TimeclockCode -> TimeclockCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == TimeclockCode
    In  = [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
    pairClockEntries [TimeclockEntry]
    es [TimeclockEntry]
    inentries [Session]
    sessions1
          | TimeclockEntry -> TimeclockCode
    tlcode TimeclockEntry
    entry TimeclockCode -> TimeclockCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == TimeclockCode
    Out = [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
    pairClockEntries [TimeclockEntry]
    es' [TimeclockEntry]
    actives' [Session]
    sessions2
          | Bool
    otherwise = [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
    pairClockEntries [TimeclockEntry]
    es [TimeclockEntry]
    actives [Session]
    sessions1
          where
            (TimeclockEntry
    inentry, [TimeclockEntry]
    newactive) = TimeclockEntry
    -> ([TimeclockEntry], [TimeclockEntry])
    -> (TimeclockEntry, [TimeclockEntry])
    findInForOut TimeclockEntry
    entry ((TimeclockEntry -> Bool)
    -> [TimeclockEntry] -> ([TimeclockEntry], [TimeclockEntry])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (\TimeclockEntry
    e -> TimeclockEntry -> Text
    tlaccount TimeclockEntry
    e Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == TimeclockEntry -> Text
    tlaccount TimeclockEntry
    entry) [TimeclockEntry]
    actives)
            (LocalTime
    itime, LocalTime
    otime) = (TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    inentry, TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    entry)
            (Day
    idate, Day
    odate) = (LocalTime -> Day
    localDay LocalTime
    itime, LocalTime -> Day
    localDay LocalTime
    otime)
            omidnight :: TimeclockEntry
    omidnight = TimeclockEntry
    entry {tldatetime = itime {localDay = idate, localTimeOfDay = TimeOfDay 23 59 59}}
            imidnight :: TimeclockEntry
    imidnight = TimeclockEntry
    inentry {tldatetime = itime {localDay = addDays 1 idate, localTimeOfDay = midnight}}
            ([Session]
    sessions2, [TimeclockEntry]
    actives', [TimeclockEntry]
    es')
              | Day
    odate Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    > Day
    idate = (Session {in' :: TimeclockEntry
    in' = TimeclockEntry
    inentry, out :: TimeclockEntry
    out = TimeclockEntry
    omidnight} Session -> [Session] -> [Session]
    forall a. a -> [a] -> [a]
    : [Session]
    sessions1, TimeclockEntry
    imidnightTimeclockEntry -> [TimeclockEntry] -> [TimeclockEntry]
    forall a. a -> [a] -> [a]
    :[TimeclockEntry]
    newactive, TimeclockEntry
    entryTimeclockEntry -> [TimeclockEntry] -> [TimeclockEntry]
    forall a. a -> [a] -> [a]
    :[TimeclockEntry]
    es)
              | Bool
    otherwise     = (Session {in' :: TimeclockEntry
    in' = TimeclockEntry
    inentry, out :: TimeclockEntry
    out = TimeclockEntry
    entry} Session -> [Session] -> [Session]
    forall a. a -> [a] -> [a]
    : [Session]
    sessions1, [TimeclockEntry]
    newactive, [TimeclockEntry]
    es)
            inentries :: [TimeclockEntry]
    inentries = case (TimeclockEntry -> Bool) -> [TimeclockEntry] -> [TimeclockEntry]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == TimeclockEntry -> Text
    tlaccount TimeclockEntry
    entry) (Text -> Bool)
    -> (TimeclockEntry -> Text) -> TimeclockEntry -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeclockEntry -> Text
    tlaccount) [TimeclockEntry]
    actives of
              []                -> TimeclockEntry
    entryTimeclockEntry -> [TimeclockEntry] -> [TimeclockEntry]
    forall a. a -> [a] -> [a]
    :[TimeclockEntry]
    actives
              [TimeclockEntry]
    activesinthisacct -> String -> [TimeclockEntry]
    forall a. String -> a
    error' (String -> [TimeclockEntry]) -> String -> [TimeclockEntry]
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> Text -> Text
    makeTimeClockErrorExcerpt TimeclockEntry
    entry (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.unlines ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ [
                Text
    ""
                ,Text
    "overlaps with session beginning at:"
                ,Text
    ""
                ]
                [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <> (TimeclockEntry -> Text) -> [TimeclockEntry] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map ((TimeclockEntry -> Text -> Text) -> Text -> TimeclockEntry -> Text
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TimeclockEntry -> Text -> Text
    makeTimeClockErrorExcerpt Text
    "") [TimeclockEntry]
    activesinthisacct
                [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <> [ Text
    "Overlapping sessions with the same account name are not supported." ]
                -- XXX better to show full session(s)
                -- <> map (T.pack . show) (filter ((`elem` activesinthisacct).in') sessions)

            -- | Find the relevant clockin in the actives list that should be paired with this clockout.
            -- If there is a session that has the same account name, then use that.
            -- Otherwise, if there is an active anonymous session, use that.
            -- Otherwise, raise an error.
            findInForOut :: TimeclockEntry -> ([TimeclockEntry], [TimeclockEntry]) -> (TimeclockEntry, [TimeclockEntry])
            findInForOut :: TimeclockEntry
    -> ([TimeclockEntry], [TimeclockEntry])
    -> (TimeclockEntry, [TimeclockEntry])
    findInForOut TimeclockEntry
    _ (TimeclockEntry
    matchingout:[TimeclockEntry]
    othermatches, [TimeclockEntry]
    rest) = (TimeclockEntry
    matchingout, [TimeclockEntry]
    othermatches [TimeclockEntry] -> [TimeclockEntry] -> [TimeclockEntry]
    forall a. Semigroup a => a -> a -> a
    <> [TimeclockEntry]
    rest)
            findInForOut TimeclockEntry
    o ([], [TimeclockEntry]
    activeins) =
                if Bool
    emptyname then (TimeclockEntry
    first, [TimeclockEntry]
    rest) else String -> (TimeclockEntry, [TimeclockEntry])
    forall a. String -> a
    error' String
    errmsg
                where
                    l :: String
    l = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ Pos -> Int
    unPos (Pos -> Int) -> Pos -> Int
    forall a b. (a -> b) -> a -> b
    $ SourcePos -> Pos
    sourceLine (SourcePos -> Pos) -> SourcePos -> Pos
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    o
                    c :: Int
    c = Pos -> Int
    unPos (Pos -> Int) -> Pos -> Int
    forall a b. (a -> b) -> a -> b
    $ SourcePos -> Pos
    sourceColumn (SourcePos -> Pos) -> SourcePos -> Pos
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    o
                    emptyname :: Bool
    emptyname = TimeclockEntry -> Text
    tlaccount TimeclockEntry
    o Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    ""
                    (TimeclockEntry
    first, [TimeclockEntry]
    rest) = case [TimeclockEntry] -> Maybe (TimeclockEntry, [TimeclockEntry])
    forall a. [a] -> Maybe (a, [a])
    uncons [TimeclockEntry]
    activeins of
                        Just (TimeclockEntry
    hd, [TimeclockEntry]
    tl) -> (TimeclockEntry
    hd, [TimeclockEntry]
    tl)
                        Maybe (TimeclockEntry, [TimeclockEntry])
    Nothing -> String -> (TimeclockEntry, [TimeclockEntry])
    forall a. String -> a
    error' String
    errmsg
                    errmsg :: String
    errmsg =
                        String -> String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf
                          String
    "%s:\n%s\n%s\n\nCould not find previous clockin to match this clockout."
                          (SourcePos -> String
    sourcePosPretty (SourcePos -> String) -> SourcePos -> String
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    o)
                          (String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " | " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TimeclockEntry -> String
    forall a. Show a => a -> String
    show TimeclockEntry
    o)
                          (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    l) Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " |" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    c Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "^")

    errorExpectedCodeButGot :: TimeclockCode -> TimeclockEntry -> a
    errorExpectedCodeButGot :: forall a. TimeclockCode -> TimeclockEntry -> a
    errorExpectedCodeButGot TimeclockCode
    expected TimeclockEntry
    actual = String -> a
    forall a. String -> a
    error' (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf
      (String
    "%s:\n%s\n%s\n\nExpected a timeclock %s entry but got %s.\n"
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "Please alternate i and o, beginning with i.")
      (SourcePos -> String
    sourcePosPretty (SourcePos -> String) -> SourcePos -> String
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    actual)
      (String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " | " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TimeclockEntry -> String
    forall a. Show a => a -> String
    show TimeclockEntry
    actual)
      (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    l) Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " |" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    c Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "^")
      (TimeclockCode -> String
    forall a. Show a => a -> String
    show TimeclockCode
    expected)
      (TimeclockCode -> String
    forall a. Show a => a -> String
    show (TimeclockCode -> String) -> TimeclockCode -> String
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> TimeclockCode
    tlcode TimeclockEntry
    actual)
      where
        l :: String
    l = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ Pos -> Int
    unPos (Pos -> Int) -> Pos -> Int
    forall a b. (a -> b) -> a -> b
    $ SourcePos -> Pos
    sourceLine (SourcePos -> Pos) -> SourcePos -> Pos
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    actual
        c :: Int
    c = Pos -> Int
    unPos (Pos -> Int) -> Pos -> Int
    forall a b. (a -> b) -> a -> b
    $ SourcePos -> Pos
    sourceColumn (SourcePos -> Pos) -> SourcePos -> Pos
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    actual

    makeTimeClockErrorExcerpt :: TimeclockEntry -> T.Text -> T.Text
    makeTimeClockErrorExcerpt :: TimeclockEntry -> Text -> Text
    makeTimeClockErrorExcerpt e :: TimeclockEntry
    e@TimeclockEntry{tlsourcepos :: TimeclockEntry -> SourcePos
    tlsourcepos=SourcePos
    pos} Text
    msg = [Text] -> Text
    T.unlines [
      String -> Text
    T.pack (SourcePos -> String
    sourcePosPretty SourcePos
    pos) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ":"
      ,Text
    l Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " | " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (TimeclockEntry -> String
    forall a. Show a => a -> String
    show TimeclockEntry
    e)
      -- ,T.replicate (T.length l) " " <> " |" -- <> T.replicate c " " <> "^")
      ] Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    msg
      where
        l :: Text
    l = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ Pos -> Int
    unPos (Pos -> Int) -> Pos -> Int
    forall a b. (a -> b) -> a -> b
    $ SourcePos -> Pos
    sourceLine (SourcePos -> Pos) -> SourcePos -> Pos
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    e
        -- c = unPos $ sourceColumn $ tlsourcepos e

    -- | Convert a timeclock clockin and clockout entry to an equivalent journal
    -- transaction, representing the time expenditure. Note this entry is  not balanced,
    -- since we omit the \"assets:time\" transaction for simpler output.
    entryFromTimeclockInOut :: Bool -> TimeclockEntry -> TimeclockEntry -> Transaction
    entryFromTimeclockInOut :: Bool -> TimeclockEntry -> TimeclockEntry -> Transaction
    entryFromTimeclockInOut Bool
    requiretimeordered TimeclockEntry
    i TimeclockEntry
    o
        | Bool -> Bool
    not Bool
    requiretimeordered Bool -> Bool -> Bool
    || LocalTime
    otime LocalTime -> LocalTime -> Bool
    forall a. Ord a => a -> a -> Bool
    >= LocalTime
    itime = Transaction
    t
        | Bool
    otherwise =
          -- Clockout time earlier than clockin is an error.
          -- (Clockin earlier than preceding clockin/clockout is allowed.)
          -- We should never encounter this case now that we sort the entries,
          -- but let's leave it in case of error.
          String -> Transaction
    forall a. String -> a
    error' (String -> Transaction) -> String -> Transaction
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf
            (String
    "%s:\n%s\nThis clockout time (%s) is earlier than the previous clockin.\n"
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "Please adjust it to be later than %s.")
            (SourcePos -> String
    sourcePosPretty (SourcePos -> String) -> SourcePos -> String
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    o)
            ([String] -> String
    unlines [
              Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    l) Char
    ' 'String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " | " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TimeclockEntry -> String
    forall a. Show a => a -> String
    show TimeclockEntry
    i,
              String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " | " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TimeclockEntry -> String
    forall a. Show a => a -> String
    show TimeclockEntry
    o,
              (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    l) Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " |" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    c Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    19 Char
    '^')
              ])
            (LocalTime -> String
    forall a. Show a => a -> String
    show (LocalTime -> String) -> LocalTime -> String
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    o)
            (LocalTime -> String
    forall a. Show a => a -> String
    show (LocalTime -> String) -> LocalTime -> String
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    i)
        where
          l :: String
    l = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ Pos -> Int
    unPos (Pos -> Int) -> Pos -> Int
    forall a b. (a -> b) -> a -> b
    $ SourcePos -> Pos
    sourceLine (SourcePos -> Pos) -> SourcePos -> Pos
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    o
          c :: Int
    c = (Pos -> Int
    unPos (Pos -> Int) -> Pos -> Int
    forall a b. (a -> b) -> a -> b
    $ SourcePos -> Pos
    sourceColumn (SourcePos -> Pos) -> SourcePos -> Pos
    forall a b. (a -> b) -> a -> b
    $ TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    o) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
          t :: Transaction
    t = Transaction {
                tindex :: Integer
    tindex       = Integer
    0,
                tsourcepos :: (SourcePos, SourcePos)
    tsourcepos   = (TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    i, TimeclockEntry -> SourcePos
    tlsourcepos TimeclockEntry
    i),
                tdate :: Day
    tdate        = Day
    idate,
                tdate2 :: Maybe Day
    tdate2       = Maybe Day
    forall a. Maybe a
    Nothing,
                tstatus :: Status
    tstatus      = Status
    Cleared,
                tcode :: Text
    tcode        = Text
    "",
                tdescription :: Text
    tdescription = Text
    desc,
                tcomment :: Text
    tcomment     = TimeclockEntry -> Text
    tlcomment TimeclockEntry
    i Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> TimeclockEntry -> Text
    tlcomment TimeclockEntry
    o,
                ttags :: [Tag]
    ttags        = TimeclockEntry -> [Tag]
    tltags TimeclockEntry
    i [Tag] -> [Tag] -> [Tag]
    forall a. [a] -> [a] -> [a]
    ++ TimeclockEntry -> [Tag]
    tltags TimeclockEntry
    o,
                tpostings :: [Posting]
    tpostings    = [Posting]
    ps,
                tprecedingcomment :: Text
    tprecedingcomment=Text
    ""
              }
          itime :: LocalTime
    itime    = TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    i
          otime :: LocalTime
    otime    = TimeclockEntry -> LocalTime
    tldatetime TimeclockEntry
    o
          itod :: TimeOfDay
    itod     = LocalTime -> TimeOfDay
    localTimeOfDay LocalTime
    itime
          otod :: TimeOfDay
    otod     = LocalTime -> TimeOfDay
    localTimeOfDay LocalTime
    otime
          idate :: Day
    idate    = LocalTime -> Day
    localDay LocalTime
    itime
          desc :: Text
    desc     | Text -> Bool
    T.null (TimeclockEntry -> Text
    tldescription TimeclockEntry
    i) = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ TimeOfDay -> String
    showtime TimeOfDay
    itod String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TimeOfDay -> String
    showtime TimeOfDay
    otod
                   | Bool
    otherwise                = TimeclockEntry -> Text
    tldescription TimeclockEntry
    i
          showtime :: TimeOfDay -> String
    showtime = Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    5 (String -> String) -> (TimeOfDay -> String) -> TimeOfDay -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeOfDay -> String
    forall a. Show a => a -> String
    show
          hours :: Quantity
    hours    = UTCTime -> UTCTime -> Quantity
    forall a. Fractional a => UTCTime -> UTCTime -> a
    elapsedSeconds (LocalTime -> UTCTime
    toutc LocalTime
    otime) (LocalTime -> UTCTime
    toutc LocalTime
    itime) Quantity -> Quantity -> Quantity
    forall a. Fractional a => a -> a -> a
    / Quantity
    3600 where toutc :: LocalTime -> UTCTime
    toutc = TimeZone -> LocalTime -> UTCTime
    localTimeToUTC TimeZone
    utc
          acctname :: Text
    acctname = TimeclockEntry -> Text
    tlaccount TimeclockEntry
    i
          -- Generate an hours amount. Unusually, we also round the internal Decimal value,
          -- since otherwise it will often have large recurring decimal parts which (since 1.21)
          -- print would display all 255 digits of. timeclock amounts have one second resolution,
          -- so two decimal places is precise enough (#1527).
          amt :: MixedAmount
    amt = case Amount -> MixedAmount
    mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Amount -> Amount
    setAmountInternalPrecision Word8
    2 (Amount -> Amount) -> Amount -> Amount
    forall a b. (a -> b) -> a -> b
    $ Quantity -> Amount
    hrs Quantity
    hours of
            MixedAmount
    a | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ MixedAmount
    a MixedAmount -> MixedAmount -> Bool
    forall a. Ord a => a -> a -> Bool
    < MixedAmount
    0 -> MixedAmount
    a
            MixedAmount
    _ -> String -> MixedAmount
    forall a. String -> a
    error' (String -> MixedAmount) -> String -> MixedAmount
    forall a b. (a -> b) -> a -> b
    $ String -> Text -> Text -> String
    forall r. PrintfType r => String -> r
    printf
              String
    "%s%s:\nThis clockout is earlier than the clockin."
              (TimeclockEntry -> Text -> Text
    makeTimeClockErrorExcerpt TimeclockEntry
    i Text
    "")
              (TimeclockEntry -> Text -> Text
    makeTimeClockErrorExcerpt TimeclockEntry
    o Text
    "")
          ps :: [Posting]
    ps = [Posting
    posting{paccount=acctname, pamount=amt, ptype=VirtualPosting, ptransaction=Just t}]

    -- tests

    tests_Timeclock :: TestTree
    tests_Timeclock = String -> [TestTree] -> TestTree
    testGroup String
    "Timeclock" [
      String -> ((String -> IO ()) -> IO ()) -> TestTree
    testCaseSteps String
    "timeclockToTransactions tests" (((String -> IO ()) -> IO ()) -> TestTree)
    -> ((String -> IO ()) -> IO ()) -> TestTree
    forall a b. (a -> b) -> a -> b
    $ \String -> IO ()
    step -> do
          String -> IO ()
    step String
    "gathering data"
          today <- IO Day
    getCurrentDay
          now' <- getCurrentTime
          tz <- getCurrentTimeZone
          let now = TimeZone -> UTCTime -> LocalTime
    utcToLocalTime TimeZone
    tz UTCTime
    now'
              nowstr = LocalTime -> String
    showtime LocalTime
    now
              yesterday = Day -> Day
    prevday Day
    today
              clockin = SourcePos
    -> TimeclockCode
    -> LocalTime
    -> Text
    -> Text
    -> Text
    -> [Tag]
    -> TimeclockEntry
    TimeclockEntry (String -> SourcePos
    initialPos String
    "") TimeclockCode
    In
              clockout = SourcePos
    -> TimeclockCode
    -> LocalTime
    -> Text
    -> Text
    -> Text
    -> [Tag]
    -> TimeclockEntry
    TimeclockEntry (String -> SourcePos
    initialPos String
    "") TimeclockCode
    Out
              mktime Day
    d = Day -> TimeOfDay -> LocalTime
    LocalTime Day
    d (TimeOfDay -> LocalTime)
    -> (String -> TimeOfDay) -> String -> LocalTime
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeOfDay -> Maybe TimeOfDay -> TimeOfDay
    forall a. a -> Maybe a -> a
    fromMaybe TimeOfDay
    midnight (Maybe TimeOfDay -> TimeOfDay)
    -> (String -> Maybe TimeOfDay) -> String -> TimeOfDay
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                         Bool -> TimeLocale -> String -> String -> Maybe TimeOfDay
    forall (m :: * -> *) t.
    (MonadFail m, ParseTime t) =>
    Bool -> TimeLocale -> String -> String -> m t
    parseTimeM Bool
    True TimeLocale
    defaultTimeLocale String
    "%H:%M:%S"
              showtime = TimeLocale -> String -> LocalTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%H:%M"
              txndescs = (Transaction -> String) -> [Transaction] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> String
    T.unpack (Text -> String) -> (Transaction -> Text) -> Transaction -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transaction -> Text
    tdescription) ([Transaction] -> [String])
    -> ([TimeclockEntry] -> [Transaction])
    -> [TimeclockEntry]
    -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocalTime -> [TimeclockEntry] -> [Transaction]
    timeclockToTransactions LocalTime
    now
              future = TimeZone -> UTCTime -> LocalTime
    utcToLocalTime TimeZone
    tz (UTCTime -> LocalTime) -> UTCTime -> LocalTime
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> UTCTime -> UTCTime
    addUTCTime NominalDiffTime
    100 UTCTime
    now'
              futurestr = LocalTime -> String
    showtime LocalTime
    future
          step "started yesterday, split session at midnight"
          txndescs [clockin (mktime yesterday "23:00:00") "" "" "" []] @?= ["23:00-23:59","00:00-"++nowstr]
          step "split multi-day sessions at each midnight"
          txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" "" "" []] @?= ["23:00-23:59","00:00-23:59","00:00-"++nowstr]
          step "auto-clock-out if needed"
          txndescs [clockin (mktime today "00:00:00") "" "" "" []] @?= ["00:00-"++nowstr]
          step "use the clockin time for auto-clockout if it's in the future"
          txndescs [clockin future "" "" "" []] @?= [printf "%s-%s" futurestr futurestr]
          step "multiple open sessions"
          txndescs (reverse [
            clockin (mktime today "00:00:00") "a" "" "" [],
            clockin (mktime today "01:00:00") "b" "" "" [],
            clockin (mktime today "02:00:00") "c" "" "" [],
            clockout (mktime today "03:00:00") "b" "" "" [],
            clockout (mktime today "04:00:00") "a" "" "" [],
            clockout (mktime today "05:00:00") "c" "" "" []
            ])
            @?= ["00:00-04:00", "01:00-03:00", "02:00-05:00"]
     ]