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