```{- |
description: Primitive natural number functions

maintainer: Joe Leslie-Hurd <joe@gilith.com>
stability: provisional
portability: portable
-}
module OpenTheory.Primitive.Natural
( Natural,
shiftLeft,
shiftRight )
where

import Data.Bits
import qualified Data.Maybe as Maybe
import qualified Test.QuickCheck

newtype Natural =
Natural { unNatural :: Integer }
deriving (Eq, Ord)

shiftLeft :: Natural -> Natural -> Natural
shiftLeft (Natural x) k = Natural (shiftL x (fromIntegral k))

shiftRight :: Natural -> Natural -> Natural
shiftRight (Natural x) k = Natural (shiftR x (fromIntegral k))

instance Show Natural where
show x = show (unNatural x)

instance Num Natural where
x + y = Natural (unNatural x + unNatural y)

x - y =
if x < y
then error "OpenTheory.Primitive.Natural.-"
else Natural (unNatural x - unNatural y)

x * y = Natural (unNatural x * unNatural y)

abs x = x

signum x = if unNatural x == 0 then x else Natural 1

fromInteger x =
if x < 0
then error "OpenTheory.Primitive.Natural.fromInteger"
else Natural x

instance Real Natural where
toRational x = toRational (unNatural x)

instance Enum Natural where
toEnum x =
if x < 0
then error "OpenTheory.Primitive.Natural.toEnum"
else Natural (toEnum x)

instance Integral Natural where
divMod x y =
if y == 0
then error "OpenTheory.Primitive.Natural.divMod"
else
let (d,m) = divMod (unNatural x) (unNatural y)
in (Natural d, Natural m)

quotRem x y =
if y == 0
then error "OpenTheory.Primitive.Natural.quotRem"
else
let (q,r) = quotRem (unNatural x) (unNatural y)
in (Natural q, Natural r)

toInteger = unNatural

\p -> Maybe.mapMaybe f . readsPrec p
where
f (n,s) = if n < 0 then Nothing else Just (Natural n, s)

instance Data.Bits.Bits Natural where
x .&. y = Natural (unNatural x .&. unNatural y)

x .|. y = Natural (unNatural x .|. unNatural y)

xor x y = Natural (xor (unNatural x) (unNatural y))

complement _ = error "OpenTheory.Primitive.Natural.complement"

shift x k = Natural (shift (unNatural x) k)

shiftL x k = Natural (shiftL (unNatural x) k)

shiftR x k = Natural (shiftR (unNatural x) k)

rotate _ _ = error "OpenTheory.Primitive.Natural.rotate"

bitSize _ = error "OpenTheory.Primitive.Natural.bitSize"

isSigned _ = False

testBit x k = testBit (unNatural x) k

bit k = Natural (bit k)

popCount x = popCount (unNatural x)

instance Test.QuickCheck.Arbitrary Natural where
arbitrary = fmap fromRandomInteger Test.QuickCheck.arbitrary
where
fromRandomInteger x =
Natural (if x < 0 then -(x + 1) else x)
```