{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Data.Word.Crc32 (

	C, fromWord, toWord, step, initial, complement

	) where

import Control.Arrow
import Data.Bits hiding (complement)
import Data.Bits qualified as Bits
import Data.Bits.ToolsYj
import Data.Array
import Data.Bool
import Data.Word

newtype C = C { C -> Word32
unC :: Word32 } deriving (Int -> C -> ShowS
[C] -> ShowS
C -> String
(Int -> C -> ShowS) -> (C -> String) -> ([C] -> ShowS) -> Show C
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> C -> ShowS
showsPrec :: Int -> C -> ShowS
$cshow :: C -> String
show :: C -> String
$cshowList :: [C] -> ShowS
showList :: [C] -> ShowS
Show, C -> C -> Bool
(C -> C -> Bool) -> (C -> C -> Bool) -> Eq C
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: C -> C -> Bool
== :: C -> C -> Bool
$c/= :: C -> C -> Bool
/= :: C -> C -> Bool
Eq)

fromWord :: Word32 -> C
fromWord :: Word32 -> C
fromWord = Word32 -> C
C

toWord :: C -> Word32
toWord :: C -> Word32
toWord = C -> Word32
unC

crc1 :: Word32 -> Word32
crc1 :: Word32 -> Word32
crc1 = (Bool -> Word32 -> Word32) -> (Bool, Word32) -> Word32
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word32 -> Word32)
-> (Word32 -> Word32) -> Bool -> Word32 -> Word32
forall a. a -> a -> Bool -> a
bool Word32 -> Word32
forall a. a -> a
id (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
0xedb88320)) ((Bool, Word32) -> Word32)
-> (Word32 -> (Bool, Word32)) -> Word32 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> (Bool, Word32)
forall b. Bits b => b -> (Bool, b)
popBit

crc8 :: Word8 -> Word32
crc8 :: Word8 -> Word32
crc8 Word8
n = (Word32 -> Word32) -> Word32 -> [Word32]
forall a. (a -> a) -> a -> [a]
iterate Word32 -> Word32
crc1 (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) [Word32] -> Int -> Word32
forall a. HasCallStack => [a] -> Int -> a
!! Int
8

table :: Array Word8 Word32
table :: Array Word8 Word32
table = (Word8, Word8) -> [Word32] -> Array Word8 Word32
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Word8
0, Word8
255) ([Word32] -> Array Word8 Word32) -> [Word32] -> Array Word8 Word32
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word32) -> [Word8] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word32
crc8 [Word8
0 .. Word8
255]

popByte :: (Integral a, Bits a) => a -> (Word8, a)
popByte :: forall a. (Integral a, Bits a) => a -> (Word8, a)
popByte a
n = (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n, a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)

step :: C -> Word8 -> C
step :: C -> Word8 -> C
step (C Word32
n) Word8
b = Word32 -> C
C (Word32 -> C)
-> ((Word8, Word32) -> Word32) -> (Word8, Word32) -> C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32) -> (Word32, Word32) -> Word32
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
xor ((Word32, Word32) -> Word32)
-> ((Word8, Word32) -> (Word32, Word32))
-> (Word8, Word32)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word8 -> Word32) -> (Word8, Word32) -> (Word32, Word32)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Word8 -> Word32) -> (Word8, Word32) -> (Word32, Word32))
-> (Word8 -> Word32) -> (Word8, Word32) -> (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ (Array Word8 Word32
table Array Word8 Word32 -> Word8 -> Word32
forall i e. Ix i => Array i e -> i -> e
!) (Word8 -> Word32) -> (Word8 -> Word8) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
b)) ((Word8, Word32) -> C) -> (Word8, Word32) -> C
forall a b. (a -> b) -> a -> b
$ Word32 -> (Word8, Word32)
forall a. (Integral a, Bits a) => a -> (Word8, a)
popByte Word32
n

initial :: C
initial :: C
initial = Word32 -> C
C Word32
0xffffffff

complement :: C -> C
complement :: C -> C
complement = Word32 -> C
C (Word32 -> C) -> (C -> Word32) -> C -> C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
forall a. Bits a => a -> a
Bits.complement (Word32 -> Word32) -> (C -> Word32) -> C -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C -> Word32
unC