module Data.Falsify.Integer (
    -- * Encoding
    Bit(..)
  , encIntegerEliasG
  ) where

import Data.Bits
import Numeric.Natural

{-------------------------------------------------------------------------------
  Binary encoding
-------------------------------------------------------------------------------}

data Bit = I | O
  deriving (Int -> Bit -> ShowS
[Bit] -> ShowS
Bit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bit] -> ShowS
$cshowList :: [Bit] -> ShowS
show :: Bit -> String
$cshow :: Bit -> String
showsPrec :: Int -> Bit -> ShowS
$cshowsPrec :: Int -> Bit -> ShowS
Show, Bit -> Bit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bit -> Bit -> Bool
$c/= :: Bit -> Bit -> Bool
== :: Bit -> Bit -> Bool
$c== :: Bit -> Bit -> Bool
Eq, Eq Bit
Bit -> Bit -> Bool
Bit -> Bit -> Ordering
Bit -> Bit -> Bit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bit -> Bit -> Bit
$cmin :: Bit -> Bit -> Bit
max :: Bit -> Bit -> Bit
$cmax :: Bit -> Bit -> Bit
>= :: Bit -> Bit -> Bool
$c>= :: Bit -> Bit -> Bool
> :: Bit -> Bit -> Bool
$c> :: Bit -> Bit -> Bool
<= :: Bit -> Bit -> Bool
$c<= :: Bit -> Bit -> Bool
< :: Bit -> Bit -> Bool
$c< :: Bit -> Bit -> Bool
compare :: Bit -> Bit -> Ordering
$ccompare :: Bit -> Bit -> Ordering
Ord)

-- | Binary encoding (most significant bit first)
natToBits :: Natural -> [Bit]
natToBits :: Natural -> [Bit]
natToBits = \Natural
n -> if
  | Natural
n forall a. Ord a => a -> a -> Bool
< Natural
0     -> forall a. HasCallStack => String -> a
error String
"toBits: negative input"
  | Natural
n forall a. Eq a => a -> a -> Bool
== Natural
0    -> []
  | Bool
otherwise -> forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Natural -> [Bit]
go Natural
n
  where
    go :: Natural -> [Bit]
    go :: Natural -> [Bit]
go Natural
0 = []
    go Natural
n = (if forall a. Bits a => a -> Int -> Bool
testBit Natural
n Int
0 then Bit
I else Bit
O) forall a. a -> [a] -> [a]
: Natural -> [Bit]
go (forall a. Bits a => a -> Int -> a
shiftR Natural
n Int
1)

{-------------------------------------------------------------------------------
  Elias γ code
-------------------------------------------------------------------------------}

-- | Elias γ code
--
-- Precondition: input @x >= 1@.
--
-- See <https://en.wikipedia.org/wiki/Elias_gamma_coding> .
encEliasG :: Natural -> [Bit]
encEliasG :: Natural -> [Bit]
encEliasG Natural
x
  | Natural
x forall a. Eq a => a -> a -> Bool
== Natural
0    = forall a. HasCallStack => String -> a
error String
"eliasG: zero"
  | Bool
otherwise = Natural -> [Bit]
zeroes Natural
x
  where
    zeroes :: Natural -> [Bit]
    zeroes :: Natural -> [Bit]
zeroes Natural
n
      | Natural
n forall a. Ord a => a -> a -> Bool
<= Natural
1    = Natural -> [Bit]
natToBits Natural
x
      | Bool
otherwise = Bit
O forall a. a -> [a] -> [a]
: Natural -> [Bit]
zeroes (forall a. Bits a => a -> Int -> a
shiftR Natural
n Int
1)

-- | Extension of Elias γ coding to signed integers
--
-- This is adapted from @integerVariant@ in @Test.QuickCheck.Random@. The first
-- bit encs whether @x >= 1@ or not (this will result in @0@ and @1@ having
-- short codes).
encIntegerEliasG :: Integer -> [Bit]
encIntegerEliasG :: Integer -> [Bit]
encIntegerEliasG = \Integer
x ->
    if Integer
x forall a. Ord a => a -> a -> Bool
>= Integer
1
      then Bit
O forall a. a -> [a] -> [a]
: Natural -> [Bit]
encEliasG (forall a. Num a => Integer -> a
fromInteger          forall a b. (a -> b) -> a -> b
$ Integer
x)
      else Bit
I forall a. a -> [a] -> [a]
: Natural -> [Bit]
encEliasG (forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
mangle forall a b. (a -> b) -> a -> b
$ Integer
x)
  where
    mangle :: Integer -> Integer
    mangle :: Integer -> Integer
mangle Integer
x = Integer
1 forall a. Num a => a -> a -> a
- Integer
x