diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,19 @@
+Copyright 2017 Clinton Mead
+
+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/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/disjoint-set-stateful.cabal b/disjoint-set-stateful.cabal
new file mode 100644
--- /dev/null
+++ b/disjoint-set-stateful.cabal
@@ -0,0 +1,39 @@
+name:                 disjoint-set-stateful
+version:              0.1.0.0
+synopsis:             Monadic disjoint set
+description:
+  This package includes a monadic disjoint int set datatype, which can also be "frozen" into a non-monadic queriable
+  disjoint set (which however can not be modified).
+  .
+  In the future, I will write a wrapper that allows disjoint sets for all datatypes.
+  .
+  One common use case for disjoint sets is for creating equivalence classes.
+license: MIT
+license-file: LICENSE
+homepage:             https://github.com/clintonmead/disjoint-set-stateful
+author:               Clinton Mead
+maintainer:           clintonmead@gmail.com
+category:             Data
+build-type:           Simple
+cabal-version:        >=1.10
+tested-with: GHC == 8.0.2
+bug-reports: https://github.com/clintonmead/disjoint-set-stateful/issues
+
+source-repository head
+  type: git
+  location: https://github.com/clintonmead/disjoint-set-stateful.git
+
+library
+  exposed-modules:      Data.DisjointSet.Int.Monadic, Data.DisjointSet.Int
+  other-modules:        Data.DisjointSet.Int.Monadic.Impl
+  build-depends:        base == 4.9.*, vector == 0.12.*, primitive == 0.6.*, ref-tf == 0.4.*
+  hs-source-dirs:       src
+  default-language:     Haskell2010
+
+Test-Suite tests
+  type: exitcode-stdio-1.0
+  other-modules:  Data.DisjointSet.Int.Monadic, Data.DisjointSet.Int, Data.DisjointSet.Int.Monadic.Impl
+  main-is: Tests.hs
+  build-depends: base == 4.9.*, vector == 0.12.*, primitive == 0.6.*, ref-tf == 0.4.*, hspec == 2.4.*
+  hs-source-dirs:       src, test
+  default-language:     Haskell2010
diff --git a/src/Data/DisjointSet/Int.hs b/src/Data/DisjointSet/Int.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/DisjointSet/Int.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+{-|
+This module contains non-monadic functions for querying disjoint int sets. See "Data.DisjointSet.Int.Monadic" for information about
+how to create and modify disjoint int sets.
+
+There are two other disjoint int set packages on hackage, namely:
+
+* "disjoint-set"
+* "disjoint-sets-st"
+
+The first is a pure disjoint int set implementation, so as it doesn't do in place array updates in ST it will presumably
+be somewhat slower, with the data structure used likely taking more space and having log(n) access speed.
+
+This package does not include a pure implementation, you're better off using "disjoint-set" for that.
+
+"disjoint-sets-st" does offer an implementation in IO, however, it's missing two features:
+
+1) The ability to "freeze" a disjoint set, and then query it in a pure way.
+2) Maintaining a circular linked list of each set so one can quickly discover all the elements of one set without
+quering through the entire structure.
+
+This package implements both of the above features.
+-}
+module Data.DisjointSet.Int (
+  find,
+  count,
+  findAndCount,
+  numSets,
+  size,
+  nextInSet,
+  setToList
+)
+where
+
+import Data.Vector.Unboxed (Vector, (!))
+import Data.DisjointSet.Int.Monadic (DisjointIntSet(DisjointIntSet))
+import Data.DisjointSet.Int.Monadic.Impl (PointerOrCount(Pointer, Count), isPointer)
+
+import Prelude (
+  Int,
+  Bool (True, False),
+  negate,
+  fst,
+  snd,
+  (/=),
+  Maybe (Just, Nothing),
+  (.)
+  )
+
+import Data.List (unfoldr)
+
+type VectorT = Vector Int
+
+read :: VectorT -> Int -> PointerOrCount
+read v i =
+  let
+    r = v ! i
+  in
+    case (isPointer r) of
+      True -> Pointer r
+      False -> Count (negate r)
+
+{-|
+Both 'find' and 'count', but in one operation, so in theory faster than running them separately.
+-}
+findAndCount :: DisjointIntSet -> Int -> (Int, Int)
+findAndCount (DisjointIntSet v _ _ _) i = go i where
+  go i = case (read v i) of
+    Pointer next_i -> go next_i
+    Count c -> (i, c)
+
+{-|
+Finds the representative set for that element.
+-}
+find :: DisjointIntSet -> Int -> Int
+find v i = fst (findAndCount v i)
+
+{-|
+Gives how many elements in this element's set.
+-}
+count :: DisjointIntSet -> Int -> Int
+count v i = snd (findAndCount v i)
+
+{-|
+How many distinct sets.
+-}
+numSets :: DisjointIntSet -> Int
+numSets (DisjointIntSet _ _ numSets _) = numSets
+
+{-|
+How many elements in this disjoint set.
+-}
+size ::  DisjointIntSet -> Int
+size (DisjointIntSet _ _ _ size) = size
+
+{-|
+Gets the next element in the current set. This is a circular list, so if you iterate on this you'll get back to the
+element you started with in the end.
+-}
+nextInSet :: DisjointIntSet -> Int -> Int
+nextInSet (DisjointIntSet _ set_v _ _) i = set_v ! i
+
+{-|
+Returns a list of the elements in the selected set.
+-}
+setToList :: DisjointIntSet -> Int -> [Int]
+setToList ds i = i:(unfoldr f i) where
+  f curr_i = let next_i = nextInSet ds curr_i in if next_i /= i then Just (next_i, next_i) else Nothing
+
diff --git a/src/Data/DisjointSet/Int/Monadic.hs b/src/Data/DisjointSet/Int/Monadic.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/DisjointSet/Int/Monadic.hs
@@ -0,0 +1,306 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE RankNTypes #-}
+
+{-|
+This module implements data types and monadic operations to build, modify and query disjoint int sets in a monadic way
+(such as through ST). Keep in mind that that this module assumes your int set is 0 based, i.e has no negatives, and is
+contiguous from zero. Storage space required is two machine integers per int in the set.
+
+For more information see the <https://en.wikipedia.org/wiki/Disjoint_sets Disjoint Sets> article on wikipedia, noting that
+this modules only deals with disjoint sets with elements of type 'Int', in particular contiguous and starting at 0.
+-}
+module Data.DisjointSet.Int.Monadic (
+  DisjointIntSetMonadic(DisjointIntSetMonadicFixed, DisjointIntSetMonadicVariable),
+  DisjointIntSet(DisjointIntSet),
+  newDisjointIntSetFixed,
+  newDisjointIntSetVariable,
+  union,
+  find,
+  count,
+  findAndCount,
+  numSets,
+  size,
+  nextInSet,
+  setToList,
+  unsafeFreeze,
+  freeze,
+  runDisjointIntSet
+  )
+where
+
+import qualified Data.DisjointSet.Int.Monadic.Impl as Impl
+
+import Data.DisjointSet.Int.Monadic.Impl (MVectorT)
+
+import Prelude (
+  Int, (+), (-), (*), negate,
+  ($),
+  return,
+  Monad, (>>),
+  Bool(True, False),
+  (<), (>=), (==), (>), (/=), (<=),
+  mapM_,
+  max,
+  pred, succ,
+  undefined,
+  minBound,
+  div,
+  Maybe,
+  Foldable,
+  (.),
+  (>>=),
+  (<$>),
+  Show
+  )
+
+import Data.Vector.Unboxed.Mutable (
+  MVector,
+  new,
+  unsafeRead, unsafeWrite,
+  unsafeGrow
+  )
+
+import qualified Data.Vector.Unboxed
+import qualified Data.Vector.Unboxed.Mutable
+
+import Data.Vector.Unboxed (
+  Vector
+  )
+
+import Control.Monad.Primitive (
+  PrimState, PrimMonad
+  )
+
+import Control.Monad.ST (
+  ST, runST
+  )
+
+import Control.Monad.Ref (
+  MonadRef, Ref, newRef,
+  readRef, writeRef, modifyRef'
+  )
+
+import Control.Monad (
+  when
+  )
+
+data Size = Variable | Fixed
+
+{-|
+There are two sorts of monadic int sets, one of fixed size and one of variable size. The variable sized one automatically expands
+but is presumably a bit slower due to the extra indirection and time taken for copies when resizing.
+
+Note that when the variable sized int set expands, it expands to at least twice it's current size, so you won't get @O(n^2)@ behaviour due to
+frequent resizings.
+
+Whilst the following is implementation details, it might be interesting to know. Each int set has two vectors of Ints. The first either contains a
+positive or negative number, if it's positive, it's a pointer which eventually points to the representative set. However, if it's negative,
+this element is the representative set, and the absolute value of it is the number of elements in the set.
+
+The second set maintains a circular linked lists for each set. This allows one to iterate though elements of a set quickly.
+
+For more information on the algorithms, the <https://en.wikipedia.org/wiki/Disjoint-set_data_structure disjoint set data structure page on Wikipedia>
+is a good start.
+-}
+data DisjointIntSetMonadic m where
+  DisjointIntSetMonadicFixed :: (Monad m) => (MVectorT m) -> (MVectorT m) -> (Ref m Int) -> Int -> DisjointIntSetMonadic m
+  DisjointIntSetMonadicVariable :: (Monad m) => (Ref m (MVectorT m)) -> (Ref m (MVectorT m)) -> (Ref m Int) -> (Ref m Int) -> DisjointIntSetMonadic m
+
+{-|
+This is the non-monadic disjoint int set. It can be created by using the monadic operations and then calling
+'freeze', 'unsafeFreeze' or 'runDisjointIntSet' as appropriate. There's not a variable and fixed length version of this
+because well, you can't modify the non-monadic version anyway.
+-}
+data DisjointIntSet = DisjointIntSet (Vector Int) (Vector Int) Int Int deriving Show
+
+type MonadT m = (MonadRef m, PrimMonad m)
+
+runMonadicIntSetFunc ::(MonadT m) => DisjointIntSetMonadic m -> ((?v :: MVectorT m, ?set_v :: MVectorT m, ?numElems :: Int, ?numSets :: Int, ?numSets_ref :: Ref m Int) => m b) -> m b
+runMonadicIntSetFunc (DisjointIntSetMonadicVariable v_ref set_v_ref numSets_ref numElems_ref) f = do
+  v <- readRef v_ref
+  set_v <- readRef set_v_ref
+  numElems <- readRef numElems_ref
+  numSets <- readRef numSets_ref
+  let
+    ?v = v
+    ?set_v = set_v
+    ?numElems = numElems
+    ?numSets = numSets
+    ?numSets_ref = numSets_ref
+    in f
+runMonadicIntSetFunc (DisjointIntSetMonadicFixed v set_v numSets_ref numElems) f =
+  do
+    numSets <- readRef numSets_ref
+    let
+      ?v = v
+      ?set_v = set_v
+      ?numElems = numElems
+      ?numSets = numSets
+      ?numSets_ref = numSets_ref
+      in f
+
+{-|
+Merges the two elements passed into one set.
+-}
+union :: (MonadT m) => DisjointIntSetMonadic m -> Int -> Int -> m Bool
+union x@(DisjointIntSetMonadicFixed _ _ _ _) i1 i2 = runMonadicIntSetFunc x (Impl.union (i1, i2))
+union x@(DisjointIntSetMonadicVariable v_ref set_v_ref numSets_ref numElems_ref) i1 i2 = do
+  let
+    ?v_ref = v_ref
+    ?set_v_ref = set_v_ref
+    ?numSets_ref = numSets_ref
+    ?numElems_ref = numElems_ref
+    in do
+      Impl.resize (max i1 i2)
+      runMonadicIntSetFunc x (Impl.union (i1,i2))
+
+{-|
+Finds the representative set for that element.
+-}
+find :: (MonadT m) => DisjointIntSetMonadic m -> Int -> m Int
+find x i = runMonadicIntSetFunc x (Impl.find i)
+
+{-|
+Gives how many elements in this element's set.
+-}
+count :: (MonadT m) => DisjointIntSetMonadic m -> Int -> m Int
+count x i = runMonadicIntSetFunc x (Impl.count i)
+
+{-|
+Both 'find' and 'count', but in one operation, so in theory faster than running them separately.
+-}
+findAndCount :: (MonadT m) => DisjointIntSetMonadic m -> Int -> m (Int, Int)
+findAndCount x i = runMonadicIntSetFunc x (Impl.findAndCount i)
+
+{-|
+How many distinct sets. Note for fixed size disjoint sets this starts at the size, all ints are assumed to be in
+separate sets.
+-}
+numSets :: (MonadT m) => DisjointIntSetMonadic m -> m Int
+numSets (DisjointIntSetMonadicFixed _ _ numSets_ref _) = readRef numSets_ref
+numSets (DisjointIntSetMonadicVariable _ _ numSets_ref _) = readRef numSets_ref
+
+{-|
+How many elements in this disjoint set. Note for fixed size disjoint sets this is always the size
+they are created with, regardless of whether these elements have been assigned to sets.
+-}
+size :: (MonadT m) => DisjointIntSetMonadic m -> m Int
+size (DisjointIntSetMonadicFixed _ _ _ numElems) = return numElems
+size (DisjointIntSetMonadicVariable _ _ _ numElems_ref) = readRef numElems_ref
+
+{-|
+Creates a new disjoint set of fixed size.
+-}
+newDisjointIntSetFixed :: (PrimMonad m, MonadRef m) => Int -> m (DisjointIntSetMonadic m)
+newDisjointIntSetFixed size = let ?size = size; ?array_size = size in do
+  v <- Impl.new_count
+  set_v <- Impl.new_set
+  n <- newRef size
+  return (DisjointIntSetMonadicFixed v set_v n size)
+
+{-|
+Creates a new disjoint set of variable size.
+-}
+newDisjointIntSetVariable :: (PrimMonad m, MonadRef m) => m (DisjointIntSetMonadic m)
+newDisjointIntSetVariable = let ?size = 0; ?array_size = 1024 in do
+  v <- Impl.new_count
+  set_v <- Impl.new_set
+  v_ref <- newRef v
+  set_v_ref <- newRef set_v
+  zero <- newRef 0
+  n <- newRef 0
+  return (DisjointIntSetMonadicVariable v_ref set_v_ref zero n)
+
+{-|
+Repeated calls iterates through the circular linked list of elements in this set
+-}
+nextInSet :: (MonadT m) => DisjointIntSetMonadic m -> Int -> m Int
+nextInSet x i =  runMonadicIntSetFunc x (Impl.nextInSet i)
+
+{-|
+Repeatedly calls nextInSet to generate a list of elements in this set.
+-}
+setToList :: forall m. (MonadT m) => DisjointIntSetMonadic m -> Int -> m [Int]
+setToList x i = do
+  n <- count x i
+  go n i where
+    go :: Int -> Int -> m [Int]
+    go n i = case n of
+      0 -> return []
+      _ -> do
+        next_i <- nextInSet x i
+        rest <- go (n - 1) next_i
+        return (i:rest)
+
+
+{-|
+Freezes the disjoint int set into a non-mondaic set, but without copying. You should not modify the
+monadic disjoint int set after this operation.
+-}
+unsafeFreeze :: (MonadT m) => DisjointIntSetMonadic m -> m DisjointIntSet
+unsafeFreeze (DisjointIntSetMonadicFixed v set_v numSets_ref numElems) = do
+  v_frozen <- Data.Vector.Unboxed.unsafeFreeze v
+  set_v_frozen <- Data.Vector.Unboxed.unsafeFreeze set_v
+  numSets <- readRef numSets_ref
+  return (DisjointIntSet v_frozen set_v_frozen numSets numElems)
+unsafeFreeze (DisjointIntSetMonadicVariable v_ref set_v_ref numSets_ref numElems_ref) = do
+  numSets <- readRef numSets_ref
+  numElems <- readRef numElems_ref
+  v <- readRef v_ref
+  set_v <- readRef set_v_ref
+  v_frozen <- Data.Vector.Unboxed.unsafeFreeze v
+  set_v_frozen <- Data.Vector.Unboxed.unsafeFreeze set_v
+  return (DisjointIntSet v_frozen set_v_frozen numSets numElems)
+
+{-|
+Safely freezes the disjoint int set into a non-mondaic set by doing a full copy. You should not modify the
+monadic disjoint int set after this operation.
+-}
+freeze :: (MonadT m) => DisjointIntSetMonadic m -> m DisjointIntSet
+freeze (DisjointIntSetMonadicFixed v set_v numSets_ref numElems) = do
+  v_frozen <- Data.Vector.Unboxed.freeze (Data.Vector.Unboxed.Mutable.slice 0 numElems v)
+  set_v_frozen <- Data.Vector.Unboxed.freeze (Data.Vector.Unboxed.Mutable.slice 0 numElems set_v)
+  numSets <- readRef numSets_ref
+  return (DisjointIntSet v_frozen set_v_frozen numSets numElems)
+freeze (DisjointIntSetMonadicVariable v_ref set_v_ref numSets_ref numElems_ref) = do
+  numSets <- readRef numSets_ref
+  numElems <- readRef numElems_ref
+  v <- readRef v_ref
+  set_v <- readRef set_v_ref
+  v_frozen <- Data.Vector.Unboxed.freeze (Data.Vector.Unboxed.Mutable.slice 0 numElems v)
+  set_v_frozen <- Data.Vector.Unboxed.freeze (Data.Vector.Unboxed.Mutable.slice 0 numElems set_v)
+  return (DisjointIntSet v_frozen set_v_frozen numSets numElems)
+
+{-|
+A bit like 'runST', runs the ST action which must have the result of 'DisjointIntSetMonadic', but then
+returns a non monadic 'DisjointIntSet'. It uses 'unsafeFreeze' interally, but this is perfectly safe as
+nothing is done to the monadic disjoint int set after 'unsafeFreeze'.
+-}
+runDisjointIntSet :: (forall s. ST s (DisjointIntSetMonadic (ST s))) -> DisjointIntSet
+runDisjointIntSet actions = runST (actions >>= unsafeFreeze)
+
+{-|
+This package has a separate interface for working with non-monadic disjoint int sets ('DisjointIntSet').
+Naturally you can't do modifications unless you're in the monad, but you can do queries outside it.
+
+If you're written a function that does work on a non-monadic int set (i.e. 'DisjointIntSet') but you want to
+run it inside the monad, this is a way of doing it safely.
+-}
+runPure :: (MonadT m) => DisjointIntSetMonadic m -> (DisjointIntSet -> a) -> m a
+runPure x f = f <$> (unsafeFreeze x)
+
+{-|
+Much like 'runPure', but incase you want to return a monadic result back to the monad. Can't imagine many
+situations where this is useful but it's provided for completeness.
+-}
+runMonad :: (MonadT m) => DisjointIntSetMonadic m -> (DisjointIntSet -> m a) -> m a
+runMonad x f = (unsafeFreeze x) >>= f
diff --git a/src/Data/DisjointSet/Int/Monadic/Impl.hs b/src/Data/DisjointSet/Int/Monadic/Impl.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/DisjointSet/Int/Monadic/Impl.hs
@@ -0,0 +1,329 @@
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+
+module Data.DisjointSet.Int.Monadic.Impl where
+
+
+import Prelude (
+  Int, (+), (-), (*), negate,
+  ($),
+  return,
+  Monad, (>>),
+  Bool(True, False),
+  (<), (>=), (==), (>), (/=), (<=),
+  mapM_,
+  max,
+  pred, succ,
+  undefined,
+  minBound,
+  div,
+  Maybe,
+  Foldable,
+  (.)
+  )
+
+import Data.Vector.Unboxed.Mutable (
+  MVector,
+  new,
+  unsafeRead, unsafeWrite, unsafeSwap,
+  unsafeGrow
+  )
+
+import qualified Data.Vector.Unboxed.Mutable as Vector
+
+import Data.Vector.Unboxed (
+  Vector,
+  unsafeFreeze
+  )
+
+import Control.Monad.Primitive (
+  PrimState, PrimMonad
+  )
+
+import Control.Monad.ST (
+  ST, runST
+  )
+
+import Control.Monad.Ref (
+  MonadRef, Ref, newRef,
+  readRef, writeRef, modifyRef'
+  )
+
+import Control.Monad (
+  when
+  )
+
+type MVectorT m = MVector (PrimState m) Int
+
+initNewElem :: (PrimMonad m, ?v :: MVectorT m, ?set_v :: MVectorT m) => Int -> m ()
+initNewElem i = do
+  init_count i
+  init_set i
+
+
+resize :: (
+  MonadRef m,
+  PrimMonad m,
+  PrimMonad m,
+  ?v_ref :: Ref m (MVectorT m),
+  ?set_v_ref :: Ref m (MVectorT m),
+  ?numElems_ref :: Ref m Int,
+  ?numSets_ref :: Ref m Int
+  ) =>  Int -> m ()
+resize i = do
+  numElems <- readRef ?numElems_ref
+  let new_numElems = i+1
+  let addedElems = new_numElems - numElems
+  when (addedElems > 0) $ do
+    v <- readRef ?v_ref
+    set_v <- readRef ?set_v_ref
+    modifyRef' ?numSets_ref (+addedElems)
+    writeRef ?numElems_ref new_numElems
+    if (new_numElems > Vector.length v)
+    then
+      do
+        new_v <- unsafeGrow v new_numElems
+        writeRef ?v_ref new_v
+        new_set_v <- unsafeGrow set_v new_numElems
+        writeRef ?set_v_ref new_set_v
+        let
+          ?v = new_v
+          ?set_v = new_set_v
+          in
+            init_range numElems new_numElems
+    else
+      do
+        let
+          ?v = v
+          ?set_v = set_v
+          in
+            init_range numElems new_numElems
+
+
+
+isCount = (<0)
+isPointer = (>=0)
+--isNonCanonical = (<= halfNegativeMax)
+--toCanonical x = (x - minBound)
+--fromCanonical x = (x + minBound
+{-
+freeze' :: (MonadRef m, PrimMonad m) => MVectorT m -> MVectorT m -> Int -> Int -> m DisjointIntSet
+freeze' v target_v numSets numElems = do
+  currSet_ref <- newRef 0
+  set_v <- new numSets
+  mapM_ (finalCollapse set_v v target_v currSet_ref) [0..(numElems-1)]
+  result_v <- unsafeFreeze target_v
+  set_result_v <- unsafeFreeze set_v
+  return (DisjointIntSet result_v set_result_v)
+-}
+
+
+collapse :: (PrimMonad m, ?v :: MVectorT m) => Int -> Int -> m ()
+collapse target_i current_i = when (target_i /= current_i) $ collapse' current_i where
+  collapse' current_i = do
+    next_i <- read_absolute current_i
+    when (target_i /= next_i) $ do
+      write current_i target_i
+      collapse' next_i
+
+data PointerOrCount = Pointer Int | Count Int
+
+
+read :: (PrimMonad m, ?v :: MVectorT m) => Int -> m PointerOrCount
+read i =
+  do
+    r <- read_absolute i
+    return (if (isPointer r) then (Pointer r) else (Count (negate r)))
+
+read_absolute :: (PrimMonad m, ?v :: MVectorT m) => Int -> m Int
+read_absolute i = unsafeRead ?v i
+
+write ::  (PrimMonad m, ?v :: MVectorT m) => Int -> Int -> m ()
+write = unsafeWrite ?v
+
+write_count :: (PrimMonad m, ?v :: MVectorT m) => Int -> Int -> m ()
+write_count i x = write i (-x)
+
+
+read_set ::  (PrimMonad m, ?set_v :: MVectorT m) => Int -> m Int
+read_set = unsafeRead ?set_v
+
+
+swap_set :: (PrimMonad m, ?set_v :: MVectorT m) => Int -> Int -> m ()
+swap_set = unsafeSwap ?set_v
+
+
+mapM_zeroToN :: (Monad m) => Int -> (Int -> m ()) -> m ()
+mapM_zeroToN = mapM_nToN 0
+
+mapM_nToN :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ()
+mapM_nToN start_n end_n f = mapM_ f [start_n..(end_n-1)]
+
+new_count :: (PrimMonad m, ?size :: Int, ?array_size :: Int) => m (MVectorT m)
+new_count = do
+  v <- new ?array_size
+  let ?v = v in mapM_zeroToN ?size init_count
+  return v
+
+init_count :: (PrimMonad m, ?v :: MVectorT m) => Int -> m ()
+init_count i = write_count i 1
+
+init_count_range :: (PrimMonad m, ?v :: MVectorT m) => Int -> Int -> m ()
+init_count_range start_i end_i = mapM_nToN start_i end_i init_count
+
+init_set :: (PrimMonad m, ?set_v :: MVectorT m) => Int -> m ()
+init_set i = unsafeWrite ?set_v i i
+
+init_set_range :: (PrimMonad m, ?set_v :: MVectorT m) => Int -> Int -> m ()
+init_set_range start_i end_i = mapM_nToN start_i end_i init_set
+
+init_range :: (PrimMonad m, ?v :: MVectorT m, ?set_v :: MVectorT m) => Int -> Int -> m ()
+init_range start_i end_i = do
+  init_count_range start_i end_i
+  init_set_range start_i end_i
+
+new_set :: (PrimMonad m, ?size :: Int, ?array_size :: Int)  => m (MVectorT m)
+new_set = do
+  set_v <- new ?array_size
+  let ?set_v = set_v in mapM_zeroToN ?size init_set
+  return set_v
+
+{-
+new_next_set :: (PrimMonad m, ?size :: Int, ?array_size :: Int) => m (MVectorT m)
+new_next_set = do
+  next_set_v <- new ?array_size
+  when (?size /= 0) $ do
+    mapM_zeroToN (?size - 1) (\i -> unsafeWrite next_set_v i (i+1))
+    unsafeWrite next_set_v (?size - 1) 0
+  return next_set_v
+
+init_next_set_range :: (PrimMonad m, ?next_set_v :: MVectorT m, ?v :: MVectorT m) => Int -> Int -> m ()
+init_next_set_range start_i end_i = do
+  zero_i <- find 0
+  one_i <- unsafeRead ?next_set_v zero_i
+  unsafeWrite ?next_set_v zero_i start_i
+  mapM_nToN start_i (end_i-1) (\i -> unsafeWrite ?next_set_v i (i+1))
+  unsafeWrite ?next_set_v end_i one_i
+-}
+
+
+union :: forall m. (MonadRef m, PrimMonad m, ?v :: MVectorT m, ?set_v :: MVectorT m, ?numSets_ref :: Ref m Int) =>  (Int,Int) -> m Bool
+union (x_i, y_i) = go x_i y_i where
+  go :: (?v :: MVectorT m) => Int -> Int -> m Bool
+  go x_i y_i = do
+    (x_count_i, x_count) <- findAndCountNoCollapse x_i
+    (y_count_i, y_count) <- findAndCountNoCollapse y_i
+    let new_count = x_count + y_count
+    (target_i, result) <-
+      case (x_count_i /= y_count_i) of
+        True -> do
+          final_i <-
+            case (x_count > y_count) of
+              True ->
+                do
+                  write_count x_count_i new_count
+                  write y_count_i x_count_i
+                  return x_count_i
+              False ->
+                do
+                  write_count y_count_i new_count
+                  write x_count_i y_count_i
+                  return y_count_i
+          swap_set x_count_i y_count_i
+          modifyRef' ?numSets_ref pred
+          return (final_i, True)
+        False -> return (x_count_i, False)
+    collapse target_i x_i
+    collapse target_i y_i
+    return result
+
+equivalent :: (PrimMonad m, ?set_v :: MVectorT m) => (a -> Int -> m a) -> a -> Int -> m a
+equivalent f init i = go init i where
+  go acc i' = do
+    p <- read_set i'
+    r <- f acc i'
+    if (p /= i) then go r p else return r
+
+find :: (PrimMonad m, ?v :: MVectorT m) =>  Int -> m Int
+find i = do
+  (final_i, _) <- findAndCount i
+  return final_i
+
+
+count :: (PrimMonad m, ?v :: MVectorT m) =>  Int -> m Int
+count i =  do
+  (_, count) <- findAndCount i
+  return count
+
+findAndCountNoCollapse :: (PrimMonad m, ?v :: MVectorT m) => Int -> m (Int,Int)
+findAndCountNoCollapse i = do
+  r <- read i
+  case r of
+    Pointer p -> findAndCountNoCollapse p
+    Count c -> return (i, c)
+
+findAndCount :: (PrimMonad m, ?v :: MVectorT m) => Int -> m (Int,Int)
+findAndCount i = do
+  r@(final_i, _) <- findAndCountNoCollapse i
+  collapse final_i i
+  return r
+
+nextInSet :: (PrimMonad m, ?set_v :: MVectorT m) => Int -> m Int
+nextInSet = read_set
+
+
+
+
+
+
+{-
+finalCollapse :: forall m. (MonadRef m, PrimMonad m) => MVectorT m -> MVectorT m -> MVectorT m -> Ref m Int -> Int -> m ()
+finalCollapse set_v old_v new_v set_i_ref i =
+  let
+    read_old = read' old_v
+    read_new = read' new_v
+
+    write_old = write' old_v
+    write_new = write' new_v
+
+    write_set = write' set_v
+
+    orig_i = i
+    init = do
+      r <- read_old i
+      case (isPointer r) of
+        True -> go r
+        False -> case (isNonCanonical r) of
+          True -> write_new i (toCanonical r)
+          False -> do
+            set_i <- readRef set_i_ref
+            writeRef set_i_ref (succ set_i)
+            write_new i set_i
+            write_set set_i (-r)
+    go i = do
+      case (i >= orig_i) of
+        True -> do
+          r <- read_old i
+          case (isPointer r) of
+            True -> go r
+            False -> case (isNonCanonical r) of
+              True -> collapseCanonical (toCanonical r) r i
+              False -> do
+                set_i <- readRef set_i_ref
+                writeRef set_i_ref (succ set_i)
+                let nonCanonical = fromCanonical set_i
+                write_set set_i (-r)
+                write_old i nonCanonical
+                collapseCanonical set_i nonCanonical i
+        False -> do
+          r <- read_new i
+          collapseCanonical r (fromCanonical r) i
+
+    collapseCanonical canonical_r non_canonical_r last_i = do
+      next_i <- read_old orig_i
+      write_new orig_i canonical_r
+      (let ?v = old_v in collapse last_i next_i) :: m () -- Signature due to potentual GHC bug #13006
+  in
+    init
+-}
diff --git a/test/Tests.hs b/test/Tests.hs
new file mode 100644
--- /dev/null
+++ b/test/Tests.hs
@@ -0,0 +1,38 @@
+module Main where
+
+import Data.DisjointSet.Int
+import qualified Data.DisjointSet.Int.Monadic as M
+
+import Data.List (nub, sort)
+
+import Test.Hspec (hspec, it, shouldBe)
+
+ds t =
+  M.runDisjointIntSet (do
+    ds <- case t of
+      Just n -> M.newDisjointIntSetFixed n
+      Nothing -> M.newDisjointIntSetVariable
+    M.union ds 0 1
+    M.union ds 3 2
+    M.union ds 1 2
+    M.union ds 8 9
+    M.union ds 8 3
+    M.union ds 7 4
+    return ds
+  )
+
+allEqual (x:xs) = all (==x) xs
+
+testds x = do
+  it "check set1" $ allEqual [find x 0, find x 1, find x 2, find x 3, find x 8, find x 9] `shouldBe` True
+  it "check set2" $ allEqual [find x 4, find x 7] `shouldBe` True
+  it "check different" $ length (nub [find x 0, find x 4, find x 5, find x 6]) `shouldBe` 4
+  it "check count" $ map (count x) [0..9] `shouldBe` [6,6,6,6,2,1,1,2,6,6]
+  it "check size" $ size x `shouldBe` 10
+  it "check num_sets" $ numSets x `shouldBe` 4
+  it "check setToList" $ [sort (setToList x 8), sort (setToList x 4), setToList x 5, setToList x 6] `shouldBe` [[0,1,2,3,8,9], [4,7], [5], [6]]
+
+
+main = hspec $ do
+  testds (ds (Just 10))
+  testds (ds Nothing)