diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for circe +## 1.0.0.0 -- 8-16-26 + +* Split internal and external API +* Update tests + ## 0.2.0.0 -- 8-14-26 * CRC8 and CRC64 support diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ ``` crc (8|16|32|64) --help # crc options echo -n "hello world" | crc 16 # stream stdin -crc 32 100gb.bin # stream file +crc 32 10gb.bin # stream file ``` Development diff --git a/circe.cabal b/circe.cabal --- a/circe.cabal +++ b/circe.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: circe -version: 0.2.0.0 +version: 1.0.0.0 synopsis: CRC description: Cyclic redundancy check CRC8 CRC16 CRC32 CRC64 homepage: https://github.com/dopamane/circe @@ -24,8 +24,7 @@ hs-source-dirs: lib exposed-modules: Codec.Circe, - Codec.Circe.Pretty, - Codec.Circe.Reflect + Codec.Circe.Internal build-depends: base < 5, bytestring, @@ -50,10 +49,8 @@ hs-source-dirs: test type: exitcode-stdio-1.0 main-is: Main.hs - other-modules: Test.Circe build-depends: base, circe, tasty, - tasty-hunit, - vector + tasty-hunit diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,7 +1,8 @@ module Main (main) where import Codec.Circe -import Codec.Circe.Pretty +import Codec.Circe.Internal +import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BS import Data.Version import Data.Word @@ -16,17 +17,17 @@ CRC16Table p -> putStrLn $ table $ w16 <$> crc16Table p CRC32Table p -> putStrLn $ table $ w32 <$> crc32Table p CRC64Table p -> putStrLn $ table $ w64 <$> crc64Table p - CRC8 cfg (Just f) -> putStrLn . w8 . crc8 cfg =<< BS.readFile f - CRC8 cfg Nothing -> putStrLn . w8 . crc8 cfg =<< BS.getContents - CRC16 cfg (Just f) -> putStrLn . w16 . crc16 cfg =<< BS.readFile f - CRC16 cfg Nothing -> putStrLn . w16 . crc16 cfg =<< BS.getContents - CRC32 cfg (Just f) -> putStrLn . w32 . crc32 cfg =<< BS.readFile f - CRC32 cfg Nothing -> putStrLn . w32 . crc32 cfg =<< BS.getContents - CRC64 cfg (Just f) -> putStrLn . w64 . crc64 cfg =<< BS.readFile f - CRC64 cfg Nothing -> putStrLn . w64 . crc64 cfg =<< BS.getContents + CRC8 cfg fM -> stream fM $ w8 . crc8 cfg + CRC16 cfg fM -> stream fM $ w16 . crc16 cfg + CRC32 cfg fM -> stream fM $ w32 . crc32 cfg + CRC64 cfg fM -> stream fM $ w64 . crc64 cfg +stream :: Maybe String -> (ByteString -> String) -> IO () +stream Nothing f = putStrLn . f =<< BS.getContents +stream (Just file) f = putStrLn . f =<< BS.readFile file + data CirceCLI - = CRC8 CRC8Cfg (Maybe String) + = CRC8 CRC8Cfg (Maybe String) | CRC16 CRC16Cfg (Maybe String) | CRC32 CRC32Cfg (Maybe String) | CRC64 CRC64Cfg (Maybe String) @@ -53,30 +54,11 @@ , command "32" $ info crc32Parser $ progDesc "CRC32" , command "64" $ info crc64Parser $ progDesc "CRC64" ] - -crc8Parser :: Parser CirceCLI -crc8Parser = asum - [ CRC8 <$> crc8CfgParser <*> optional fileArg - , CRC8Table <$> tableOpt 8 - ] - -crc16Parser :: Parser CirceCLI -crc16Parser = asum - [ CRC16 <$> crc16CfgParser <*> optional fileArg - , CRC16Table <$> tableOpt 16 - ] - -crc32Parser :: Parser CirceCLI -crc32Parser = asum - [ CRC32 <$> crc32CfgParser <*> optional fileArg - , CRC32Table <$> tableOpt 32 - ] - -crc64Parser :: Parser CirceCLI -crc64Parser = asum - [ CRC64 <$> crc64CfgParser <*> optional fileArg - , CRC64Table <$> tableOpt 64 - ] + where + crc8Parser = liftA2 CRC8 crc8CfgParser (optional fileArg) <|> CRC8Table `fmap` tableOpt 8 + crc16Parser = liftA2 CRC16 crc16CfgParser (optional fileArg) <|> CRC16Table `fmap` tableOpt 16 + crc32Parser = liftA2 CRC32 crc32CfgParser (optional fileArg) <|> CRC32Table `fmap` tableOpt 32 + crc64Parser = liftA2 CRC64 crc64CfgParser (optional fileArg) <|> CRC64Table `fmap` tableOpt 64 tableOpt :: (Num a, Read a) => Int -> Parser a tableOpt n = option auto $ mconcat @@ -156,17 +138,10 @@ CRCCfg <$> option auto (short 'p' <> long "poly" <> help "polynomial") <*> option auto (short 'i' <> long "init" <> help "initial value") - <*> refinSwitch - <*> refoutSwitch + <*> switch (long "ri" <> long "refin" <> help "reflect input") + <*> switch (long "ro" <> long "refout" <> help "reflect output") <*> option auto (short 'x' <> long "xor" <> help "final xor") -refinSwitch :: Parser Bool -refinSwitch = switch $ long "ri" <> long "refin" <> help "reflect input" - -refoutSwitch :: Parser Bool -refoutSwitch = switch $ long "ro" <> long "refout" <> help "reflect output" - fileArg :: Parser String -fileArg = strArgument $ - metavar "FILE" <> completer (bashCompleter "file") - <> help "Optional binary input file otherwise stream STDIN." +fileArg = strArgument $ metavar "FILE" <> completer (bashCompleter "file") + <> help "Optional binary input file otherwise stream STDIN." diff --git a/lib/Codec/Circe.hs b/lib/Codec/Circe.hs --- a/lib/Codec/Circe.hs +++ b/lib/Codec/Circe.hs @@ -21,34 +21,27 @@ crc64, crc64WithTable, crc64Table , CRC64Cfg, showCRC64Cfg , crc64ECMA182, crc64GoISO, crc64WE, crc64XZ - , -- ** CRCCfg + , -- ** Config CRCCfg(..) - , -- ** Unsafe - crc, crcWithTable, crcUnsafe, crcTable ) where -import Codec.Circe.Pretty -import Codec.Circe.Reflect -import Data.Bits +import Codec.Circe.Internal import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString.Lazy as BS import Data.Vector.Storable (Vector) -import qualified Data.Vector.Storable as V -import Data.Function import Data.Word -- | calculate CRC8 using lookup table generated from config crc8 :: CRC8Cfg -> ByteString -> Word8 -crc8 = crc ref8 +crc8 = crcInternal ref8 -- | calculate CRC16 using lookup table generated from config crc16 :: CRC16Cfg -> ByteString -> Word16 -crc16 = crc ref16 +crc16 = crcInternal ref16 -- | calculate CRC32 using lookup table generated from config crc32 :: CRC32Cfg -> ByteString -> Word32 -crc32 = crc ref32 +crc32 = crcInternal ref32 -- | calculate CRC64 using lookup table generated from config crc64 :: CRC64Cfg -> ByteString -> Word64 -crc64 = crc ref64 +crc64 = crcInternal ref64 -- | calculate CRC8 with precalculated poly table crc8WithTable :: Vector Word8 -> CRC8Cfg -> ByteString -> Word8 @@ -75,69 +68,6 @@ -- | generate CRC64 lookup table using polynomial crc64Table :: Word64 -> [Word64] crc64Table = crcTable - --- | calculate CRC using lookup table generated from config -crc :: (FiniteBits a, Integral a, Num a, V.Storable a) => (a -> a) -> CRCCfg a -> ByteString -> a -crc ref cfg = crcWithTable ref t cfg - where - t = V.fromList $ crcTable $ crcPoly cfg - --- | calculate CRC with reflection & precalculated poly table. -crcWithTable - :: (FiniteBits a, Integral a, Num a, V.Storable a) - => (a -> a) - -> Vector a -> CRCCfg a -> ByteString -> a -crcWithTable ref t cfg = - xor (crcFinXor cfg) . applyWhen (crcRefOut cfg) ref . crcUnsafe t (crcRefIn cfg) (crcInit cfg) - --- | calculate CRC using width, efficient lookup table, input reflection, and init value -crcUnsafe :: (FiniteBits a, Integral a, Num a, V.Storable a) => Vector a -> Bool -> a -> ByteString -> a -crcUnsafe t refIn i = BS.foldl' go i - where - go crc' b = crc' `shiftL` 8 `xor` t `V.unsafeIndex` fromIntegral pos - where - pos = fromIntegral ((crc' `xor` fromIntegral b' `shiftL` w') `shiftR` w') :: Word8 - where - b' = applyWhen refIn ref8 b - w' = finiteBitSize i - 8 - --- | Generate CRC table using width and poly -crcTable :: (FiniteBits a, Enum a, Num a) => a -> [a] -crcTable poly = calc <$> [0..255] - where - l = fromIntegral (finiteBitSize poly) :: Int - calc = (!! 8) . iterate step . (`shiftL` (l - 8)) - where - step curByte = applyWhen (testBit curByte $ l - 1) (`xor` poly) $ curByte `shiftL` 1 - --- | CRC configuration parameters -data CRCCfg a = CRCCfg - { crcPoly :: a - -- ^ polynomial - , crcInit :: a - -- ^ initial value - , crcRefIn :: Bool - -- ^ reflect input - , crcRefOut :: Bool - -- ^ reflect output - , crcFinXor :: a - -- ^ final xor - } - deriving (Eq, Read, Show) - -instance Functor CRCCfg where - fmap f (CRCCfg p i ri ro x) = CRCCfg (f p) (f i) ri ro (f x) - -showCRCCfg :: CRCCfg String -> String -showCRCCfg (CRCCfg p i ri ro x) = unwords ["POLY", p, "INIT", i, showRefl (ri, ro), "XOR", x] - --- | display reflection config -showRefl :: (Bool, Bool) -> String -showRefl (ri, ro) = case (ri, ro) of - (False, False) -> "NOREFL" - (False, True) -> "REFLOUT" - (True, False) -> "REFLIN" - (True, True) -> "REFLINOUT" -- | specialized CRC for 'Word8' type CRC8Cfg = CRCCfg Word8 diff --git a/lib/Codec/Circe/Internal.hs b/lib/Codec/Circe/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/Codec/Circe/Internal.hs @@ -0,0 +1,203 @@ +-- | Internal CRC functions. See "Codec.Circe" for the stable API. +module Codec.Circe.Internal + ( -- ** CRC + CRCCfg(..), showCRCCfg + , crcInternal, crcWithTable, crcUnsafe, crcStep, crcIdx, crcTable + , -- ** Prettyprinting + w8, w16, w32, w64, table + , -- ** Reflection + ref64, ref32, ref16, ref8 + ) where + +import Data.Bits +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BS +import Data.Vector.Storable (Vector) +import qualified Data.Vector.Storable as V +import Data.Function +import Data.Word +import Numeric + +-- | CRC configuration parameters +data CRCCfg a = CRCCfg + { crcPoly :: a + -- ^ polynomial + , crcInit :: a + -- ^ initial value + , crcRefIn :: Bool + -- ^ reflect input + , crcRefOut :: Bool + -- ^ reflect output + , crcFinXor :: a + -- ^ final xor + } + deriving (Eq, Read, Show) + +instance Functor CRCCfg where + fmap f (CRCCfg p i ri ro x) = CRCCfg (f p) (f i) ri ro (f x) + +-- | pretty cfg +showCRCCfg :: CRCCfg String -> String +showCRCCfg (CRCCfg p i ri ro x) = unwords ["POLY", p, "INIT", i, showRefl (ri, ro), "XOR", x] + +-- | display reflection config +showRefl :: (Bool, Bool) -> String +showRefl (ri, ro) = case (ri, ro) of + (False, False) -> "NOREFL" + (False, True) -> "REFLOUT" + (True, False) -> "REFLIN" + (True, True) -> "REFLINOUT" + +-- | calculate CRC using lookup table generated from config +crcInternal :: (FiniteBits a, Integral a, Num a, V.Storable a) => (a -> a) -> CRCCfg a -> ByteString -> a +crcInternal ref cfg = crcWithTable ref t cfg + where + t = V.fromList $ crcTable $ crcPoly cfg + +-- | calculate CRC with reflection & precalculated poly table. +crcWithTable + :: (FiniteBits a, Integral a, Num a, V.Storable a) + => (a -> a) -> Vector a -> CRCCfg a -> ByteString -> a +crcWithTable ref t cfg = + xor (crcFinXor cfg) . applyWhen (crcRefOut cfg) ref . crcUnsafe t (crcRefIn cfg) (crcInit cfg) + +-- | calculate CRC using width, efficient lookup table, input reflection, and init value +crcUnsafe :: (FiniteBits a, Integral a, Num a, V.Storable a) => Vector a -> Bool -> a -> ByteString -> a +crcUnsafe t refIn = BS.foldl' $ \crc -> crcStep t crc . applyWhen refIn ref8 + +-- | single crc iteration with table and accumulator +crcStep :: (FiniteBits a, Integral a, Num a, V.Storable a) => Vector a -> a -> Word8 -> a +crcStep t crc b = crc `shiftL` 8 `xor` t `V.unsafeIndex` crcIdx crc b + +-- | calculate lookup table index +crcIdx :: (FiniteBits a, Integral a, Num a) => a -> Word8 -> Int +crcIdx crc b' = fromIntegral ((crc `xor` fromIntegral b' `shiftL` w') `shiftR` w') + where + w' = finiteBitSize crc - 8 + +-- | Generate CRC table using width and poly +crcTable :: (FiniteBits a, Enum a, Num a) => a -> [a] +crcTable poly = calc <$> [0..255] + where + l = fromIntegral (finiteBitSize poly) :: Int + calc = (!! 8) . iterate step . (`shiftL` (l - 8)) + where + step curByte = applyWhen (testBit curByte $ l - 1) (xor poly) $ curByte `shiftL` 1 + +-- | @0x0a@ +w8 :: Word8 -> String +w8 w = "0x" ++ w8' w + +-- | pretty word8 without 0x prefix +w8' :: Word8 -> String +w8' w = showHex (w `shiftR` 4) "" ++ showHex (w .&. 0xF) "" + +-- | @0x01ab@ +w16 :: Word16 -> String +w16 w = "0x" ++ w16' w + +-- | pretty word16 without 0x prefix +w16' :: Word16 -> String +w16' w = w8' h ++ w8' l + where + h = fromIntegral $ w `shiftR` 8 + l = fromIntegral w + +-- | @0x0123abcd@ +w32 :: Word32 -> String +w32 w = "0x" ++ w32' w + +-- | pretty word32 without 0x prefix +w32' :: Word32 -> String +w32' w = w16' h ++ w16' l + where + h = fromIntegral $ w `shiftR` 16 + l = fromIntegral w + +-- | @0x01234567abcdefff@ +w64 :: Word64 -> String +w64 w = "0x" ++ w32' h ++ w32' l + where + h = fromIntegral $ w `shiftR` 32 + l = fromIntegral w + +-- | prettyprint 8 cols across +table :: [String] -> String +table = unlines . map unwords . chunks 8 + +-- | chunk a list +chunks :: Int -> [a] -> [[a]] +chunks _ [] = [] +chunks n xs = ys : chunks n zs + where + (ys, zs) = splitAt n xs + +-- | Reflect 'Word64' +ref64 :: Word64 -> Word64 +ref64 = s1 . s2 . s4 . s8 . s16 . s32 + where + s1 n = ((n .&. 0xAAAAAAAAAAAAAAAA) `shiftR` 1) .|. ((n .&. 0x5555555555555555) `shiftL` 1) + s2 n = ((n .&. 0xCCCCCCCCCCCCCCCC) `shiftR` 2) .|. ((n .&. 0x3333333333333333) `shiftL` 2) + s4 n = ((n .&. 0xF0F0F0F0F0F0F0F0) `shiftR` 4) .|. ((n .&. 0x0F0F0F0F0F0F0F0F) `shiftL` 4) + s8 n = ((n .&. 0xFF00FF00FF00FF00) `shiftR` 8) .|. ((n .&. 0x00FF00FF00FF00FF) `shiftL` 8) + s16 n = ((n .&. 0xFFFF0000FFFF0000) `shiftR` 16) .|. ((n .&. 0x0000FFFF0000FFFF) `shiftL` 16) + s32 n = (n `shiftR` 32) .|. (n `shiftL` 32) + +-- | Reflect 'Word32' +ref32 :: Word32 -> Word32 +ref32 = s1 . s2 . s4 . s8 . s16 + where + s1 n = ((n .&. 0xAAAAAAAA) `shiftR` 1) .|. ((n .&. 0x55555555) `shiftL` 1) + s2 n = ((n .&. 0xCCCCCCCC) `shiftR` 2) .|. ((n .&. 0x33333333) `shiftL` 2) + s4 n = ((n .&. 0xF0F0F0F0) `shiftR` 4) .|. ((n .&. 0x0F0F0F0F) `shiftL` 4) + s8 n = ((n .&. 0xFF00FF00) `shiftR` 8) .|. ((n .&. 0x00FF00FF) `shiftL` 8) + s16 n = (n `shiftR` 16) .|. (n `shiftL` 16) + +-- | Reflect 'Word16' +ref16 :: Word16 -> Word16 +ref16 = s1 . s2 . s4 . s8 + where + s1 n = ((n .&. 0xAAAA) `shiftR` 1) .|. ((n .&. 0x5555) `shiftL` 1) + s2 n = ((n .&. 0xCCCC) `shiftR` 2) .|. ((n .&. 0x3333) `shiftL` 2) + s4 n = ((n .&. 0xF0F0) `shiftR` 4) .|. ((n .&. 0x0F0F) `shiftL` 4) + s8 n = (n `shiftR` 8) .|. (n `shiftL` 8) + +-- | Reflect 'Word8' +ref8 :: Word8 -> Word8 +ref8 = V.unsafeIndex ref8Table . fromIntegral + +ref8Table :: Vector Word8 +ref8Table = V.fromList + [ 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0 + , 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 + , 0x08, 0x88, 0x48, 0xc8, 0x28, 0xa8, 0x68, 0xe8 + , 0x18, 0x98, 0x58, 0xd8, 0x38, 0xb8, 0x78, 0xf8 + , 0x04, 0x84, 0x44, 0xc4, 0x24, 0xa4, 0x64, 0xe4 + , 0x14, 0x94, 0x54, 0xd4, 0x34, 0xb4, 0x74, 0xf4 + , 0x0c, 0x8c, 0x4c, 0xcc, 0x2c, 0xac, 0x6c, 0xec + , 0x1c, 0x9c, 0x5c, 0xdc, 0x3c, 0xbc, 0x7c, 0xfc + , 0x02, 0x82, 0x42, 0xc2, 0x22, 0xa2, 0x62, 0xe2 + , 0x12, 0x92, 0x52, 0xd2, 0x32, 0xb2, 0x72, 0xf2 + , 0x0a, 0x8a, 0x4a, 0xca, 0x2a, 0xaa, 0x6a, 0xea + , 0x1a, 0x9a, 0x5a, 0xda, 0x3a, 0xba, 0x7a, 0xfa + , 0x06, 0x86, 0x46, 0xc6, 0x26, 0xa6, 0x66, 0xe6 + , 0x16, 0x96, 0x56, 0xd6, 0x36, 0xb6, 0x76, 0xf6 + , 0x0e, 0x8e, 0x4e, 0xce, 0x2e, 0xae, 0x6e, 0xee + , 0x1e, 0x9e, 0x5e, 0xde, 0x3e, 0xbe, 0x7e, 0xfe + , 0x01, 0x81, 0x41, 0xc1, 0x21, 0xa1, 0x61, 0xe1 + , 0x11, 0x91, 0x51, 0xd1, 0x31, 0xb1, 0x71, 0xf1 + , 0x09, 0x89, 0x49, 0xc9, 0x29, 0xa9, 0x69, 0xe9 + , 0x19, 0x99, 0x59, 0xd9, 0x39, 0xb9, 0x79, 0xf9 + , 0x05, 0x85, 0x45, 0xc5, 0x25, 0xa5, 0x65, 0xe5 + , 0x15, 0x95, 0x55, 0xd5, 0x35, 0xb5, 0x75, 0xf5 + , 0x0d, 0x8d, 0x4d, 0xcd, 0x2d, 0xad, 0x6d, 0xed + , 0x1d, 0x9d, 0x5d, 0xdd, 0x3d, 0xbd, 0x7d, 0xfd + , 0x03, 0x83, 0x43, 0xc3, 0x23, 0xa3, 0x63, 0xe3 + , 0x13, 0x93, 0x53, 0xd3, 0x33, 0xb3, 0x73, 0xf3 + , 0x0b, 0x8b, 0x4b, 0xcb, 0x2b, 0xab, 0x6b, 0xeb + , 0x1b, 0x9b, 0x5b, 0xdb, 0x3b, 0xbb, 0x7b, 0xfb + , 0x07, 0x87, 0x47, 0xc7, 0x27, 0xa7, 0x67, 0xe7 + , 0x17, 0x97, 0x57, 0xd7, 0x37, 0xb7, 0x77, 0xf7 + , 0x0f, 0x8f, 0x4f, 0xcf, 0x2f, 0xaf, 0x6f, 0xef + , 0x1f, 0x9f, 0x5f, 0xdf, 0x3f, 0xbf, 0x7f, 0xff + ] diff --git a/lib/Codec/Circe/Pretty.hs b/lib/Codec/Circe/Pretty.hs deleted file mode 100644 --- a/lib/Codec/Circe/Pretty.hs +++ /dev/null @@ -1,60 +0,0 @@ --- | prettyprinting utilities -module Codec.Circe.Pretty - ( w8 - , w16 - , w32 - , w64 - , table - ) where - -import Data.Bits -import Data.Word -import Numeric - --- | @0x0a@ -w8 :: Word8 -> String -w8 w = "0x" ++ w8' w - --- | pretty word8 without 0x prefix -w8' :: Word8 -> String -w8' w = showHex (w `shiftR` 4) "" ++ showHex (w .&. 0xF) "" - --- | @0x01ab@ -w16 :: Word16 -> String -w16 w = "0x" ++ w16' w - --- | pretty word16 without 0x prefix -w16' :: Word16 -> String -w16' w = w8' h ++ w8' l - where - h = fromIntegral $ w `shiftR` 8 - l = fromIntegral w - --- | @0x0123abcd@ -w32 :: Word32 -> String -w32 w = "0x" ++ w32' w - --- | pretty word32 without 0x prefix -w32' :: Word32 -> String -w32' w = w16' h ++ w16' l - where - h = fromIntegral $ w `shiftR` 16 - l = fromIntegral w - --- | @0x01234567abcdefff@ -w64 :: Word64 -> String -w64 w = "0x" ++ w32' h ++ w32' l - where - h = fromIntegral $ w `shiftR` 32 - l = fromIntegral w - --- | prettyprint 8 cols across -table :: [String] -> String -table = unlines . map unwords . chunks 8 - --- | chunk a list -chunks :: Int -> [a] -> [[a]] -chunks _ [] = [] -chunks n xs = ys : chunks n zs - where - (ys, zs) = splitAt n xs diff --git a/lib/Codec/Circe/Reflect.hs b/lib/Codec/Circe/Reflect.hs deleted file mode 100644 --- a/lib/Codec/Circe/Reflect.hs +++ /dev/null @@ -1,77 +0,0 @@ --- | Reflect bits -module Codec.Circe.Reflect (ref64, ref32, ref16, ref8) where - -import Data.Bits -import Data.Vector.Storable (Vector) -import qualified Data.Vector.Storable as V -import Data.Word - --- | Reflect 'Word64' -ref64 :: Word64 -> Word64 -ref64 = s1 . s2 . s4 . s8 . s16 . s32 - where - s1 n = ((n .&. 0xAAAAAAAAAAAAAAAA) `shiftR` 1) .|. ((n .&. 0x5555555555555555) `shiftL` 1) - s2 n = ((n .&. 0xCCCCCCCCCCCCCCCC) `shiftR` 2) .|. ((n .&. 0x3333333333333333) `shiftL` 2) - s4 n = ((n .&. 0xF0F0F0F0F0F0F0F0) `shiftR` 4) .|. ((n .&. 0x0F0F0F0F0F0F0F0F) `shiftL` 4) - s8 n = ((n .&. 0xFF00FF00FF00FF00) `shiftR` 8) .|. ((n .&. 0x00FF00FF00FF00FF) `shiftL` 8) - s16 n = ((n .&. 0xFFFF0000FFFF0000) `shiftR` 16) .|. ((n .&. 0x0000FFFF0000FFFF) `shiftL` 16) - s32 n = (n `shiftR` 32) .|. (n `shiftL` 32) - --- | Reflect 'Word32' -ref32 :: Word32 -> Word32 -ref32 = s1 . s2 . s4 . s8 . s16 - where - s1 n = ((n .&. 0xAAAAAAAA) `shiftR` 1) .|. ((n .&. 0x55555555) `shiftL` 1) - s2 n = ((n .&. 0xCCCCCCCC) `shiftR` 2) .|. ((n .&. 0x33333333) `shiftL` 2) - s4 n = ((n .&. 0xF0F0F0F0) `shiftR` 4) .|. ((n .&. 0x0F0F0F0F) `shiftL` 4) - s8 n = ((n .&. 0xFF00FF00) `shiftR` 8) .|. ((n .&. 0x00FF00FF) `shiftL` 8) - s16 n = (n `shiftR` 16) .|. (n `shiftL` 16) - --- | Reflect 'Word16' -ref16 :: Word16 -> Word16 -ref16 = s1 . s2 . s4 . s8 - where - s1 n = ((n .&. 0xAAAA) `shiftR` 1) .|. ((n .&. 0x5555) `shiftL` 1) - s2 n = ((n .&. 0xCCCC) `shiftR` 2) .|. ((n .&. 0x3333) `shiftL` 2) - s4 n = ((n .&. 0xF0F0) `shiftR` 4) .|. ((n .&. 0x0F0F) `shiftL` 4) - s8 n = (n `shiftR` 8) .|. (n `shiftL` 8) - --- | Reflect 'Word8' -ref8 :: Word8 -> Word8 -ref8 = V.unsafeIndex ref8Table . fromIntegral - -ref8Table :: Vector Word8 -ref8Table = V.fromList - [ 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0 - , 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 - , 0x08, 0x88, 0x48, 0xc8, 0x28, 0xa8, 0x68, 0xe8 - , 0x18, 0x98, 0x58, 0xd8, 0x38, 0xb8, 0x78, 0xf8 - , 0x04, 0x84, 0x44, 0xc4, 0x24, 0xa4, 0x64, 0xe4 - , 0x14, 0x94, 0x54, 0xd4, 0x34, 0xb4, 0x74, 0xf4 - , 0x0c, 0x8c, 0x4c, 0xcc, 0x2c, 0xac, 0x6c, 0xec - , 0x1c, 0x9c, 0x5c, 0xdc, 0x3c, 0xbc, 0x7c, 0xfc - , 0x02, 0x82, 0x42, 0xc2, 0x22, 0xa2, 0x62, 0xe2 - , 0x12, 0x92, 0x52, 0xd2, 0x32, 0xb2, 0x72, 0xf2 - , 0x0a, 0x8a, 0x4a, 0xca, 0x2a, 0xaa, 0x6a, 0xea - , 0x1a, 0x9a, 0x5a, 0xda, 0x3a, 0xba, 0x7a, 0xfa - , 0x06, 0x86, 0x46, 0xc6, 0x26, 0xa6, 0x66, 0xe6 - , 0x16, 0x96, 0x56, 0xd6, 0x36, 0xb6, 0x76, 0xf6 - , 0x0e, 0x8e, 0x4e, 0xce, 0x2e, 0xae, 0x6e, 0xee - , 0x1e, 0x9e, 0x5e, 0xde, 0x3e, 0xbe, 0x7e, 0xfe - , 0x01, 0x81, 0x41, 0xc1, 0x21, 0xa1, 0x61, 0xe1 - , 0x11, 0x91, 0x51, 0xd1, 0x31, 0xb1, 0x71, 0xf1 - , 0x09, 0x89, 0x49, 0xc9, 0x29, 0xa9, 0x69, 0xe9 - , 0x19, 0x99, 0x59, 0xd9, 0x39, 0xb9, 0x79, 0xf9 - , 0x05, 0x85, 0x45, 0xc5, 0x25, 0xa5, 0x65, 0xe5 - , 0x15, 0x95, 0x55, 0xd5, 0x35, 0xb5, 0x75, 0xf5 - , 0x0d, 0x8d, 0x4d, 0xcd, 0x2d, 0xad, 0x6d, 0xed - , 0x1d, 0x9d, 0x5d, 0xdd, 0x3d, 0xbd, 0x7d, 0xfd - , 0x03, 0x83, 0x43, 0xc3, 0x23, 0xa3, 0x63, 0xe3 - , 0x13, 0x93, 0x53, 0xd3, 0x33, 0xb3, 0x73, 0xf3 - , 0x0b, 0x8b, 0x4b, 0xcb, 0x2b, 0xab, 0x6b, 0xeb - , 0x1b, 0x9b, 0x5b, 0xdb, 0x3b, 0xbb, 0x7b, 0xfb - , 0x07, 0x87, 0x47, 0xc7, 0x27, 0xa7, 0x67, 0xe7 - , 0x17, 0x97, 0x57, 0xd7, 0x37, 0xb7, 0x77, 0xf7 - , 0x0f, 0x8f, 0x4f, 0xcf, 0x2f, 0xaf, 0x6f, 0xef - , 0x1f, 0x9f, 0x5f, 0xdf, 0x3f, 0xbf, 0x7f, 0xff - ] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,6 +1,78 @@ +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Test.Circe +import Codec.Circe +import Codec.Circe.Internal +import Test.Tasty +import Test.Tasty.HUnit main :: IO () -main = testCirce +main = defaultMain $ testGroup "Test.Circe" + [crc8Test, crc16Test, crc32Test, crc64Test, prettyTest, reflectTest] + +crc8Test :: TestTree +crc8Test = testCaseSteps "crc8" $ \step -> do + step "crc8" + crc8 crc8Cfg "alpha and omega" @?= 0x6f + crc8 crc8Cfg "black and yellow" @?= 0x67 + crc8 crc8Cfg "w2wgaBRJWx0aU0j9V0bUZqLLNtYGIJ" @?= 0x42 + step "crc88H2F" + crc8 crc88H2F "yamborghini high" @?= 0x02 + step "crc8CDMA2k" + crc8 crc8CDMA2k "asdfgh" @?= 0x79 + step "crc8DARC" + crc8 crc8DARC "i am god" @?= 0x5a + step "crc8ITU" + crc8 crc8ITU "OMG itz GODZILLA!" @?= 0xf9 + step "crc8WCDMA" + crc8 crc8WCDMA "city of angels" @?= 0x5d + +crc16Test :: TestTree +crc16Test = testCaseSteps "crc16" $ \step -> do + step "ccitt-zero" + crc16 crc16CCITZero "bosscoxwuzhere" @?= 0xbe42 + crc16 crc16CCITZero "LRwI5WKpTxoS23UKsibhwN0qy55rj3" @?= 0x53ef + step "modbus" + crc16 crc16Modbus "hello world" @?= 0xddc7 + step "X25" + crc16 crc16X25 "city of angels" @?= 0x5386 + +crc32Test :: TestTree +crc32Test = testCase "crc32" $ do + crc32 (CRCCfg 0x4c11db7 0 False False 0) "hello world" @?= 0x737af2ae + crc32 crc32IEEE "bo$$ cox rulez" @?= 0x75ce60a3 + crc32 crc32IEEE "hello world" @?= 0x0d4a1185 + crc32 crc32IEEE "YOLO DOLO" @?= 0xa13ee2ed + crc32 crc32IEEE "A3FCx@Tgv(fS1yaGE=QG%T&:ffG2!q" @?= 0xeef35f36 + +crc64Test :: TestTree +crc64Test = testCaseSteps "crc64" $ \step -> do + step "ECMA182" + crc64 crc64ECMA182 "fast cars" @?= 0x5c991e3b22f9bd5f + crc64 crc64ECMA182 "f.Mc.4B}fu:[e#+_beaqP!wF}[/avf" @?= 0xb102fcf42a9b6f57 + step "XZ" + crc64 crc64XZ "goodbye" @?= 0x8F627A49FD449B48 + +prettyTest :: TestTree +prettyTest = testCase "pretty" $ do + w8 0x00 @?= "0x00" + w8 0x1f @?= "0x1f" + w16 0x01a9 @?= "0x01a9" + w32 0xbeefdead @?= "0xbeefdead" + w64 0xdead1334cafeface @?= "0xdead1334cafeface" + +reflectTest :: TestTree +reflectTest = testCaseSteps "reflect" $ \step -> do + step "ref8" + ref8 0b1011_1110 @?= 0b0111_1101 + ref8 0b1111_0000 @?= 0b0000_1111 + step "ref16" + ref16 0b1010_1111_0000_0011 @?= 0b1100_0000_1111_0101 + ref16 0b1111_0110_0101_1100 @?= 0b0011_1010_0110_1111 + step "ref32" + ref32 0b1110_0111_0000_0000_1111_1111_1010_1010 + @?= 0b0101_0101_1111_1111_0000_0000_1110_0111 + ref32 0b1000_0010_0111_1000_0001_0101_1111_0000 + @?= 0b0000_1111_1010_1000_0001_1110_0100_0001 diff --git a/test/Test/Circe.hs b/test/Test/Circe.hs deleted file mode 100644 --- a/test/Test/Circe.hs +++ /dev/null @@ -1,99 +0,0 @@ -{-# LANGUAGE BinaryLiterals #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE OverloadedStrings #-} -module Test.Circe (testCirce) where - -import Codec.Circe -import Codec.Circe.Reflect -import qualified Data.Vector.Storable as V -import Test.Tasty -import Test.Tasty.HUnit - -testCirce :: IO () -testCirce = defaultMain tests - -tests :: TestTree -tests = testGroup "Test.Circe" - [ testGroup "CRC8" - [ crc8Test - ] - , testGroup "CRC16" - [ crc16UnsafeTest - , crc16Test - ] - , testGroup "CRC32" - [ crc32UnsafeTest - , crc32Test - ] - , testGroup "CRC64" - [ crc64Test - ] - , testGroup "Reflect" - [ ref8Test - , ref16Test - , ref32Test - ] - ] - -crc8Test :: TestTree -crc8Test = testCaseSteps "crc8" $ \step -> do - step "crc8" - crc8 crc8Cfg "alpha and omega" @?= 0x6f - crc8 crc8Cfg "black and yellow" @?= 0x67 - step "crc88H2F" - crc8 crc88H2F "yamborghini high" @?= 0x02 - step "crc8CDMA2k" - crc8 crc8CDMA2k "asdfgh" @?= 0x79 - step "crc8DARC" - crc8 crc8DARC "i am god" @?= 0x5a - step "crc8ITU" - crc8 crc8ITU "OMG itz GODZILLA!" @?= 0xf9 - step "crc8WCDMA" - crc8 crc8WCDMA "city of angels" @?= 0x5d - -crc16UnsafeTest :: TestTree -crc16UnsafeTest = testCase "crc16Unsafe" $ - crcUnsafe (V.fromList t) False 0 "bosscoxwuzhere" @?= 0xbe42 - where - t = crc16Table 0x1021 - -crc16Test :: TestTree -crc16Test = testCaseSteps "crc16" $ \step -> do - step "modbus" - crc16 crc16Modbus "hello world" @?= 0xddc7 - step "X25" - crc16 crc16X25 "city of angels" @?= 0x5386 - -crc32UnsafeTest :: TestTree -crc32UnsafeTest = testCase "crc32Unsafe" $ - crcUnsafe (V.fromList t) False 0 "hello world" @?= 0x737af2ae - where - t = crc32Table 0x4c11db7 - -crc32Test :: TestTree -crc32Test = testCase "crc32" $ do - crc32 crc32IEEE "bo$$ cox rulez" @?= 0x75ce60a3 - crc32 crc32IEEE "hello world" @?= 0x0d4a1185 - crc32 crc32IEEE "YOLO DOLO" @?= 0xa13ee2ed - -crc64Test :: TestTree -crc64Test = testCaseSteps "crc64" $ \step -> do - step "ECMA182" - crc64 crc64ECMA182 "fast cars" @?= 0x5c991e3b22f9bd5f - step "XZ" - crc64 crc64XZ "goodbye" @?= 0x8F627A49FD449B48 - -ref8Test :: TestTree -ref8Test = testCase "ref8" $ - ref8 0b1011_1110 - @?= 0b0111_1101 - -ref16Test :: TestTree -ref16Test = testCase "ref16" $ - ref16 0b1010_1111_0000_0011 - @?= 0b1100_0000_1111_0101 - -ref32Test :: TestTree -ref32Test = testCase "ref32" $ - ref32 0b1110_0111_0000_0000_1111_1111_1010_1010 - @?= 0b0101_0101_1111_1111_0000_0000_1110_0111