{-# LANGUAGE OverloadedStrings #-}
module Hledger.Data.Timeclock (
timeclockEntriesToTransactions
,tests_Timeclock
)
where
import Data.Maybe
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
_ = []
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}}
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
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
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_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]
]