{- |
Bit manipulation.

Taken from Haskore.

Bit operations work with numbers on the level of ones and zeros.
These functions should be called something like \"pseudo-bit-operations\".
They do not reach into the ones and zeros,
but they do duplicate the effects using regular math.
Note that these bitops, though convenient,
are no more efficient than the high-level arithmetic that does the same thing.
(This is different than in other languages such as C.)
-}

module Sound.MIDI.Bit where

import Data.Maybe.HT (toMaybe, )
import Data.Tuple.HT (swap, )
import Data.Word  (Word8, )
import qualified Data.List as List
import qualified Data.Bits as Bits

{- |
Shift bitwise to the left and right.
-}

shiftL, shiftR :: Bits.Bits a => Int -> a -> a
shiftL :: forall a. Bits a => Int -> a -> a
shiftL = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
Bits.shiftL
shiftR :: forall a. Bits a => Int -> a -> a
shiftR = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
Bits.shiftR

{- |
The call @toBase n x@ takes a given number x and "chops it up,"
returning its digits in base b.  Its output is in the form of a
big-endian list of ints.  divMod is used because it gives the correct
rounding for negative numbers.  Ex. toBytes 1000 -> toBase 256 1000 ->
(256*3) + 232 -> [ 3 , 232 ]
-}

toBase :: Integral a => a -> a -> [a]
toBase :: forall a. Integral a => a -> a -> [a]
toBase a
b =
   forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (\a
n -> forall a. Bool -> a -> Maybe a
toMaybe (a
nforall a. Ord a => a -> a -> Bool
>a
0) (forall a b. (a, b) -> (b, a)
swap (forall a. Integral a => a -> a -> (a, a)
divMod a
n a
b)))

toBits, toOctal, toHex, toBytes :: Integral a => a -> [a]
toBytes :: forall a. Integral a => a -> [a]
toBytes = forall a. Integral a => a -> a -> [a]
toBase a
256
toHex :: forall a. Integral a => a -> [a]
toHex   = forall a. Integral a => a -> a -> [a]
toBase a
16
toOctal :: forall a. Integral a => a -> [a]
toOctal = forall a. Integral a => a -> a -> [a]
toBase a
8
toBits :: forall a. Integral a => a -> [a]
toBits  = forall a. Integral a => a -> a -> [a]
toBase a
2

{- |
Get only n of the least significant bytes of x.  If it takes less than
n digits to express x, then fill the extra digits with zeros.
-}

someBytes :: Integral a => Int -> a -> [Word8]
someBytes :: forall a. Integral a => Int -> a -> [Word8]
someBytes Int
n =
   forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod (a
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
8::Int)))

{- |
The fromBase function converts a list of digits in another base into a
single base-10 number.

fromBase b [x,y,z] = x*b^2 + y*b^1 + z*b^0
-}

fromBase :: Integral a => a -> [a] -> a
fromBase :: forall a. Integral a => a -> [a] -> a
fromBase a
base [a]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
a a
x -> a
baseforall a. Num a => a -> a -> a
*a
aforall a. Num a => a -> a -> a
+a
x) a
0 [a]
xs

fromBits, fromOctal, fromHex, fromBytes :: Integral a => [a] -> a
fromBytes :: forall a. Integral a => [a] -> a
fromBytes = forall a. Integral a => a -> [a] -> a
fromBase a
256
fromHex :: forall a. Integral a => [a] -> a
fromHex   = forall a. Integral a => a -> [a] -> a
fromBase a
16
fromOctal :: forall a. Integral a => [a] -> a
fromOctal = forall a. Integral a => a -> [a] -> a
fromBase a
8
fromBits :: forall a. Integral a => [a] -> a
fromBits  = forall a. Integral a => a -> [a] -> a
fromBase a
2


{- |
Like 'replicate' but for big numbers.
It chops the list into blocks of tractable sizes (e.g. @maxBound::Int@).
-}
replicateBig :: Integer -> Integer -> a -> [a]
replicateBig :: forall a. Integer -> Integer -> a -> [a]
replicateBig Integer
base Integer
x a
c =
   let loopSizes :: [Int]
loopSizes = forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => Integer -> a
fromInteger (forall a. Integral a => a -> a -> [a]
toBase Integer
base Integer
x)
       b :: Int
b = forall a. Num a => Integer -> a
fromInteger Integer
base
   in  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[a]
cs Int
n -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> a -> [a]
replicate Int
b [a]
cs) forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
n a
c) [] [Int]
loopSizes



{- |
@trunc b n@ takes the b least significant bits of n.
-}

trunc :: Integral a => Int -> a -> a
trunc :: forall a. Integral a => Int -> a -> a
trunc Int
b a
n = a
n forall a. Integral a => a -> a -> a
`mod` (a
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
b)

{- |
@splitAt b n@ splits a number into a tuple: (before bit b, after bit b).
-}

splitAt :: Integral a => Int -> a -> (a, a)
splitAt :: forall a. Integral a => Int -> a -> (a, a)
splitAt Int
b a
n = a
n forall a. Integral a => a -> a -> (a, a)
`divMod` (a
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
b)