correl.phoenixinquis.net

projects and coding adventures


Project maintained by correl Hosted on GitHub Pages — Theme by mattgraham

How Does The Phillips Hue Wake-Up Feature Work?


13 March 2018

I recently got myself a set of Phillips Hue White and Color Ambiance lights. One of the features I was looking forward to in particular (besides playing with all the color options) was setting a wake-up alarm with the lights gradually brightening. This was pretty painless to get set up using the phone app. I'm pretty happy with the result, but there's certainly some things I wouldn't mind tweaking. For example, the initial brightness of the bulbs (at the lowest setting) still seems a bit bright, so I might want to delay the bedside lamps and let the more distant lamp start fading in first. I also want to see if I can fiddle it into transitioning between some colors to get more of a sunrise effect (perhaps "rising" from the other side of the room, with the light spreading towards the head of the bed).

Figuring out how the wake-up settings that the app installed on my bridge seemed a good first step towards introducing my own customizations.

Information on getting access to a Hue bridge to make REST API calls to it can be found in the Hue API getting started guide.

My wake-up settings

My wake-up is scheduled for 7:00 to gradually brighten the lights with a half-hour fade-in each weekday. I also toggled on the setting to automatically turn the lights off at 9:00.

nil nil

Finding things on the bridge

The most natural starting point is to check the schedules. Right off the bat, I find what I'm after:

The schedule …

GET http://bridge/api/${username}/schedules/1
{
  "name": "Wake up",
  "description": "L_04_fidlv_start wake up",
  "command": {
    "address": "/api/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx/sensors/2/state",
    "body": {
      "flag": true
    },
    "method": "PUT"
  },
  "localtime": "W124/T06:30:00",
  "time": "W124/T10:30:00",
  "created": "2018-03-11T19:46:54",
  "status": "enabled",
  "recycle": true
}

This is a recurring schedule item that runs every weekday at 6:30. We can tell this by looking at the localtime field. From the documentation on time patterns, we can see that it's a recurring time pattern specifying days of the week as a bitmask, and a time (6:30).

Table 1: Unraveling the weekday portion
0MTWTFSS
01111100 (124 in decimal)

Since this schedule is enabled, we can be assured that it will run, and in doing so, will issue a PUT to a sensors endpoint, setting a flag to true.

… triggers the sensor …

GET http://bridge/api/${username}/sensors/2
{
  "state": {
    "flag": false,
    "lastupdated": "2018-03-13T13:00:00"
  },
  "config": {
    "on": true,
    "reachable": true
  },
  "name": "Sensor for wakeup",
  "type": "CLIPGenericFlag",
  "modelid": "WAKEUP",
  "manufacturername": "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
  "swversion": "A_1801260942",
  "uniqueid": "L_04_fidlv",
  "recycle": true
}

The sensor is what's really setting things in motion. Here we've got a generic CLIP flag sensor that is triggered exclusively by our schedule. Essentially, by updating the flag state, we trigger the sensor.

… triggers a rule …

GET http://bridge/api/${username}/rules/1
{
  "name": "L_04_fidlv_Start",
  "owner": "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
  "created": "2018-03-11T19:46:51",
  "lasttriggered": "2018-03-13T10:30:00",
  "timestriggered": 2,
  "status": "enabled",
  "recycle": true,
  "conditions": [
    {
      "address": "/sensors/2/state/flag",
      "operator": "eq",
      "value": "true"
    }
  ],
  "actions": [
    {
      "address": "/groups/1/action",
      "method": "PUT",
      "body": {
        "scene": "7GJer2-5ahGIqz6"
      }
    },
    {
      "address": "/schedules/2",
      "method": "PUT",
      "body": {
        "status": "enabled"
      }
    }
  ]
}

Now things are happening. Looking at the conditions, we can see that this rule triggers when the wakeup sensor updates, and its flag is set to true. When that happens, the bridge will iterate through its rules, find that the above condition has been met, and iterate through each of the actions.

… which sets the scene …

The bedroom group (/groups/1 in the rule's action list) is set to the following scene, which turns on the lights at minimum brightness:

GET http://bridge/api/${username}/scenes/7GJer2-5ahGIqz6
{
  "name": "Wake Up init",
  "lights": [
    "2",
    "3",
    "5"
  ],
  "owner": "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
  "recycle": true,
  "locked": true,
  "appdata": {},
  "picture": "",
  "lastupdated": "2018-03-11T19:46:50",
  "version": 2,
  "lightstates": {
    "2": {
      "on": true,
      "bri": 1,
      "ct": 447
    },
    "3": {
      "on": true,
      "bri": 1,
      "ct": 447
    },
    "5": {
      "on": true,
      "bri": 1,
      "ct": 447
    }
  }
}

… and schedules the transition …

Another schedule (/schedules/2 in the rule's action list) is enabled by the rule.

GET http://bridge/api/${username}/schedules/2
{
  "name": "L_04_fidlv",
  "description": "L_04_fidlv_trigger end scene",
  "command": {
    "address": "/api/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx/groups/0/action",
    "body": {
      "scene": "gXdkB1um68N1sZL"
    },
    "method": "PUT"
  },
  "localtime": "PT00:01:00",
  "time": "PT00:01:00",
  "created": "2018-03-11T19:46:51",
  "status": "disabled",
  "autodelete": false,
  "starttime": "2018-03-13T10:30:00",
  "recycle": true
}

This schedule is a bit different from the one we saw before. It is normally disabled, and it's time pattern (in localtime) is different. The PT prefix specifies that this is a timer which expires after the given amount of time has passed. In this case, it is set to one minute (the first 60 seconds of our wake-up will be spent in minimal lighting). Enabling this schedule starts up the timer. When one minute is up, another scene will be set.

This one, strangely, is applied to group 0, the meta-group including all lights, but since the scene itself specifies to which lights it applies, there's no real problem with it.

… to a fully lit room …

GET http://bridge/api/${username}/scenes/gXdkB1um68N1sZL
{
  "name": "Wake Up end",
  "lights": [
    "2",
    "3",
    "5"
  ],
  "owner": "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
  "recycle": true,
  "locked": true,
  "appdata": {},
  "picture": "",
  "lastupdated": "2018-03-11T19:46:51",
  "version": 2,
  "lightstates": {
    "2": {
      "on": true,
      "bri": 254,
      "ct": 447,
      "transitiontime": 17400
    },
    "3": {
      "on": true,
      "bri": 254,
      "ct": 447,
      "transitiontime": 17400
    },
    "5": {
      "on": true,
      "bri": 254,
      "ct": 447,
      "transitiontime": 17400
    }
  }
}

This scene transitions the lights to full brightness over the next 29 minutes (1740 seconds), per the specified transitiontime (which is specified in deciseconds).

… which will be switched off later.

Finally, an additional rule takes care of turning the lights off and the wake-up sensor at 9:00 (Two and a half hours after the initial triggering of the sensor).

GET http://bridge/api/${username}/rules/2
{
  "name": "Wake up 1.end",
  "owner": "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
  "created": "2018-03-11T19:46:51",
  "lasttriggered": "2018-03-13T13:00:00",
  "timestriggered": 2,
  "status": "enabled",
  "recycle": true,
  "conditions": [
    {
      "address": "/sensors/2/state/flag",
      "operator": "eq",
      "value": "true"
    },
    {
      "address": "/sensors/2/state/flag",
      "operator": "ddx",
      "value": "PT02:30:00"
    }
  ],
  "actions": [
    {
      "address": "/groups/2/action",
      "method": "PUT",
      "body": {
        "on": false
      }
    },
    {
      "address": "/sensors/2/state",
      "method": "PUT",
      "body": {
        "flag": false
      }
    }
  ]
}

Unlike the first rule, this one doesn't trigger immediately. It has an additional condition on the sensor state flag using the special ddx operator, which (given the timer specified) is true two and a half hours after the flag has been set. As the schedule sets it at 6:30, that means that this rule will trigger at 9:00, turn the lights off in the bedroom, and set the sensor's flag to false.

Where to go from here

The wake-up config in the phone app touched on pretty much every major aspect of the Hue bridge API. Given the insight I now have into how it works, I can start constructing my own schedules and transitions, and playing with different ways of triggering them and even having them trigger each other.

If I get around to building my rolling sunrise, I'll be sure to get a post up on it :)

Cleaner Recursive HTTP Requests with Elm Tasks


23 January 2018 elm · programming

Continued from part one, Recursive HTTP Requests with Elm.

In my last post, I described my first pass at building a library to fetch data from a paginated JSON REST API. It worked, but it wasn't too clean. In particular, the handling of the multiple pages and concatenation of results was left up to the calling code. Ideally, both of these concerns should be handled by the library, letting the application focus on working with a full result set. Using Elm's Tasks, we can achieve exactly that!

What's a Task?

A Task is a data structure in Elm which represents an asynchronous operation that may fail, which can be mapped and chained. What this means is, we can create an action, transform it, and chain it with additional actions, building up a complex series of things to do into a single Task, which we can then package up into a Cmd and hand to the Elm runtime to perform. You can think of it like building up a Future or Promise, setting up a sort of callback chain of mutations and follow-up actions to be taken. The Elm runtime will work its way through the chain and hand your application back the result in the form of a Msg.

So, tasks sound great!

Moving to Tasks

Just to get things rolling, let's quit using Http.send, and instead prepare a simple toTask function leveraging the very handy Http.toTask. This'll give us a place to start building up some more complex behavior.

send :
    (Result Http.Error (Response a) -> msg)
    -> Request a
    -> Cmd msg
send resultToMessage request =
        toTask request
        |> Task.attempt resultToMessage


toTask : Request a -> Task Http.Error (Response a)
toTask =
    httpRequest >> Http.toTask

Shifting the recursion

Now, for the fun bit. We want, when a request completes, to inspect the result. If the task failed, we do nothing. If it succeeded, we move on to checking the response. If we have a Complete response, we're done. If we do not, we want to build another task for the next request, and start a new iteration on that.

All that needs to be done here is to chain our response handling using Task.andThen, and either recurse to continue the chain with the next Task, or wrap up the final results with Task.succeed!

recurse :
    Task Http.Error (Response a)
    -> Task Http.Error (Response a)
recurse =
    Task.andThen
        (\response ->
            case response of
                Partial request _ ->
                    httpRequest request
                        |> Http.toTask
                        |> recurse

                Complete _ ->
                    Task.succeed response
        )

That wasn't so bad. The function recursion almost seems like cheating: I'm able to build up a whole chain of requests based on the results without actually having the results yet! The Task lets us define a complete plan for what to do with the results, using what we know about the data structures flowing through to make decisions and tack on additional things to do.

Accumulating results

There's just one thing left to do: we're not accumulating results yet. We're just handing off the results of the final request, which isn't too helpful to the caller. We're also still returning our Response structure, which is no longer necessary, since we're not bothering with returning incomplete requests anymore.

Cleaning up the types is pretty easy. It's just a matter of switching out some instances of Response a with List a in our type declarations…

send :
    (Result Http.Error (List a) -> msg)
    -> Request a
    -> Cmd msg


toTask : Request a -> Task Http.Error (List a)


recurse :
    Task Http.Error (Response a)
    -> Task Http.Error (List a)

…then changing our Complete case to return the actual items:

Complete xs ->
    Task.succeed xs

The final step, then, is to accumulate the results. Turns out this is super easy. We already have an update function that combines two responses, so we can map that over our next request task so that it incorporates the previous request's results!

Partial request _ ->
    httpRequest request
        |> Http.toTask
        |> Task.map (update response)
        |> recurse

Tidying up

Things are tied up pretty neatly, now! Calling code no longer needs to care whether the JSON endpoints its calling paginate their results, they'll receive everything they asked for as though it were a single request. Implementation details like the Response structure, update method, and httpRequest no longer need to be exposed. toTask can be exposed now as a convenience to anyone who wants to perform further chaining on their calls.

Now that there's a cleaner interface to the module, the example app is looking a lot cleaner now, too:

module Example exposing (..)

import Html exposing (Html)
import Http
import Json.Decode exposing (field, string)
import Paginated


type alias Model =
    { repositories : Maybe (List String) }


type Msg
    = GotRepositories (Result Http.Error (List String))


main : Program Never Model Msg
main =
    Html.program
        { init = init
        , update = update
        , view = view
        , subscriptions = \_ -> Sub.none
        }


init : ( Model, Cmd Msg )
init =
    ( { repositories = Nothing }
    , getRepositories
    )


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        GotRepositories result ->
            ( { model | repositories = Result.toMaybe result }
            , Cmd.none
            )


view : Model -> Html Msg
view model =
    case model.repositories of
        Nothing ->
            Html.div [] [ Html.text "Loading" ]

        Just repos ->
            Html.ul [] <|
                List.map
                    (\x -> Html.li [] [ Html.text x ])
                    repos


getRepositories : Cmd Msg
getRepositories =
    Paginated.send GotRepositories <|
        Paginated.get
            "http://git.phoenixinquis.net/api/v4/projects?per_page=5"
            (field "name" string)

So, there we have it! Feel free to check out the my complete Paginated library on the Elm package index, or on GitHub. Hopefully you'll find it or this post useful. I'm still finding my way around Elm, so any and all feedback is quite welcome :)

Recursive HTTP Requests with Elm


22 January 2018 elm · programming

So I got the idea in my head that I wanted to pull data from the GitLab / GitHub APIs in my Elm app. This seemed straightforward enough; just wire up an HTTP request and a JSON decoder, and off I go. Then I remember, oh crap… like any sensible API with a potentially huge amount of data behind it, the results come back paginated. For anyone unfamiliar, this means that a single API request for a list of, say, repositories, is only going to return up to some maximum number of results. If there are more results available, there will be a reference to additional pages of results, that you can then fetch with another API request. My single request decoding only the results returned from that single request wasn't going to cut it.

I had a handful of problems to solve. I needed to:

  • Detect when additional results were available.
  • Parse out the URL to use to fetch the next page of results.
  • Continue fetching results until none remained.
  • Combine all of the results, maintaining their order.

Are there more results?

The first two bullet points can be dealt with by parsing and inspecting the response header. Both GitHub and GitLab embed pagination links in the HTTP Link header. As I'm interested in consuming pages until no further results remain, I'll be looking for a link in the header with the relationship "next". If I find one, I know I need to hit the associated URL to fetch more results. If I don't find one, I'm done!

Parsing this stuff out went straight into a utility module.

module Paginated.Util exposing (links)

import Dict exposing (Dict)
import Maybe.Extra
import Regex


{-| Parse an HTTP Link header into a dictionary. For example, to look
for a link to additional results in an API response, you could do the
following:

    Dict.get "Link" response.headers
        |> Maybe.map links
        |> Maybe.andThen (Dict.get "next")

-}
links : String -> Dict String String
links s =
    let
        toTuples xs =
            case xs of
                [ Just a, Just b ] ->
                    Just ( b, a )

                _ ->
                    Nothing
    in
        Regex.find
            Regex.All
            (Regex.regex "<(.*?)>; rel=\"(.*?)\"")
            s
            |> List.map .submatches
            |> List.map toTuples
            |> Maybe.Extra.values
            |> Dict.fromList

A little bit of regular expression magic, tuples, and Maybe.Extra.values to keep the matches, and now I've got my (Maybe) URL.

Time to make some requests

Now's the time to define some types. I'll need a Request, which will be similar to a standard Http.Request, with a slight difference.

type alias RequestOptions a =
    { method : String
    , headers : List Http.Header
    , url : String
    , body : Http.Body
    , decoder : Decoder a
    , timeout : Maybe Time.Time
    , withCredentials : Bool
    }


type Request a
    = Request (RequestOptions a)

What separates it from a basic Http.Request is the decoder field instead of an expect field. The expect field in an HTTP request is responsible for parsing the full response into whatever result the caller wants. For my purposes, I always intend to be hitting a JSON API returning a list of items, and I have my own designs on parsing bits of the request to pluck out the headers. Therefore, I expose only a slot for including a JSON decoder representing the type of item I'll be getting a collection of.

I'll also need a Response, which will either be Partial (containing the results from the response, plus a Request for getting the next batch), or Complete.

type Response a
    = Partial (Request a) (List a)
    | Complete (List a)

Sending the request isn't too bad. I can just convert my request into an Http.Request, and use Http.send.

send :
    (Result Http.Error (Response a) -> msg)
    -> Request a
    -> Cmd msg
send resultToMessage request =
    Http.send resultToMessage <|
        httpRequest request


httpRequest : Request a -> Http.Request (Response a)
httpRequest (Request options) =
    Http.request
        { method = options.method
        , headers = options.headers
        , url = options.url
        , body = options.body
        , expect = expect options
        , timeout = options.timeout
        , withCredentials = options.withCredentials
        }


expect : RequestOptions a -> Http.Expect (Response a)
expect options =
    Http.expectStringResponse (fromResponse options)

All of my special logic for handling the headers, mapping the decoder over the results, and packing them up into a Response is baked into my Http.Request via a private fromResponse translator:

fromResponse :
    RequestOptions a
    -> Http.Response String
    -> Result String (Response a)
fromResponse options response =
    let
        items : Result String (List a)
        items =
            Json.Decode.decodeString
                (Json.Decode.list options.decoder)
                response.body

        nextPage =
            Dict.get "Link" response.headers
                |> Maybe.map Paginated.Util.links
                |> Maybe.andThen (Dict.get "next")
    in
        case nextPage of
            Nothing ->
                Result.map Complete items

            Just url ->
                Result.map
                    (Partial (request { options | url = url }))
                    items

Putting it together

Now, I can make my API request, and get back a response with potentially partial results. All that needs to be done now is to make my request, and iterate on the results I get back in my update method.

To make things a bit easier, I add a method for concatenating two responses:

update : Response a -> Response a -> Response a
update old new =
    case ( old, new ) of
        ( Complete items, _ ) ->
            Complete items

        ( Partial _ oldItems, Complete newItems ) ->
            Complete (oldItems ++ newItems)

        ( Partial _ oldItems, Partial request newItems ) ->
            Partial request (oldItems ++ newItems)

Putting it all together, I get a fully functional test app that fetches a paginated list of repositories from GitLab, and renders them when I've fetched them all:

module Example exposing (..)

import Html exposing (Html)
import Http
import Json.Decode exposing (field, string)
import Paginated exposing (Response(..))


type alias Model =
    { repositories : Maybe (Response String) }


type Msg
    = GotRepositories (Result Http.Error (Paginated.Response String))


main : Program Never Model Msg
main =
    Html.program
        { init = init
        , update = update
        , view = view
        , subscriptions = \_ -> Sub.none
        }


init : ( Model, Cmd Msg )
init =
    ( { repositories = Nothing }
    , getRepositories
    )


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        GotRepositories (Ok response) ->
            ( { model
                | repositories =
                    case model.repositories of
                        Nothing ->
                            Just response

                        Just previous ->
                            Just (Paginated.update previous response)
              }
            , case response of
                Partial request _ ->
                    Paginated.send GotRepositories request

                Complete _ ->
                    Cmd.none
            )

        GotRepositories (Err _) ->
            ( { model | repositories = Nothing }
            , Cmd.none
            )


view : Model -> Html Msg
view model =
    case model.repositories of
        Nothing ->
            Html.div [] [ Html.text "Loading" ]

        Just (Partial _ _) ->
            Html.div [] [ Html.text "Loading..." ]

        Just (Complete repos) ->
            Html.ul [] <|
                List.map
                    (\x -> Html.li [] [ Html.text x ])
                    repos


getRepositories : Cmd Msg
getRepositories =
    Paginated.send GotRepositories <|
        Paginated.get
            "http://git.phoenixinquis.net/api/v4/projects?per_page=5"
            (field "name" string)

There's got to be a better way

I've got it working, and it's working well. However, it's kind of a pain to use. It's nice that I can play with the results as they come in by peeking into the Partial structure, but it's a real chore to have to stitch the results together in my application's update method. It'd be nice if I could somehow encapsulate that behavior in my request and not have to worry about the pagination at all in my app.

It just so happens that, with Tasks, I can.

Feel free to check out the full library documentation and code referenced in this post here.

Continue on with part two, Cleaner Recursive HTTP Requests with Elm Tasks.

Use a different theme when publishing Org files


23 February 2016 emacs · org-mode · themes

I've been using material-theme lately, and I sometimes switch around, but I've found that solarized produces the best exported code block results. To avoid having to remember to switch themes when exporting, I wrote a quick wrapper for org-export to do it for me:

(defun my/with-theme (theme fn &rest args)
  (let ((current-themes custom-enabled-themes))
    (mapcar #'disable-theme custom-enabled-themes)
    (load-theme theme t)
    (let ((result (apply fn args)))
      (mapcar #'disable-theme custom-enabled-themes)
      (mapcar (lambda (theme) (load-theme theme t)) current-themes)
      result)))

(advice-add #'org-export-to-file :around (apply-partially #'my/with-theme 'solarized-dark))
(advice-add #'org-export-to-buffer :around (apply-partially #'my/with-theme 'solarized-dark))

VoilĂ , no more bizarrely formatted code block exports from whatever theme I might have loaded at the time :)

Drawing Git Graphs with Graphviz and Org-Mode


12 July 2015 emacs · org-mode · git · graphviz

Digging through Derek Feichtinger's org-babel examples (which I came across via irreal.org), I found he had some great examples of displaying git-style graphs using graphviz. I thought it'd be a fun exercise to generate my own graphs based on his graphviz source using elisp, and point it at actual git repos.

Getting Started

I started out with the goal of building a simple graph showing a mainline branch and a topic branch forked from it and eventually merged back in.

Using Derek's example as a template, I described 5 commits on a master branch, plus two on a topic branch.

digraph G {
        rankdir="LR";
        bgcolor="transparent";
        node[width=0.15, height=0.15, shape=point];
        edge[weight=2, arrowhead=none];
        node[group=master];
        1 -> 2 -> 3 -> 4 -> 5;
        node[group=branch];
        2 -> 6 -> 7 -> 4;
}

The resulting image looks like this:

G 1 2 1->2 3 2->3 6 2->6 4 3->4 5 4->5 7 6->7 7->4

Designing the Data Structure

The first thing I needed to do was describe my data structure. Leaning on my experiences reading and working through SICP, I got to work building a constructor function, and several accessors.

I decided to represent each node on a graph with an id, a list of parent ids, and a group which will correspond to the branch on the graph the commit belongs to.

(defun git-graph/make-node (id &optional parents group)
  (list id parents group))

(defun git-graph/node-id (node)
  (nth 0 node))

(defun git-graph/node-parents (node)
  (nth 1 node))

(defun git-graph/node-group (node)
  (nth 2 node))

Converting the structure to Graphviz

Now that I had my data structures sorted out, it was time to step through them and generate the graphviz source that'd give me the nice-looking graphs I was after.

The graph is constructed using the example above as a template. The nodes are defined first, followed by the edges between them.

(defun git-graph/to-graphviz (id nodes)
  (string-join
   (list
    (concat "digraph " id " {")
    "bgcolor=\"transparent\";"
    "rankdir=\"LR\";"
    "node[width=0.15,height=0.15,shape=point,fontsize=8.0];"
    "edge[weight=2,arrowhead=none];"
    (string-join
     (-map #'git-graph/to-graphviz-node nodes)
     "\n")
     (string-join
      (-uniq (-flatten (-map #'git-graph/to-graphviz-edges nodes)))
      "\n")
      "}")
   "\n"))

For the sake of readability, I'll format the output:

(defun git-graph/to-graphviz-pretty (id nodes)
  (with-temp-buffer
    (graphviz-dot-mode)
    (insert (git-graph/to-graphviz id nodes))
    (indent-region (point-min) (point-max))
    (buffer-string)))

Each node is built, setting its group attribute when applicable.

(defun git-graph/to-graphviz-node (node)
  (let ((node-id (git-graph/to-graphviz-node-id
                  (git-graph/node-id node))))
    (concat node-id
            (--if-let (git-graph/node-group node)
                (concat "[group=\"" it "\"]"))
            ";")))

Graphviz node identifiers are quoted to avoid running into issues with spaces or other special characters.

(defun git-graph/to-graphviz-node-id (id)
  (format "\"%s\"" id))

For each node, an edge is built connecting the node to each of its parents.

(defun git-graph/to-graphviz-edges (node)
  (let ((node-id (git-graph/node-id node))
        (parents (git-graph/node-parents node)))
    (-map (lambda (parent)
            (git-graph/to-graphviz-edge node-id parent))
          parents)))

(defun git-graph/to-graphviz-edge (from to)
  (concat
   (git-graph/to-graphviz-node-id to)
   " -> "
   (git-graph/to-graphviz-node-id from)
   ";"))

With that done, the simple graph above could be generated with the following code:

(git-graph/to-graphviz-pretty
 "example"
 (list (git-graph/make-node 1 nil "master")
       (git-graph/make-node 2 '(1) "master")
       (git-graph/make-node 3 '(2) "master")
       (git-graph/make-node 4 '(3 7) "master")
       (git-graph/make-node 5 '(4) "master")
       (git-graph/make-node 6 '(2) "branch")
       (git-graph/make-node 7 '(6) "branch")))

Which generates the following graphviz source:

digraph example {
        bgcolor="transparent";
        rankdir="LR";
        node[width=0.15,height=0.15,shape=point,fontsize=8.0];
        edge[weight=2,arrowhead=none];
        "1"[group="master"];
        "2"[group="master"];
        "3"[group="master"];
        "4"[group="master"];
        "5"[group="master"];
        "6"[group="branch"];
        "7"[group="branch"];
        "1" -> "2";
        "2" -> "3";
        "3" -> "4";
        "7" -> "4";
        "4" -> "5";
        "2" -> "6";
        "6" -> "7";
}

The generated image matches the example exactly:

example 1 2 1->2 3 2->3 6 2->6 4 3->4 5 4->5 7 6->7 7->4

Adding Labels

The next thing my graph needed was a way of labeling nodes. Rather than trying to figure out some way of attaching a separate label to a node, I decided to simply draw a labeled node as a box with text.

digraph G {
        rankdir="LR";
        bgcolor="transparent";
        node[width=0.15, height=0.15, shape=point,fontsize=8.0];
        edge[weight=2, arrowhead=none];
        node[group=main];
        1 -> 2 -> 3 -> 4 -> 5;
        5[shape=box,label=master];
        node[group=branch1];
        2 -> 6 -> 7 -> 4;
        7[shape=box,label=branch];
}
G 1 2 1->2 3 2->3 6 2->6 4 3->4 5 master 4->5 7 branch 6->7 7->4

Updating the Data Structure

I updated my data structure to support an optional label applied to a node. I opted to store it in an associative list alongside the group.

(defun git-graph/make-node (id &optional parents options)
  (list id parents options))

(defun git-graph/node-id (node)
  (nth 0 node))

(defun git-graph/node-parents (node)
  (nth 1 node))

(defun git-graph/node-group (node)
  (cdr (assoc 'group (nth 2 node))))

(defun git-graph/node-label (node)
  (cdr (assoc 'label (nth 2 node))))

Updating the Graphviz node generation

The next step was updating the Graphviz generation functions to handle the new data structure, and set the shape and label attributes of labeled nodes.

(defun git-graph/to-graphviz-node (node)
  (let ((node-id (git-graph/to-graphviz-node-id (git-graph/node-id node))))
    (concat node-id
            (git-graph/to-graphviz-node--attributes node)
            ";")))

(defun git-graph/to-graphviz-node--attributes (node)
  (let ((attributes (git-graph/to-graphviz-node--compute-attributes node)))
    (and attributes
         (concat "["
                 (mapconcat (lambda (pair)
                              (format "%s=\"%s\""
                                      (car pair) (cdr pair)))
                            attributes
                            ", ")
                 "]"))))

(defun git-graph/to-graphviz-node--compute-attributes (node)
  (-filter #'identity
           (append (and (git-graph/node-group node)
                        (list (cons 'group (git-graph/node-group node))))
                   (and (git-graph/node-label node)
                        (list (cons 'shape 'box)
                              (cons 'label (git-graph/node-label node)))))))

I could then label the tips of each branch:

(git-graph/to-graphviz-pretty
 "labeled"
 (list (git-graph/make-node 1 nil '((group . "master")))
       (git-graph/make-node 2 '(1) '((group . "master")))
       (git-graph/make-node 3 '(2) '((group . "master")))
       (git-graph/make-node 4 '(3 7) '((group . "master")))
       (git-graph/make-node 5 '(4) '((group . "master")
                                     (label . "master")))
       (git-graph/make-node 6 '(2) '((group . "branch")))
       (git-graph/make-node 7 '(6) '((group . "branch")
                                     (label . "branch")))))
digraph labeled {
        bgcolor="transparent";
        rankdir="LR";
        node[width=0.15,height=0.15,shape=point,fontsize=8.0];
        edge[weight=2,arrowhead=none];
        "1"[group="master"];
        "2"[group="master"];
        "3"[group="master"];
        "4"[group="master"];
        "5"[group="master", shape="box", label="master"];
        "6"[group="branch"];
        "7"[group="branch", shape="box", label="branch"];
        "1" -> "2";
        "2" -> "3";
        "3" -> "4";
        "7" -> "4";
        "4" -> "5";
        "2" -> "6";
        "6" -> "7";
}
labeled 1 2 1->2 3 2->3 6 2->6 4 3->4 5 master 4->5 7 branch 6->7 7->4

Automatic Grouping Using Leaf Nodes

Manually assigning groups to each node is tedious, and easy to accidentally get wrong. Also, with the goal to graph git repositories, I was going to have to figure out groupings automatically anyway.

To do this, it made sense to traverse the nodes in topological order.

Repeating the example above,

digraph G {
        rankdir="LR";
        bgcolor="transparent";
        node[width=0.15, height=0.15, shape=circle];
        edge[weight=2, arrowhead=none];
        node[group=main];
        1 -> 2 -> 3 -> 4 -> 5;
        node[group=branch1];
        2 -> 6 -> 7 -> 4;
}
G 1 1 2 2 1->2 3 3 2->3 6 6 2->6 4 4 3->4 5 5 4->5 7 7 6->7 7->4

These nodes can be represented (right to left) in topological order as either 5, 4, 3, 7, 6, 2, 1 or 5, 4, 7, 6, 3, 2, 1.

Having no further children, 5 is a leaf node, and can be used as a group. All first parents of 5 can therefore be considered to be in group 5.

7 is a second parent to 4, and so should be used as the group for all of its parents not present in group 5.

(defun git-graph/group-topo (nodelist)
  (reverse
   (car
    (-reduce-from
     (lambda (acc node)
       (let* ((grouped-nodes (car acc))
              (group-stack (cdr acc))
              (node-id (git-graph/node-id node))
              (group-from-stack (--if-let (assoc node-id group-stack)
                                    (cdr it)))
              (group (or group-from-stack node-id))
              (parents (git-graph/node-parents node))
              (first-parent (first parents)))
         (if group-from-stack
             (pop group-stack))
         (if (and first-parent (not (assoc first-parent group-stack)))
             (push (cons first-parent group) group-stack))
         (cons (cons (git-graph/make-node node-id
                                    parents
                                    `((group . ,group)
                                      (label . ,(git-graph/node-label node))))
                     grouped-nodes)
               group-stack)))
     nil
     nodelist))))

While iterating through the node list, I maintained a stack of pairs built from the first parent of the current node, and the current group. To determine the group, the head of the stack is checked to see if it contains a group for the current node id. If it does, that group is used and it is popped off the stack, otherwise the current node id is used.

The following table illustrates how the stack is used to store and assign group relationships as the process iterates through the node list:

Table 1: Progressing through the nodes
Node Parents Group Stack Group
5 (4) (4 . 5) 5
4 (3 7) (3 . 5) 5
3 (2) (2 . 5) 5
7 (6) (6 . 7) (2 . 5) 7
6 (2) (2 . 5) 7
2 (1) (1 . 5) 5
1     5

Graph without automatic grouping

(git-graph/to-graphviz-pretty
 "nogroups"
 (list (git-graph/make-node 5 '(4) '((label . master)))
       (git-graph/make-node 4 '(3 7))
       (git-graph/make-node 3 '(2))
       (git-graph/make-node 7 '(6) '((label . develop)))
       (git-graph/make-node 6 '(2))
       (git-graph/make-node 2 '(1))
       (git-graph/make-node 1 nil)))
digraph nogroups {
        bgcolor="transparent";
        rankdir="LR";
        node[width=0.15,height=0.15,shape=point,fontsize=8.0];
        edge[weight=2,arrowhead=none];
        "5"[shape="box", label="master"];
        "4";
        "3";
        "7"[shape="box", label="develop"];
        "6";
        "2";
        "1";
        "4" -> "5";
        "3" -> "4";
        "7" -> "4";
        "2" -> "3";
        "6" -> "7";
        "2" -> "6";
        "1" -> "2";
}
nogroups 5 master 4 4->5 3 3->4 7 develop 7->4 6 6->7 2 2->3 2->6 1 1->2

Graph with automatic grouping

(git-graph/to-graphviz-pretty
 "autogroups"
 (git-graph/group-topo
  (list (git-graph/make-node 5 '(4) '((label . master)))
        (git-graph/make-node 4 '(3 7))
        (git-graph/make-node 3 '(2))
        (git-graph/make-node 7 '(6) '((label . develop)))
        (git-graph/make-node 6 '(2))
        (git-graph/make-node 2 '(1))
        (git-graph/make-node 1 nil))))
digraph autogroups {
        bgcolor="transparent";
        rankdir="LR";
        node[width=0.15,height=0.15,shape=point,fontsize=8.0];
        edge[weight=2,arrowhead=none];
        "5"[group="5", shape="box", label="master"];
        "4"[group="5"];
        "3"[group="5"];
        "7"[group="7", shape="box", label="develop"];
        "6"[group="7"];
        "2"[group="5"];
        "1"[group="5"];
        "4" -> "5";
        "3" -> "4";
        "7" -> "4";
        "2" -> "3";
        "6" -> "7";
        "2" -> "6";
        "1" -> "2";
}
autogroups 5 master 4 4->5 3 3->4 7 develop 7->4 6 6->7 2 2->3 2->6 1 1->2

Graphing a Git Repository

Satisfied that I had all the necessary tools to start graphing real git repositories, I created an example repository to test against.

Creating a Sample Repository

Using the following script, I created a sample repository to test against. I performed the following actions:

  • Forked a develop branch from master.
  • Forked a feature branch from develop, with two commits.
  • Added another commit to develop.
  • Forked a second feature branch from develop, with two commits.
  • Merged the second feature branch to develop.
  • Merged develop to master and tagged it.
mkdir /tmp/test.git
cd /tmp/test.git
git init
touch README
git add README
git commit -m 'initial'
git commit --allow-empty -m 'first'
git checkout -b develop
git commit --allow-empty -m 'second'
git checkout -b feature-1
git commit --allow-empty -m 'feature 1'
git commit --allow-empty -m 'feature 1 again'
git checkout develop
git commit --allow-empty -m 'third'
git checkout -b feature-2
git commit --allow-empty -m 'feature 2'
git commit --allow-empty -m 'feature 2 again'
git checkout develop
git merge --no-ff feature-2
git checkout master
git merge --no-ff develop
git tag -a 1.0 -m '1.0!'

Generating a Graph From a Git Branch

The first order of business was to have a way to call out to git and return the results:

(defun git-graph/git-execute (repo-url command &rest args)
  (with-temp-buffer
    (shell-command (format "git -C \"%s\" %s"
                           repo-url
                           (string-join (cons command args)
                                        " "))
                   t)
    (buffer-string)))

Next, I needed to get the list of commits for a branch in topological order, with a list of parent commits for each. It turns out git provides exactly that via its rev-list command.

(defun git-graph/git-rev-list (repo-url head)
  (-map (lambda (line) (split-string line))
        (split-string (git-graph/git-execute
                       repo-url
                       "rev-list" "--topo-order" "--parents" head)
                      "\n" t)))

I also wanted to label branch heads wherever possible. To do this, I looked up the revision name from git, discarding it if it was relative to some other named commit.

(defun git-graph/git-label (repo-url rev)
  (let ((name (string-trim
               (git-graph/git-execute repo-url
                                      "name-rev" "--name-only" rev))))
    (unless (s-contains? "~" name)
      name)))

Generating the graph for a single branch was as simple as iterating over each commit and creating a node for it.

(defun git-graph/git-graph-head (repo-url head)
  (git-graph/group-topo
   (-map (lambda (rev-with-parents)
           (let* ((rev (car rev-with-parents))
                  (parents (cdr rev-with-parents))
                  (label (git-graph/git-label repo-url rev)))
             (git-graph/make-node rev parents
                                  `((label . ,label)))))
         (git-graph/git-rev-list repo-url head))))

Here's the result of graphing the master branch:

(git-graph/to-graphviz-pretty
 "git"
 (git-graph/git-graph-head
  "/tmp/test.git"
  "master"))
digraph git {
        bgcolor="transparent";
        rankdir="LR";
        node[width=0.15,height=0.15,shape=point,fontsize=8.0];
        edge[weight=2,arrowhead=none];
        "b705cc1cf18544636e46164174e60645c94f3c28"[group="b705cc1cf18544636e46164174e60645c94f3c28", shape="box", label="master"];
        "c417706bcf893d6c97edfd4557bd9aa380ac79aa"[group="c417706bcf893d6c97edfd4557bd9aa380ac79aa", shape="box", label="develop"];
        "2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0"[group="2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0", shape="box", label="feature-2"];
        "e84b9e97fe99f7c9edddf726c531192288868ded"[group="2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0"];
        "bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6"[group="c417706bcf893d6c97edfd4557bd9aa380ac79aa"];
        "16f6f06916f130bf2fd8c2cd6676c237d8b86e68"[group="c417706bcf893d6c97edfd4557bd9aa380ac79aa"];
        "813c0cce8970964c4f30c1c755a494137f16f120"[group="b705cc1cf18544636e46164174e60645c94f3c28"];
        "02d0748a87816cd252097bb53b7d090db5d177e9"[group="b705cc1cf18544636e46164174e60645c94f3c28"];
        "813c0cce8970964c4f30c1c755a494137f16f120" -> "b705cc1cf18544636e46164174e60645c94f3c28";
        "c417706bcf893d6c97edfd4557bd9aa380ac79aa" -> "b705cc1cf18544636e46164174e60645c94f3c28";
        "bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6" -> "c417706bcf893d6c97edfd4557bd9aa380ac79aa";
        "2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0" -> "c417706bcf893d6c97edfd4557bd9aa380ac79aa";
        "e84b9e97fe99f7c9edddf726c531192288868ded" -> "2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0";
        "bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6" -> "e84b9e97fe99f7c9edddf726c531192288868ded";
        "16f6f06916f130bf2fd8c2cd6676c237d8b86e68" -> "bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6";
        "813c0cce8970964c4f30c1c755a494137f16f120" -> "16f6f06916f130bf2fd8c2cd6676c237d8b86e68";
        "02d0748a87816cd252097bb53b7d090db5d177e9" -> "813c0cce8970964c4f30c1c755a494137f16f120";
}
git b705cc1cf18544636e46164174e60645c94f3c28 master c417706bcf893d6c97edfd4557bd9aa380ac79aa develop c417706bcf893d6c97edfd4557bd9aa380ac79aa->b705cc1cf18544636e46164174e60645c94f3c28 2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0 feature-2 2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0->c417706bcf893d6c97edfd4557bd9aa380ac79aa e84b9e97fe99f7c9edddf726c531192288868ded e84b9e97fe99f7c9edddf726c531192288868ded->2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0 bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6 bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6->c417706bcf893d6c97edfd4557bd9aa380ac79aa bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6->e84b9e97fe99f7c9edddf726c531192288868ded 16f6f06916f130bf2fd8c2cd6676c237d8b86e68 16f6f06916f130bf2fd8c2cd6676c237d8b86e68->bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6 813c0cce8970964c4f30c1c755a494137f16f120 813c0cce8970964c4f30c1c755a494137f16f120->b705cc1cf18544636e46164174e60645c94f3c28 813c0cce8970964c4f30c1c755a494137f16f120->16f6f06916f130bf2fd8c2cd6676c237d8b86e68 02d0748a87816cd252097bb53b7d090db5d177e9 02d0748a87816cd252097bb53b7d090db5d177e9->813c0cce8970964c4f30c1c755a494137f16f120

Graphing Multiple Branches

To graph multiple branches, I needed a function for combining histories. To do so, I simply append any nodes I don't already know about in the first history from the second.

(defun git-graph/+ (a b)
  (append a
          (-remove (lambda (node)
                     (assoc (git-graph/node-id node) a))
                   b)))

From there, all that remained was to accumulate the branch histories and output the complete graph:

(defun git-graph/git-load (repo-url heads)
  (-reduce #'git-graph/+
           (-map (lambda (head)
                   (git-graph/git-graph-head repo-url head))
                 heads)))

And here's the example repository, graphed in full:

(git-graph/to-graphviz-pretty
 "git"
 (git-graph/git-load
  "/tmp/test.git"
  '("master" "feature-1")))
digraph git {
        bgcolor="transparent";
        rankdir="LR";
        node[width=0.15,height=0.15,shape=point,fontsize=8.0];
        edge[weight=2,arrowhead=none];
        "b705cc1cf18544636e46164174e60645c94f3c28"[group="b705cc1cf18544636e46164174e60645c94f3c28", shape="box", label="master"];
        "c417706bcf893d6c97edfd4557bd9aa380ac79aa"[group="c417706bcf893d6c97edfd4557bd9aa380ac79aa", shape="box", label="develop"];
        "2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0"[group="2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0", shape="box", label="feature-2"];
        "e84b9e97fe99f7c9edddf726c531192288868ded"[group="2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0"];
        "bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6"[group="c417706bcf893d6c97edfd4557bd9aa380ac79aa"];
        "16f6f06916f130bf2fd8c2cd6676c237d8b86e68"[group="c417706bcf893d6c97edfd4557bd9aa380ac79aa"];
        "813c0cce8970964c4f30c1c755a494137f16f120"[group="b705cc1cf18544636e46164174e60645c94f3c28"];
        "02d0748a87816cd252097bb53b7d090db5d177e9"[group="b705cc1cf18544636e46164174e60645c94f3c28"];
        "2c3627a9512bafa4b67f36fa9284cc8857b41e57"[group="2c3627a9512bafa4b67f36fa9284cc8857b41e57", shape="box", label="feature-1"];
        "b3b234b4b4396e21c027ea40eef997ed9f38d045"[group="2c3627a9512bafa4b67f36fa9284cc8857b41e57"];
        "813c0cce8970964c4f30c1c755a494137f16f120" -> "b705cc1cf18544636e46164174e60645c94f3c28";
        "c417706bcf893d6c97edfd4557bd9aa380ac79aa" -> "b705cc1cf18544636e46164174e60645c94f3c28";
        "bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6" -> "c417706bcf893d6c97edfd4557bd9aa380ac79aa";
        "2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0" -> "c417706bcf893d6c97edfd4557bd9aa380ac79aa";
        "e84b9e97fe99f7c9edddf726c531192288868ded" -> "2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0";
        "bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6" -> "e84b9e97fe99f7c9edddf726c531192288868ded";
        "16f6f06916f130bf2fd8c2cd6676c237d8b86e68" -> "bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6";
        "813c0cce8970964c4f30c1c755a494137f16f120" -> "16f6f06916f130bf2fd8c2cd6676c237d8b86e68";
        "02d0748a87816cd252097bb53b7d090db5d177e9" -> "813c0cce8970964c4f30c1c755a494137f16f120";
        "b3b234b4b4396e21c027ea40eef997ed9f38d045" -> "2c3627a9512bafa4b67f36fa9284cc8857b41e57";
        "16f6f06916f130bf2fd8c2cd6676c237d8b86e68" -> "b3b234b4b4396e21c027ea40eef997ed9f38d045";
}
git b705cc1cf18544636e46164174e60645c94f3c28 master c417706bcf893d6c97edfd4557bd9aa380ac79aa develop c417706bcf893d6c97edfd4557bd9aa380ac79aa->b705cc1cf18544636e46164174e60645c94f3c28 2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0 feature-2 2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0->c417706bcf893d6c97edfd4557bd9aa380ac79aa e84b9e97fe99f7c9edddf726c531192288868ded e84b9e97fe99f7c9edddf726c531192288868ded->2cfd88c610e0d4fd3be5bcbf4c3586e39256c3d0 bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6 bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6->c417706bcf893d6c97edfd4557bd9aa380ac79aa bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6->e84b9e97fe99f7c9edddf726c531192288868ded 16f6f06916f130bf2fd8c2cd6676c237d8b86e68 16f6f06916f130bf2fd8c2cd6676c237d8b86e68->bd5ca4b50b8b7139ef56298b9d1b73a0e0c16be6 b3b234b4b4396e21c027ea40eef997ed9f38d045 16f6f06916f130bf2fd8c2cd6676c237d8b86e68->b3b234b4b4396e21c027ea40eef997ed9f38d045 813c0cce8970964c4f30c1c755a494137f16f120 813c0cce8970964c4f30c1c755a494137f16f120->b705cc1cf18544636e46164174e60645c94f3c28 813c0cce8970964c4f30c1c755a494137f16f120->16f6f06916f130bf2fd8c2cd6676c237d8b86e68 02d0748a87816cd252097bb53b7d090db5d177e9 02d0748a87816cd252097bb53b7d090db5d177e9->813c0cce8970964c4f30c1c755a494137f16f120 2c3627a9512bafa4b67f36fa9284cc8857b41e57 feature-1 b3b234b4b4396e21c027ea40eef997ed9f38d045->2c3627a9512bafa4b67f36fa9284cc8857b41e57

Things I may add in the future

Limiting Commits to Graph

Running this against repos with any substantial history can make the graph unwieldy. It'd be a good idea to abstract out the commit list fetching, and modify it to support different ways of limiting the history to display.

Ideas would include:

  • Specifying commit ranges
  • Stopping at a common ancestor to all graphed branches (e.g., using git-merge-base).
  • Other git commit limiting options, like searches, showing only merge or non-merge commits, etc.

Collapsing History

Another means of reducing the size of the resulting graph would be to collapse unimportant sections of it. It should be possible to collapse a section of the graph, showing a count of skipped nodes.

The difficult part would be determining what parts aren't worth drawing. Something like this would be handy, though, for concisely graphing the state of multiple ongoing development branches (say, to get a picture of what's been going on since the last release, and what's still incomplete).

digraph G {
        rankdir="LR";
        bgcolor="transparent";
        node[width=0.15,height=0.15,shape=point];
        edge[weight=2,arrowhead=none];
        node[group=main];
        1 -> 2 -> 3 -> 4 -> 5;
        node[group=branch];
        2 -> 6 -> 7 -> 8 -> 9 -> 10 -> 4;
}
G 1 2 1->2 3 2->3 6 2->6 4 3->4 5 4->5 7 6->7 8 7->8 9 8->9 10 9->10 10->4
digraph G {
        rankdir="LR";
        bgcolor="transparent";
        node[width=0.15,height=0.15,shape=point];
        edge[weight=2,arrowhead=none];
        node[group=main];
        1 -> 2 -> 3 -> 4 -> 5;
        node[group=branch];
        2 -> 6;
        6 -> 10[style=dashed,label="+3"];
        10 -> 4;
}
G 1 2 1->2 3 2->3 6 2->6 4 3->4 5 4->5 10 6->10 +3 10->4

Clean up and optimize the code a bit

Some parts of this (particularly, the grouping) are probably pretty inefficient. If this turns out to actually be useful, I may take another crack at it.

Final Code

In case anyone would like to use this code for anything, or maybe just pick it apart and play around with it, all the Emacs Lisp code in this post is collected into a single file below:

;;; git-graph.el --- Generate git-style graphs using graphviz

;; Copyright (c) 2015 Correl Roush <correl@gmail.com>

;;; License:

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(require 'dash)

(defun git-graph/make-node (id &optional parents options)
  (list id parents options))

(defun git-graph/node-id (node)
  (nth 0 node))

(defun git-graph/node-parents (node)
  (nth 1 node))

(defun git-graph/node-group (node)
  (cdr (assoc 'group (nth 2 node))))

(defun git-graph/node-label (node)
  (cdr (assoc 'label (nth 2 node))))

(defun git-graph/+ (a b)
  (append a
          (-remove (lambda (node)
                     (assoc (git-graph/node-id node) a))
                   b)))

(defun git-graph/to-graphviz (id nodes)
  (string-join
   (list
    (concat "digraph " id " {")
    "bgcolor=\"transparent\";"
    "rankdir=\"LR\";"
    "node[width=0.15,height=0.15,shape=point,fontsize=8.0];"
    "edge[weight=2,arrowhead=none];"
    (string-join
     (-map #'git-graph/to-graphviz-node nodes)
     "\n")
     (string-join
      (-uniq (-flatten (-map #'git-graph/to-graphviz-edges nodes)))
      "\n")
      "}")
   "\n"))
(defun git-graph/to-graphviz-pretty (id nodes)
  (with-temp-buffer
    (graphviz-dot-mode)
    (insert (git-graph/to-graphviz id nodes))
    (indent-region (point-min) (point-max))
    (buffer-string)))

(defun git-graph/to-graphviz-node-id (id)
  (format "\"%s\"" id))
(defun git-graph/to-graphviz-node (node)
  (let ((node-id (git-graph/to-graphviz-node-id (git-graph/node-id node))))
    (concat node-id
            (git-graph/to-graphviz-node--attributes node)
            ";")))

(defun git-graph/to-graphviz-node--attributes (node)
  (let ((attributes (git-graph/to-graphviz-node--compute-attributes node)))
    (and attributes
         (concat "["
                 (mapconcat (lambda (pair)
                              (format "%s=\"%s\""
                                      (car pair) (cdr pair)))
                            attributes
                            ", ")
                 "]"))))

(defun git-graph/to-graphviz-node--compute-attributes (node)
  (-filter #'identity
           (append (and (git-graph/node-group node)
                        (list (cons 'group (git-graph/node-group node))))
                   (and (git-graph/node-label node)
                        (list (cons 'shape 'box)
                              (cons 'label (git-graph/node-label node)))))))

(defun git-graph/to-graphviz-edges (node)
  (let ((node-id (git-graph/node-id node))
        (parents (git-graph/node-parents node)))
    (-map (lambda (parent)
            (git-graph/to-graphviz-edge node-id parent))
          parents)))

(defun git-graph/to-graphviz-edge (from to)
  (concat
   (git-graph/to-graphviz-node-id to)
   " -> "
   (git-graph/to-graphviz-node-id from)
   ";"))

(defun git-graph/group-topo (nodelist)
  (reverse
   (car
    (-reduce-from
     (lambda (acc node)
       (let* ((grouped-nodes (car acc))
              (group-stack (cdr acc))
              (node-id (git-graph/node-id node))
              (group-from-stack (--if-let (assoc node-id group-stack)
                                    (cdr it)))
              (group (or group-from-stack node-id))
              (parents (git-graph/node-parents node))
              (first-parent (first parents)))
         (if group-from-stack
             (pop group-stack))
         (if (and first-parent (not (assoc first-parent group-stack)))
             (push (cons first-parent group) group-stack))
         (cons (cons (git-graph/make-node node-id
                                    parents
                                    `((group . ,group)
                                      (label . ,(git-graph/node-label node))))
                     grouped-nodes)
               group-stack)))
     nil
     nodelist))))

(defun git-graph/git-execute (repo-url command &rest args)
  (with-temp-buffer
    (shell-command (format "git -C \"%s\" %s"
                           repo-url
                           (string-join (cons command args)
                                        " "))
                   t)
    (buffer-string)))
(defun git-graph/git-rev-list (repo-url head)
  (-map (lambda (line) (split-string line))
        (split-string (git-graph/git-execute
                       repo-url
                       "rev-list" "--topo-order" "--parents" head)
                      "\n" t)))
(defun git-graph/git-label (repo-url rev)
  (let ((name (string-trim
               (git-graph/git-execute repo-url
                                      "name-rev" "--name-only" rev))))
    (unless (s-contains? "~" name)
      name)))
(defun git-graph/git-graph-head (repo-url head)
  (git-graph/group-topo
   (-map (lambda (rev-with-parents)
           (let* ((rev (car rev-with-parents))
                  (parents (cdr rev-with-parents))
                  (label (git-graph/git-label repo-url rev)))
             (git-graph/make-node rev parents
                                  `((label . ,label)))))
         (git-graph/git-rev-list repo-url head))))
(defun git-graph/git-load (repo-url heads)
  (-reduce #'git-graph/+
           (-map (lambda (head)
                   (git-graph/git-graph-head repo-url head))
                 heads)))

(provide 'git-graph)
;;; git-graph.el ends here

Download: git-graph.el