DEV Community

Vehbi Sinan Tunalioglu
Vehbi Sinan Tunalioglu

Posted on • Originally published at thenegation.com

Hacking Watson with Haskell - Part 2

In the previous blog post, we read the Watson frames from a JSON file. In this blog post, we will read the Watson state file and print it to the standard output.

Watson State

In addition to the frames, Watson also stores the state of the frame in a separate JSON file, called state. As far as I understand, there can be 3 possible states at a given time:

  1. There is no state file: You have installed Watson, but you have not started tracking time yet.
  2. The state file is empty: You have started using Watson, but currently not tracking any time.
  3. The state file contains some data: You are tracking time at the moment.

When we say that the state file is empty, actually it is an empty JSON object:

{}
Enter fullscreen mode Exit fullscreen mode

When the state file contains some data, it is a JSON object with 3 keys, project, start time and tags list:

{
  "project": "project1",
  "start": 1629043200,
  "tags": ["tag1", "tag2"]
}
Enter fullscreen mode Exit fullscreen mode

Let's work with this state file...

Program

This blog post is a Literate Haskell program that attempts to read the Watson state from a JSON file and prints it to the standard output. That's it for this very blog post.

Let's start with the language extensions:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
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. Let's run our imports:

import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import System.Directory (doesFileExist)
import System.Environment (getArgs)
import qualified Data.Aeson as Aeson
import qualified Data.Text as T
import qualified Data.Time as Time
Enter fullscreen mode Exit fullscreen mode

Our entry point function is main as usual. Here is what it will do:

  1. Read the path to the state JSON file from the command line arguments.
  2. Attempt to read the state from the file.
  3. Print the current state to the standard output if reading is successful, otherwise print an appropriate message.
main :: IO ()
main = do
Enter fullscreen mode Exit fullscreen mode

First, attempt to read the path from the command line arguments:

  fp <- head <$> getArgs
Enter fullscreen mode Exit fullscreen mode

Then, attempt to read the state from the file:

  mState <- readState fp
Enter fullscreen mode Exit fullscreen mode

By now, we have a result of type Maybe CurrentState. We will pattern match to print the state if it is available:

  case mState of
    Just state -> print state
    Nothing -> putStrLn "State file can not be parsed."
Enter fullscreen mode Exit fullscreen mode

That's all what main function does. Now, let's define the CurrentState data type which is a sum type encoding both no-tracking and tracking states:

data CurrentState
  = CurrentStatePending
  | CurrentStateRunning
      { currentStateRunningSince :: !Time.UTCTime
      , currentStateRunningProject :: !T.Text
      , currentStateRunningTags :: ![T.Text]
      }
Enter fullscreen mode Exit fullscreen mode

... and add the Show and Eq instances for it:

  deriving (Show, Eq)
Enter fullscreen mode Exit fullscreen mode

Let's define an instance of the FromJSON type class for it. We will match against a JSON object:

instance Aeson.FromJSON CurrentState where
  parseJSON = Aeson.withObject "CurrentState" $ \o -> do
Enter fullscreen mode Exit fullscreen mode

If the object is empty, we will return CurrentStatePending:

    if null o
      then pure CurrentStatePending
Enter fullscreen mode Exit fullscreen mode

..., otherwise try to parse the project, start and tags fields:

      else CurrentStateRunning
             <$> (fromEpoch <$> o Aeson..: "start")
             <*> o Aeson..: "project"
             <*> o Aeson..: "tags"
Enter fullscreen mode Exit fullscreen mode

... where our fromEpoch function converts an epoch time to a UTCTime value:

    where
      fromEpoch = posixSecondsToUTCTime . fromIntegral @Int
Enter fullscreen mode Exit fullscreen mode

Now, we can define the readState function:

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
Enter fullscreen mode Exit fullscreen mode

Done!

As usual, let's create a symbolic link to the source code file:

ln -sr \
  content/posts/2024-08-16_hacking-watson-part-2.md  \
  content/posts/2024-08-16_hacking-watson-part-2.lhs
Enter fullscreen mode Exit fullscreen mode

..., run our program:

runhaskell -pgmLmarkdown-unlit content/posts/2024-08-16_hacking-watson-part-2.lhs ~/.config/watson/state
Enter fullscreen mode Exit fullscreen mode

..., and see the output:

CurrentStateRunning {currentStateRunningSince = 2024-08-16 14:53:57 UTC, currentStateRunningProject = "vst", currentStateRunningTags = ["gh:vst/vst.github.io"]}
Enter fullscreen mode Exit fullscreen mode

Wrap-Up

With this blog post, we completed the reading part of the Watson files. In the next blog post, we will write the state file and start tracking time with Haskell instead of the Watson CLI.

Top comments (0)