diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+## 0.1.0.0
+
+Initial release.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,7 @@
+Copyright 2022 Gareth Daniel Smith
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,46 @@
+# Monomer-Hagrid
+
+A datagrid widget for the [Monomer](https://github.com/fjvallarino/monomer) library.
+
+![Example hagrid widget screenshot](readme/example.png)
+
+## Current Status
+- Somewhat buggy and incomplete. Don't build your business on this.
+
+## Features
+- Vertical and horizontal scrolling.
+- Resizable columns.
+- Column sorting, with a customizable sort key.
+- Configurable column alignment (left or right).
+- Custom widgets for each cell, to override the standard label.
+- Custom width/height padding for each cell, configured per column.
+- Scrolling to a particular row when sent a message.
+- Custom footer widgets on the bottom of each column.
+
+## Goals
+- Have complete and helpful documentation.
+- Be reasonably configurable and inspectable.
+- Be no uglier than standard Monomer widgets.
+- Be performant with up to ten thousand rows.
+- Have some tests.
+
+## Todo List
+- Improve performance with lots of rows (e.g. 1000).
+- Explore providing an API where current sort/column widths/etc are stored in the parent model and updated by hagrid via a lens. This may remove some complexity around merging and the specification of initial sorts/column widths.
+
+## To build and run examples
+```bash
+stack run
+```
+
+## Contribution Guide
+- This is "free as in mattress" software!
+- You are welcome to open an issue with bug reports or feature requests, but you may not get a response.
+- Unsolicited pull requests will likely be ignored.
+
+### To format the source code
+
+```bash
+# This needs at least ormolu 0.5.0.0 to avoid breaking dot-record syntax
+ormolu --mode inplace $(find . -name '*.hs')
+```
diff --git a/examples/Main.hs b/examples/Main.hs
new file mode 100644
--- /dev/null
+++ b/examples/Main.hs
@@ -0,0 +1,218 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+module Main (main) where
+
+import Control.Lens (Ixed (ix), makeLensesFor, singular)
+import Data.List.Index (setAt)
+import Data.Text (Text, pack)
+import qualified Data.Text as T
+import Data.Time (Day, addDays, defaultTimeLocale, formatTime, fromGregorian)
+import Monomer
+import Monomer.Hagrid (Column (..), ColumnAlign (..), ColumnFooterWidget (..), ColumnSortKey (..), SortDirection (..), hagrid_, initialSort, scrollToRow, showOrdColumn, textColumn, widgetColumn)
+import Text.Printf (printf)
+
+data AppModel = AppModel
+  { theme :: Theme,
+    spiders :: [Spider],
+    columns :: [AppColumn],
+    rowToScrollTo :: Int
+  }
+  deriving (Eq, Show)
+
+newtype AppColumn = AppColumn
+  {enabled :: Bool}
+  deriving (Eq, Show)
+
+data AppEvent
+  = FeedSpider Int
+  | AddSpider
+  | NameColumnResized Int
+  | NameColumnSorted SortDirection
+  | ScrollToOriginalIndex
+
+data Spider = Spider
+  { index :: Integer,
+    species :: Text,
+    name :: Text,
+    dateOfBirth :: Day,
+    weightKilos :: Double
+  }
+  deriving (Eq, Show)
+
+makeLensesFor [("enabled", "_enabled")] ''AppColumn
+makeLensesFor [("columns", "_columns"), ("theme", "_theme"), ("rowToScrollTo", "_rowToScrollTo")] ''AppModel
+
+main :: IO ()
+main = startApp model handleEvent buildUI config
+  where
+    config =
+      [ appWindowTitle "Hagrid Examples",
+        appFontDef "Bold" "./assets/fonts/Cantarell/Cantarell-Bold.ttf",
+        appFontDef "Regular" "./assets/fonts/Cantarell/Cantarell-Regular.ttf",
+        appDisableAutoScale True,
+        appWindowState (MainWindowNormal (1200, 1000))
+      ]
+    model =
+      AppModel
+        { theme = darkTheme,
+          spiders = spiders,
+          columns = AppColumn True <$ gridColumns,
+          rowToScrollTo = 0
+        }
+    spiders = spider <$> [0 .. numSpiders - 1]
+    spider i =
+      Spider
+        { index = i,
+          species = "Acromantula",
+          name = T.pack (printf "Son of Aragog %d" (i + 1)),
+          dateOfBirth = addDays i (fromGregorian 1942 3 1),
+          weightKilos = fromIntegral (numSpiders + 2 - i) * 2.3
+        }
+    numSpiders = 100
+
+buildUI :: UIBuilder AppModel AppEvent
+buildUI _wenv model = tree
+  where
+    tree =
+      themeSwitch_ model.theme [themeClearBg] $
+        vstack
+          [ grid `nodeKey` hagridKey,
+            vstack_
+              [childSpacing]
+              (themeConfigurer : columnConfigurers <> actionButtons)
+              `styleBasic` [padding 8]
+          ]
+
+    grid =
+      hagrid_
+        [initialSort 1 SortDescending]
+        (mconcat (zipWith column model.columns gridColumns))
+        model.spiders
+
+    column (AppColumn enabled) columnDef =
+      [columnDef | enabled]
+
+    themeConfigurer =
+      hstack_
+        [childSpacing]
+        [ labeledRadio_ "Dark Theme" darkTheme _theme [textRight],
+          labeledRadio_ "Light Theme" lightTheme _theme [textRight]
+        ]
+
+    columnConfigurers =
+      zipWith columnConfigurer [0 .. length model.columns - 1] gridColumns
+
+    columnConfigurer :: Int -> Column AppEvent Spider -> WidgetNode AppModel AppEvent
+    columnConfigurer idx columnDef =
+      labeledCheckbox_
+        columnDef.name
+        (_columns . singular (ix idx) . _enabled)
+        [textRight]
+
+    actionButtons =
+      [ hstack_
+          [childSpacing]
+          [ label "Scroll to index of unsorted list",
+            numericField _rowToScrollTo,
+            button "Go!" ScrollToOriginalIndex
+          ],
+        hstack_
+          [childSpacing]
+          [button "Add spider" AddSpider]
+      ]
+
+handleEvent :: EventHandler AppModel AppEvent sp ep
+handleEvent _wenv _node model = \case
+  FeedSpider idx -> evts
+    where
+      evts =
+        [ Producer (const (putStrLn ("Feeding spider " <> T.unpack spdr.name))),
+          Model model {spiders = setAt idx spdr {weightKilos = spdr.weightKilos + 1} model.spiders}
+        ]
+      spdr = model.spiders !! idx
+  AddSpider ->
+    [Model model {spiders = model.spiders <> [newSpider model]}]
+  NameColumnResized colWidth ->
+    [Producer (const (putStrLn ("Name column was resized: " <> show colWidth)))]
+  NameColumnSorted direction ->
+    [Producer (const (putStrLn ("Name column was sorted: " <> show direction)))]
+  ScrollToOriginalIndex ->
+    [scrollToRow (WidgetKey hagridKey) (rowScrollIndex model)]
+
+newSpider :: AppModel -> Spider
+newSpider model =
+  Spider
+    { index = fromIntegral (length model.spiders),
+      name = "Extra Spider " <> pack (show (length model.spiders)),
+      species = "Spider plant",
+      dateOfBirth = fromGregorian 2022 6 26,
+      weightKilos = 0.01
+    }
+
+rowScrollIndex :: AppModel -> [(Spider, Int)] -> Maybe Int
+rowScrollIndex model items
+  | model.rowToScrollTo >= 0 && model.rowToScrollTo < length items =
+      Just (snd (items !! model.rowToScrollTo))
+  | otherwise =
+      Nothing
+
+gridColumns :: [Column AppEvent Spider]
+gridColumns = cols
+  where
+    cols =
+      [ (showOrdColumn "Index" (.index))
+          { initialWidth = 120,
+            align = ColumnAlignRight,
+            footerWidget = CustomFooterWidget countFooter
+          },
+        (textColumn "Name" (.name))
+          { initialWidth = 300,
+            resizeHandler = Just NameColumnResized,
+            sortHandler = Just NameColumnSorted
+          },
+        (textColumn "Species" (.species))
+          { initialWidth = 200
+          },
+        (textColumn "Date of Birth" (T.pack . formatTime defaultTimeLocale "%Y-%m-%d" . dateOfBirth))
+          { initialWidth = 200
+          },
+        (textColumn "Weight (Kg)" (T.pack . printf "%.2f" . weightKilos))
+          { sortKey = SortWith weightKilos,
+            initialWidth = 200,
+            align = ColumnAlignRight,
+            footerWidget = CustomFooterWidget sumWeightFooter
+          },
+        (widgetColumn "Actions" actionsColumn)
+          { initialWidth = 100,
+            paddingW = 5,
+            paddingH = 5
+          }
+      ]
+
+    countFooter spiders =
+      labelledFooter "Count" (T.pack . show . length $ spiders)
+
+    sumWeightFooter spiders = tree
+      where
+        tree = labelledFooter "Sum" (T.pack (printf "%.2f" totalWeightKilos))
+        totalWeightKilos = sum (weightKilos . fst <$> spiders)
+
+    labelledFooter labelText text =
+      hstack
+        [ label labelText,
+          filler,
+          label text
+            `styleBasic` [textFont "Bold"]
+        ]
+        `styleBasic` [padding 10]
+
+    actionsColumn :: Int -> Spider -> WidgetNode s AppEvent
+    actionsColumn idx _spdr =
+      button "Feed" (FeedSpider idx)
+
+hagridKey :: Text
+hagridKey = "SpiderHagrid"
diff --git a/monomer-hagrid.cabal b/monomer-hagrid.cabal
new file mode 100644
--- /dev/null
+++ b/monomer-hagrid.cabal
@@ -0,0 +1,104 @@
+cabal-version:      2.0
+name:               monomer-hagrid
+version:            0.1.0.0
+license:            MIT
+license-file:       LICENSE
+maintainer:         garethdanielsmith@gmail.com
+homepage:           https://github.com/Dretch/monomer-hagrid#readme
+bug-reports:        https://github.com/Dretch/monomer-hagrid/issues
+synopsis:           A datagrid widget for the Monomer library.
+description:
+    A configurable Monomer widget that shows a scrollable grid of data.
+
+category:           GUI
+build-type:         Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+    type:     git
+    location: https://github.com/Dretch/monomer-hagrid
+
+library
+    exposed-modules:    Monomer.Hagrid
+    hs-source-dirs:     src
+    other-modules:      Paths_monomer_hagrid
+    autogen-modules:    Paths_monomer_hagrid
+    default-language:   Haskell2010
+    default-extensions:
+        DisambiguateRecordFields DuplicateRecordFields FlexibleContexts
+        OverloadedRecordDot OverloadedStrings
+
+    ghc-options:
+        -Wall -Wcompat -Wincomplete-record-updates
+        -Wincomplete-uni-patterns -Wredundant-constraints
+
+    build-depends:
+        base >=4.7 && <5,
+        containers >=0.6.5.1 && <0.7,
+        data-default-class >=0.1.2.0 && <0.2,
+        ilist >=0.4.0.1 && <0.5,
+        lens >=5.1.1 && <5.2,
+        monomer >=1.5.0.0 && <1.6,
+        text >=1.2.5.0 && <1.3
+
+executable examples
+    main-is:            Main.hs
+    hs-source-dirs:     examples
+    other-modules:      Paths_monomer_hagrid
+    default-language:   Haskell2010
+    default-extensions:
+        DisambiguateRecordFields DuplicateRecordFields FlexibleContexts
+        OverloadedRecordDot OverloadedStrings
+
+    ghc-options:
+        -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat
+        -Wincomplete-record-updates -Wincomplete-uni-patterns
+        -Wredundant-constraints
+
+    build-depends:
+        base >=4.7 && <5,
+        containers >=0.6.5.1 && <0.7,
+        data-default-class >=0.1.2.0 && <0.2,
+        ilist >=0.4.0.1 && <0.5,
+        lens >=5.1.1 && <5.2,
+        monomer >=1.5.0.0 && <1.6,
+        monomer-hagrid -any,
+        text >=1.2.5.0 && <1.3,
+        time >=1.11.1.1 && <1.12
+
+test-suite spec
+    type:               exitcode-stdio-1.0
+    main-is:            Spec.hs
+    build-tool-depends: hspec-discover:hspec-discover ==2.*
+    hs-source-dirs:     test
+    other-modules:
+        Monomer.HagridSpec
+        Monomer.TestUtil
+        Paths_monomer_hagrid
+
+    default-language:   Haskell2010
+    default-extensions:
+        DisambiguateRecordFields DuplicateRecordFields FlexibleContexts
+        OverloadedRecordDot OverloadedStrings
+
+    ghc-options:
+        -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat
+        -Wincomplete-record-updates -Wincomplete-uni-patterns
+        -Wredundant-constraints
+
+    build-depends:
+        base >=4.7 && <5,
+        bytestring >=0.11.3.1 && <0.12,
+        containers >=0.6.5.1 && <0.7,
+        data-default >=0.7.1.1 && <0.8,
+        data-default-class >=0.1.2.0 && <0.2,
+        hspec ==2.*,
+        ilist >=0.4.0.1 && <0.5,
+        lens >=5.1.1 && <5.2,
+        monomer >=1.5.0.0 && <1.6,
+        monomer-hagrid -any,
+        mtl >=2.2.2 && <2.3,
+        stm >=2.5.0.2 && <2.6,
+        text >=1.2.5.0 && <1.3
diff --git a/src/Monomer/Hagrid.hs b/src/Monomer/Hagrid.hs
new file mode 100644
--- /dev/null
+++ b/src/Monomer/Hagrid.hs
@@ -0,0 +1,862 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+-- | A datagrid widget for the Monomer UI library.
+module Monomer.Hagrid
+  ( -- * Types
+    HagridCfg,
+    Column (..),
+    ColumnAlign (..),
+    ColumnWidget (..),
+    ColumnFooterWidget (..),
+    ColumnSortKey (..),
+    SortDirection (..),
+    ScrollToRowCallback,
+
+    -- * Configuration options
+    initialSort,
+
+    -- * Hagrid constructors
+    hagrid,
+    hagrid_,
+
+    -- * Column Constructors
+    textColumn,
+    showOrdColumn,
+    widgetColumn,
+
+    -- * Messages
+    scrollToRow,
+  )
+where
+
+import Control.Applicative ((<|>))
+import Control.Lens ((.~), (<>~), (^.))
+import Control.Lens.Combinators (non)
+import Control.Lens.Lens ((&))
+import Control.Monad as X (forM_)
+import Data.Data (Typeable)
+import Data.Default.Class as X (Default, def)
+import Data.Foldable (foldl')
+import qualified Data.List as List
+import Data.List.Index (indexed, izipWith, modifyAt)
+import Data.Maybe (fromJust, maybeToList)
+import Data.Maybe as X (fromMaybe)
+import Data.Ord (Down (Down))
+import Data.Sequence (Seq ((:<|), (:|>)))
+import qualified Data.Sequence as S
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Typeable (cast)
+import Monomer
+import qualified Monomer.Lens as L
+import Monomer.Widgets.Container
+import Monomer.Widgets.Single
+
+-- | Configuration options for Hagrid widgets.
+data HagridCfg s e = HagridCfg
+  { cfgInitialSort :: Maybe (Int, SortDirection)
+  }
+
+instance Default (HagridCfg s e) where
+  def = HagridCfg {cfgInitialSort = Nothing}
+
+instance Semigroup (HagridCfg s e) where
+  c1 <> c2 = HagridCfg {cfgInitialSort = c2.cfgInitialSort <|> c1.cfgInitialSort}
+
+instance Monoid (HagridCfg s e) where
+  mempty = def
+
+-- | Configures the initial sort column and direction.
+initialSort ::
+  -- | The initial sort column (zero-indexed, out of bounds values will have no effect).
+  Int ->
+  -- | The initial sort direction.
+  SortDirection ->
+  HagridCfg s e
+initialSort column direction =
+  HagridCfg {cfgInitialSort = Just (column, direction)}
+
+-- | A column definition.
+data Column e a = Column
+  { -- | The name of the column, displayed in the column header.
+    name :: Text,
+    -- | Creates the widget for each cell in the column.
+    widget :: ColumnWidget e a,
+    -- | Creates the widget for the column footer, if any.
+    footerWidget :: ColumnFooterWidget e a,
+    -- | How to align the widget within each cell in the column.
+    align :: ColumnAlign,
+    -- | Determines if and how the column can be sorted by clicking the column header.
+    sortKey :: ColumnSortKey a,
+    -- | The initial width of the column, in pixels. The user can then change the
+    -- width by dragging the edge of the column header.
+    initialWidth :: Int,
+    -- | The minimum allowed width of the column, in pixels.
+    minWidth :: Int,
+    -- | The padding to the left and right of the widget in each cell of the column, in pixels.
+    paddingW :: Double,
+    -- | The padding above and below the widget in each cell in the column, in pixels.
+    paddingH :: Double,
+    -- | An optional event to emit when a user has finished resizing the column. The function receives the new width in pixels.
+    resizeHandler :: Maybe (Int -> e),
+    -- | An optional event to emit when a user has sorted the column by clicking the header. The function receives the new sort direction.
+    sortHandler :: Maybe (SortDirection -> e)
+  }
+
+-- | How to create the widget that displays each cell in a column.
+data ColumnWidget e a
+  = -- | Create a label widget.. The function receives the original item index (i.e.
+    -- not the index in the sorted list) and the item itself.
+    LabelWidget (Int -> a -> Text)
+  | -- | Create a widget of arbitrary type. The function receives the original item
+    -- index (i.e. not the index in the sorted list) and the item itself.
+    CustomWidget (forall s. WidgetModel s => Int -> a -> WidgetNode s e)
+
+-- | How to create the footer widget for a column.
+data ColumnFooterWidget e a
+  = -- | No footer widget for this column.
+    NoFooterWidget
+  | -- | Create a footer widget. The function receives the items in their current sort
+    -- order, and also along with each item it's original (unsorted) index.
+    CustomFooterWidget (forall s. WidgetModel s => [(a, Int)] -> WidgetNode s e)
+
+-- | How to align the widget within each cell of a column.
+data ColumnAlign
+  = ColumnAlignLeft
+  | ColumnAlignRight
+  deriving (Eq, Show)
+
+-- | Whether a column can be sorted by the user clicking the column header, and if so, how.
+data ColumnSortKey a
+  = -- | Means that a column can't be sorted.
+    DontSort
+  | -- | Means that a column can be sorted, using the specified sort key function.
+    forall b. Ord b => SortWith (a -> b)
+
+-- | Whether a column is being sorted in ascending or descending order.
+data SortDirection
+  = SortAscending
+  | SortDescending
+  deriving (Eq, Show)
+
+-- | Picks an item to scroll to, based on the sorted or original grid contents.
+type ScrollToRowCallback a =
+  -- | The items in the grid, in the originally provided order, along with each item's index
+  -- in the current grid order.
+  [(a, Int)] ->
+  -- | The row to scroll to, as an index into the sorted items (e.g. 0 is always the first row
+  -- in the grid, regardless of the current order). 'Nothing' will cancel the scroll.
+  Maybe Int
+
+data HagridEvent ep
+  = ContentScrollChange ScrollStatus
+  | OrderByColumn Int
+  | ResizeColumn Int Int
+  | ResizeColumnFinished Int
+  | forall a. Typeable a => ScrollToRow (ScrollToRowCallback a)
+  | ParentEvent ep
+
+data HagridModel a = HagridModel
+  { sortedItems :: [(a, Int)], -- each item, plus its index in the original (unsorted) list
+    columns :: [ModelColumn],
+    sortColumn :: Maybe (Int, SortDirection)
+  }
+  deriving (Eq, Show)
+
+data ModelColumn = ModelColumn
+  { currentWidth :: Int,
+    name :: Text
+  }
+  deriving (Eq, Show)
+
+-- | The state of the header or footer, which have a scroll offset because they
+-- scroll horizontally along with the content pane.
+data OffsetXState = OffsetXState
+  { offsetX :: Double
+  }
+  deriving (Eq, Show)
+
+data OffsetXEvent = SetOffsetX Double
+
+data HeaderDragHandleState = HeaderDragHandleState
+  { dragStartMouseX :: Double,
+    dragStartColumnW :: Int
+  }
+  deriving (Eq, Show)
+
+data ContentPaneMessage a
+  = ContentPaneScrollToRow (ScrollToRowCallback a)
+
+-- | Creates a hagrid widget, using the default configuration.
+hagrid ::
+  forall a s e.
+  (CompositeModel a, WidgetModel s, WidgetEvent e) =>
+  -- | The definitions for each column in the grid.
+  [Column e a] ->
+  -- | The items for each row in the grid.
+  [a] ->
+  WidgetNode s e
+hagrid = hagrid_ def
+
+-- | Creates a hagrid widget, using the given configuration.
+hagrid_ ::
+  forall a s e.
+  (CompositeModel a, WidgetModel s, WidgetEvent e) =>
+  [HagridCfg s e] ->
+  -- | The definitions for each column in the grid.
+  [Column e a] ->
+  -- | The items for each row in the grid.
+  [a] ->
+  WidgetNode s e
+hagrid_ cfg columnDefs items = widget
+  where
+    -- todo: accept lens ?
+
+    widget =
+      compositeD_
+        "Hagrid.Root"
+        (WidgetValue (initialModel cfg columnDefs items))
+        buildUI
+        handleEvent
+        [compositeMergeModel mergeModel]
+
+    buildUI :: UIBuilder (HagridModel a) (HagridEvent e)
+    buildUI _wenv model = tree
+      where
+        tree =
+          vstack
+            [ headerPane columnDefs model `nodeKey` headerPaneKey,
+              contentScroll `nodeKey` contentScrollKey,
+              footerPane columnDefs model `nodeKey` footerPaneKey
+            ]
+        contentScroll =
+          scroll_ [onChange ContentScrollChange] $
+            contentPane columnDefs model `nodeKey` contentPaneKey
+
+    handleEvent :: EventHandler (HagridModel a) (HagridEvent e) sp e
+    handleEvent wenv _node model = \case
+      ScrollToRow row ->
+        [Message (WidgetKey contentPaneKey) (ContentPaneScrollToRow row)]
+      ContentScrollChange ScrollStatus {scrollDeltaX} ->
+        [ Message (WidgetKey headerPaneKey) (SetOffsetX scrollDeltaX),
+          Message (WidgetKey footerPaneKey) (SetOffsetX scrollDeltaX)
+        ]
+      OrderByColumn colIndex -> result
+        where
+          Column {sortHandler, sortKey} = columnDefs !! colIndex
+          (sortColumn, sortedItems)
+            | Just (c, dir) <- model.sortColumn,
+              c == colIndex =
+                let sortColumn = Just (colIndex, flipSortDirection dir)
+                    sortedItems = reverse model.sortedItems
+                 in (sortColumn, sortedItems)
+            | otherwise =
+                let sortColumn = Just (colIndex, SortAscending)
+                    sortedItems = sortItems columnDefs sortColumn model.sortedItems
+                 in (sortColumn, sortedItems)
+          result = case sortKey of
+            DontSort -> []
+            SortWith _ -> Model model {sortColumn, sortedItems} : handler
+          handler =
+            Report <$> maybeToList (sortHandler <*> (snd <$> sortColumn))
+      ResizeColumn colIndex newWidth ->
+        [ Model (model {columns = modifyAt colIndex (\c -> c {currentWidth = newWidth}) model.columns}),
+          Request (ResizeWidgets headerPaneId),
+          Request (ResizeWidgets footerPaneId),
+          Request (ResizeWidgets contentPaneId)
+        ]
+      ResizeColumnFinished colIndex -> result
+        where
+          ModelColumn {currentWidth} = model.columns !! colIndex
+          Column {resizeHandler} = columnDefs !! colIndex
+          result =
+            Report <$> maybeToList (resizeHandler <*> Just currentWidth)
+      ParentEvent e ->
+        [Report e]
+      where
+        headerPaneId = fromJust (widgetIdFromKey wenv (WidgetKey headerPaneKey))
+        footerPaneId = fromJust (widgetIdFromKey wenv (WidgetKey footerPaneKey))
+        contentPaneId = fromJust (widgetIdFromKey wenv (WidgetKey contentPaneKey))
+
+    -- If the column names have not changed then preseve the column widths and sort
+    -- order too, otherwise unrelated model changes will reset the column widths/sort.
+    mergeModel :: MergeModelHandler (HagridModel a) (HagridEvent e) s
+    mergeModel _wenv _parentModel oldModel newModel = resultModel
+      where
+        resultModel
+          | columnNames oldModel == columnNames newModel =
+              newModel
+                { columns = oldModel.columns,
+                  sortColumn = oldModel.sortColumn,
+                  sortedItems = sortItems columnDefs oldModel.sortColumn newModel.sortedItems
+                }
+          | otherwise =
+              newModel
+        columnNames m =
+          (.name) <$> m.columns
+
+drawSortIndicator :: Renderer -> Rect -> Maybe Color -> SortDirection -> IO ()
+drawSortIndicator renderer rect color dir = drawCmd
+  where
+    drawCmd = case dir of
+      SortAscending -> drawTriangle renderer p2 p4 p3 color
+      SortDescending -> drawTriangle renderer p1 p2 p4 color
+    Rect x y w h = rect
+    p1 = Point x y
+    p2 = Point (x + w) y
+    p3 = Point x (y + h)
+    p4 = Point (x + w) (y + h)
+
+accentColor :: WidgetEnv s e -> Color
+accentColor wenv = transColor
+  where
+    style = wenv ^. L.theme . L.basic . L.btnStyle
+    color = fromMaybe (rgb 255 255 255) (_sstText style >>= _txsFontColor)
+    transColor = color {_colorA = 0.7}
+
+headerPane :: forall s ep a. WidgetEvent ep => [Column ep a] -> HagridModel a -> WidgetNode s (HagridEvent ep)
+headerPane columnDefs model = makeNode (OffsetXState 0)
+  where
+    makeNode :: OffsetXState -> WidgetNode s (HagridEvent ep)
+    makeNode state = node
+      where
+        node =
+          defaultWidgetNode "Hagrid.HeaderPane" (makeWidget state)
+            & L.children .~ S.fromList childWidgets
+
+        childWidgets =
+          mconcat (izipWith childWidgetPair columnDefs model.columns)
+
+        childWidgetPair i columnDef column = [btn, handle]
+          where
+            btn = headerButton i columnDef
+            handle = headerDragHandle i columnDef column
+
+    makeWidget :: OffsetXState -> Widget s (HagridEvent ep)
+    makeWidget state = container
+      where
+        container =
+          createContainer
+            state
+            def
+              { containerChildrenOffset = Just (Point state.offsetX 0),
+                containerUpdateCWenv = updateCWenv,
+                containerMerge = merge,
+                containerHandleMessage = handleMessage,
+                containerGetSizeReq = getSizeReq,
+                containerResize = resize,
+                containerRenderAfter = renderAfter
+              }
+
+        -- needed to ensure child widgets don't disappear when scrolling
+        updateCWenv wenv node _cnode _cidx = newWenv
+          where
+            style = currentStyle wenv node
+            carea = getContentArea node style
+            newWenv =
+              wenv
+                & L.viewport .~ moveRect (Point (-state.offsetX) 0) carea
+
+        -- keep the scroll offset from the old node
+        merge _wenv node _oldNode oldState = resultNode newNode
+          where
+            newNode = node & L.widget .~ makeWidget oldState
+
+        handleMessage :: ContainerMessageHandler s (HagridEvent ep)
+        handleMessage _wenv node _target msg = result
+          where
+            handleTypedMessage (SetOffsetX offsetX)
+              | offsetX == state.offsetX = Nothing
+              | otherwise =
+                  Just . resultNode $
+                    node & L.widget .~ makeWidget state {offsetX}
+            result = cast msg >>= handleTypedMessage
+
+        getSizeReq _wenv _node _children = (w, h)
+          where
+            w = fixedSize (sum (fromIntegral . currentWidth <$> model.columns) + hScrollFudgeFactor)
+            h = fixedSize dragHandleHeight
+
+        resize _wenv node viewport _children = (resultNode node, assignedAreas)
+          where
+            Rect l t _w h = viewport
+            widgetWidths = do
+              w <- currentWidth <$> model.columns
+              [w - dragHandleWidth, dragHandleWidth]
+            (assignedAreas, _) = foldl' assignArea (mempty, l) widgetWidths
+            assignArea (areas, colX) columnWidth =
+              (areas :|> Rect colX t (fromIntegral columnWidth) h, colX + fromIntegral columnWidth)
+
+        renderAfter wenv node renderer =
+          forM_ model.sortColumn (renderSortIndicator wenv node renderer)
+
+        renderSortIndicator wenv node renderer (sortCol, sortDirection) = do
+          drawSortIndicator renderer indRect (Just (accentColor wenv)) sortDirection
+          where
+            style = wenv ^. L.theme . L.basic . L.btnStyle
+            Rect l t _w h = node ^. L.info . L.viewport
+            size = style ^. L.text . non def . L.fontSize . non def
+            colOffset = fromIntegral (sum (take (sortCol + 1) (currentWidth <$> model.columns)) - dragHandleWidth)
+            indW = unFontSize size * 2 / 3
+            pad = indW / 3
+            indT = case sortDirection of
+              SortAscending -> t + h - pad - indW
+              SortDescending -> t + pad
+            indL = l + state.offsetX + colOffset - indW - pad
+            indRect = Rect indL indT indW indW
+
+headerButton :: WidgetEvent ep => Int -> Column ep a -> WidgetNode s (HagridEvent ep)
+headerButton colIndex columnDef =
+  button_ columnDef.name (OrderByColumn colIndex) [ellipsis]
+    `styleBasic` [radius 0]
+
+footerPane :: forall s ep a. (CompositeModel a, CompositeModel s, Typeable ep) => [Column ep a] -> HagridModel a -> WidgetNode (HagridModel s) (HagridEvent ep)
+footerPane columnDefs model = makeNode (OffsetXState 0)
+  where
+    makeNode :: OffsetXState -> WidgetNode (HagridModel s) (HagridEvent ep)
+    makeNode state = node
+      where
+        node =
+          defaultWidgetNode "Hagrid.FooterPane" (makeWidget state)
+            & L.children .~ childWidgets
+
+    childWidgets :: Seq (WidgetNode (HagridModel s) (HagridEvent ep))
+    childWidgets =
+      S.fromList $
+        footerWidgetNode model.sortedItems . footerWidget <$> columnDefs
+
+    makeWidget :: OffsetXState -> Widget (HagridModel s) (HagridEvent ep)
+    makeWidget state = container
+      where
+        container =
+          createContainer
+            state
+            def
+              { containerChildrenOffset = Just (Point state.offsetX 0),
+                containerUpdateCWenv = updateCWenv,
+                containerMerge = merge,
+                containerHandleMessage = handleMessage,
+                containerGetSizeReq = getSizeReq,
+                containerResize = resize
+              }
+
+        -- needed to ensure child widgets don't disappear when scrolling
+        updateCWenv wenv node _cnode _cidx = newWenv
+          where
+            style = currentStyle wenv node
+            carea = getContentArea node style
+            newWenv =
+              wenv
+                & L.viewport .~ moveRect (Point (-state.offsetX) 0) carea
+
+        -- keep the scroll offset from the old node
+        merge _wenv node _oldNode oldState = resultNode newNode
+          where
+            newNode = node & L.widget .~ makeWidget oldState
+
+        handleMessage :: ContainerMessageHandler (HagridModel s) (HagridEvent ep)
+        handleMessage _wenv node _target msg = result
+          where
+            handleTypedMessage (SetOffsetX offsetX)
+              | offsetX == state.offsetX = Nothing
+              | otherwise =
+                  Just . resultNode $
+                    node & L.widget .~ makeWidget state {offsetX}
+            result = cast msg >>= handleTypedMessage
+
+        getSizeReq _wenv _node children = (w, h)
+          where
+            w = fixedSize (sum (fromIntegral . currentWidth <$> model.columns) + hScrollFudgeFactor)
+            h = foldl' sizeReqMergeMax (fixedSize 0) ((_wniSizeReqH . _wnInfo) <$> children)
+
+        resize _wenv node viewport _children = (resultNode node, assignedAreas)
+          where
+            Rect l t _w h = viewport
+            (assignedAreas, _) = foldl' assignArea (mempty, l) model.columns
+            assignArea (areas, colX) ModelColumn {currentWidth} =
+              (areas :|> Rect colX t (fromIntegral currentWidth) h, colX + fromIntegral currentWidth)
+
+headerDragHandle :: WidgetEvent ep => Int -> Column ep a -> ModelColumn -> WidgetNode s (HagridEvent ep)
+headerDragHandle colIndex columnDef column = tree
+  where
+    tree = defaultWidgetNode "Hagrid.HeaderDragHandle" (headerDragHandleWidget Nothing)
+
+    headerDragHandleWidget state = single
+      where
+        single =
+          createSingle
+            state
+            def
+              { singleGetBaseStyle = getBaseStyle,
+                singleMerge = merge,
+                singleHandleEvent = handleEvent,
+                singleRender = render
+              }
+
+        getBaseStyle _wenv _node =
+          Just def {_styleBasic = Just def {_sstCursorIcon = Just CursorSizeH}}
+
+        merge _wenv newNode _oldNode oldState =
+          -- preserve the drag state (this will be called continually as the column resizes)
+          resultNode $ newNode & L.widget .~ headerDragHandleWidget oldState
+
+        handleEvent wenv node _target = \case
+          ButtonAction (Point _pX _pY) _btn BtnPressed _clicks -> Just result
+            where
+              -- todo: only if not focussed? set focus?
+              result = resultNode newNode
+              newNode = node & L.widget .~ headerDragHandleWidget newState
+              newState = Just (HeaderDragHandleState _pX column.currentWidth)
+          ButtonAction _point _btn BtnReleased _clicks -> Just result
+            where
+              result = resultReqs newNode [RaiseEvent (ResizeColumnFinished colIndex)]
+              newNode = node & L.widget .~ headerDragHandleWidget Nothing
+          Move (Point _pX _pY) -> Just result
+            where
+              result
+                | Just nw <- newColumnW =
+                    resizeRequest
+                      & L.requests
+                        <>~ S.fromList
+                          [RaiseEvent (ResizeColumn colIndex nw)]
+                | otherwise =
+                    resultReqs node []
+              newColumnW = do
+                HeaderDragHandleState clickX columnW <- state
+                pure (max columnDef.minWidth (columnW + fromFractional (_pX - clickX)))
+          _ -> Nothing
+          where
+            resizeRequest = widgetResize (node ^. L.widget) wenv node vp (const True)
+            vp = node ^. L.info . L.viewport
+
+        render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
+        render wenv node renderer = do
+          drawRect renderer vp (Just (accentColor wenv)) Nothing
+          where
+            vp = node ^. L.info . L.viewport
+
+-- | This needs to be at least as big as the width of a vertical scrollbar.
+hScrollFudgeFactor :: Double
+hScrollFudgeFactor = 100
+
+contentPane ::
+  forall a ep.
+  (CompositeModel a, WidgetEvent ep) =>
+  [Column ep a] ->
+  HagridModel a ->
+  WidgetNode (HagridModel a) (HagridEvent ep)
+contentPane columnDefs model = node
+  where
+    node =
+      defaultWidgetNode "Hagrid.ContentPane" contentPaneContainer
+        & L.children .~ S.fromList (mconcat childWidgetRows)
+
+    childWidgetRows =
+      [ [cellWidget idx item widget | Column {widget} <- columnDefs]
+        | (item, idx) <- model.sortedItems
+      ]
+
+    nCols = length columnDefs
+    columnDefsSeq = S.fromList columnDefs
+
+    contentPaneContainer =
+      createContainer
+        model
+        def
+          { containerGetSizeReq = getSizeReq,
+            containerResize = resize,
+            containerRender = render,
+            containerHandleEvent = handleEvent,
+            containerHandleMessage = handleMessage
+          }
+
+    getSizeReq _wenv _node children = (w, h)
+      where
+        w = fixedSize (sum (fromIntegral . currentWidth <$> model.columns))
+        h = fixedSize (sum (toRowHeights children columnDefsSeq))
+
+    resize wenv node viewport children = (resultNode node, assignedAreas)
+      where
+        style = currentStyle wenv node
+        Rect l t _w _h = fromMaybe def (removeOuterBounds style viewport)
+
+        colXs = sizesToPositions (S.fromList (fromIntegral . currentWidth <$> model.columns))
+        rowYs = sizesToPositions (toRowHeights children columnDefsSeq)
+
+        assignedAreas = do
+          (rowN, row) <-
+            S.mapWithIndex (\i -> (i,)) (S.chunksOf nCols children)
+          (colN, columnDef, widget) <-
+            S.mapWithIndex (\i (cd, w) -> (i, cd, w)) (S.zip columnDefsSeq row)
+          pure (assignArea colN columnDef rowN widget)
+
+        assignArea col Column {paddingW, paddingH, align} row widget = Rect chX chY chW chH
+          where
+            (chX, chW)
+              | widgetReqW >= cellW = (cellX, cellW)
+              | align == ColumnAlignLeft = (cellX, widgetReqW)
+              | otherwise = (cellX + cellW - widgetReqW, widgetReqW)
+            (chY, chH) =
+              (cellY, cellH)
+
+            cellX = l + S.index colXs col + paddingW
+            cellY = t + S.index rowYs row + paddingH
+            cellW = S.index colXs (col + 1) - S.index colXs col - paddingW * 2
+            cellH = S.index rowYs (row + 1) - S.index rowYs row - paddingH * 2
+
+            widgetReqW =
+              widget
+                & _wnInfo
+                & _wniSizeReqW
+                & \r -> _szrFixed r + _szrFlex r
+
+    render wenv node renderer = do
+      forM_ (neighbours rowYs) $ \(y1, y2, even) -> do
+        let color
+              | mouseover && _pY mouse >= (t + y1) && _pY mouse < (t + y2) = Just mouseOverColor
+              | not even = Just oddRowBgColor
+              | otherwise = Nothing
+        drawRect renderer (Rect l (t + y1) lastColX (y2 - y1)) color Nothing
+
+      forM_ (S.drop 1 colXs) $ \colX -> do
+        drawLine renderer (Point (l + colX) t) (Point (l + colX) (t + lastRowY)) 1 (Just lineColor)
+
+      forM_ (S.drop 1 rowYs) $ \rowY -> do
+        drawLine renderer (Point l (t + rowY)) (Point (l + lastColX) (t + rowY)) 1 (Just lineColor)
+      where
+        colXs = sizesToPositions (S.fromList (fromIntegral . currentWidth <$> model.columns))
+        rowYs = sizesToPositions (toRowHeights (node ^. L.children) columnDefsSeq)
+        lastColX
+          | _ :|> a <- colXs = a
+          | otherwise = 0
+        lastRowY
+          | _ :|> a <- rowYs = a
+          | otherwise = 0
+        vp = node ^. L.info . L.viewport
+        Rect l t _w _h = vp
+        mouseover = pointInRect mouse vp
+        mouse = wenv ^. L.inputStatus . L.mousePos
+        mouseOverColor = (accentColor wenv) {_colorA = 0.3}
+        oddRowBgColor = (accentColor wenv) {_colorA = 0.1}
+        lineColor = accentColor wenv
+
+    handleEvent _wenv node _path = \case
+      Move (Point _pX _pY) ->
+        -- refresh which row shows as hovered
+        Just (resultReqs node [RenderOnce])
+      _ -> Nothing
+
+    handleMessage :: ContainerMessageHandler (HagridModel a) (HagridEvent ep)
+    handleMessage wenv node _path msg = result
+      where
+        result = cast msg >>= handleTypedMessage
+
+        handleTypedMessage (ContentPaneScrollToRow callback) = result
+          where
+            result
+              | Just row <- callback indexedItems,
+                Just y1 <- S.lookup row rowYs,
+                Just y2 <- S.lookup (row + 1) rowYs =
+                  Just (resultReqs node [SendMessage scrollId (ScrollTo (Rect vp._rX (vp._rY + y1) 1 (y2 - y1)))])
+              | otherwise =
+                  Nothing
+
+            indexedItems =
+              model.sortedItems
+                & indexed
+                & List.sortOn (snd . snd)
+                & map (\(sortedIndex, (item, _originalIndex)) -> (item, sortedIndex))
+
+            vp = node ^. L.info . L.viewport
+            rowYs = sizesToPositions (toRowHeights (node ^. L.children) columnDefsSeq)
+
+            scrollId = fromJust (widgetIdFromKey wenv (WidgetKey contentScrollKey))
+
+initialModel :: [HagridCfg s e] -> [Column ep a] -> [a] -> HagridModel a
+initialModel cfg columnDefs items = model
+  where
+    model =
+      HagridModel
+        { sortedItems = sortItems columnDefs sortColumn (zip items [0 ..]),
+          columns = initialColumn <$> columnDefs,
+          sortColumn
+        }
+
+    sortColumn
+      | Just (col, dir) <- (mconcat cfg).cfgInitialSort,
+        col >= 0,
+        col < length columnDefs =
+          Just (col, dir)
+      | otherwise = Nothing
+
+    initialColumn Column {name, initialWidth} =
+      ModelColumn
+        { name,
+          currentWidth = initialWidth
+        }
+
+dragHandleWidth :: Int
+dragHandleWidth = 4
+
+dragHandleHeight :: Double
+dragHandleHeight = 40
+
+headerPaneKey :: Text
+headerPaneKey = "Hagrid.headerPane"
+
+contentScrollKey :: Text
+contentScrollKey = "Hagrid.contentScroll"
+
+contentPaneKey :: Text
+contentPaneKey = "Hagrid.contentPane"
+
+footerPaneKey :: Text
+footerPaneKey = "Hagrid.footerPane"
+
+sortItems :: [Column ep a] -> Maybe (Int, SortDirection) -> [(a, Int)] -> [(a, Int)]
+sortItems columnDefs sortColumn items =
+  case modelSortKey columnDefs sortColumn of
+    DontSort -> items
+    SortWith f -> List.sortOn (f . fst) items
+
+modelSortKey :: [Column ep a] -> Maybe (Int, SortDirection) -> ColumnSortKey a
+modelSortKey columnDefs sortColumn = case sortColumn of
+  Just (sc, dir)
+    | Column {sortKey = SortWith f} <- columnDefs !! sc ->
+        case dir of
+          SortAscending -> SortWith f
+          SortDescending -> SortWith (Down . f)
+  _ ->
+    DontSort
+
+sizesToPositions :: Seq Double -> Seq Double
+sizesToPositions = S.scanl (+) 0
+
+toRowHeights :: Seq (WidgetNode s e1) -> Seq (Column e2 a) -> Seq Double
+toRowHeights children columnDefs = mergeHeights <$> S.chunksOf (length columnDefs) children
+  where
+    mergeHeights rowWidgets =
+      foldl' max 0 (S.zipWith widgetHeight columnDefs rowWidgets)
+
+    widgetHeight Column {paddingH} widget =
+      widget
+        & _wnInfo
+        & _wniSizeReqH
+        & \r -> _szrFixed r + _szrFlex r + paddingH * 2
+
+neighbours :: Seq a -> Seq (a, a, Bool)
+neighbours = \case
+  a :<| b :<| c :<| rest -> (a, b, False) :<| (b, c, True) :<| neighbours (c :<| rest)
+  a :<| b :<| S.Empty -> S.singleton (a, b, False)
+  _ -> S.empty
+
+-- | Creates a column that displays a text value, and is sortable by the text.
+textColumn ::
+  -- | Name of the column, to display in the header.
+  Text ->
+  -- | Called with the item for each row to get the text to display for that row.
+  (a -> Text) ->
+  Column e a
+textColumn name get = (defaultColumn name widget) {sortKey}
+  where
+    widget = LabelWidget (const get)
+    sortKey = SortWith get
+
+-- | Creates a column that displays the result of calling @'show'@ on a value, and is sortable by the value.
+showOrdColumn ::
+  (Show b, Ord b) =>
+  -- | Name of the column, to display in the header.
+  Text ->
+  -- | Called with the item for each row to get the value to display (via @'show'@) and sort by.
+  (a -> b) ->
+  Column e a
+showOrdColumn name get = (defaultColumn name widget) {sortKey}
+  where
+    widget = LabelWidget (const (T.pack . show . get))
+    sortKey = SortWith get
+
+-- | Creates a column that displays the a custom widget in each cell.
+widgetColumn ::
+  -- | Name of the column, to display in the header.
+  Text ->
+  -- | Called with the (original, not sorted) index and the item for each row to get the widget to
+  -- display for that row.
+  (forall s. Int -> a -> WidgetNode s e) ->
+  Column e a
+widgetColumn name get = defaultColumn name (CustomWidget get)
+
+defaultColumn :: Text -> ColumnWidget e a -> Column e a
+defaultColumn name widget =
+  Column
+    { name,
+      widget,
+      footerWidget = NoFooterWidget,
+      align = ColumnAlignLeft,
+      initialWidth = defaultColumnInitialWidth,
+      sortKey = DontSort,
+      minWidth = defaultColumnMinWidth,
+      paddingW = defaultColumnPadding,
+      paddingH = defaultColumnPadding,
+      resizeHandler = Nothing,
+      sortHandler = Nothing
+    }
+
+cellWidget :: (CompositeModel a, WidgetEvent e, WidgetModel s) => Int -> a -> ColumnWidget e a -> WidgetNode (HagridModel s) (HagridEvent e)
+cellWidget idx item = \case
+  LabelWidget get -> label_ (get idx item) [ellipsis]
+  CustomWidget get -> widget
+    where
+      widget =
+        compositeD_ "Hagrid.Cell" (WidgetValue item) buildUI handleEvent []
+      buildUI _wenv model =
+        get idx model
+      handleEvent _wenv _node _model e =
+        [Report (ParentEvent e)]
+
+footerWidgetNode ::
+  (CompositeModel a, CompositeModel s, Typeable e) =>
+  [(a, Int)] ->
+  ColumnFooterWidget e a ->
+  WidgetNode (HagridModel s) (HagridEvent e)
+footerWidgetNode items = \case
+  NoFooterWidget -> spacer
+  CustomFooterWidget get -> widget
+    where
+      widget =
+        compositeD_ "Hagrid.FooterCell" (WidgetValue items) buildUI handleEvent []
+      buildUI _wenv _model =
+        get items
+      handleEvent _wenv _node _model e =
+        [Report (ParentEvent e)]
+
+-- | Sends a message to the targeted 'hagrid' widget, that causes the
+-- widget to scroll such that a specified row becomes visible.
+scrollToRow ::
+  forall s e sp ep a.
+  (Typeable a, Typeable e) =>
+  -- | The widget to target.
+  WidgetKey ->
+  -- | Determines which row to scroll to.
+  ScrollToRowCallback a ->
+  EventResponse s e sp ep
+scrollToRow key row =
+  Message key (ScrollToRow row :: HagridEvent e)
+
+defaultColumnInitialWidth :: Int
+defaultColumnInitialWidth = 100
+
+defaultColumnMinWidth :: Int
+defaultColumnMinWidth = 60
+
+defaultColumnPadding :: Double
+defaultColumnPadding = 10
+
+flipSortDirection :: SortDirection -> SortDirection
+flipSortDirection SortAscending = SortDescending
+flipSortDirection SortDescending = SortAscending
diff --git a/test/Monomer/HagridSpec.hs b/test/Monomer/HagridSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Monomer/HagridSpec.hs
@@ -0,0 +1,197 @@
+module Monomer.HagridSpec (spec) where
+
+import Control.Concurrent (newEmptyMVar, putMVar, takeMVar)
+import Control.Lens ((&), (.~), (^.))
+import qualified Data.Foldable as Foldable
+import Data.Text (Text)
+import GHC.IO (unsafePerformIO)
+import Monomer
+import Monomer.Hagrid
+import qualified Monomer.Lens as L
+import Monomer.TestUtil
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+data TestModel = TestModel
+  deriving (Eq, Show)
+
+data TestEvent
+
+newtype TestItem = TestItem
+  {sizeReq :: SizeReq}
+  deriving (Eq, Show)
+
+spec :: Spec
+spec = do
+  resize
+  sorting
+  merging
+  messages
+
+resize :: Spec
+resize = describe "resize" $ do
+  it "should assign cell widths according to column widths" $ do
+    cellViewports
+      [ (testColumn "Col 1" sizeReq) {initialWidth = 33},
+        (testColumn "Col 2" sizeReq) {initialWidth = 77}
+      ]
+      [TestItem (fixedSize 10)]
+      `shouldBe` [ Rect 0 40 33 10,
+                   Rect 33 40 77 10
+                 ]
+
+  it "should assign single column cell heights according to cell heights" $ do
+    cellViewports
+      [ (testColumn "Col 1" sizeReq) {initialWidth = 50}
+      ]
+      [TestItem (fixedSize 33), TestItem (fixedSize 77)]
+      `shouldBe` [Rect 0 40 50 33, Rect 0 73 50 77]
+
+  it "should assign multi column cell heights according to max cell height from row" $ do
+    cellViewports
+      [ (testColumn "Col 1" (const (fixedSize 33))) {initialWidth = 50},
+        (testColumn "Col 2" (const (fixedSize 47))) {initialWidth = 50}
+      ]
+      [TestItem (fixedSize 0)]
+      `shouldBe` [Rect 0 40 50 47, Rect 50 40 50 47]
+
+  it "should use both fixed and flex height to calculate row height" $ do
+    cellViewports
+      [ (testColumn "Col 1" sizeReq) {initialWidth = 50}
+      ]
+      [TestItem (fixedSize 10 & L.flex .~ 7)]
+      `shouldBe` [Rect 0 40 50 17]
+
+sorting :: Spec
+sorting = describe "sorting" $ do
+  it "should not sort rows by default" $ do
+    cellViewports
+      [(testColumn "Col 1" sizeReq) {initialWidth = 50, sortKey = SortWith (_szrFixed . sizeReq)}]
+      [ TestItem (fixedSize 20),
+        TestItem (fixedSize 10),
+        TestItem (fixedSize 30)
+      ]
+      `shouldBe` [ Rect 0 40 50 20,
+                   Rect 0 60 50 10,
+                   Rect 0 70 50 30
+                 ]
+
+  it "should sort in ascending order when column header clicked" $ do
+    cellViewports_
+      [(testColumn "Col 1" sizeReq) {initialWidth = 50, sortKey = SortWith (_szrFixed . sizeReq)}]
+      [ TestItem (fixedSize 20),
+        TestItem (fixedSize 10),
+        TestItem (fixedSize 30)
+      ]
+      [Click (Point 10 10) BtnLeft 1]
+      `shouldBe` [ Rect 0 40 50 10,
+                   Rect 0 50 50 20,
+                   Rect 0 70 50 30
+                 ]
+
+  it "should sort in descending order when column header clicked again" $ do
+    cellViewports_
+      [(testColumn "Col 1" sizeReq) {initialWidth = 50, sortKey = SortWith (_szrFixed . sizeReq)}]
+      [ TestItem (fixedSize 20),
+        TestItem (fixedSize 10),
+        TestItem (fixedSize 30)
+      ]
+      [ Click (Point 10 10) BtnLeft 1,
+        Click (Point 10 10) BtnLeft 1
+      ]
+      `shouldBe` [ Rect 0 40 50 30,
+                   Rect 0 70 50 20,
+                   Rect 0 90 50 10
+                 ]
+
+merging :: Spec
+merging = describe "merging" $ do
+  it "should preserve column widths when items change" $ do
+    let col = textColumn "Col" (const "")
+        startNode = nodeInit wenv (hagrid [col {initialWidth = 75}] [TestItem (fixedSize 1)])
+        mergedNode = nodeMerge wenv (hagrid [col {initialWidth = 64}] [TestItem (fixedSize 2)]) startNode
+        resizedNode = nodeResize wenv mergedNode (mergedNode ^. L.info . L.viewport)
+    columnWidths startNode `shouldBe` [75]
+    columnWidths resizedNode `shouldBe` [75]
+
+messages :: Spec
+messages = describe "messages" $ do
+  it "should give items and sorted indices to scrollToRow callback" $ do
+    itemsMVar <- newEmptyMVar
+    let cols =
+          [(textColumn "Col" (const "")) {sortKey = SortWith (_szrFixed . sizeReq)}]
+        items =
+          [ TestItem (fixedSize 1),
+            TestItem (fixedSize 2),
+            TestItem (fixedSize 3)
+          ]
+        {-# NOINLINE scrollToRowCallback #-}
+        scrollToRowCallback cbItems =
+          unsafePerformIO (Nothing <$ putMVar itemsMVar cbItems) -- hacky, but seems to work!
+        buildUI _wenv _model =
+          hagrid_ [initialSort 0 SortDescending] cols items `nodeKey` "testKey"
+        handleEvent _wenv _node () () =
+          [scrollToRow (WidgetKey "testKey") scrollToRowCallback]
+        cmpNode =
+          compositeV_ "test" () (error "should not be called") buildUI handleEvent [onInit ()]
+        evts =
+          nodeHandleEventEvts wenv [] cmpNode
+    actualItems <- seq evts (takeMVar itemsMVar)
+    actualItems
+      `shouldBe` [ (TestItem (fixedSize 1), 2),
+                   (TestItem (fixedSize 2), 1),
+                   (TestItem (fixedSize 3), 0)
+                 ]
+
+testColumn :: Text -> (TestItem -> SizeReq) -> Column TestEvent TestItem
+testColumn name getHeight =
+  (widgetColumn name (testCellWidget getHeight)) {paddingW = 0, paddingH = 0}
+
+-- | We test with custom widgets because these will create special "Hagrid.Cell" nodes in the widget
+-- tree that we can later use to pick out the cell widgets.
+testCellWidget :: (TestItem -> SizeReq) -> Int -> TestItem -> WidgetNode s TestEvent
+testCellWidget getHeight _idx item = wgt
+  where
+    wgt = label "test" `styleBasic` [sizeReqW reqW, sizeReqH reqH]
+    reqW = fixedSize 100
+    reqH = getHeight item
+
+cellViewports :: [Column TestEvent TestItem] -> [TestItem] -> [Rect]
+cellViewports columnDefs items =
+  cellViewports_ columnDefs items []
+
+cellViewports_ :: [Column TestEvent TestItem] -> [TestItem] -> [SystemEvent] -> [Rect]
+cellViewports_ columnDefs items evts = Foldable.toList childVps
+  where
+    startNode = nodeInit wenv (hagrid columnDefs items)
+    ((wenv', eventedNode, _reqs), _) = nodeHandleEvents wenv WNoInit evts startNode
+    resizedNode = nodeResize wenv' eventedNode (eventedNode ^. L.info . L.viewport)
+    instanceTree = widgetGetInstanceTree (resizedNode ^. L.widget) wenv' resizedNode
+    childVps = roundRectUnits . _wniViewport . _winInfo <$> widgetsOfType "Hagrid.Cell" instanceTree
+
+-- Extract the column widths by observing the locations of the special drag handle widgets
+columnWidths :: WidgetNode TestModel TestEvent -> [Int]
+columnWidths node = fromFractional <$> colWidths
+  where
+    (_, colWidths) =
+      Foldable.foldl' (\(px, cws) (Rect x _y w _h) -> (x + w, (x + w - px) : cws)) (0, []) vps
+    vps =
+      _wniViewport . _winInfo <$> dragHandles
+    dragHandles =
+      widgetsOfType "Hagrid.HeaderDragHandle" instanceTree
+    instanceTree =
+      widgetGetInstanceTree (_wnWidget node) wenv node
+
+widgetsOfType :: WidgetType -> WidgetInstanceNode -> [WidgetInstanceNode]
+widgetsOfType typ node = thisOne <> childOnes
+  where
+    thisOne
+      | (node ^. (L.info . L.widgetType)) == typ = [node]
+      | otherwise = []
+    childOnes =
+      mconcat (widgetsOfType typ <$> Foldable.toList (node ^. L.children))
+
+windowSize :: Size
+windowSize = Size 100 100
+
+wenv :: WidgetEnv TestModel TestEvent
+wenv = mockWenv TestModel & L.windowSize .~ windowSize
diff --git a/test/Monomer/TestUtil.hs b/test/Monomer/TestUtil.hs
new file mode 100644
--- /dev/null
+++ b/test/Monomer/TestUtil.hs
@@ -0,0 +1,432 @@
+{- ORMOLU_DISABLE -}
+{-|
+Everything below this line in this file was taken verbatim from the Monomer source code, commit e49a79357653f171efe4a2e93a273ac9504d029f.
+
+Module      : Monomer.TestUtil
+Copyright   : (c) 2018 Francisco Vallarino
+License     : BSD-3-Clause (see the LICENSE file)
+Maintainer  : fjvallarino@gmail.com
+Stability   : experimental
+Portability : non-portable
+
+Helper functions for testing Monomer widgets.
+-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Monomer.TestUtil where
+
+import Control.Concurrent (newMVar)
+import Control.Concurrent.STM.TChan (newTChanIO)
+import Control.Lens ((&), (^.), (.~), (.=))
+import Control.Monad.State
+import Data.Default
+import Data.Maybe
+import Data.Text (Text)
+import Data.Sequence (Seq)
+import System.Environment (lookupEnv)
+import System.IO.Unsafe (unsafePerformIO)
+import Test.Hspec (Expectation, pendingWith)
+
+import qualified Data.ByteString as BS
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import qualified Data.Sequence as Seq
+
+import Monomer.Core
+import Monomer.Event
+import Monomer.Graphics
+import Monomer.Main.Handlers
+import Monomer.Main.Types
+import Monomer.Main.Util
+
+import qualified Monomer.Lens as L
+
+data InitWidget
+  = WInit
+  | WInitKeepFirst
+  | WNoInit
+  deriving (Eq, Show)
+
+testW :: Double
+testW = 640
+
+testH :: Double
+testH = 480
+
+testWindowSize :: Size
+testWindowSize = Size testW testH
+
+testWindowRect :: Rect
+testWindowRect = Rect 0 0 testW testH
+
+mockTextMetrics :: Double -> Font -> FontSize -> TextMetrics
+mockTextMetrics scale font fontSize = TextMetrics {
+  _txmAsc = 15,
+  _txmDesc = 5,
+  _txmLineH = 20,
+  _txmLowerX = 10
+}
+
+mockTextSize
+  :: Maybe Double -> Double -> Font -> FontSize -> FontSpace -> Text -> Size
+mockTextSize mw scale font (FontSize fs) spaceH text = Size width height where
+  w = fromMaybe fs mw + unFontSpace spaceH
+  width = fromIntegral (T.length text) * w
+  height = 20
+
+mockGlyphsPos
+  :: Maybe Double
+  -> Double
+  -> Font
+  -> FontSize
+  -> FontSpace
+  -> Text
+  -> Seq GlyphPos
+mockGlyphsPos mw scale font (FontSize fs) spaceH text = glyphs where
+  w = fromMaybe fs mw + unFontSpace spaceH
+  chars = Seq.fromList $ T.unpack text
+  mkGlyph idx chr = GlyphPos {
+    _glpGlyph = chr,
+    _glpX = fromIntegral idx * w,
+    _glpXMin = fromIntegral idx * w,
+    _glpXMax = (fromIntegral idx + 1) * w,
+    _glpYMin = 0,
+    _glpYMax = 10,
+    _glpW = w,
+    _glpH = 10
+  }
+  glyphs = Seq.mapWithIndex mkGlyph chars
+
+mockRenderText :: Point -> Font -> FontSize -> FontSpace -> Text -> IO ()
+mockRenderText point font size spaceH text = return ()
+
+mockRenderer :: Renderer
+mockRenderer = Renderer {
+  beginFrame = \w h -> return (),
+  endFrame = return (),
+  -- Path
+  beginPath = return (),
+  closePath = return (),
+  -- Context management
+  saveContext = return (),
+  restoreContext = return (),
+  -- Overlays
+  createOverlay = \overlay -> return (),
+  renderOverlays = return (),
+  -- Raw tasks
+  createRawTask = \task -> return (),
+  renderRawTasks = return (),
+  -- Raw overlays
+  createRawOverlay = \overlay -> return (),
+  renderRawOverlays = return (),
+  -- Scissor operations
+  intersectScissor = \rect -> return (),
+  -- Translation
+  setTranslation = \point -> return (),
+  -- Scale
+  setScale = \point -> return (),
+  -- Rotation
+  setRotation = \angle -> return (),
+  -- Global Alpha
+  setGlobalAlpha = \alpha -> return (),
+  -- Path Winding
+  setPathWinding = \winding -> return (),
+  -- Strokes
+  stroke = return (),
+  setStrokeColor = \color -> return (),
+  setStrokeWidth = \width -> return (),
+  setStrokeLinearGradient = \p1 p2 c1 c2 -> return (),
+  setStrokeRadialGradient = \p1 a1 a2 c1 c2 -> return (),
+  setStrokeBoxGradient = \r1 r f c1 c2 -> return (),
+  setStrokeImagePattern = \n1 p1 s1 w1 h1 -> return (),
+  -- Fill
+  fill = return (),
+  setFillColor = \color -> return (),
+  setFillLinearGradient = \p1 p2 c1 c2 -> return (),
+  setFillRadialGradient = \p1 a1 a2 c1 c2 -> return (),
+  setFillBoxGradient = \r1 r f c1 c2 -> return (),
+  setFillImagePattern = \n1 p1 s1 w1 h1 -> return (),
+  -- Drawing
+  moveTo = \point -> return (),
+  renderLine = \p1 p2 -> return (),
+  renderLineTo = \point -> return (),
+  renderRect = \rect -> return (),
+  renderRoundedRect = \rect r1 r2 r3 r4 -> return (),
+  renderArc = \center radius angleStart angleEnd winding -> return (),
+  renderQuadTo = \p1 p2 -> return (),
+  renderEllipse = \rect -> return (),
+  -- Text
+  renderText = mockRenderText,
+
+  -- Image
+  getImage = const . return $ Just $ ImageDef "test" def BS.empty [],
+  addImage = \name size imgData flags -> return (),
+  updateImage = \name size imgData -> return (),
+  deleteImage = \name -> return ()
+}
+
+mockFontManager :: FontManager
+mockFontManager = FontManager {
+  computeTextMetrics = mockTextMetrics 1,
+  computeTextMetrics_ = mockTextMetrics,
+  computeTextSize = mockTextSize (Just 10) 1,
+  computeTextSize_ = mockTextSize (Just 10),
+  computeGlyphsPos = mockGlyphsPos (Just 10) 1,
+  computeGlyphsPos_ = mockGlyphsPos (Just 10)
+}
+mockWenv :: s -> WidgetEnv s e
+mockWenv model = WidgetEnv {
+  _weOs = "Mac OS X",
+  _weDpr = 2,
+  _weAppStartTs = 0,
+  _weFontManager = mockFontManager,
+  _weFindBranchByPath = const Seq.empty,
+  _weMainButton = BtnLeft,
+  _weContextButton = BtnRight,
+  _weTheme = def,
+  _weWindowSize = testWindowSize,
+  _weWidgetShared = unsafePerformIO (newMVar M.empty),
+  _weWidgetKeyMap = M.empty,
+  _weHoveredPath = Nothing,
+  _weFocusedPath = emptyPath,
+  _weOverlayPath = Nothing,
+  _weDragStatus = Nothing,
+  _weMainBtnPress = Nothing,
+  _weCursor = Nothing,
+  _weModel = model,
+  _weInputStatus = def,
+  _weTimestamp = 0,
+  _weThemeChanged = False,
+  _weInTopLayer = const True,
+  _weLayoutDirection = LayoutNone,
+  _weViewport = Rect 0 0 testW testH,
+  _weOffset = def
+}
+
+mockWenvEvtUnit :: s -> WidgetEnv s ()
+mockWenvEvtUnit model = mockWenv model
+
+nodeInit :: (Eq s) => WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
+nodeInit wenv node = nodeHandleEventRoot wenv [] node
+
+nodeMerge :: WidgetEnv s e -> WidgetNode s e -> WidgetNode s e -> WidgetNode s e
+nodeMerge wenv node oldNode = resNode where
+  newNode = node
+    & L.info . L.path .~ oldNode ^. L.info . L.path
+  WidgetResult resNode _ = widgetMerge (newNode^. L.widget) wenv newNode oldNode
+
+nodeGetSizeReq :: WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
+nodeGetSizeReq wenv node = (sizeReqW,  sizeReqH) where
+  WidgetResult node2 _ = widgetInit (node ^. L.widget) wenv node
+  sizeReqW = node2 ^. L.info . L.sizeReqW
+  sizeReqH = node2 ^. L.info . L.sizeReqH
+
+nodeResize :: WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetNode s e
+nodeResize wenv node viewport = result ^. L.node where
+  resizeCheck = const True
+  widget = node ^. L.widget
+  result = widgetResize widget wenv node viewport resizeCheck
+
+nodeHandleEventCtx
+  :: (Eq s)
+  => WidgetEnv s e
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> MonomerCtx s e
+nodeHandleEventCtx wenv evts node = ctx where
+  ctx = nodeHandleEventCtx_ wenv WInit evts node
+
+nodeHandleEventCtx_
+  :: (Eq s)
+  => WidgetEnv s e
+  -> InitWidget
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> MonomerCtx s e
+nodeHandleEventCtx_ wenv init evts node = ctx where
+  ctx = snd $ nodeHandleEvents wenv init evts node
+
+nodeHandleEventModel
+  :: (Eq s)
+  => WidgetEnv s e
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> s
+nodeHandleEventModel wenv evts node = model where
+  model = nodeHandleEventModel_ wenv WInit evts node
+
+nodeHandleEventModel_
+  :: (Eq s)
+  => WidgetEnv s e
+  -> InitWidget
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> s
+nodeHandleEventModel_ wenv init evts node = _weModel wenv2 where
+  (wenv2, _, _) = fst $ nodeHandleEvents wenv init evts node
+
+nodeHandleEventRoot
+  :: (Eq s)
+  => WidgetEnv s e
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> WidgetNode s e
+nodeHandleEventRoot wenv evts node = newRoot where
+  newRoot = nodeHandleEventRoot_ wenv WInit evts node
+
+nodeHandleEventRoot_
+  :: (Eq s)
+  => WidgetEnv s e
+  -> InitWidget
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> WidgetNode s e
+nodeHandleEventRoot_ wenv init evts node = newRoot where
+  (_, newRoot, _) = fst $ nodeHandleEvents wenv init evts node
+
+nodeHandleEventReqs
+  :: (Eq s)
+  => WidgetEnv s e
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> Seq (WidgetRequest s e)
+nodeHandleEventReqs wenv evts node = reqs where
+  reqs = nodeHandleEventReqs_ wenv WInit evts node
+
+nodeHandleEventReqs_
+  :: (Eq s)
+  => WidgetEnv s e
+  -> InitWidget
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> Seq (WidgetRequest s e)
+nodeHandleEventReqs_ wenv init evts node = reqs where
+  (_, _, reqs) = fst $ nodeHandleEvents wenv init evts node
+
+nodeHandleEventEvts
+  :: (Eq s)
+  => WidgetEnv s e
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> Seq e
+nodeHandleEventEvts wenv evts node = newEvts where
+  newEvts = nodeHandleEventEvts_ wenv WInit evts node
+
+nodeHandleEventEvts_
+  :: (Eq s)
+  => WidgetEnv s e
+  -> InitWidget
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> Seq e
+nodeHandleEventEvts_ wenv init evts node = eventsFromReqs reqs where
+  (_, _, reqs) = fst $ nodeHandleEvents wenv init evts node
+
+nodeHandleEvents
+  :: (Eq s)
+  => WidgetEnv s e
+  -> InitWidget
+  -> [SystemEvent]
+  -> WidgetNode s e
+  -> (HandlerStep s e, MonomerCtx s e)
+nodeHandleEvents wenv init evts node = result where
+  steps = case init of
+    WInit -> tail $ nodeHandleEvents_ wenv init [evts] node
+    WInitKeepFirst -> nodeHandleEvents_ wenv WInit [evts] node
+    _ -> nodeHandleEvents_ wenv init [evts] node
+  result = foldl1 stepper steps
+  stepper step1 step2 = result where
+    ((_, _, reqs1), _) = step1
+    ((wenv2, root2, reqs2), ctx2) = step2
+    result = ((wenv2, root2, reqs1 <> reqs2), ctx2)
+
+nodeHandleEvents_
+  :: (Eq s)
+  => WidgetEnv s e
+  -> InitWidget
+  -> [[SystemEvent]]
+  -> WidgetNode s e
+  -> [(HandlerStep s e, MonomerCtx s e)]
+nodeHandleEvents_ wenv init evtsG node = unsafePerformIO $ do
+  -- Do NOT test code involving SDL Window functions
+  channel <- liftIO newTChanIO
+
+  fmap fst $ flip runStateT (monomerCtx channel) $ do
+    L.inputStatus .= wenv ^. L.inputStatus
+    handleResourcesInit
+
+    stepA <- if init == WInit
+      then do
+        handleWidgetInit wenv pathReadyRoot
+      else
+        return (wenv, pathReadyRoot, Seq.empty)
+
+    ctxA <- get
+    let (wenvA, nodeA, reqsA) = stepA
+    let resizeCheck = const True
+    let resizeRes = widgetResize (nodeA ^. L.widget) wenv nodeA vp resizeCheck
+    step <- handleWidgetResult wenvA True resizeRes
+    ctx <- get
+    let (wenvr, rootr, reqsr) = step
+
+    (_, _, steps) <- foldM runStep (wenvr, rootr, [(step, ctx)]) evtsG
+
+    return $ if init == WInit
+      then (stepA, ctxA) : reverse steps
+      else reverse steps
+  where
+    winSize = _weWindowSize wenv
+    vp = Rect 0 0 (_sW winSize) (_sH winSize)
+    dpr = 1
+    epr = 1
+    model = _weModel wenv
+    monomerCtx channel = initMonomerCtx undefined channel winSize dpr epr model
+    pathReadyRoot = node
+      & L.info . L.path .~ rootPath
+      & L.info . L.widgetId .~ WidgetId (wenv ^. L.timestamp) rootPath
+    runStep (wenv, root, accum) evts = do
+      step <- handleSystemEvents wenv root evts
+      ctx <- get
+      let (wenv2, root2, reqs2) = step
+
+      return (wenv2, root2, (step, ctx) : accum)
+
+nodeHandleResult
+  :: (Eq s)
+  => WidgetEnv s e
+  -> WidgetResult s e
+  -> (HandlerStep s e, MonomerCtx s e)
+nodeHandleResult wenv result = unsafePerformIO $ do
+  channel <- liftIO newTChanIO
+
+  let winSize = _weWindowSize wenv
+  let dpr = 1
+  let epr = 1
+  let model = _weModel wenv
+  -- Do NOT test code involving SDL Window functions
+  let monomerCtx = initMonomerCtx undefined channel winSize dpr epr model
+
+  flip runStateT monomerCtx $ do
+    L.inputStatus .= wenv ^. L.inputStatus
+    handleResourcesInit
+
+    handleWidgetResult wenv True result
+
+roundRectUnits :: Rect -> Rect
+roundRectUnits (Rect x y w h) = Rect nx ny nw nh where
+  nx = fromIntegral (round x)
+  ny = fromIntegral (round y)
+  nw = fromIntegral (round w)
+  nh = fromIntegral (round h)
+
+useVideoSubSystem :: IO Bool
+useVideoSubSystem = do
+  (== Just "1") <$> lookupEnv "USE_SDL_VIDEO_SUBSYSTEM"
+
+testInVideoSubSystem :: Expectation -> Expectation
+testInVideoSubSystem expectation = do
+  useVideo <- useVideoSubSystem
+  if useVideo then
+    expectation
+  else
+    pendingWith "SDL Video sub system not initialized. Skipping."
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}