In Part 2, we extended our continuous build system in Haskell to use TVars for tracking the status of whether our CI system was currently working, or just waiting for more file changes. In this post, we’re going to actually kick off some cabal compilation.

This post applies to Linux users only, due to build dependencies. Hackage does not yet have a corresponding package for Windows.

This post also assumes a basic but passable familiarity with developing in Haskell. If you don’t know how to use cabal yet, this is probably a bit advanced for you.

On your Marks!

I won’t be covering as many API mechanisms this time around, as what we have to build is fairly straightforward. It will largely consist of building up some boilerplate to structure our workflow.

Setting up our Imports

We’ll need to execute external processes, so we’ve got a few more imports to pull in this time.

import Control.Concurrent
import Control.Monad
import System.Exit
import System.Process

Extending our Config Type

Before we dive in to firing off our cabal project, let’s define an output file in which to write our results. This way, if our project has a lot of details, we can easily review the full results. We’ll add this to our Config type:

data Config =
  Config
    { confOutputFile :: FilePath
    , confCabalFile :: FilePath
    , confWorking :: Bool
    } deriving (Show,Read)

We’ll also modify our main function to expect an argument for this output file. If you wanted to handle this in a more real-world setting, I’d recommend setting up your program to use the System.Console.GetOpt library. But, for our purposes today, we’ll just do this the quick-and-dirty way, by continuing to expect verbatim arguments at process execution.

The full updated main function is here. I’ve also tweaked the input to the runThread function just a bit, to pass in our initialized Config object:

main = do
  args <- getArgs
  let dir = head args
  let cabalOutput = args !! 1
  putStrLn $ "Watching directory: " ++ dir
  putStrLn $ "Cabal output file: " ++ cabalOutput
  contents <- getDirectoryContents dir
  let contents' = filter filterCabal contents
  case contents' of
    (x:_) -> do
      let config = Config cabalOutput x False
      runThread config dir
    [] -> do
      putStrLn "No cabal file found!"
      putStrLn "Exiting"

runThread config dir = do
  config <- newTVarIO config
  -- ...

Simplify our Filtering

Now, if we’ve set up our cabal project appropriately, we shouldn’t much care what file was modified. We’ll just want to kick off the entire CI chain again.

This allows us to simplify our handleFilteredFile function:

handleFilteredFile conf evt fp =
  when (filterHS fp) $ print evt >> doWork conf

when is a handy function for saying “if some expression is true, do the following work; otherwise, do nothing”.

With this change, we can also simplify our doWork function definition to simply expect our Config data.

doWork :: TVar Config -> IO ()
doWork conf = do
  -- ...

Building our CI Chain From the Inside Out

At this point, we can start building our functions to execute our CI chain. We’ll want to do three things with this:

1. Execute individual pieces of our CI chain.
2. Define our CI chain.
3. Manage our CI state.

I’m going to walk us through building these up, one function at a time. I’m sorry to say that you’ll actually need to put that mai tai down this time.

Executing a cabal Process

Let’s define a simple function for executing a cabal process from the shell. We’ll simply pass this our Config and a list of shell arguments to pass to cabal. Then, we’ll wait for the process to exit and write any output or error streams to the output file we’ve defined in the Config. Lastly, we’ll return a Bool result to indicate whether the process succeeded.

runCabal :: TVar Config -> [String] -> IO Bool
runCabal conf args = do
  (code, out, err) <- readProcessWithExitCode "cabal" args ""
  config <- readTVarIO conf
  let outputFile = confOutputFile config
  _ <- when (out /= []) $ appendFile outputFile out
  _ <- when (err /= []) $ appendFile outputFile err
  case code of
    ExitSuccess   -> return True
    ExitFailure _ -> return False

We use readProcessWithExitCode here to execute our cabal process with the arguments that were passed in. This function will wait until the process completed (or was terminated) and hands back the results. We again leverage when to append any stdout or stderr to our defined output file, but only when that data is not empty (it’s no use writing empty content to a file).

In this example, we’ll simply ignore the wide variety of error exit codes and just return False if the process failed.

Constructing the CI Chain

In a more complex world, you might want to do a lot of things with a CI system. But, as we prefer white sand beaches and tasty beverages, we’re going to Keep It Simple. All we’ll do here is fire off a cabal build, followed by a cabal test.

This is pretty easy to construct: We’ll just use the runCabal function we just constructed.

runCIChain :: TVar Config -> IO ()
runCIChain conf = do
  cabalBuild <- runCabal conf ["build"]
  print $ "*** cabal build result: " ++ show cabalBuild
  case cabalBuild of
    False -> return ()
    True -> do
      cabalTest <- runCabal conf ["test"]
      print $ "*** cabal test result: " ++ show cabalTest

Remember, our runCabal function expects a list of arguments, so even though we only have one argument for both calls, we need to wrap the strings in brackets. This list of strings error almost always catches me, for some reason. My mind just fails to work that way!

Let’s Get to Work

The last piece we need is to put our runCIChain function to work and (very importantly!) reset our confWorking flag when we’re finished. If we forget to reset that flag, we’ll never catch any additional file updates.

We can do this with a pretty basic runCI function. There’s nothing here you haven’t seen in the previous post.

runCI :: TVar Config -> IO ()
runCI conf = do
  runCIChain conf
  config <- readTVarIO conf
  atomically $ writeTVar conf (config { confWorking = False })
  return ()

There’s only one thing left we need to do: Actually fire off this whole sequence. And we can do so with one line. Right after setting our confWorking flag in our doWork function, spin off a thread to run our CI chain:

_ <- forkIO $ runCI conf

If you haven’t seen it before, forkIO is a function that fires off a lightweight thread to do some work. Python calls these “green threads”, as they don’t consume a full CPU thread and require very little overhead. Haskell uses them profusely.

Closing Thoughts

Well, that was easy! You can pick up that mai tai, again, because we’re done!

If you’d rather have your CI chain run a generic set of commands instead, you can tweak the code we’ve developed to just fire off the contents of an external file, one at a time. Perhaps you’d like to run hlint static code analysis before your cabal test, or push all the files at a successful compile up to some staged source control system. You can see what changes you’d need to make from what we’ve done here to execute this kind of generic script file (and drop the dependency on executing a cabal process).

Keep in mind that what we’ve done here isn’t particularly Haskell-y. I’ve simply shown a lightweight but real-world applicable solution, but we haven’t particularly leveraged the real capabilities that Haskell provides. I’ve also written this in a fairly imperative manner, so the functional purists out there are probably cringing – but, this should have been readily accessible to relative newcomers to functional programming. If you really wanted to make this kind of system production-worthy, you’d likely be better off leveraging a library like conduit.

But, all in all, this wasn’t too bad! About 100 lines of Haskell with few external dependencies makes it quick to deploy, compile, and run in the background when you just want a lightweight, local build system. Of course, you’ll usually be much better off with a full-fledged CI system, such as Jenkins, but this sort of thing is always a fun exercise.

Wrapping up

As always, the full cabal project is available on https://github.com/stormont/continuous-hs. To get the version used in this post, use the tag part-3. You can also grab that extended generic command handling I mentioned earlier using the tag part-3-1.

For a better side-by-side comparison of what we’ve changed, check out this diff.

Here’s the full code we’ve developed:

import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import Control.Monad
import System.Directory
import System.Environment (getArgs)
import System.Exit
import System.INotify
import System.IO
import System.Process

data Config =
  Config
    { confOutputFile :: FilePath
    , confCabalFile :: FilePath
    , confWorking :: Bool
    } deriving (Show,Read)

main = do
  args <- getArgs
  let dir = head args
  let cabalOutput = args !! 1
  putStrLn $ "Watching directory: " ++ dir
  putStrLn $ "Cabal output file: " ++ cabalOutput
  contents <- getDirectoryContents dir
  let contents' = filter filterCabal contents
  case contents' of
    (x:_) -> do
      let config = Config cabalOutput x False
      runThread config dir
    [] -> do
      putStrLn "No cabal file found!"
      putStrLn "Exiting"

runThread config dir = do
  config <- newTVarIO config
  n <- initINotify
  putStrLn "Press <Enter> to exit"
  print n
  wd <- addWatch n
                 [ Modify, CloseWrite, Create, Delete, MoveIn, MoveOut ]
                 dir
                 (eventHandler config)
  print wd
  getLine
  removeWatch wd
  killINotify n

eventHandler :: TVar Config -> Event -> IO ()
eventHandler conf x@(Modified _ (Just fp)) = handleFilteredFile conf x fp
eventHandler conf x@(MovedIn _ fp _) = handleFilteredFile conf x fp
eventHandler conf x@(MovedOut _ fp _) = handleFilteredFile conf x fp
eventHandler conf x@(Created _ fp) = handleFilteredFile conf x fp
eventHandler conf x@(Deleted _ fp) = handleFilteredFile conf x fp
eventHandler _ _ = return ()

handleFilteredFile conf evt fp =
  when (filterHS fp) $ print evt >> doWork conf

filterHS fp = fileExt fp == "hs"
filterCabal fp = fileExt fp == "cabal"

fileExt = reverse
        . takeWhile (/= '.')
        . reverse

doWork :: TVar Config -> IO ()
doWork conf = do
  config <- readTVarIO conf
  if confWorking config
    then do
      print "Already working!"
      return ()
    else do
      print "New work available!"
      atomically $ writeTVar conf (config { confWorking = True })
      _ <- forkIO $ runCI conf
      return ()

runCI :: TVar Config -> IO ()
runCI conf = do
  runCIChain conf
  config <- readTVarIO conf
  atomically $ writeTVar conf (config { confWorking = False })
  return ()

runCIChain :: TVar Config -> IO ()
runCIChain conf = do
  cabalBuild <- runCabal conf ["build"]
  print $ "*** cabal build result: " ++ show cabalBuild
  case cabalBuild of
    False -> return ()
    True -> do
      cabalTest <- runCabal conf ["test"]
      print $ "*** cabal test result: " ++ show cabalTest

runCabal :: TVar Config -> [String] -> IO Bool
runCabal conf args = do
  (code, out, err) <- readProcessWithExitCode "cabal" args ""
  config <- readTVarIO conf
  let outputFile = confOutputFile config
  _ <- when (out /= []) $ appendFile outputFile out
  _ <- when (err /= []) $ appendFile outputFile err
  case code of
    ExitSuccess -> return True
    ExitFailure _ -> return False