{-|

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
  ,tests_Timeclock
)
where

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 = forall r. PrintfType r => String -> r
printf String
"%s %s %s  %s" (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> TimeclockCode
tlcode TimeclockEntry
t) (forall a. Show a => a -> String
show 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
_ = []

-- | 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.
timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions LocalTime
_ [] = []
timeclockEntriesToTransactions LocalTime
now [TimeclockEntry
i]
    | TimeclockEntry -> TimeclockCode
tlcode TimeclockEntry
i forall a. Eq a => a -> a -> Bool
/= TimeclockCode
In = forall a. TimeclockCode -> TimeclockEntry -> a
errorExpectedCodeButGot TimeclockCode
In TimeclockEntry
i
    | Day
odate forall a. Ord a => a -> a -> Bool
> Day
idate = TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut TimeclockEntry
i TimeclockEntry
o' 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
-> TimeclockEntry
TimeclockEntry (TimeclockEntry -> SourcePos
tlsourcepos TimeclockEntry
i) TimeclockCode
Out LocalTime
end AccountName
"" AccountName
""
      end :: LocalTime
end = if LocalTime
itime 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 :: LocalTime
tldatetime=LocalTime
itime{localDay :: Day
localDay=Day
idate, localTimeOfDay :: TimeOfDay
localTimeOfDay=Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
23 Int
59 Pico
59}}
      i' :: TimeclockEntry
i' = TimeclockEntry
i{tldatetime :: LocalTime
tldatetime=LocalTime
itime{localDay :: Day
localDay=Integer -> Day -> Day
addDays Integer
1 Day
idate, localTimeOfDay :: TimeOfDay
localTimeOfDay=TimeOfDay
midnight}}
timeclockEntriesToTransactions LocalTime
now (TimeclockEntry
i:TimeclockEntry
o:[TimeclockEntry]
rest)
    | TimeclockEntry -> TimeclockCode
tlcode TimeclockEntry
i forall a. Eq a => a -> a -> Bool
/= TimeclockCode
In  = forall a. TimeclockCode -> TimeclockEntry -> a
errorExpectedCodeButGot TimeclockCode
In TimeclockEntry
i
    | TimeclockEntry -> TimeclockCode
tlcode TimeclockEntry
o forall a. Eq a => a -> a -> Bool
/= TimeclockCode
Out = forall a. TimeclockCode -> TimeclockEntry -> a
errorExpectedCodeButGot TimeclockCode
Out TimeclockEntry
o
    | Day
odate forall a. Ord a => a -> a -> Bool
> Day
idate   = TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut TimeclockEntry
i TimeclockEntry
o' forall a. a -> [a] -> [a]
: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions LocalTime
now (TimeclockEntry
i'forall a. a -> [a] -> [a]
:TimeclockEntry
oforall a. a -> [a] -> [a]
:[TimeclockEntry]
rest)
    | Bool
otherwise       = TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut TimeclockEntry
i TimeclockEntry
o 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 :: LocalTime
tldatetime=LocalTime
itime{localDay :: Day
localDay=Day
idate, localTimeOfDay :: TimeOfDay
localTimeOfDay=Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
23 Int
59 Pico
59}}
      i' :: TimeclockEntry
i' = TimeclockEntry
i{tldatetime :: LocalTime
tldatetime=LocalTime
itime{localDay :: Day
localDay=Integer -> Day -> Day
addDays Integer
1 Day
idate, localTimeOfDay :: TimeOfDay
localTimeOfDay=TimeOfDay
midnight}}
{- HLINT ignore timeclockEntriesToTransactions -}

errorExpectedCodeButGot :: TimeclockCode -> TimeclockEntry -> a
errorExpectedCodeButGot :: forall a. TimeclockCode -> TimeclockEntry -> a
errorExpectedCodeButGot TimeclockCode
expected TimeclockEntry
actual = forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf
  (String
"%s:\n%s\n%s\n\nExpected a timeclock %s entry but got %s.\n"
  forall a. [a] -> [a] -> [a]
++String
"Only one session may be clocked in at a time.\n"
  forall a. [a] -> [a] -> [a]
++String
"Please alternate i and o, beginning with i.")
  (SourcePos -> String
sourcePosPretty forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> SourcePos
tlsourcepos TimeclockEntry
actual)
  (String
l forall a. [a] -> [a] -> [a]
++ String
" | " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TimeclockEntry
actual)
  (forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) Char
' ' forall a. [a] -> [a] -> [a]
++ String
" |" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
c Char
' ' forall a. [a] -> [a] -> [a]
++ String
"^")
  (forall a. Show a => a -> String
show TimeclockCode
expected)
  (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> TimeclockCode
tlcode TimeclockEntry
actual)
  where
    l :: String
l = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Pos -> Int
unPos forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> SourcePos
tlsourcepos TimeclockEntry
actual
    c :: Int
c = Pos -> Int
unPos forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn 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 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.)
      forall a. String -> a
error' forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf
        (String
"%s:\n%s\nThis clockout time (%s) is earlier than the previous clockin.\n"
        forall a. [a] -> [a] -> [a]
++String
"Please adjust it to be later than %s.")
        (SourcePos -> String
sourcePosPretty forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> SourcePos
tlsourcepos TimeclockEntry
o)
        ([String] -> String
unlines [
          forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) Char
' 'forall a. [a] -> [a] -> [a]
++ String
" | " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TimeclockEntry
i,
          String
l forall a. [a] -> [a] -> [a]
++ String
" | " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TimeclockEntry
o,
          (forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) Char
' ' forall a. [a] -> [a] -> [a]
++ String
" |" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
c Char
' ' forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
19 Char
'^')
          ])
        (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> LocalTime
tldatetime TimeclockEntry
o)
        (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> LocalTime
tldatetime TimeclockEntry
i)
    where
      l :: String
l = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Pos -> Int
unPos forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> SourcePos
tlsourcepos TimeclockEntry
o
      c :: Int
c = (Pos -> Int
unPos forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn forall a b. (a -> b) -> a -> b
$ TimeclockEntry -> SourcePos
tlsourcepos TimeclockEntry
o) 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       = forall a. Maybe a
Nothing,
            tstatus :: Status
tstatus      = Status
Cleared,
            tcode :: AccountName
tcode        = AccountName
"",
            tdescription :: AccountName
tdescription = AccountName
desc,
            tcomment :: AccountName
tcomment     = AccountName
"",
            ttags :: [Tag]
ttags        = [],
            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 forall a b. (a -> b) -> a -> b
$ TimeOfDay -> String
showtime TimeOfDay
itod forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ TimeOfDay -> String
showtime TimeOfDay
otod
               | Bool
otherwise                = TimeclockEntry -> AccountName
tldescription TimeclockEntry
i
      showtime :: TimeOfDay -> String
showtime = forall a. Int -> [a] -> [a]
take Int
5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
      hours :: Quantity
hours    = forall a. Fractional a => UTCTime -> UTCTime -> a
elapsedSeconds (LocalTime -> UTCTime
toutc LocalTime
otime) (LocalTime -> UTCTime
toutc LocalTime
itime) 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 forall a b. (a -> b) -> a -> b
$ Word8 -> Amount -> Amount
setAmountInternalPrecision Word8
2 forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
hrs Quantity
hours
      ps :: [Posting]
ps       = [Posting
posting{paccount :: AccountName
paccount=AccountName
acctname, pamount :: MixedAmount
pamount=MixedAmount
amt, ptype :: PostingType
ptype=PostingType
VirtualPosting, ptransaction :: Maybe Transaction
ptransaction=forall a. a -> Maybe a
Just Transaction
t}]


-- tests

tests_Timeclock :: TestTree
tests_Timeclock = String -> [TestTree] -> TestTree
testGroup String
"Timeclock" [
  String -> ((String -> IO ()) -> IO ()) -> TestTree
testCaseSteps String
"timeclockEntriesToTransactions tests" 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 -> TimeclockEntry
clockin = SourcePos
-> TimeclockCode
-> LocalTime
-> AccountName
-> AccountName
-> TimeclockEntry
TimeclockEntry (String -> SourcePos
initialPos String
"") TimeclockCode
In
          mktime :: Day -> String -> LocalTime
mktime Day
d = Day -> TimeOfDay -> LocalTime
LocalTime Day
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe TimeOfDay
midnight forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     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 = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M"
          txndescs :: [TimeclockEntry] -> [String]
txndescs = forall a b. (a -> b) -> [a] -> [b]
map (AccountName -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> AccountName
tdescription) 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 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 -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
yesterday String
"23:00:00") AccountName
"" AccountName
""] forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String
"23:00-23:59",String
"00:00-"forall a. [a] -> [a] -> [a]
++String
nowstr]
      String -> IO ()
step String
"split multi-day sessions at each midnight"
      [TimeclockEntry] -> [String]
txndescs [LocalTime -> AccountName -> AccountName -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime (Integer -> Day -> Day
addDays (-Integer
2) Day
today) String
"23:00:00") AccountName
"" AccountName
""] forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String
"23:00-23:59",String
"00:00-23:59",String
"00:00-"forall a. [a] -> [a] -> [a]
++String
nowstr]
      String -> IO ()
step String
"auto-clock-out if needed"
      [TimeclockEntry] -> [String]
txndescs [LocalTime -> AccountName -> AccountName -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today String
"00:00:00") AccountName
"" AccountName
""] forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String
"00:00-"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 -> TimeclockEntry
clockin LocalTime
future AccountName
"" AccountName
""] forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [forall r. PrintfType r => String -> r
printf String
"%s-%s" String
futurestr String
futurestr]
 ]