{-|

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
-- import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.Format
import Data.Time.LocalTime
import Text.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) -> String -> Transaction
forall a b. (a -> b) -> a -> b
$ String
"clock-out time less than clock-in time in:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Transaction -> String
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]
 ]