{-|

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

module Hledger.Data.Timeclock (
   timeclockToTransactions
  ,timeclockToTransactionsOld
  ,tests_Timeclock
)
where

import Data.List (partition, sortBy, uncons)
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

-- detailed output for debugging
-- deriving instance Show TimeclockEntry

-- compact output
instance Show TimeclockEntry where
  show t = printf "%s %s %s  %s" (show $ tlcode t) (show $ tldatetime t) (tlaccount t) (tldescription t)

instance Show TimeclockCode where
  show SetBalance = "b"
  show SetRequiredHours = "h"
  show In = "i"
  show Out = "o"
  show FinalOut = "O"

instance Read TimeclockCode where
  readsPrec _ ('b':xs) = [(SetBalance, xs)]
  readsPrec _ ('h':xs) = [(SetRequiredHours, xs)]
  readsPrec _ ('i':xs) = [(In, xs)]
  readsPrec _ ('o':xs) = [(Out, xs)]
  readsPrec _ ('O':xs) = [(FinalOut, xs)]
  readsPrec _ _ = []

data Session = Session {
  in' :: TimeclockEntry,
  out :: TimeclockEntry
} deriving Show

data Sessions = Sessions {
  completed :: [Session],
  active :: [TimeclockEntry]
} deriving Show

-- | Convert timeclock entries to journal transactions.
-- This is the old version from hledger <1.43, now enabled by --old-timeclock.
-- It requires strictly alternating clock-in and clock-entries.
-- It was documented as allowing only one clocked-in session at a time,
-- but in fact it allows concurrent sessions, even with the same account name.
--
-- Entries must be a strict alternation of in and out, beginning with in.
-- When there is no clockout, one is added with the provided current time. 
-- Sessions crossing midnight are split into days to give accurate per-day totals.
-- If entries are not in the expected in/out order, an error is raised.
--
timeclockToTransactionsOld :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockToTransactionsOld _ [] = []
timeclockToTransactionsOld now [i]
  | tlcode i /= In = errorExpectedCodeButGot In i
  | odate > idate = entryFromTimeclockInOut True i o' : timeclockToTransactionsOld now [i',o]
  | otherwise = [entryFromTimeclockInOut True i o]
  where
    o = TimeclockEntry (tlsourcepos i) Out end "" "" "" []
    end = if itime > now then itime else now
    (itime,otime) = (tldatetime i,tldatetime o)
    (idate,odate) = (localDay itime,localDay otime)
    o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}
    i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}}
timeclockToTransactionsOld now (i:o:rest)
  | tlcode i /= In  = errorExpectedCodeButGot In i
  | tlcode o /= Out = errorExpectedCodeButGot Out o
  | odate > idate   = entryFromTimeclockInOut True i o' : timeclockToTransactionsOld now (i':o:rest)
  | otherwise       = entryFromTimeclockInOut True i o : timeclockToTransactionsOld now rest
  where
    (itime,otime) = (tldatetime i,tldatetime o)
    (idate,odate) = (localDay itime,localDay otime)
    o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}}
    i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}}
{- HLINT ignore timeclockToTransactionsOld -}

-- | Convert timeclock entries to journal transactions.
-- This is the new, default version added in hledger 1.43 and improved in 1.50.
-- It allows concurrent clocked-in sessions (though not with the same account name),
-- and clock-in/clock-out entries in any order.
--
-- Entries are processed in parse order.
-- Sessions crossing midnight are split into days to give accurate per-day totals.
-- At the end, any sessions with no clockout get an implicit clockout with the provided "now" time.
-- If any entries cannot be paired as expected, an error is raised.
--
timeclockToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockToTransactions now entries0 = transactions
  where
    -- don't sort by time, it messes things up; just reverse to get the parsed order
    entries = dbg7 "timeclock entries" $ reverse entries0
    sessions = dbg6 "sessions" $ pairClockEntries entries [] []
    transactionsFromSession s = entryFromTimeclockInOut False (in' s) (out s)
    -- If any "in" sessions are in the future, then set their out time to the initial time
    outtime te = max now (tldatetime te)
    createout te = TimeclockEntry (tlsourcepos te) Out (outtime te) (tlaccount te) "" "" []
    outs = map createout (active sessions)
    stillopen = dbg6 "stillopen" $ pairClockEntries ((active sessions) <> outs) [] []
    transactions = map transactionsFromSession $ sortBy (\s1 s2 -> compare (in' s1) (in' s2)) (completed sessions ++ completed stillopen)

    -- | Assuming that entries have been sorted, we go through each time log entry.
    -- We collect all of the "i" in the list "actives," and each time we encounter
    -- an "o," we look for the corresponding "i" in actives.
    -- If we cannot find it, then it is an error (since the list is sorted).
    -- If the "o" is recorded on a different day than the "i" then we close the
    -- active entry at the end of its day, replace it in the active list
    -- with a start at midnight on the next day, and try again.
    -- This raises an error if any outs cannot be paired with an in.
    pairClockEntries :: [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions
    pairClockEntries [] actives sessions1 = Sessions {completed = sessions1, active = actives}
    pairClockEntries (entry:es) actives sessions1
      | tlcode entry == In  = pairClockEntries es inentries sessions1
      | tlcode entry == Out = pairClockEntries es' actives' sessions2
      | otherwise = pairClockEntries es actives sessions1
      where
        (inentry, newactive) = findInForOut entry (partition (\e -> tlaccount e == tlaccount entry) actives)
        (itime, otime) = (tldatetime inentry, tldatetime entry)
        (idate, odate) = (localDay itime, localDay otime)
        omidnight = entry {tldatetime = itime {localDay = idate, localTimeOfDay = TimeOfDay 23 59 59}}
        imidnight = inentry {tldatetime = itime {localDay = addDays 1 idate, localTimeOfDay = midnight}}
        (sessions2, actives', es')
          | odate > idate = (Session {in' = inentry, out = omidnight} : sessions1, imidnight:newactive, entry:es)
          | otherwise     = (Session {in' = inentry, out = entry} : sessions1, newactive, es)
        inentries = case filter ((== tlaccount entry) . tlaccount) actives of
          []                -> entry:actives
          activesinthisacct -> error' $ T.unpack $ makeTimeClockErrorExcerpt entry $ T.unlines $ [
            ""
            ,"overlaps with session beginning at:"
            ,""
            ]
            <> map (flip makeTimeClockErrorExcerpt "") activesinthisacct
            <> [ "Overlapping sessions with the same account name are not supported." ]
            -- XXX better to show full session(s)
            -- <> map (T.pack . show) (filter ((`elem` activesinthisacct).in') sessions)

        -- | Find the relevant clockin in the actives list that should be paired with this clockout.
        -- If there is a session that has the same account name, then use that.
        -- Otherwise, if there is an active anonymous session, use that.
        -- Otherwise, raise an error.
        findInForOut :: TimeclockEntry -> ([TimeclockEntry], [TimeclockEntry]) -> (TimeclockEntry, [TimeclockEntry])
        findInForOut _ (matchingout:othermatches, rest) = (matchingout, othermatches <> rest)
        findInForOut o ([], activeins) =
            if emptyname then (first, rest) else error' errmsg
            where
                l = show $ unPos $ sourceLine $ tlsourcepos o
                c = unPos $ sourceColumn $ tlsourcepos o
                emptyname = tlaccount o == ""
                (first, rest) = case uncons activeins of
                    Just (hd, tl) -> (hd, tl)
                    Nothing -> error' errmsg
                errmsg =
                    printf
                      "%s:\n%s\n%s\n\nCould not find previous clockin to match this clockout."
                      (sourcePosPretty $ tlsourcepos o)
                      (l ++ " | " ++ show o)
                      (replicate (length l) ' ' ++ " |" ++ replicate c ' ' ++ "^")

errorExpectedCodeButGot :: TimeclockCode -> TimeclockEntry -> a
errorExpectedCodeButGot expected actual = error' $ printf
  ("%s:\n%s\n%s\n\nExpected a timeclock %s entry but got %s.\n"
  ++"Please alternate i and o, beginning with i.")
  (sourcePosPretty $ tlsourcepos actual)
  (l ++ " | " ++ show actual)
  (replicate (length l) ' ' ++ " |" ++ replicate c ' ' ++ "^")
  (show expected)
  (show $ tlcode actual)
  where
    l = show $ unPos $ sourceLine $ tlsourcepos actual
    c = unPos $ sourceColumn $ tlsourcepos actual

makeTimeClockErrorExcerpt :: TimeclockEntry -> T.Text -> T.Text
makeTimeClockErrorExcerpt e@TimeclockEntry{tlsourcepos=pos} msg = T.unlines [
  T.pack (sourcePosPretty pos) <> ":"
  ,l <> " | " <> T.pack (show e)
  -- ,T.replicate (T.length l) " " <> " |" -- <> T.replicate c " " <> "^")
  ] <> msg
  where
    l = T.pack $ show $ unPos $ sourceLine $ tlsourcepos e
    -- c = unPos $ sourceColumn $ tlsourcepos e

-- | 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 :: Bool -> TimeclockEntry -> TimeclockEntry -> Transaction
entryFromTimeclockInOut requiretimeordered i o
    | not requiretimeordered || otime >= itime = t
    | otherwise =
      -- Clockout time earlier than clockin is an error.
      -- (Clockin earlier than preceding clockin/clockout is allowed.)
      -- We should never encounter this case now that we sort the entries,
      -- but let's leave it in case of error.
      error' $ printf
        ("%s:\n%s\nThis clockout time (%s) is earlier than the previous clockin.\n"
        ++"Please adjust it to be later than %s.")
        (sourcePosPretty $ tlsourcepos o)
        (unlines [
          replicate (length l) ' '++ " | " ++ show i,
          l ++ " | " ++ show o,
          (replicate (length l) ' ' ++ " |" ++ replicate c ' ' ++ replicate 19 '^')
          ])
        (show $ tldatetime o)
        (show $ tldatetime i)
    where
      l = show $ unPos $ sourceLine $ tlsourcepos o
      c = (unPos $ sourceColumn $ tlsourcepos o) + 2
      t = Transaction {
            tindex       = 0,
            tsourcepos   = (tlsourcepos i, tlsourcepos i),
            tdate        = idate,
            tdate2       = Nothing,
            tstatus      = Cleared,
            tcode        = "",
            tdescription = desc,
            tcomment     = tlcomment i <> tlcomment o,
            ttags        = tltags i ++ tltags o,
            tpostings    = ps,
            tprecedingcomment=""
          }
      itime    = tldatetime i
      otime    = tldatetime o
      itod     = localTimeOfDay itime
      otod     = localTimeOfDay otime
      idate    = localDay itime
      desc     | T.null (tldescription i) = T.pack $ showtime itod ++ "-" ++ showtime otod
               | otherwise                = tldescription i
      showtime = take 5 . show
      hours    = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
      acctname = tlaccount i
      -- Generate an hours amount. Unusually, we also round the internal Decimal value,
      -- since otherwise it will often have large recurring decimal parts which (since 1.21)
      -- print would display all 255 digits of. timeclock amounts have one second resolution,
      -- so two decimal places is precise enough (#1527).
      amt = case mixedAmount $ setAmountInternalPrecision 2 $ hrs hours of
        a | not $ a < 0 -> a
        _ -> error' $ printf
          "%s%s:\nThis clockout is earlier than the clockin."
          (makeTimeClockErrorExcerpt i "")
          (makeTimeClockErrorExcerpt o "")
      ps = [posting{paccount=acctname, pamount=amt, ptype=VirtualPosting, ptransaction=Just t}]


-- tests

tests_Timeclock = testGroup "Timeclock" [
  testCaseSteps "timeclockToTransactions tests" $ \step -> do
      step "gathering data"
      today <- getCurrentDay
      now' <- getCurrentTime
      tz <- getCurrentTimeZone
      let now = utcToLocalTime tz now'
          nowstr = showtime now
          yesterday = prevday today
          clockin = TimeclockEntry (initialPos "") In
          clockout = TimeclockEntry (initialPos "") Out
          mktime d = LocalTime d . fromMaybe midnight .
                     parseTimeM True defaultTimeLocale "%H:%M:%S"
          showtime = formatTime defaultTimeLocale "%H:%M"
          txndescs = map (T.unpack . tdescription) . timeclockToTransactions now
          future = utcToLocalTime tz $ addUTCTime 100 now'
          futurestr = showtime future
      step "started yesterday, split session at midnight"
      txndescs [clockin (mktime yesterday "23:00:00") "" "" "" []] @?= ["23:00-23:59","00:00-"++nowstr]
      step "split multi-day sessions at each midnight"
      txndescs [clockin (mktime (addDays (-2) today) "23:00:00") "" "" "" []] @?= ["23:00-23:59","00:00-23:59","00:00-"++nowstr]
      step "auto-clock-out if needed"
      txndescs [clockin (mktime today "00:00:00") "" "" "" []] @?= ["00:00-"++nowstr]
      step "use the clockin time for auto-clockout if it's in the future"
      txndescs [clockin future "" "" "" []] @?= [printf "%s-%s" futurestr futurestr]
      step "multiple open sessions"
      txndescs (reverse [
        clockin (mktime today "00:00:00") "a" "" "" [],
        clockin (mktime today "01:00:00") "b" "" "" [],
        clockin (mktime today "02:00:00") "c" "" "" [],
        clockout (mktime today "03:00:00") "b" "" "" [],
        clockout (mktime today "04:00:00") "a" "" "" [],
        clockout (mktime today "05:00:00") "c" "" "" []
        ])
        @?= ["00:00-04:00", "01:00-03:00", "02:00-05:00"]
 ]