DEV Community

Vehbi Sinan Tunalioglu
Vehbi Sinan Tunalioglu

Posted on • Originally published at thenegation.com

Hacking Watson with Haskell - Part 3

#haskell #lifehack

In the previous blog posts (part 1, part 2), we managed to read Watson frames and state from its JSON files. In this blog post, we will do something more useful: start and stop timer.

Program

This blog post is a Literate Haskell program that attempts to start/stop Watson timer. We will build on top of the previous blog posts (part 1, part 2). If you haven't read them, I recommend you to read them first.

Let's start with the language extensions:

{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}
Enter fullscreen mode Exit fullscreen mode

We will use aeson package like in the previous post, in addition to the libraries coming with the GHC. Also, we will use directory and uuid packages. Finally, we will use the infamous optparse-applicative library. Let's declare our imports:

import Control.Applicative ((<**>)) import Control.Monad (join) import Data.Aeson qualified as Aeson import Data.Text qualified as T import Data.Time qualified as Time import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Data.UUID qualified as UUID import Data.UUID.V4 qualified as UUID import Options.Applicative qualified as OA import System.Directory (XdgDirectory (..), doesFileExist, getXdgDirectory) import System.Environment (getArgs)
Enter fullscreen mode Exit fullscreen mode

First of all, we will hardcode filepaths to the Watson JSON files:

getFileFrames :: IO FilePath getFileFrames = getXdgDirectory XdgConfig "watson/frames" getFileState :: IO FilePath getFileState = getXdgDirectory XdgConfig "watson/state"
Enter fullscreen mode Exit fullscreen mode

Our program represents time as UTCTime although Watson uses epoch time. These are our conversion functions:

fromEpoch :: Int -> Time.UTCTime fromEpoch = posixSecondsToUTCTime . fromIntegral toEpoch :: Time.UTCTime -> Int toEpoch = floor . utcTimeToPOSIXSeconds
Enter fullscreen mode Exit fullscreen mode

Working with Frames

Let's improve our Frame data type and how we read/write it:

data Frame = Frame { frameId :: !T.Text , frameSince :: !Time.UTCTime , frameUntil :: !Time.UTCTime , frameProject :: !T.Text , frameTags :: ![T.Text] , frameUpdatedAt :: !Time.UTCTime } deriving (Show, Eq) instance Aeson.FromJSON Frame where parseJSON v = do arr <- Aeson.parseJSON v case arr of [fSince, fUntil, fProj, fId, fTags, fUpdated] -> do frameId <- Aeson.parseJSON fId frameSince <- fromEpoch <$> Aeson.parseJSON fSince frameUntil <- fromEpoch <$> Aeson.parseJSON fUntil frameProject <- Aeson.parseJSON fProj frameTags <- Aeson.parseJSON fTags frameUpdatedAt <- fromEpoch <$> Aeson.parseJSON fUpdated pure $ Frame {..} _ -> fail "Frame: expected an array of 6 elements" instance Aeson.ToJSON Frame where toJSON Frame {..} = Aeson.toJSON [ Aeson.toJSON (toEpoch frameSince) , Aeson.toJSON (toEpoch frameUntil) , Aeson.toJSON frameProject , Aeson.toJSON frameId , Aeson.toJSON frameTags , Aeson.toJSON (toEpoch frameUpdatedAt) ] readFrames :: FilePath -> IO (Either String [Frame]) readFrames fp = do frames <- Aeson.eitherDecodeFileStrict fp pure $ case frames of Left err -> Left ("Failed to parse frames: " <> err) Right fs -> Right fs writeFrames :: FilePath -> [Frame] -> IO () writeFrames = Aeson.encodeFile
Enter fullscreen mode Exit fullscreen mode

Working with State

Let's improve our State data type and how we read/write it:

data CurrentState = CurrentStatePending | CurrentStateRunning { currentStateRunningSince :: !Time.UTCTime , currentStateRunningProject :: !T.Text , currentStateRunningTags :: ![T.Text] } deriving (Show, Eq) instance Aeson.FromJSON CurrentState where parseJSON = Aeson.withObject "CurrentState" $ \o -> do if null o then pure CurrentStatePending else CurrentStateRunning <$> (fromEpoch <$> o Aeson..: "start") <*> o Aeson..: "project" <*> o Aeson..: "tags" instance Aeson.ToJSON CurrentState where toJSON CurrentStatePending = Aeson.object [] toJSON CurrentStateRunning {..} = Aeson.object [ "start" Aeson..= toEpoch currentStateRunningSince , "project" Aeson..= currentStateRunningProject , "tags" Aeson..= currentStateRunningTags ] readState :: FilePath -> IO (Maybe CurrentState) readState fp = do exists <- doesFileExist fp if exists then do mState <- Aeson.eitherDecodeFileStrict fp pure $ case mState of Left _ -> Nothing Right state -> Just state else pure $ Just CurrentStatePending writeState :: FilePath -> CurrentState -> IO () writeState = Aeson.encodeFile
Enter fullscreen mode Exit fullscreen mode

Main Program

Our main program is a CLI program powered by optparse-applicative. It will offer two subcommands to start and stop the timer. Let's define our options:

opts :: OA.Parser (IO ()) opts = OA.subparser ( OA.command "start" (OA.info (startCommand <**> OA.helper) OA.idm) <> OA.command "stop" (OA.info (stopCommand <**> OA.helper) OA.idm) ) startCommand :: OA.Parser (IO ()) startCommand = start <$> OA.strOption (OA.long "project" <> OA.short 'p' <> OA.metavar "PROJECT") <*> OA.many (OA.strOption (OA.long "tag" <> OA.short 't' <> OA.metavar "TAG")) stopCommand :: OA.Parser (IO ()) stopCommand = do pure stop
Enter fullscreen mode Exit fullscreen mode

Good. Now, let's define the start function. It should be easy: If there is no timer running (or state file exists), we will start the timer. Otherwise, we will print an error message:

start :: T.Text -> [T.Text] -> IO () start project tags = do fState <- getFileState mState <- readState fState case mState of Just CurrentStateRunning {} -> putStrLn "Already running" _ -> do putStrLn "Starting..." now <- Time.getCurrentTime writeState fState $ CurrentStateRunning now project tags
Enter fullscreen mode Exit fullscreen mode

The stop function is just a bit more involved. We will read the state file and if the timer is running, we will stop it. We will also write the frame to the frames file. If the timer is not running, we will print an error message:

stop :: IO () stop = do fState <- getFileState mState <- readState fState case mState of Just CurrentStateRunning {..} -> do putStrLn "Stopping..." now <- Time.getCurrentTime fFrames <- getFileFrames frames <- readFrames fFrames case frames of Left err -> putStrLn err Right fs -> do frameId <- T.replace "-" "" . UUID.toText <$> UUID.nextRandom let frame = Frame { frameSince = currentStateRunningSince , frameUntil = now , frameProject = currentStateRunningProject , frameTags = currentStateRunningTags , frameUpdatedAt = now , .. } writeFrames fFrames (fs <> [frame]) writeState fState CurrentStatePending _ -> putStrLn "Not running..."
Enter fullscreen mode Exit fullscreen mode

Now, we can define our main function:

main :: IO () main = do join $ OA.execParser (OA.info (opts <**> OA.helper) OA.idm)
Enter fullscreen mode Exit fullscreen mode

Wrap-Up

In just 3 blog posts, we managed to read/write Watson JSON files and start/stop the timer.

From a functionality point of view, we are missing a lot of features. This is what Watson offers:

$ watson --help Usage: watson [OPTIONS] COMMAND [ARGS]... Watson is a tool aimed at helping you monitoring your time. You just have to tell Watson when you start working on your project with the `start` command, and you can stop the timer when you're done with the `stop` command. Options: --version Show the version and exit. --color / --no-color (Don't) color output. --help Show this message and exit. Commands: add Add time to a project with tag(s) that was not tracked live. aggregate Display a report of the time spent on each project... cancel Cancel the last call to the start command. config Get and set configuration options. edit Edit a frame. frames Display the list of all frame IDs. help Display help information log Display each recorded session during the given timespan. merge Perform a merge of the existing frames with a conflicting... projects Display the list of all the existing projects. remove Remove a frame. rename Rename a project or tag. report Display a report of the time spent on each project. restart Restart monitoring time for a previously stopped project. start Start monitoring time for the given project. status Display when the current project was started and the time... stop Stop monitoring time for the current project. sync Get the frames from the server and push the new ones. tags Display the list of all the tags.
Enter fullscreen mode Exit fullscreen mode

And this is what we have:

$ runhaskell -pgmLmarkdown-unlit content/posts/2024-08-17_hacking-watson-part-3.lhs --help Usage: 2024-08-17_hacking-watson-part-3.lhs COMMAND Available options: -h,--help Show this help text Available commands: start stop
Enter fullscreen mode Exit fullscreen mode

Also, our start and stop functions do not perform any validation or offer options such as --no-gap or --at.

From a Good Haskell point of view, we are missing a lot of things. For example, we are not dealing with errors properly. We could have defined an error data type and use it with MonadError to make sure that we cover possible error cases and propagate them properly.

I know someone who is willing to learn Haskell. Maybe I can convince him to work on this project.

Top comments (0)