{-|

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

-- 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"
      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 -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockin = SourcePos
-> TimeclockCode
-> LocalTime
-> Text
-> Text
-> Text
-> [Tag]
-> TimeclockEntry
TimeclockEntry (String -> SourcePos
initialPos String
"") TimeclockCode
In
          clockout :: LocalTime -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockout = SourcePos
-> TimeclockCode
-> LocalTime
-> Text
-> Text
-> Text
-> [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 (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 :: 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 -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
yesterday String
"23:00:00") Text
"" Text
"" Text
"" []] [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 -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime (Integer -> Day -> Day
addDays (-Integer
2) Day
today) String
"23:00:00") Text
"" Text
"" Text
"" []] [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 -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today String
"00:00:00") Text
"" Text
"" Text
"" []] [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 -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockin LocalTime
future Text
"" Text
"" Text
"" []] [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 ([TimeclockEntry] -> [TimeclockEntry]
forall a. [a] -> [a]
reverse [
        LocalTime -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today String
"00:00:00") Text
"a" Text
"" Text
"" [],
        LocalTime -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today String
"01:00:00") Text
"b" Text
"" Text
"" [],
        LocalTime -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today String
"02:00:00") Text
"c" Text
"" Text
"" [],
        LocalTime -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockout (Day -> String -> LocalTime
mktime Day
today String
"03:00:00") Text
"b" Text
"" Text
"" [],
        LocalTime -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockout (Day -> String -> LocalTime
mktime Day
today String
"04:00:00") Text
"a" Text
"" Text
"" [],
        LocalTime -> Text -> Text -> Text -> [Tag] -> TimeclockEntry
clockout (Day -> String -> LocalTime
mktime Day
today String
"05:00:00") Text
"c" Text
"" Text
"" []
        ])
        [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"]
 ]