{-|

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 CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

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

import Data.Maybe (fromMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
-- import Data.Text (Text)
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
import Hledger.Data.Transaction

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
_ = []

-- | 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 TimeclockCode -> TimeclockCode -> Bool
forall a. Eq a => a -> a -> Bool
/= TimeclockCode
In = TimeclockCode -> TimeclockEntry -> [Transaction]
forall a a. Show a => a -> 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 = GenericSourcePos
-> TimeclockCode
-> LocalTime
-> AccountName
-> AccountName
-> TimeclockEntry
TimeclockEntry (TimeclockEntry -> GenericSourcePos
tlsourcepos TimeclockEntry
i) TimeclockCode
Out LocalTime
end 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 :: 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 TimeclockCode -> TimeclockCode -> Bool
forall a. Eq a => a -> a -> Bool
/= TimeclockCode
In = TimeclockCode -> TimeclockEntry -> [Transaction]
forall a a. Show a => a -> 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 a. Show a => a -> 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 :: 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 :: a -> TimeclockEntry -> a
errorExpectedCodeButGot a
expected TimeclockEntry
actual = Int -> String -> a
forall a a. Show a => a -> String -> a
errorWithSourceLine Int
line (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"expected timeclock code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
expected) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TimeclockCode -> String
forall a. Show a => a -> String
show (TimeclockEntry -> TimeclockCode
tlcode TimeclockEntry
actual)
    where
        line :: Int
line = case TimeclockEntry -> GenericSourcePos
tlsourcepos TimeclockEntry
actual of
                  GenericSourcePos String
_ Int
l Int
_ -> Int
l
                  JournalSourcePos String
_ (Int
l, Int
_) -> Int
l

errorWithSourceLine :: a -> String -> a
errorWithSourceLine a
line String
msg = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg

-- | 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 = String -> Transaction
forall a. String -> a
error' (String -> Transaction)
-> (AccountName -> String) -> AccountName -> Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> String
T.unpack (AccountName -> Transaction) -> AccountName -> Transaction
forall a b. (a -> b) -> a -> b
$
        AccountName
"clock-out time less than clock-in time in:\n" AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> Transaction -> AccountName
showTransaction Transaction
t  -- PARTIAL:
    where
      t :: Transaction
t = Transaction :: Integer
-> AccountName
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> AccountName
-> AccountName
-> AccountName
-> [Tag]
-> [Posting]
-> Transaction
Transaction {
            tindex :: Integer
tindex       = Integer
0,
            tsourcepos :: GenericSourcePos
tsourcepos   = TimeclockEntry -> GenericSourcePos
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     = 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 (String -> AccountName) -> String -> AccountName
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> String
showtime TimeOfDay
itod String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TimeOfDay -> String
showtime TimeOfDay
otod
               | Bool
otherwise                = TimeclockEntry -> AccountName
tldescription TimeclockEntry
i
      showtime :: TimeOfDay -> String
showtime = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
5 ShowS -> (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
      amount :: MixedAmount
amount   = [Amount] -> MixedAmount
Mixed [Quantity -> Amount
hrs Quantity
hours]
      ps :: [Posting]
ps       = [Posting
posting{paccount :: AccountName
paccount=AccountName
acctname, pamount :: MixedAmount
pamount=MixedAmount
amount, ptype :: PostingType
ptype=PostingType
VirtualPosting, ptransaction :: Maybe Transaction
ptransaction=Transaction -> Maybe Transaction
forall a. a -> Maybe a
Just Transaction
t}]


-- tests

tests_Timeclock :: TestTree
tests_Timeclock = String -> [TestTree] -> TestTree
tests 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 -> TimeclockEntry
clockin = GenericSourcePos
-> TimeclockCode
-> LocalTime
-> AccountName
-> AccountName
-> TimeclockEntry
TimeclockEntry GenericSourcePos
nullsourcepos TimeclockCode
In
          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 -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
yesterday String
"23:00:00") AccountName
"" AccountName
""] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String
"23:00-23:59",String
"00:00-"String -> ShowS
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
""] [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 -> ShowS
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
""] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String
"00:00-"String -> ShowS
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
""] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%s-%s" String
futurestr String
futurestr]
 ]