{-# LANGUAGE CPP, 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
#if !(MIN_VERSION_time(1,5,0))
import System.Locale (defaultTimeLocale)
#endif
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 t :: TimeclockEntry
t = String -> String -> String -> AccountName -> AccountName -> String
forall r. PrintfType r => String -> r
printf "%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 SetBalance = "b"
show SetRequiredHours = "h"
show In = "i"
show Out = "o"
show FinalOut = "O"
instance Read TimeclockCode where
readsPrec :: Int -> ReadS TimeclockCode
readsPrec _ ('b' : xs :: String
xs) = [(TimeclockCode
SetBalance, String
xs)]
readsPrec _ ('h' : xs :: String
xs) = [(TimeclockCode
SetRequiredHours, String
xs)]
readsPrec _ ('i' : xs :: String
xs) = [(TimeclockCode
In, String
xs)]
readsPrec _ ('o' : xs :: String
xs) = [(TimeclockCode
Out, String
xs)]
readsPrec _ ('O' : xs :: String
xs) = [(TimeclockCode
FinalOut, String
xs)]
readsPrec _ _ = []
timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions _ [] = []
timeclockEntriesToTransactions now :: LocalTime
now [i :: 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 "" ""
end :: LocalTime
end = if LocalTime
itime LocalTime -> LocalTime -> Bool
forall a. Ord a => a -> a -> Bool
> LocalTime
now then LocalTime
itime else LocalTime
now
(itime :: LocalTime
itime,otime :: LocalTime
otime) = (TimeclockEntry -> LocalTime
tldatetime TimeclockEntry
i,TimeclockEntry -> LocalTime
tldatetime TimeclockEntry
o)
(idate :: Day
idate,odate :: 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 23 59 59}}
i' :: TimeclockEntry
i' = TimeclockEntry
i{tldatetime :: LocalTime
tldatetime=LocalTime
itime{localDay :: Day
localDay=Integer -> Day -> Day
addDays 1 Day
idate, localTimeOfDay :: TimeOfDay
localTimeOfDay=TimeOfDay
midnight}}
timeclockEntriesToTransactions now :: LocalTime
now (i :: TimeclockEntry
i:o :: TimeclockEntry
o:rest :: [TimeclockEntry]
rest)
| 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
(itime :: LocalTime
itime,otime :: LocalTime
otime) = (TimeclockEntry -> LocalTime
tldatetime TimeclockEntry
i,TimeclockEntry -> LocalTime
tldatetime TimeclockEntry
o)
(idate :: Day
idate,odate :: 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 23 59 59}}
i' :: TimeclockEntry
i' = TimeclockEntry
i{tldatetime :: LocalTime
tldatetime=LocalTime
itime{localDay :: Day
localDay=Integer -> Day -> Day
addDays 1 Day
idate, localTimeOfDay :: TimeOfDay
localTimeOfDay=TimeOfDay
midnight}}
entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut i :: TimeclockEntry
i o :: 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
$ "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 = 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 = "",
tdescription :: AccountName
tdescription = AccountName
desc,
tcomment :: AccountName
tcomment = "",
ttags :: [Tag]
ttags = [],
tpostings :: [Posting]
tpostings = [Posting]
ps,
tprecedingcomment :: AccountName
tprecedingcomment=""
}
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 -> 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 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
/ 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 "Timeclock" [
String -> ((String -> IO ()) -> IO ()) -> TestTree
testCaseSteps "timeclockEntriesToTransactions tests" (((String -> IO ()) -> IO ()) -> TestTree)
-> ((String -> IO ()) -> IO ()) -> TestTree
forall a b. (a -> b) -> a -> b
$ \step :: String -> IO ()
step -> do
String -> IO ()
step "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 d :: 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
.
#if MIN_VERSION_time(1,5,0)
Bool -> TimeLocale -> String -> String -> Maybe TimeOfDay
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale "%H:%M:%S"
#else
parseTime defaultTimeLocale "%H:%M:%S"
#endif
showtime :: LocalTime -> String
showtime = TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale "%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 100 UTCTime
now'
futurestr :: String
futurestr = LocalTime -> String
showtime LocalTime
future
String -> IO ()
step "started yesterday, split session at midnight"
[TimeclockEntry] -> [String]
txndescs [LocalTime -> AccountName -> AccountName -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
yesterday "23:00:00") "" ""] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= ["23:00-23:59","00:00-"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nowstr]
String -> IO ()
step "split multi-day sessions at each midnight"
[TimeclockEntry] -> [String]
txndescs [LocalTime -> AccountName -> AccountName -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime (Integer -> Day -> Day
addDays (-2) Day
today) "23:00:00") "" ""] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= ["23:00-23:59","00:00-23:59","00:00-"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nowstr]
String -> IO ()
step "auto-clock-out if needed"
[TimeclockEntry] -> [String]
txndescs [LocalTime -> AccountName -> AccountName -> TimeclockEntry
clockin (Day -> String -> LocalTime
mktime Day
today "00:00:00") "" ""] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= ["00:00-"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nowstr]
String -> IO ()
step "use the clockin time for auto-clockout if it's in the future"
[TimeclockEntry] -> [String]
txndescs [LocalTime -> AccountName -> AccountName -> TimeclockEntry
clockin LocalTime
future "" ""] [String] -> [String] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [String -> String -> ShowS
forall r. PrintfType r => String -> r
printf "%s-%s" String
futurestr String
futurestr]
]