diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,1 @@
+# ChangeLog
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Andrew Martin (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Andrew Martin nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,1 @@
+# subtraction-semigroups
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/monus.cabal b/monus.cabal
new file mode 100644
--- /dev/null
+++ b/monus.cabal
@@ -0,0 +1,45 @@
+cabal-version:  2.2
+name:           monus
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/andrewthad/monus#readme>
+homepage:       https://github.com/andrewthad/monus#readme
+bug-reports:    https://github.com/andrewthad/monus/issues
+author:         Andrew Martin
+maintainer:     andrew.thaddeus@gmail.com
+copyright:      2018 Andrew Martin
+license:        BSD-3-Clause
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    ChangeLog.md
+    README.md
+
+source-repository head
+  type: git
+  location: https://github.com/andrewthad/monus
+
+library
+  exposed-modules:
+    Data.Monoid.Monus
+    Data.Monoid.Monus.Generic
+    Data.Map.Annihilate
+  hs-source-dirs: src
+  build-depends:
+    , base >=4.5 && <5
+    , containers >= 0.4.2.1
+  default-language: Haskell2010
+
+test-suite test
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  hs-source-dirs: test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+    , base
+    , containers
+    , smallcheck
+    , monus
+    , tasty
+    , tasty-smallcheck
+    , tasty-quickcheck
+  default-language: Haskell2010
diff --git a/src/Data/Map/Annihilate.hs b/src/Data/Map/Annihilate.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Map/Annihilate.hs
@@ -0,0 +1,74 @@
+{-# language CPP #-}
+{-# language GeneralizedNewtypeDeriving #-}
+
+#if !MIN_VERSION_containers(0,5,9)
+module Data.Map.Annihilate
+  (
+  ) where
+#else
+
+module Data.Map.Annihilate
+  ( Map
+  , singleton
+  , lookup
+  ) where
+
+import Prelude hiding (lookup)
+
+import Data.Semigroup (Semigroup((<>)))
+import Data.Monoid (Monoid(mempty))
+import Data.Monoid.Monus (Monus(monus))
+import Data.Maybe (fromMaybe)
+
+import qualified Data.Map.Strict as M
+import qualified Data.Map.Merge.Strict as MM
+
+-- todo: manually write Show instance
+newtype Map k v = Map (M.Map k v)
+  deriving (Eq,Ord,Functor,Foldable,Show)
+
+singleton :: (Monoid v, Eq v) => k -> v -> Map k v
+singleton k v = if v == mempty
+  then Map M.empty
+  else Map (M.singleton k v)
+
+lookup :: (Ord k, Monoid v) => k -> Map k v -> v
+lookup k (Map m) = fromMaybe mempty (M.lookup k m)
+
+instance (Ord k, Monoid v, Eq v) => Semigroup (Map k v) where
+  Map x <> Map y = Map
+    ( MM.merge
+      MM.dropMissing
+      MM.dropMissing
+      ( MM.zipWithMaybeMatched
+        (\_ a b ->
+          let c = a `mappend` b
+           in if c == mempty then Nothing else Just c
+        )
+      )
+      x 
+      y
+    )
+
+instance (Ord k, Monoid v, Eq v) => Monoid (Map k v) where
+  mempty = Map M.empty
+#if !MIN_VERSION_base(4,11,0)
+  mappend x y = x <> y
+#endif
+
+instance (Ord k, Monus v, Eq v) => Monus (Map k v) where
+  monus (Map x) (Map y) = Map
+    ( MM.merge
+      MM.dropMissing
+      MM.dropMissing
+      ( MM.zipWithMaybeMatched
+        (\_ a b ->
+          let c = monus a b
+           in if c == mempty then Nothing else Just c
+        )
+      )
+      x 
+      y
+    )
+
+#endif
diff --git a/src/Data/Monoid/Monus.hs b/src/Data/Monoid/Monus.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Monus.hs
@@ -0,0 +1,106 @@
+{-# language TypeFamilies #-}
+{-# language ScopedTypeVariables #-}
+{-# language RankNTypes #-}
+
+-- | A <https://en.wikipedia.org/wiki/Monus commutative monoid with monus>
+-- is a 'Monoid' equipped with a subtraction operator.
+module Data.Monoid.Monus
+  ( Monus(..)
+  , (-)
+  ) where
+
+import Prelude hiding ((-))
+import Data.Set (Set)
+import Data.Complex (Complex(..))
+import Data.Monoid (Any(..),All(..),Sum(..), Endo(..))
+import Control.Applicative (liftA2)
+import Numeric.Natural (Natural)
+import Data.Foldable
+import Data.Coerce
+
+import qualified Prelude as P
+import qualified Data.Set as S
+
+infixl 6 -
+
+-- | A commutative monoid that supports subtraction. The following
+-- laws must hold:
+--
+-- > x <> (y - x) = y <> (x - y)
+-- > (x - y) - z = x - (y <> z)
+-- > x - x = mempty
+-- > mempty - x = mempty
+class Monoid a => Monus a where
+  monus :: a -> a -> a
+
+-- | An infix synonym for 'subtraction'.
+(-) :: Monus a => a -> a -> a
+(-) = monus
+{-# INLINE (-) #-}
+
+instance Ord a => Monus (Set a) where
+  monus = S.difference
+  {-# INLINE monus #-}
+
+-- | Unlike the subtraction provided by the 'Num' instance of
+-- 'Natural', this subtraction is total.
+instance (a ~ Natural) => Monus (Sum a) where
+  monus (Sum x) (Sum y) = Sum (if x > y then x P.- y else 0)
+  {-# INLINE monus #-}
+
+-- | Defined as @P - Q = P ∧ ¬Q@
+instance Monus Any where
+  monus (Any x) (Any y) = case x of
+    False -> Any False
+    True -> Any (not y)
+  {-# INLINE monus #-}
+
+-- | Defined as @P - Q = P ∨ ¬Q@
+instance Monus All where
+  monus (All x) (All y) = case x of
+    False -> All (not y)
+    True -> All True
+  {-# INLINE monus #-}
+
+instance forall a. Monus a => Monus (Endo a) where
+  monus = coerce (liftA2 monus :: (a -> a) -> (a -> a) -> (a -> a))
+  {-# INLINE monus #-}
+
+instance Monus () where
+  monus _ _ = ()
+  {-# INLINE monus #-}
+
+instance (Monus a, Monus b) => Monus (a,b) where
+  monus (a1,b1) (a2,b2) = (monus a1 a2,monus b1 b2)
+  {-# INLINE monus #-}
+
+instance (Monus a, Monus b, Monus c) => Monus (a,b,c) where
+  monus (a1,b1,c1) (a2,b2,c2) = (monus a1 a2,monus b1 b2,monus c1 c2)
+  {-# INLINE monus #-}
+
+instance (Monus a, Monus b, Monus c,Monus d) => Monus (a,b,c,d) where
+  monus (a1,b1,c1,d1) (a2,b2,c2,d2) =
+    (monus a1 a2,monus b1 b2,monus c1 c2,monus d1 d2)
+  {-# INLINE monus #-}
+
+instance (Monus a, Monus b, Monus c,Monus d,Monus e) => Monus (a,b,c,d,e) where
+  monus (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = 
+    (monus a1 a2,monus b1 b2,monus c1 c2,monus d1 d2,monus e1 e2)
+  {-# INLINE monus #-}
+
+instance Monus b => Monus (a -> b) where
+  monus = liftA2 monus
+  {-# INLINE monus #-}
+
+instance Monus a => Monus (IO a) where
+  monus = liftA2 monus
+  {-# INLINE monus #-}
+
+instance Monus a => Monus [a] where
+  monus [] _ = []
+  monus x [] = x
+  monus (x:xs) (y:ys) = monus x y : monus xs ys
+
+instance Monus a => Monus (Maybe a) where
+  monus = liftA2 monus
+  {-# INLINE monus #-}
diff --git a/src/Data/Monoid/Monus/Generic.hs b/src/Data/Monoid/Monus/Generic.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Monus/Generic.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Data.Monoid.Monus.Generic
+  ( GMonus(..)
+  , gmonus
+  , WrappedMonus(..)
+  ) where
+
+import Data.Semigroup (Semigroup)
+import GHC.Generics
+import Data.Monoid.Monus
+import Prelude hiding (Num(..))
+
+-- | Useful with -XDerivingVia.
+newtype WrappedMonus a = WrappedMonus a
+  deriving (Generic, Semigroup, Monoid)
+
+instance Monus a => Monus (WrappedMonus a) where
+  monus = gmonus;
+
+gmonus :: (Generic a, GMonus (Rep a)) => a -> a -> a
+gmonus x y = to (from x `gmonus'` from y)
+
+class GMonus f where
+  {-# MINIMAL gmonus' #-}
+  gmonus' :: f a -> f a -> f a
+
+instance GMonus U1 where
+  gmonus' _ _ = U1
+
+instance (GMonus a, GMonus b) => GMonus (a :*: b) where
+  gmonus' (a :*: b) (c :*: d) = gmonus' a c :*: gmonus' b d
+
+instance GMonus a => GMonus (M1 i c a) where
+  gmonus' (M1 x) (M1 y) = M1 (gmonus' x y)
+
+instance Monus a => GMonus (K1 i a) where
+  gmonus' (K1 x) (K1 y) = K1 (monus x y)
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,76 @@
+{-# language GeneralizedNewtypeDeriving #-}
+{-# language ScopedTypeVariables #-}
+{-# language TypeApplications #-}
+{-# language FlexibleContexts #-}
+{-# language StandaloneDeriving #-}
+{-# language FlexibleInstances #-}
+{-# language MultiParamTypeClasses #-}
+
+import Prelude hiding ((-))
+
+import Test.Tasty
+import Test.Tasty.SmallCheck as SC
+import Test.Tasty.QuickCheck as QC
+import Test.SmallCheck.Series (Serial(series))
+
+import Data.Proxy (Proxy(..))
+import Data.Monoid (Any(..),All(..),Sum(..))
+import Data.Set (Set)
+import Data.Monoid.Monus (Monus,(-))
+import Type.Reflection (typeRep,TypeRep)
+import Numeric.Natural (Natural)
+
+import qualified Data.Set as S
+import qualified Data.Map.Annihilate as MA
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Monus"
+  [ props (typeRep @Any)
+  , props (typeRep @All)
+  , props (typeRep @(Set Bool))
+  , qcProps (typeRep @(Sum Natural))
+  , qcProps (typeRep @(MA.Map Int (Set Int)))
+  ]
+
+props :: forall m a. (Serial IO a, Monus a, Eq a, Show a) => TypeRep a -> TestTree
+props r = testGroup (show r)
+  [ SC.testProperty "x <> (y - x) = y <> (x - y)" $
+      \(x :: a) y -> x <> (y - x) == y <> (x - y)
+  , SC.testProperty "(x - y) - z = x - (y <> z)" $
+      \(x :: a) y z -> (x - y) - z == x - (y <> z)
+  , SC.testProperty "x - x = mempty" $
+      \(x :: a) -> x - x == mempty
+  , SC.testProperty "mempty - x = mempty" $
+      \(x :: a) -> mempty - x == mempty
+  ]
+
+qcProps :: forall m a. (Arbitrary a, Monus a, Eq a, Show a) => TypeRep a -> TestTree
+qcProps r = testGroup (show r)
+  [ QC.testProperty "x <> (y - x) = y <> (x - y)" $
+      \(x :: a) y -> x <> (y - x) == y <> (x - y)
+  , QC.testProperty "(x - y) - z = x - (y <> z)" $
+      \(x :: a) y z -> (x - y) - z == x - (y <> z)
+  , QC.testProperty "x - x = mempty" $
+      \(x :: a) -> x - x == mempty
+  , QC.testProperty "mempty - x = mempty" $
+      \(x :: a) -> mempty - x == mempty
+  ]
+
+instance Monad m => Serial m Any where
+  series = fmap Any series
+
+instance Monad m => Serial m All where
+  series = fmap All series
+
+instance (Monad m, Ord a, Serial m a) => Serial m (Set a) where
+  series = fmap S.fromList series
+
+instance Arbitrary Natural where
+  arbitrary = fmap (fromIntegral . abs) (arbitrary @Integer)
+
+instance (Arbitrary k, Ord k, Arbitrary v, Monoid v, Eq v) => Arbitrary (MA.Map k v) where
+  arbitrary = fmap (foldMap (\(k,v) -> MA.singleton k v)) (arbitrary @[(k,v)])
+
