{-|

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 #-}

module Hledger.Data.Timeclock (
   timeclockEntriesToTransactions
  ,timeclockEntriesToTransactionsSingle
  ,tests_Timeclock
)
where

import Data.List (partition, sortBy, uncons)
import Data.Maybe (fromMaybe)
import qualified Data.Text 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

instance Show TimeclockEntry where
    show :: TimeclockEntry -> String
show TimeclockEntry
t = String -> String -> String -> AccountName -> AccountName -> 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 -> AccountName
tlaccount TimeclockEntry
t) (TimeclockEntry -> AccountName
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
    }

data Sessions = Sessions
    { Sessions -> [Session]
completed :: [Session],
      Sessions -> [TimeclockEntry]
active :: [TimeclockEntry]
    }

-- 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 -> AccountName
tlaccount TimeclockEntry
o AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
""
        (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
"^")

-- Assuming that entries has 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]
sessions = Sessions {completed :: [Session]
completed = [Session]
sessions, active :: [TimeclockEntry]
active = [TimeclockEntry]
actives}
pairClockEntries (TimeclockEntry
entry : [TimeclockEntry]
rest) [TimeclockEntry]
actives [Session]
sessions
    | TimeclockEntry -> TimeclockCode
tlcode TimeclockEntry
entry TimeclockCode -> TimeclockCode -> Bool
forall a. Eq a => a -> a -> Bool
== TimeclockCode
In = [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
pairClockEntries [TimeclockEntry]
rest [TimeclockEntry]
inentries [Session]
sessions
    | TimeclockEntry -> TimeclockCode
tlcode TimeclockEntry
entry TimeclockCode -> TimeclockCode -> Bool
forall a. Eq a => a -> a -> Bool
== TimeclockCode
Out = [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
pairClockEntries [TimeclockEntry]
rest' [TimeclockEntry]
actives' [Session]
sessions'
    | Bool
otherwise = [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
pairClockEntries [TimeclockEntry]
rest [TimeclockEntry]
actives [Session]
sessions
    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 -> AccountName
tlaccount TimeclockEntry
e AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== TimeclockEntry -> AccountName
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]
sessions', [TimeclockEntry]
actives', [TimeclockEntry]
rest') = if Day
odate Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
idate then
              (Session {in' :: TimeclockEntry
in' = TimeclockEntry
inentry, out :: TimeclockEntry
out = TimeclockEntry
omidnight} Session -> [Session] -> [Session]
forall a. a -> [a] -> [a]
: [Session]
sessions, TimeclockEntry
imidnight TimeclockEntry -> [TimeclockEntry] -> [TimeclockEntry]
forall a. a -> [a] -> [a]
: [TimeclockEntry]
newactive, TimeclockEntry
entry TimeclockEntry -> [TimeclockEntry] -> [TimeclockEntry]
forall a. a -> [a] -> [a]
: [TimeclockEntry]
rest)
            else
              (Session {in' :: TimeclockEntry
in' = TimeclockEntry
inentry, out :: TimeclockEntry
out = TimeclockEntry
entry} Session -> [Session] -> [Session]
forall a. a -> [a] -> [a]
: [Session]
sessions, [TimeclockEntry]
newactive, [TimeclockEntry]
rest)
        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
entry
        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
entry
        inentries :: [TimeclockEntry]
inentries =
          if (TimeclockEntry -> Bool) -> [TimeclockEntry] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\TimeclockEntry
e -> TimeclockEntry -> AccountName
tlaccount TimeclockEntry
e AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== TimeclockEntry -> AccountName
tlaccount TimeclockEntry
entry) [TimeclockEntry]
actives
            then String -> [TimeclockEntry]
forall a. String -> a
error' (String -> [TimeclockEntry]) -> String -> [TimeclockEntry]
forall a b. (a -> b) -> a -> b
$
                String -> String -> String -> String -> AccountName -> String
forall r. PrintfType r => String -> r
printf
                  String
"%s:\n%s\n%s\n\nEncountered clockin entry for session \"%s\" that is already active."
                  (SourcePos -> String
sourcePosPretty (SourcePos -> String) -> SourcePos -> String
forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> SourcePos
tlsourcepos TimeclockEntry
entry)
                  (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
entry)
                  (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
"^")
                  (TimeclockEntry -> AccountName
tlaccount TimeclockEntry
entry)
            else TimeclockEntry
entry TimeclockEntry -> [TimeclockEntry] -> [TimeclockEntry]
forall a. a -> [a] -> [a]
: [TimeclockEntry]
actives

-- | Convert time log entries to journal transactions. When there is no
-- clockout, add one with the provided current time. Sessions crossing
-- midnight are split into days to give accurate per-day totals.
-- If any entries cannot be paired as expected, then an error is raised.
timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions LocalTime
now [TimeclockEntry]
entries = [Transaction]
transactions
  where
    sessions :: Sessions
sessions = [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
pairClockEntries ((TimeclockEntry -> TimeclockEntry -> Ordering)
-> [TimeclockEntry] -> [TimeclockEntry]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\TimeclockEntry
e1 TimeclockEntry
e2 -> LocalTime -> LocalTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TimeclockEntry -> LocalTime
tldatetime TimeclockEntry
e1) (TimeclockEntry -> LocalTime
tldatetime TimeclockEntry
e2)) [TimeclockEntry]
entries) [] []
    transactionsFromSession :: Session -> Transaction
transactionsFromSession Session
s = TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut (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
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
TimeclockEntry (TimeclockEntry -> SourcePos
tlsourcepos TimeclockEntry
te) TimeclockCode
Out (TimeclockEntry -> LocalTime
outtime TimeclockEntry
te) (TimeclockEntry -> AccountName
tlaccount TimeclockEntry
te) AccountName
"" AccountName
"" []
    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 = [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)

-- | Convert time log entries to journal transactions, expecting the entries to be
-- a strict in/out cycle. When there is no clockout, add one with the provided current time. 
-- Sessions crossing midnight are split into days to give accurate per-day totals.
timeclockEntriesToTransactionsSingle :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactionsSingle :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactionsSingle LocalTime
_ [] = []
timeclockEntriesToTransactionsSingle 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 = TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut TimeclockEntry
i TimeclockEntry
o' Transaction -> [Transaction] -> [Transaction]
forall a. a -> [a] -> [a]
: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions LocalTime
now [TimeclockEntry
i',TimeclockEntry
o]
    | Bool
otherwise = [TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut TimeclockEntry
i TimeclockEntry
o]
    where
      o :: TimeclockEntry
o = SourcePos
-> TimeclockCode
-> LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
TimeclockEntry (TimeclockEntry -> SourcePos
tlsourcepos TimeclockEntry
i) TimeclockCode
Out LocalTime
end AccountName
"" AccountName
"" AccountName
"" []
      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}}
timeclockEntriesToTransactionsSingle 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   = TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut TimeclockEntry
i TimeclockEntry
o' Transaction -> [Transaction] -> [Transaction]
forall a. a -> [a] -> [a]
: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions 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       = TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut TimeclockEntry
i TimeclockEntry
o Transaction -> [Transaction] -> [Transaction]
forall a. a -> [a] -> [a]
: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions 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 timeclockEntriesToTransactions -}

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
"Only one session may be clocked in at a time.\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

-- | 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 :: TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut TimeclockEntry
i TimeclockEntry
o
    | 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 :: AccountName
tcode        = AccountName
"",
            tdescription :: AccountName
tdescription = AccountName
desc,
            tcomment :: AccountName
tcomment     = TimeclockEntry -> AccountName
tlcomment TimeclockEntry
i,
            ttags :: [Tag]
ttags        = TimeclockEntry -> [Tag]
tltags TimeclockEntry
i,
            tpostings :: [Posting]
tpostings    = [Posting]
ps,
            tprecedingcomment :: AccountName
tprecedingcomment=AccountName
""
          }
      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 :: AccountName
desc     | AccountName -> Bool
T.null (TimeclockEntry -> AccountName
tldescription TimeclockEntry
i) = String -> AccountName
T.pack (String -> AccountName) -> String -> AccountName
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 -> AccountName
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 :: AccountName
acctname = TimeclockEntry -> AccountName
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   = 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
      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
"timeclockEntriesToTransactions 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"
      Day
today <- IO Day
getCurrentDay
      UTCTime
now' <- IO UTCTime
getCurrentTime
      TimeZone
tz <- IO TimeZone
getCurrentTimeZone
      let now :: LocalTime
now = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz UTCTime
now'
          nowstr :: String
nowstr = LocalTime -> String
showtime LocalTime
now
          yesterday :: Day
yesterday = Day -> Day
prevday Day
today
          clockin :: LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockin = SourcePos
-> TimeclockCode
-> LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
TimeclockEntry (String -> SourcePos
initialPos String
"") TimeclockCode
In
          clockout :: LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockout = SourcePos
-> TimeclockCode
-> LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
TimeclockEntry (String -> SourcePos
initialPos String
"") TimeclockCode
Out
          mktime :: Day -> String -> LocalTime
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 :: LocalTime -> String
showtime = TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M"
          txndescs :: [TimeclockEntry] -> [String]
txndescs = (Transaction -> String) -> [Transaction] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName -> String
T.unpack (AccountName -> String)
-> (Transaction -> AccountName) -> Transaction -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> AccountName
tdescription) ([Transaction] -> [String])
-> ([TimeclockEntry] -> [Transaction])
-> [TimeclockEntry]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions LocalTime
now
          future :: LocalTime
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 :: String
futurestr = LocalTime -> String
showtime LocalTime
future
      String -> IO ()
step String
"started yesterday, split session at midnight"
      [TimeclockEntry] -> [String]
txndescs [LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
yesterday String
"23:00:00") AccountName
"" AccountName
"" AccountName
"" []] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String
"23:00-23:59",String
"00:00-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nowstr]
      String -> IO ()
step String
"split multi-day sessions at each midnight"
      [TimeclockEntry] -> [String]
txndescs [LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime (Integer -> Day -> Day
addDays (-Integer
2) Day
today) String
"23:00:00") AccountName
"" AccountName
"" AccountName
"" []] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String
"23:00-23:59",String
"00:00-23:59",String
"00:00-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nowstr]
      String -> IO ()
step String
"auto-clock-out if needed"
      [TimeclockEntry] -> [String]
txndescs [LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today String
"00:00:00") AccountName
"" AccountName
"" AccountName
"" []] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String
"00:00-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nowstr]
      String -> IO ()
step String
"use the clockin time for auto-clockout if it's in the future"
      [TimeclockEntry] -> [String]
txndescs [LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockin LocalTime
future AccountName
"" AccountName
"" AccountName
"" []] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s" String
futurestr String
futurestr]
      String -> IO ()
step String
"multiple open sessions"
      [TimeclockEntry] -> [String]
txndescs
        [ LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today String
"00:00:00") AccountName
"a" AccountName
"" AccountName
"" [],
          LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today String
"01:00:00") AccountName
"b" AccountName
"" AccountName
"" [],
          LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today String
"02:00:00") AccountName
"c" AccountName
"" AccountName
"" [],
          LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockout (Day -> String -> LocalTime
mktime Day
today String
"03:00:00") AccountName
"b" AccountName
"" AccountName
"" [],
          LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockout (Day -> String -> LocalTime
mktime Day
today String
"04:00:00") AccountName
"a" AccountName
"" AccountName
"" [],
          LocalTime
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> TimeclockEntry
clockout (Day -> String -> LocalTime
mktime Day
today String
"05:00:00") AccountName
"c" AccountName
"" AccountName
"" []
        ]
        [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String
"00:00-04:00", String
"01:00-03:00", String
"02:00-05:00"]
 ]