45 lines
1.6 KiB
Haskell
45 lines
1.6 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
module MyLib (someFunc) where
|
|
|
|
import Command (Command(..), execCommand)
|
|
import Conduit
|
|
(ConduitT, ResourceT, liftIO, runConduit, runResourceT, yield, (.|))
|
|
import qualified Data.Conduit.Combinators as Conduit
|
|
import Data.Time (getCurrentTime, getCurrentTimeZone, utcToLocalTime)
|
|
import Hledger.Row
|
|
import System.Directory (copyFile)
|
|
|
|
update :: FilePath -> (forall i m. Monad m => ConduitT i Row m () -> ConduitT i Row m ()) -> IO ()
|
|
update path action = runResourceT $ do
|
|
tempFile <- runConduit $
|
|
Conduit.sourceFile path .|
|
|
action decodeFile .|
|
|
encodeFile .|
|
|
Conduit.sinkSystemTempFile "ledger.timeclock"
|
|
liftIO $ copyFile tempFile path
|
|
|
|
query :: FilePath -> ConduitT i Row (ResourceT IO) ()
|
|
query path = Conduit.sourceFile path .| decodeFile
|
|
|
|
someFunc :: IO ()
|
|
someFunc = do
|
|
now <- utcToLocalTime <$> getCurrentTimeZone <*> getCurrentTime
|
|
execCommand >>= \case
|
|
Stop path -> update path (<> yield (stop now))
|
|
Start path requestedTask -> do
|
|
t <- maybe (error "Task name can't be empty") pure $ task requestedTask
|
|
-- Query the previous state
|
|
-- If we're clocked in, stop the previous clock before starting the new
|
|
-- one
|
|
prev <- runResourceT $ runConduit $ query path .| Conduit.last
|
|
case prev of
|
|
Just (Row (RowContent{rowOperation=In _})) ->
|
|
update path (\c -> c <> yield (stop now) <> yield (start now t))
|
|
_ -> update path (<> yield (start now t))
|
|
where
|
|
stop time = Row (RowContent Out time)
|
|
start time t = Row (RowContent (In t) time)
|
|
|