diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright M Farkas-Dyck © 2019
+
+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 M Farkas-Dyck 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/Numeric/Rational/Positive.hs b/Numeric/Rational/Positive.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/Rational/Positive.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Numeric.Rational.Positive (Qp, fromFraction, toFraction, fromRational, toRational) where
+
+import Prelude hiding (Num (..), Fractional (..), Eq (..), Ord (..), Real (..))
+import qualified Prelude
+
+import Algebra
+import Data.Bits
+import Data.Bool
+import Data.Function (on)
+import Data.Ratio
+import Data.Semigroup (Sum (..), Product (..))
+import Data.Universe.Class
+import Numeric.Natural
+import Relation.Binary.Comparison
+
+data Qp = Qp {-# UNPACK #-}!Word {-# UNPACK #-}!Natural
+  deriving (Show)
+
+fromBits :: [Bool] -> Qp
+fromBits = go 0 0 where
+    go :: Word -> Natural -> [Bool] -> Qp
+    go k n = k `seq` n `seq` \ case
+        [] -> Qp k n
+        b:bs -> go (k+1) (bool id (flip setBit $ fromIntegral k) b n) bs
+
+toBits :: Qp -> [Bool]
+toBits (Qp l n) = testBit n <$> [0..fromIntegral l-1]
+
+fromFraction :: (Natural, Natural) -> Qp
+fromFraction = fromBits . uncurry go where
+    go :: Natural -> Natural -> [Bool]
+    go p q = case compare p q of
+        EQ -> []
+        GT -> False : go (p∸q) q
+        LT -> True  : go p (q∸p)
+
+toFraction :: Qp -> (Natural, Natural)
+toFraction = go . toBits where
+    go [] = (1, 1)
+    go (b:bs) | (p, q) <- go bs = bool (p+q, q) (p, p+q) b
+
+fromRational :: Ratio Natural -> Qp
+fromRational a = fromFraction (numerator a, denominator a)
+
+toRational :: Qp -> Ratio Natural
+toRational = go . toBits where
+    go [] = 1
+    go (False:bs) = 1 + go bs
+    go (True :bs) = Prelude.recip (1 + Prelude.recip (go bs))
+
+instance Preord Qp where a ≤ b = GT ≢ compare a b
+instance PartialEq Qp where Qp l₁ n₁ ≡ Qp l₂ n₂ = (l₁, n₁) ≡ (l₂, n₂)
+instance PartialOrd Qp where tryCompare a b = Just (compare a b)
+instance Eq Qp
+instance Ord Qp where
+    compare = go `on` toBits where
+        go [] [] = EQ
+        go (a:_) [] = bool GT LT a
+        go [] (b:_) = bool LT GT b
+        go (a:as) (b:bs) = compare b a <> go as bs
+
+instance {-# OVERLAPPING #-} Semigroup (Product Qp) where
+    Product (toFraction -> (p₁, q₁)) <> Product (toFraction -> (p₂, q₂)) =
+      (Product . fromFraction) (p₁ * p₂, q₁ * q₂)
+
+instance {-# OVERLAPPING #-} Monoid (Product Qp) where
+    mempty = Product (Qp 0 0)
+
+instance Group (Product Qp) where
+    invert (Product (Qp l n)) = Product (Qp l (xor n $ shiftL 1 (fromIntegral l) ∸ 1))
+
+instance {-# OVERLAPPING #-} Semigroup (Sum Qp) where
+    Sum (toFraction -> (p₁, q₁)) <> Sum (toFraction -> (p₂, q₂)) =
+        (Sum . fromFraction) (p₁ * q₂ + p₂ * q₁, q₁ * q₂)
+
+instance Universe Qp where
+    universe = fromBits <$> go where go = [] : (go >>= traverse (:) [False, True])
+
+instance Prelude.Eq Qp where (==) = (≡)
+instance Prelude.Ord Qp where compare = compare
+instance Prelude.Num Qp where
+    fromInteger = fromRational . Prelude.fromInteger
+    (+) = (+)
+    a * b = fromRational $ ((*) `on` toRational) a b
+    abs = id
+    signum = pure 1
+    (-) = undefined
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,1 @@
+# stern-brocot
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/bench/Main.hs b/bench/Main.hs
new file mode 100644
--- /dev/null
+++ b/bench/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import Criterion.Main
+
+main :: IO ()
+main = defaultMain []
diff --git a/stern-brocot.cabal b/stern-brocot.cabal
new file mode 100644
--- /dev/null
+++ b/stern-brocot.cabal
@@ -0,0 +1,103 @@
+name:                stern-brocot
+version:             0.1.0.0
+synopsis:            Positive rational numbers represented as paths in the Stern-Brocot tree
+-- description:
+license:             BSD3
+license-file:        LICENSE
+author:              M Farkas-Dyck
+maintainer:          strake888@gmail.com
+copyright:           2019 M Farkas-Dyck
+category:            Math, Numeric
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      .
+  exposed-modules:     Numeric.Rational.Positive
+  build-depends:       alg >= 0.2.10 && < 0.3
+                     , base >= 4.7 && < 5
+                     , universe-base >= 1.0 && < 1.1
+  default-language:    Haskell2010
+  default-extensions:  UnicodeSyntax
+                     , LambdaCase
+                     , EmptyCase
+                     , InstanceSigs
+                     , PartialTypeSignatures
+                     , PolyKinds
+                     , ConstraintKinds
+                     , FlexibleContexts
+                     , FlexibleInstances
+                     , MonadComprehensions
+                     , StandaloneDeriving
+                     , DeriveFunctor, DeriveFoldable, DeriveTraversable
+  ghc-options:         -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing
+                       -Wincomplete-record-updates -Wincomplete-uni-patterns
+                       -Werror=incomplete-patterns
+                       -Werror=incomplete-uni-patterns
+                       -Werror=incomplete-record-updates
+                       -Werror=missing-fields
+                       -Werror=missing-methods
+
+test-suite test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Main.hs
+  build-depends:       base >=4.11 && <5
+                     , smallcheck >=1.1.4
+                     , tasty >=1.0
+                     , tasty-smallcheck >=0.8
+                     , universe-base >= 1.0 && < 1.1
+                     , stern-brocot
+  default-language:    Haskell2010
+  default-extensions:  UnicodeSyntax
+                     , LambdaCase
+                     , EmptyCase
+                     , InstanceSigs
+                     , PartialTypeSignatures
+                     , PolyKinds
+                     , ConstraintKinds
+                     , FlexibleContexts
+                     , FlexibleInstances
+                     , MonadComprehensions
+                     , StandaloneDeriving
+                     , DeriveFunctor, DeriveFoldable, DeriveTraversable
+  ghc-options:         -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing
+                       -Wincomplete-record-updates -Wincomplete-uni-patterns
+                       -Werror=incomplete-patterns
+                       -Werror=incomplete-uni-patterns
+                       -Werror=incomplete-record-updates
+                       -Werror=missing-fields
+                       -Werror=missing-methods
+
+benchmark bench
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      bench
+  main-is:             Main.hs
+  build-depends:       base >=4.11 && <5
+                     , criterion >=1.4.1
+                     , stern-brocot
+  default-language:    Haskell2010
+  default-extensions:  UnicodeSyntax
+                     , LambdaCase
+                     , EmptyCase
+                     , InstanceSigs
+                     , PartialTypeSignatures
+                     , PolyKinds
+                     , ConstraintKinds
+                     , FlexibleContexts
+                     , FlexibleInstances
+                     , MonadComprehensions
+                     , StandaloneDeriving
+                     , DeriveFunctor, DeriveFoldable, DeriveTraversable
+  ghc-options:         -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing
+                       -Wincomplete-record-updates -Wincomplete-uni-patterns
+                       -Werror=incomplete-patterns
+                       -Werror=incomplete-uni-patterns
+                       -Werror=incomplete-record-updates
+                       -Werror=missing-fields
+                       -Werror=missing-methods
+
+source-repository head
+  type:     git
+  location: https://github.com/strake/stern-brocot.hs
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Main where
+
+import Data.Universe.Class
+import Test.SmallCheck
+import Test.SmallCheck.Series
+import Test.Tasty
+import Test.Tasty.SmallCheck
+
+import Numeric.Rational.Positive
+
+main :: IO ()
+main = defaultMain $
+    testGroup ""
+    [testProperty "+-associative" $ \ a b c -> (a + b) + (c :: Qp) == a + (b + c),
+     testProperty "+-commutative" $ \ a b -> a + b == (b + a :: Qp),
+     testProperty "*-associative" $ \ a b c -> (a * b) * (c :: Qp) == a * (b * c),
+     testProperty "*-commutative" $ \ a b -> a * b == (b * a :: Qp),
+     testProperty "*-identity" $ \ a -> a * 1 == a && 1 * a == (a :: Qp),
+     testProperty "+-distributive" $ \ a b c -> a * (b + c) == (a * b + a * c :: Qp)]
+
+instance Monad m => Serial m Qp where series = generate $ \ d -> take (2^(d+1)-1) universe