diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,13 @@ +# ChangeLog / ReleaseNotes + + +## Version 0.1.0.0 + +* First public release. +* Uploaded to [Hackage][]: + + + +[Hackage]: + http://hackage.haskell.org/ + "HackageDB (or just Hackage) is a collection of releases of Haskell packages." diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015-2016, Peter Trško + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Peter Trško nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,49 @@ +# Number Length + +[![Hackage](http://img.shields.io/hackage/v/number-length.svg)][Hackage: number-length] +[![Hackage Dependencies](https://img.shields.io/hackage-deps/v/number-length.svg)](http://packdeps.haskellers.com/reverse/number-length) +[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] +[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3] + +[![Build](https://travis-ci.org/trskop/number-length.svg)](https://travis-ci.org/trskop/number-length) + + +## Description + +Number length in decimal and hexadecimal representation. + +There are situations when it is necessary to know the length of a number in +decimal or hexadecimal form. In example when allocating buffer while +serializing a number in to binary or human readable format. + + +## Building Options + +* `-fpedantic` (disabled by default) + + Pass additional warning flags to GHC. + + +## License + +The BSD 3-Clause License, see [LICENSE][] file for details. + + +## Contributions + +Contributions, pull requests and bug reports are welcome! Please don't be +afraid to contact author using GitHub or by e-mail. + + +[Hackage: number-length]: + http://hackage.haskell.org/package/number-length + "number-length package on Hackage" +[Haskell.org]: + http://www.haskell.org + "The Haskell Programming Language" +[LICENSE]: + https://github.com/trskop/number-length/blob/master/LICENSE + "License of number-length package." +[tl;dr Legal: BSD3]: + https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29 + "BSD 3-Clause License (Revised)" diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/number-length.cabal b/number-length.cabal new file mode 100644 --- /dev/null +++ b/number-length.cabal @@ -0,0 +1,144 @@ +name: number-length +version: 0.1.0.0 +synopsis: + Number of digits in a number in decimal and hexadecimal representation. +description: + There are situations when it is necessary to know the length of a number in + decimal or hexadecimal form. In example when allocating buffer while + serializing a number in to binary or human readable format. + +homepage: https://github.com/trskop/number-length +license: BSD3 +license-file: LICENSE +author: Peter Trško +maintainer: peter.trsko@gmail.com +copyright: (c) 2015-2016, Peter Trško +category: Data +build-type: Simple +cabal-version: >=1.10 + +extra-source-files: ChangeLog.md, README.md + +flag pedantic + description: Pass additional warning flags to GHC. + default: False + manual: True + +flag old-base + description: Supplement Data.Proxy, which is available since + base >=4.7, using tagged package. + default: False + manual: False + +library + hs-source-dirs: src + exposed-modules: + Data.NumberLength + , Data.NumberLength.Int + , Data.NumberLength.Internal + , Data.NumberLength.Word + -- other-modules: + + default-language: Haskell2010 + other-extensions: NoImplicitPrelude + + if flag(old-base) + build-depends: + base >=4.5 && <4.7 + , tagged >=0.6 && <0.9 + else + build-depends: + base >=4.7 && <5 + + ghc-options: -Wall -fwarn-tabs + + if flag(pedantic) + ghc-options: + -fwarn-implicit-prelude + -fwarn-missing-import-lists +-- -Werror + +test-suite unit-tests + hs-source-dirs: src, test + type: exitcode-stdio-1.0 + main-is: unit-tests.hs + other-modules: + TestCase + , TestCase.Data.NumberLength + , TestCase.Data.NumberLength.Int + , TestCase.Data.NumberLength.Word + + default-language: Haskell2010 + other-extensions: DefaultSignatures, NoImplicitPrelude + + build-depends: + -- {{{ Test-suite dependencies -------------------------------------------- + HUnit >=1.2 && <2 + -- ^ Same constraints as test-framework-hunit + , QuickCheck >=2.6 && <2.9 + -- ^ Same constraints as test-framework-quickcheck2==0.3.0.3. + , test-framework >=0.8 && <1 + -- ^ Same constraint as test-framework-skip, other packages that + -- depend on it have less restrictive bounds. + , test-framework-hunit >=0.2.6 && <1 + -- ^ Lower versions have more restrictive bounds on test-framework. + , test-framework-quickcheck2 >=0.3 + -- ^ There were changes in QuickCheck bounds in 0.2 branch and last one + -- on it had a compilation failure on Hackage. + -- }}} Test-suite dependencies -------------------------------------------- + + if flag(old-base) + build-depends: + base >=4.5 && <4.7 + , tagged >=0.6 && <0.9 + else + build-depends: + base >=4.7 && <5 + + ghc-options: -Wall -fwarn-tabs + + if flag(pedantic) + ghc-options: + -fwarn-implicit-prelude + -fwarn-missing-import-lists +-- -Werror + +benchmark benchmark + hs-source-dirs: src, test + type: exitcode-stdio-1.0 + main-is: benchmark.hs +--other-modules: + + default-language: Haskell2010 + other-extensions: NoImplicitPrelude + + -- {{{ Dependencies of the library ------------------------------------------ + if flag(old-base) + build-depends: + base >=4.5 && <4.7 + , tagged >=0.6 && <0.9 + else + build-depends: + base >=4.7 && <5 + -- }}} Dependencies of the library ------------------------------------------ + + build-depends: + criterion >= 1.0.0.0 && < 2 + , number-length + + ghc-options: -Wall -fwarn-tabs + + if flag(pedantic) + ghc-options: + -fwarn-implicit-prelude + -fwarn-missing-import-lists +-- -Werror + +source-repository head + type: git + location: git://github.com/trskop/number-length.git + +source-repository this + type: git + location: git://github.com/trskop/number-length.git + tag: v0.1.0.0 diff --git a/src/Data/NumberLength.hs b/src/Data/NumberLength.hs new file mode 100644 --- /dev/null +++ b/src/Data/NumberLength.hs @@ -0,0 +1,242 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: $HEADER$ +-- Description: Polymorphic interface for getting number of digits of a number +-- in decimal or hexadecimal representation. +-- Copyright: (c) 2015-2016, Peter Trško +-- License: BSD3 +-- +-- Stability: experimental +-- Portability: DefaultSignatures, NoImplicitPrelude +-- +-- Polymorphic interface for getting number of digits of a number in decimal or +-- hexadecimal representation. +module Data.NumberLength + ( + NumberLength(..) + , SignedNumberLength(..) + , BoundedNumberLength(..) + ) + where + +import Prelude(Num((+)), fromIntegral) + +import Data.Int (Int, Int16, Int32, Int64, Int8) +import Data.Ord (Ord((<))) +import Data.Proxy (Proxy) +import Data.Word (Word, Word16, Word32, Word64, Word8) + +import Data.NumberLength.Int + ( lengthInt + , lengthInt16 + , lengthInt16hex + , lengthInt32 + , lengthInt32hex + , lengthInt64 + , lengthInt64hex + , lengthInt8 + , lengthInt8hex + , lengthIntHex + ) +import Data.NumberLength.Internal (either32or64) +import Data.NumberLength.Word + ( lengthWord + , lengthWord16 + , lengthWord16hex + , lengthWord32 + , lengthWord32hex + , lengthWord64 + , lengthWord64hex + , lengthWord8 + , lengthWord8hex + , lengthWordHex + ) + + +-- | Get number of digits of a number in base 10 and base 16. Note the +-- following: +-- +-- * There is no 'Num' constraint, so that type wrappers aren't forced to +-- provide instance for it. This is because there are things represented +-- using numbers, but they aren't numbers, e.g. telephone numbers. +-- +-- * This type class doesn't handle signed numbers, in an intuitive way. See +-- also 'SignedNumberLength'. +-- +-- * There is a special class for bounded numbers, see 'BoundedNumberLength', +-- that provides similar functionality as 'Prelude.Bounded', but for number +-- of digits in a number. +class NumberLength a where + -- | Get number of digits in base 10 for specified number. Note that if + -- number is signed, then this function will return length of its absolute + -- value. + -- + -- >>> numberLength (123 :: Int) + -- 3 + -- >>> numberLength (-123 :: Int) + -- 3 + -- + -- See also 'signedNumberLength'. + numberLength :: a -> Int + + -- | Get number of digits in base 16 for specified number. Note that if + -- number is signed, then this function will return length of its absolute + -- value. + -- + -- >>> numberLengthHex (123 :: Int) -- 123 = 7b in hex + -- 2 + -- >>> numberLengthHex (-123 :: Int) + -- 2 + -- + -- See also 'signedNumberLengthHex'. + numberLengthHex :: a -> Int + +-- | Get number of digits of a signed number in base 10 and base 16. +class NumberLength a => SignedNumberLength a where + {-# MINIMAL signedNumberLengthHex #-} + + -- | Get number of digits in base 10 for specified number. + -- + -- >>> signedNumberLength (123 :: Int) + -- 3 + -- >>> signedNumberLength (-123 :: Int) + -- 4 + -- + -- Default implementation provided if @a@ has also 'Num' and 'Ord' + -- instances: + -- + -- @ + -- 'signedNumberLength' n = signLength + 'numberLength' n + -- where + -- signLength = if n < 0 then 1 else 0 + -- @ + signedNumberLength :: a -> Int + + default signedNumberLength :: (Num a, Ord a) => a -> Int + signedNumberLength n = signLength + numberLength n + where + signLength = if n < 0 then 1 else 0 + + -- | Get number of digits in base 16 for specified number. + -- + -- >>> signedNumberLengthHex (123 :: Int) + -- 2 + -- >>> signedNumberLengthHex (-123 :: Int) + -- 16 + -- + -- Negative number is shown as ones' complement, e.g. @(-123 :: Int) = + -- ffffffffffffff85@ on 64 bit platform. + signedNumberLengthHex :: a -> Int + +-- | Get maximum number of digits of a number in base 10 and 16. Minimal number +-- of digits is considered to be always 1, and therefore there is no method for +-- it. +class NumberLength a => BoundedNumberLength a where + -- | Get maximum number of digits of a number in base 10. + maxNumberLength :: Proxy a -> Int + + -- | Get maximum number of digits of a number in base 16. + maxNumberLengthHex :: Proxy a -> Int + +-- {{{ Int* ------------------------------------------------------------------- + +instance NumberLength Int where + numberLength = lengthInt + numberLengthHex = lengthIntHex + +instance SignedNumberLength Int where + signedNumberLengthHex n = numberLengthHex (fromIntegral n :: Word) + +instance BoundedNumberLength Int where + maxNumberLength _ = 10 `either32or64` 19 + maxNumberLengthHex _ = 8 `either32or64` 16 + +instance NumberLength Int64 where + numberLength = lengthInt64 + numberLengthHex = lengthInt64hex + +instance SignedNumberLength Int64 where + signedNumberLengthHex n = numberLengthHex (fromIntegral n :: Word64) + +instance BoundedNumberLength Int64 where + maxNumberLength _ = 19 + maxNumberLengthHex _ = 16 + +instance NumberLength Int32 where + numberLength = lengthInt32 + numberLengthHex = lengthInt32hex + +instance SignedNumberLength Int32 where + signedNumberLengthHex n = numberLengthHex (fromIntegral n :: Word32) + +instance BoundedNumberLength Int32 where + maxNumberLength _ = 10 + maxNumberLengthHex _ = 8 + +instance NumberLength Int16 where + numberLength = lengthInt16 + numberLengthHex = lengthInt16hex + +instance SignedNumberLength Int16 where + signedNumberLengthHex n = numberLengthHex (fromIntegral n :: Word16) + +instance BoundedNumberLength Int16 where + maxNumberLength _ = 5 + maxNumberLengthHex _ = 4 + +instance NumberLength Int8 where + numberLength = lengthInt8 + numberLengthHex = lengthInt8hex + +instance SignedNumberLength Int8 where + signedNumberLengthHex n = numberLengthHex (fromIntegral n :: Word8) + +instance BoundedNumberLength Int8 where + maxNumberLength _ = 3 + maxNumberLengthHex _ = 2 + +-- }}} Int* ------------------------------------------------------------------- +-- {{{ Word* ------------------------------------------------------------------ + +instance NumberLength Word where + numberLength = lengthWord + numberLengthHex = lengthWordHex + +instance BoundedNumberLength Word where + maxNumberLength _ = 10 `either32or64` 20 + maxNumberLengthHex _ = 8 `either32or64` 16 + +instance NumberLength Word64 where + numberLength = lengthWord64 + numberLengthHex = lengthWord64hex + +instance BoundedNumberLength Word64 where + maxNumberLength _ = 20 + maxNumberLengthHex _ = 16 + +instance NumberLength Word32 where + numberLength = lengthWord32 + numberLengthHex = lengthWord32hex + +instance BoundedNumberLength Word32 where + maxNumberLength _ = 10 + maxNumberLengthHex _ = 8 + +instance NumberLength Word16 where + numberLength = lengthWord16 + numberLengthHex = lengthWord16hex + +instance BoundedNumberLength Word16 where + maxNumberLength _ = 5 + maxNumberLengthHex _ = 4 + +instance NumberLength Word8 where + numberLength = lengthWord8 + numberLengthHex = lengthWord8hex + +instance BoundedNumberLength Word8 where + maxNumberLength _ = 3 + maxNumberLengthHex _ = 2 + +-- }}} Word* ------------------------------------------------------------------ diff --git a/src/Data/NumberLength/Int.hs b/src/Data/NumberLength/Int.hs new file mode 100644 --- /dev/null +++ b/src/Data/NumberLength/Int.hs @@ -0,0 +1,252 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: $HEADER$ +-- Description: Get number of digits of a number from a Int-family of numbers +-- in decimal or hexadecimal representation. +-- Copyright: (c) 2015-2016, Peter Trško +-- License: BSD3 +-- +-- Stability: experimental +-- Portability: NoImplicitPrelude +-- +-- Get number of digits of a number from a 'Int'-family of numbers in decimal +-- or hexadecimal representation. +module Data.NumberLength.Int + ( + -- * Decimal + lengthInt + , lengthInt8 + , lengthInt16 + , lengthInt32 + , lengthInt64 + + -- * Hexadecimal + , lengthIntHex + , lengthInt8hex + , lengthInt16hex + , lengthInt32hex + , lengthInt64hex + ) + where + +import Prelude + ( Bounded(minBound) + , Integral(quot) + , Num((+), negate) + , fromIntegral + ) + +import Data.Bool ((&&), otherwise) +import Data.Eq (Eq((==))) +import Data.Int (Int, Int16, Int32, Int64, Int8) +import Data.Ord (Ord((<), (>), (>=))) + +import Data.NumberLength.Internal (either32or64) + + +-- {{{ Decimal ---------------------------------------------------------------- + +lengthInt8 :: Int8 -> Int +lengthInt8 n + | n < 0 = go (negate (fromIntegral n)) + | otherwise = go (fromIntegral n) + where + go :: Int -> Int + go m + -- Maximum is 127 for positive and 128 for negative integer. + | m < 10 = 1 + | m < 100 = 2 + | otherwise = 3 +{-# INLINE lengthInt8 #-} + +lengthInt16 :: Int16 -> Int +lengthInt16 n + | n < 0 = go (negate (fromIntegral n)) + | otherwise = go (fromIntegral n) + where + -- Maximum is 32767 for positive and 32768 for negative integer. + go :: Int -> Int + go m + | m < 10 = 1 + | m < 100 = 2 + | m < 1000 = 3 + | m < 10000 = 4 + | otherwise = 5 +{-# INLINE lengthInt16 #-} + +lengthInt32 :: Int32 -> Int +lengthInt32 n + | n == minBound = 10 -- "negate minBound" is out of range of Int32. + | n < 0 = go (negate (fromIntegral n)) + | otherwise = go (fromIntegral n) + where + -- Maximum is 2147483647 for positive and 2147483648 for negative integer. + go :: Int -> Int + go m + | m < 10 = 1 + | m < 100 = 2 + | m < 1000 = 3 + | m < 10000 = 4 + | m >= 100000000 = 8 + go (m `quot` 100000000) + | otherwise = 4 + go (m `quot` 10000) + -- m >= 10000 +{-# INLINE lengthInt32 #-} + +lengthInt64 :: Int64 -> Int +lengthInt64 n + | n == minBound = 19 -- "negate minBound" is out of range of Int64 + | n < 0 = go (negate n) + | otherwise = go n + where + -- Maximum is 9223372036854775807 for positive and 9223372036854775808 + -- for negative integer. + go m + | m < 10 = 1 + | m < 100 = 2 + | m < 1000 = 3 + | m < 10000 = 4 + | m >= 10000000000000000 = 16 + go (m `quot` 10000000000000000) + | m >= 100000000 = 8 + go (m `quot` 100000000) + | otherwise = 4 + go (m `quot` 10000) + -- m >= 10000 +{-# INLINE lengthInt64 #-} + +lengthInt :: Int -> Int +lengthInt n = l32 `either32or64` l64 + where + -- Same code as lengthInt64: + l64 + | n == minBound = 19 -- "negate minBound" is out of range of Int64 + | n < 0 = go (negate n) + | otherwise = go n + where + -- Maximum is 9223372036854775807 for positive and 9223372036854775808 + -- for negative integer. + go m + | m < 10 = 1 + | m < 100 = 2 + | m < 1000 = 3 + | m < 10000 = 4 + | m >= 10000000000000000 = 16 + go (m `quot` 10000000000000000) + | m >= 100000000 = 8 + go (m `quot` 100000000) + | otherwise = 4 + go (m `quot` 10000) + -- m >= 10000 + + -- Same code as lengthInt32: + l32 + | n == minBound = 10 -- "negate minBound" is out of range of Int32. + | n < 0 = go (negate n) + | otherwise = go n + where + -- Maximum is 2147483647 for positive and 2147483648 for negative integer. + go m + | m < 10 = 1 + | m < 100 = 2 + | m < 1000 = 3 + | m < 10000 = 4 + | m >= 100000000 = 8 + go (m `quot` 100000000) + | otherwise = 4 + go (m `quot` 10000) + -- m >= 10000 +{-# INLINE lengthInt #-} + +-- }}} Decimal ---------------------------------------------------------------- + +-- {{{ Hexadecimal ------------------------------------------------------------ + +lengthInt8hex :: Int8 -> Int +lengthInt8hex n + | n < 16 && n > -16 = 1 + | otherwise = 2 + -- Maximum is 127 = 0x7f for positive and 128 = 0x80 for negative integer. +{-# INLINE lengthInt8hex #-} + +lengthInt16hex :: Int16 -> Int +lengthInt16hex n + | n < 0 = go (negate (fromIntegral n)) + | otherwise = go (fromIntegral n) + where + -- Maximum is 32767 = 0x7fff for positive and 32768 = 0x8000 for negative + -- integer. + go :: Int -> Int + go m + | m < 0x10 = 1 + | m < 0x100 = 2 + | m < 0x1000 = 3 + | otherwise = 4 +{-# INLINE lengthInt16hex #-} + +lengthInt32hex :: Int32 -> Int +lengthInt32hex n + | n == minBound = 8 -- "negate minBound" is out of range of Int32. + | n < 0 = go (negate (fromIntegral n)) + | otherwise = go (fromIntegral n) + where + -- Maximum is 2147483647 = 0x7fffffff for positive and + -- 2147483648 = 0x80000000 for negative integer. + go :: Int -> Int + go m + | m < 0x10 = 1 + | m < 0x100 = 2 + | m < 0x1000 = 3 + | m < 0x10000 = 4 + | otherwise = 4 + go (m `quot` 0x10000) + -- m >= 0x10000 +{-# INLINE lengthInt32hex #-} + +lengthInt64hex :: Int64 -> Int +lengthInt64hex n + | n == minBound = 16 -- "negate minBound" is out of range of Int64 + | n < 0 = if n == minBound then 16 else go (negate n) + | otherwise = go n + where + -- Maximum is 9223372036854775807 = 0x7fffffffffffffff for positive and + -- 9223372036854775808 = 0x8000000000000000 for negative integer. + go m + | m < 0x10 = 1 + | m < 0x100 = 2 + | m < 0x1000 = 3 + | m < 0x10000 = 4 + | m >= 0x100000000 = 8 + go (m `quot` 0x100000000) + | otherwise = 4 + go (m `quot` 0x10000) + -- m >= 0x10000 +{-# INLINE lengthInt64hex #-} + +lengthIntHex :: Int -> Int +lengthIntHex n = l32hex `either32or64` l64hex + where + -- Same code as lengthInt64hex: + l64hex + | n == minBound = 16 -- "negate minBound" is out of range of Int64 + | n < 0 = if n == minBound then 16 else go (negate n) + | otherwise = go n + where + -- Maximum is 9223372036854775807 = 0x7fffffffffffffff for positive and + -- 9223372036854775808 = 0x8000000000000000 for negative integer. + go m + | m < 0x10 = 1 + | m < 0x100 = 2 + | m < 0x1000 = 3 + | m < 0x10000 = 4 + | m >= 0x100000000 = 8 + go (m `quot` 0x100000000) + | otherwise = 4 + go (m `quot` 0x10000) + -- m >= 0x10000 + + -- Same code as lengthInt32hex: + l32hex + | n == minBound = 8 -- "negate minBound" is out of range of Int32. + | n < 0 = go (negate n) + | otherwise = go n + where + -- Maximum is 2147483647 = 0x7fffffff for positive and + -- 2147483648 = 0x80000000 for negative integer. + go :: Int -> Int + go m + | m < 0x10 = 1 + | m < 0x100 = 2 + | m < 0x1000 = 3 + | m < 0x10000 = 4 + | otherwise = 4 + go (m `quot` 0x10000) + -- m >= 0x10000 +{-# INLINE lengthIntHex #-} + +-- }}} Hexadecimal ------------------------------------------------------------ diff --git a/src/Data/NumberLength/Internal.hs b/src/Data/NumberLength/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/NumberLength/Internal.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: $HEADER$ +-- Description: Internally used utilities. +-- Copyright: (c) 2015, Peter Trško +-- License: BSD3 +-- +-- Stability: unstable +-- Portability: CPP, NoImplicitPrelude +module Data.NumberLength.Internal + where + +import Prelude (error) + +#if MIN_VERSION_base(4,7,0) +import Data.Bits (FiniteBits(finiteBitSize)) +#else +import Data.Bits (Bits(bitSize)) +#endif + +import Data.Function (($)) +import Data.Monoid ((<>)) +import Data.Word (Word) +import Text.Show (Show(show)) + + +-- | Returns one of its arguments, depending on bit size of 'Word' type on +-- current hardware. +either32or64 + :: a + -- ^ Used in case when 'Word' is 32bit long. + -> a + -- ^ Used in case when 'Word' is 64bit long. + -> a +either32or64 on32bit on64bit = case wordSize (0 :: Word) of + 32 -> on32bit + 64 -> on64bit + bs -> error $ "Data.NumberLength.either32or64: " <> show bs + <> ": System uses Word size not supported by this library." + where + wordSize = +#if MIN_VERSION_base(4,7,0) + finiteBitSize +#else + bitSize +#endif +{-# INLINE either32or64 #-} diff --git a/src/Data/NumberLength/Word.hs b/src/Data/NumberLength/Word.hs new file mode 100644 --- /dev/null +++ b/src/Data/NumberLength/Word.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: $HEADER$ +-- Description: Get number of digits of a number from a Word-family of numbers +-- in decimal or hexadecimal representation. +-- Copyright: (c) 2015, Peter Trško +-- License: BSD3 +-- +-- Stability: experimental +-- Portability: NoImplicitPrelude +-- +-- Get number of digits of a number from a 'Word'-family of numbers in decimal +-- or hexadecimal representation. +module Data.NumberLength.Word + ( + -- * Decimal + lengthWord + , lengthWord8 + , lengthWord16 + , lengthWord32 + , lengthWord64 + + -- * Hexadecimal + , lengthWordHex + , lengthWord8hex + , lengthWord16hex + , lengthWord32hex + , lengthWord64hex + ) + where + +import Prelude + ( Integral(quot) + , Num((+)) + , fromIntegral + ) + +import Data.Bool (otherwise) +import Data.Int (Int) +import Data.Ord (Ord((<), (>=))) +import Data.Word (Word, Word16, Word32, Word64, Word8) + +import Data.NumberLength.Internal (either32or64) + + +-- {{{ Decimal ---------------------------------------------------------------- + +lengthWord8 :: Word8 -> Int +lengthWord8 n -- Maximum is 255. + | n < 10 = 1 + | n < 100 = 2 + | otherwise = 3 +{-# INLINE lengthWord8 #-} + +lengthWord16 :: Word16 -> Int +lengthWord16 n -- Maximum is 65535. + | n < 10 = 1 + | n < 100 = 2 + | n < 1000 = 3 + | n < 10000 = 4 + | otherwise = 5 +{-# INLINE lengthWord16 #-} + +lengthWord32 :: Word32 -> Int +lengthWord32 n -- Maximum is 4294967295. + | n < 10 = 1 + | n < 100 = 2 + | n < 1000 = 3 + | n < 10000 = 4 + | n >= 100000000 = 8 + lengthWord32 (n `quot` 100000000) + | otherwise = 4 + lengthWord32 (n `quot` 10000) + -- n >= 10000 +{-# INLINE lengthWord32 #-} + +lengthWord64 :: Word64 -> Int +lengthWord64 n -- Maximum is 18446744073709551615. + | n < 10 = 1 + | n < 100 = 2 + | n < 1000 = 3 + | n < 10000 = 4 + | n >= 10000000000000000 = 16 + lengthWord64 (n `quot` 10000000000000000) + | n >= 100000000 = 8 + lengthWord64 (n `quot` 100000000) + | otherwise = 4 + lengthWord64 (n `quot` 10000) + -- n >= 10000 +{-# INLINE lengthWord64 #-} + +lengthWord :: Word -> Int +lengthWord n = + lengthWord32 (fromIntegral n) `either32or64` lengthWord64 (fromIntegral n) +{-# INLINE lengthWord #-} + +-- }}} Decimal ---------------------------------------------------------------- + +-- {{{ Hexadecimal ------------------------------------------------------------ + +lengthWord8hex :: Word8 -> Int +lengthWord8hex n -- Maximum is 255 = 0xff. + | n < 16 = 1 + | otherwise = 2 +{-# INLINE lengthWord8hex #-} + +lengthWord16hex :: Word16 -> Int +lengthWord16hex n -- Maximum is 65535 = 0xffff. + | n < 0x10 = 1 + | n < 0x100 = 2 + | n < 0x1000 = 3 + | otherwise = 4 +{-# INLINE lengthWord16hex #-} + +lengthWord32hex :: Word32 -> Int +lengthWord32hex n -- Maximum is 4294967295 = 0xffffffff. + | n < 0x10 = 1 + | n < 0x100 = 2 + | n < 0x1000 = 3 + | n < 0x10000 = 4 + | otherwise = 4 + lengthWord32hex (n `quot` 0x10000) + -- n >= 0x10000 +{-# INLINE lengthWord32hex #-} + +lengthWord64hex :: Word64 -> Int +lengthWord64hex n -- Maximum is 18446744073709551615 = 0xffffffffffffffff. + | n < 0x10 = 1 + | n < 0x100 = 2 + | n < 0x1000 = 3 + | n < 0x10000 = 4 + | n >= 0x100000000 = 8 + lengthWord64hex (n `quot` 0x100000000) + | otherwise = 4 + lengthWord64hex (n `quot` 0x10000) + -- n >= 0x10000 +{-# INLINE lengthWord64hex #-} + +lengthWordHex :: Word -> Int +lengthWordHex n = lengthWord32hex (fromIntegral n) + `either32or64` lengthWord64hex (fromIntegral n) +{-# INLINE lengthWordHex #-} + +-- }}} Hexadecimal ------------------------------------------------------------ diff --git a/test/TestCase.hs b/test/TestCase.hs new file mode 100644 --- /dev/null +++ b/test/TestCase.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: $HEADER$ +-- Description: All test cases aggregated and exported as tests :: [Test]. +-- Copyright: (c) 2015, Peter Trško +-- License: BSD3 +-- +-- Stability: stable +-- Portability: NoImplicitPrelude +-- +-- All test cases aggregated and exported as @tests :: ['Test']@. +module TestCase (tests) + where + +import Test.Framework (Test, testGroup) + +import qualified TestCase.Data.NumberLength.Int as NumberLength.Int (tests) +import qualified TestCase.Data.NumberLength as NumberLength (tests) +import qualified TestCase.Data.NumberLength.Word as NumberLength.Word (tests) + + +tests :: [Test] +tests = + [ testGroup "Data.NumberLength.Int" NumberLength.Int.tests + , testGroup "Data.NumberLength.Word" NumberLength.Word.tests + , testGroup "Data.NumberLength" NumberLength.tests + ] diff --git a/test/TestCase/Data/NumberLength.hs b/test/TestCase/Data/NumberLength.hs new file mode 100644 --- /dev/null +++ b/test/TestCase/Data/NumberLength.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: $HEADER$ +-- Description: TODO +-- Copyright: (c) 2015, Peter Trško +-- License: BSD3 +-- +-- Stability: experimental +-- Portability: NoImplicitPrelude +module TestCase.Data.NumberLength + where + +import Prelude (Bounded(maxBound)) + +import Control.Applicative (liftA2) +import Data.Bool (Bool) +import Data.Eq (Eq((==))) +import Data.Function (($)) +import Data.Int (Int, Int16, Int32, Int64, Int8) +import Data.Proxy (Proxy(Proxy)) +import Data.Word (Word, Word16, Word32, Word64, Word8) + +import Test.HUnit ((@?=)) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.Framework.Providers.QuickCheck2 (testProperty) + +import Data.NumberLength + ( NumberLength(numberLength, numberLengthHex) + , BoundedNumberLength(maxNumberLength, maxNumberLengthHex) + ) +import Data.NumberLength.Int + ( lengthInt + , lengthInt16 + , lengthInt16hex + , lengthInt32 + , lengthInt32hex + , lengthInt64 + , lengthInt64hex + , lengthInt8 + , lengthInt8hex + , lengthIntHex + ) +import Data.NumberLength.Word + ( lengthWord + , lengthWord16 + , lengthWord16hex + , lengthWord32 + , lengthWord32hex + , lengthWord64 + , lengthWord64hex + , lengthWord8 + , lengthWord8hex + , lengthWordHex + ) + + +tests :: [Test] +tests = + [ testGroup "class NumberLength" + [ testGroup "numberLengthHex" + [ testProperty "Int" $ numberLength <==> lengthInt + , testProperty "Int8" $ numberLength <==> lengthInt8 + , testProperty "Int16" $ numberLength <==> lengthInt16 + , testProperty "Int32" $ numberLength <==> lengthInt32 + , testProperty "Int64" $ numberLength <==> lengthInt64 + , testProperty "Word" $ numberLength <==> lengthWord + , testProperty "Word8" $ numberLength <==> lengthWord8 + , testProperty "Word16" $ numberLength <==> lengthWord16 + , testProperty "Word32" $ numberLength <==> lengthWord32 + , testProperty "Word64" $ numberLength <==> lengthWord64 + ] + + , testGroup "numberLengthHex" + [ testProperty "Int" $ numberLengthHex <==> lengthIntHex + , testProperty "Int8" $ numberLengthHex <==> lengthInt8hex + , testProperty "Int16" $ numberLengthHex <==> lengthInt16hex + , testProperty "Int32" $ numberLengthHex <==> lengthInt32hex + , testProperty "Int64" $ numberLengthHex <==> lengthInt64hex + , testProperty "Word" $ numberLengthHex <==> lengthWordHex + , testProperty "Word8" $ numberLengthHex <==> lengthWord8hex + , testProperty "Word16" $ numberLengthHex <==> lengthWord16hex + , testProperty "Word32" $ numberLengthHex <==> lengthWord32hex + , testProperty "Word64" $ numberLengthHex <==> lengthWord64hex + ] + ] + + , testGroup "class BoundedNumberLength" + [ testGroup "maxNumberLength" + [ testCase "Int" + $ maxNumberLength int @?= lengthInt maxBound + , testCase "Int8" + $ maxNumberLength int8 @?= lengthInt8 maxBound + , testCase "Int16" + $ maxNumberLength int16 @?= lengthInt16 maxBound + , testCase "Int32" + $ maxNumberLength int32 @?= lengthInt32 maxBound + , testCase "Int64" + $ maxNumberLength int64 @?= lengthInt64 maxBound + , testCase "Word" + $ maxNumberLength word @?= lengthWord maxBound + , testCase "Word8" + $ maxNumberLength word8 @?= lengthWord8 maxBound + , testCase "Word16" + $ maxNumberLength word16 @?= lengthWord16 maxBound + , testCase "Word32" + $ maxNumberLength word32 @?= lengthWord32 maxBound + , testCase "Word64" + $ maxNumberLength word64 @?= lengthWord64 maxBound + ] + + , testGroup "maxNumberLengthHex" + [ testCase "Int" + $ maxNumberLengthHex int @?= lengthIntHex maxBound + , testCase "Int8" + $ maxNumberLengthHex int8 @?= lengthInt8hex maxBound + , testCase "Int16" + $ maxNumberLengthHex int16 @?= lengthInt16hex maxBound + , testCase "Int32" + $ maxNumberLengthHex int32 @?= lengthInt32hex maxBound + , testCase "Int64" + $ maxNumberLengthHex int64 @?= lengthInt64hex maxBound + , testCase "Word" + $ maxNumberLengthHex word @?= lengthWordHex maxBound + , testCase "Word8" + $ maxNumberLengthHex word8 @?= lengthWord8hex maxBound + , testCase "Word16" + $ maxNumberLengthHex word16 @?= lengthWord16hex maxBound + , testCase "Word32" + $ maxNumberLengthHex word32 @?= lengthWord32hex maxBound + , testCase "Word64" + $ maxNumberLengthHex word64 @?= lengthWord64hex maxBound + ] + ] + ] + where + int = Proxy :: Proxy Int + int8 = Proxy :: Proxy Int8 + int16 = Proxy :: Proxy Int16 + int32 = Proxy :: Proxy Int32 + int64 = Proxy :: Proxy Int64 + + word = Proxy :: Proxy Word + word8 = Proxy :: Proxy Word8 + word16 = Proxy :: Proxy Word16 + word32 = Proxy :: Proxy Word32 + word64 = Proxy :: Proxy Word64 + +(<==>) :: Eq b => (a -> b) -> (a -> b) -> a -> Bool +(<==>) = liftA2 (==) diff --git a/test/TestCase/Data/NumberLength/Int.hs b/test/TestCase/Data/NumberLength/Int.hs new file mode 100644 --- /dev/null +++ b/test/TestCase/Data/NumberLength/Int.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: $HEADER$ +-- Description: TODO +-- Copyright: (c) 2015, Peter Trško +-- License: BSD3 +-- +-- Stability: experimental +-- Portability: NoImplicitPrelude +module TestCase.Data.NumberLength.Int + where + +import Prelude + ( Bounded(maxBound, minBound) + , Integral + , Num(negate) + , fromIntegral + ) + +import Control.Applicative (liftA2) +import Data.Bool (Bool, otherwise) +import Data.Eq (Eq((==))) +import Data.Function ((.), ($), id) +import Data.Int (Int, Int16, Int32, Int64, Int8) +import qualified Data.List as List (dropWhile, length) +import Data.Ord (Ord((<))) +import Data.String (String) +import Text.Printf (PrintfArg, printf) +import Text.Show (Show(show)) + +import Test.HUnit (Assertion, (@?=)) +import Test.Framework (Test) +import Test.Framework.Providers.HUnit (testCase) +import Test.Framework.Providers.QuickCheck2 (testProperty) + +import Data.NumberLength.Int + ( lengthInt + , lengthInt16 + , lengthInt16hex + , lengthInt32 + , lengthInt32hex + , lengthInt64 + , lengthInt64hex + , lengthInt8 + , lengthInt8hex + , lengthIntHex + ) + + +tests :: [Test] +tests = + [ testCase "lengthInt8 minBound" test_lengthInt8_minBound + , testCase "lengthInt8 maxBound" test_lengthInt8_maxBound + , testProperty "lengthInt8 = length . show" property_lengthInt8 + + , testCase "lengthInt16 minBound" test_lengthInt16_minBound + , testCase "lengthInt16 maxBound" test_lengthInt16_maxBound + , testProperty "lengthInt16 = length . show" property_lengthInt16 + + , testCase "lengthInt32 minBound" test_lengthInt32_minBound + , testCase "lengthInt32 maxBound" test_lengthInt32_maxBound + , testProperty "lengthInt32 = length . show" property_lengthInt32 + + , testCase "lengthInt64 minBound" test_lengthInt64_minBound + , testCase "lengthInt64 maxBound" test_lengthInt64_maxBound + , testProperty "lengthInt64 = length . show" property_lengthInt64 + + , testCase "lengthInt minBound" test_lengthInt_minBound + , testCase "lengthInt maxBound" test_lengthInt_maxBound + , testProperty "lengthInt = length . show" property_lengthInt + + , testCase "lengthInt8hex minBound" test_lengthInt8hex_minBound + , testCase "lengthInt8hex maxBound" test_lengthInt8hex_maxBound + , testProperty "lengthInt8hex = length . show" property_lengthInt8hex + + , testCase "lengthInt16hex minBound" test_lengthInt16hex_minBound + , testCase "lengthInt16hex maxBound" test_lengthInt16hex_maxBound + , testProperty "lengthInt16hex = length . show" property_lengthInt16hex + + , testCase "lengthInt32hex minBound" test_lengthInt32hex_minBound + , testCase "lengthInt32hex maxBound" test_lengthInt32hex_maxBound + , testProperty "lengthInt32hex = length . show" property_lengthInt32hex + + , testCase "lengthInt64hex minBound" test_lengthInt64hex_minBound + , testCase "lengthInt64hex maxBound" test_lengthInt64hex_maxBound + , testProperty "lengthInt64hex = length . show" property_lengthInt64hex + + , testCase "lengthIntHex minBound" test_lengthIntHex_minBound + , testCase "lengthIntHex maxBound" test_lengthIntHex_maxBound + , testProperty "lengthIntHex = length . show" property_lengthIntHex + ] + +numberLengthDec :: Show n => n -> Int +numberLengthDec = List.length . List.dropWhile (== '-') . show + +numberLengthHex :: (PrintfArg n, Integral n, Ord n) => n -> Int +numberLengthHex n + | n < 0 = numberLengthHex' . negate . int64 $ fromIntegral n + | otherwise = numberLengthHex' n + where + numberLengthHex' :: PrintfArg n => n -> Int + numberLengthHex' m = List.length (printf "%x" m :: String) + + int64 :: Int64 -> Int64 + int64 = id + +(<==>) :: Eq b => (a -> b) -> (a -> b) -> a -> Bool +(<==>) = liftA2 (==) + +-- {{{ Decimal ---------------------------------------------------------------- +-- {{{ lengthInt8 ------------------------------------------------------------- + +test_lengthInt8_minBound, test_lengthInt8_maxBound :: Assertion + +test_lengthInt8_minBound = + lengthInt8 minBound @?= numberLengthDec (minBound :: Int8) + +test_lengthInt8_maxBound = + lengthInt8 maxBound @?= numberLengthDec (maxBound :: Int8) + +property_lengthInt8 :: Int8 -> Bool +property_lengthInt8 = lengthInt8 <==> numberLengthDec + +-- }}} lengthInt8 ------------------------------------------------------------- +-- {{{ lengthInt16 ------------------------------------------------------------ + +test_lengthInt16_minBound, test_lengthInt16_maxBound :: Assertion + +test_lengthInt16_minBound = + lengthInt16 minBound @?= numberLengthDec (minBound :: Int16) + +test_lengthInt16_maxBound = + lengthInt16 maxBound @?= numberLengthDec (maxBound :: Int16) + +property_lengthInt16 :: Int16 -> Bool +property_lengthInt16 = lengthInt16 <==> numberLengthDec + +-- }}} lengthInt16 ------------------------------------------------------------ +-- {{{ lengthInt32 ------------------------------------------------------------ + +test_lengthInt32_minBound, test_lengthInt32_maxBound :: Assertion + +test_lengthInt32_minBound = + lengthInt32 minBound @?= numberLengthDec (minBound :: Int32) + +test_lengthInt32_maxBound = + lengthInt32 maxBound @?= numberLengthDec (maxBound :: Int32) + +property_lengthInt32 :: Int32 -> Bool +property_lengthInt32 = lengthInt32 <==> numberLengthDec + +-- }}} lengthInt32 ------------------------------------------------------------ +-- {{{ lengthInt64 ------------------------------------------------------------ + +test_lengthInt64_minBound, test_lengthInt64_maxBound :: Assertion + +test_lengthInt64_minBound = + lengthInt64 minBound @?= numberLengthDec (minBound :: Int64) + +test_lengthInt64_maxBound = + lengthInt64 maxBound @?= numberLengthDec (maxBound :: Int64) + +property_lengthInt64 :: Int64 -> Bool +property_lengthInt64 = lengthInt64 <==> numberLengthDec + +-- }}} lengthInt64 ------------------------------------------------------------ +-- {{{ lengthInt -------------------------------------------------------------- + +test_lengthInt_minBound, test_lengthInt_maxBound :: Assertion + +test_lengthInt_minBound = + lengthInt minBound @?= numberLengthDec (minBound :: Int) + +test_lengthInt_maxBound = + lengthInt maxBound @?= numberLengthDec (maxBound :: Int) + +property_lengthInt :: Int -> Bool +property_lengthInt = lengthInt <==> numberLengthDec + +-- }}} lengthInt -------------------------------------------------------------- +-- }}} Decimal ---------------------------------------------------------------- + +-- {{{ Hexadecimal ------------------------------------------------------------ +-- {{{ lengthInt8hex ---------------------------------------------------------- + +test_lengthInt8hex_minBound, test_lengthInt8hex_maxBound :: Assertion + +test_lengthInt8hex_minBound = + lengthInt8hex minBound @?= numberLengthHex (minBound :: Int8) + +test_lengthInt8hex_maxBound = + lengthInt8hex maxBound @?= numberLengthHex (maxBound :: Int8) + +property_lengthInt8hex :: Int8 -> Bool +property_lengthInt8hex = lengthInt8hex <==> numberLengthHex + +-- }}} lengthInt8hex ---------------------------------------------------------- +-- {{{ lengthInt16hex --------------------------------------------------------- + +test_lengthInt16hex_minBound, test_lengthInt16hex_maxBound :: Assertion + +test_lengthInt16hex_minBound = + lengthInt16hex minBound @?= numberLengthHex (minBound :: Int16) + +test_lengthInt16hex_maxBound = + lengthInt16hex maxBound @?= numberLengthHex (maxBound :: Int16) + +property_lengthInt16hex :: Int16 -> Bool +property_lengthInt16hex = lengthInt16hex <==> numberLengthHex + +-- }}} lengthInt16hex --------------------------------------------------------- +-- {{{ lengthInt32hex --------------------------------------------------------- + +test_lengthInt32hex_minBound, test_lengthInt32hex_maxBound :: Assertion + +test_lengthInt32hex_minBound = + lengthInt32hex minBound @?= numberLengthHex (minBound :: Int32) + +test_lengthInt32hex_maxBound = + lengthInt32hex maxBound @?= numberLengthHex (maxBound :: Int32) + +property_lengthInt32hex :: Int32 -> Bool +property_lengthInt32hex = lengthInt32hex <==> numberLengthHex + +-- }}} lengthInt32hex --------------------------------------------------------- +-- {{{ lengthInt64hex --------------------------------------------------------- + +test_lengthInt64hex_minBound, test_lengthInt64hex_maxBound :: Assertion + +test_lengthInt64hex_minBound = + lengthInt64hex minBound @?= 16 -- negate issue + +test_lengthInt64hex_maxBound = + lengthInt64hex maxBound @?= numberLengthHex (maxBound :: Int64) + +property_lengthInt64hex :: Int64 -> Bool +property_lengthInt64hex = lengthInt64hex <==> numberLengthHex + +-- }}} lengthInt64hex --------------------------------------------------------- +-- {{{ lengthIntHex ----------------------------------------------------------- + +test_lengthIntHex_minBound, test_lengthIntHex_maxBound :: Assertion + +test_lengthIntHex_minBound = lengthIntHex minBound @?= + -- Handling of "negate" issue: + if (minBound :: Int) == fromIntegral (minBound :: Int32) + then 8 -- 32bit + else 16 -- 64bit + +test_lengthIntHex_maxBound = + lengthIntHex maxBound @?= numberLengthHex (maxBound :: Int) + +property_lengthIntHex :: Int -> Bool +property_lengthIntHex = lengthIntHex <==> numberLengthHex + +-- }}} lengthIntHex ----------------------------------------------------------- +-- }}} Hexadecimal ------------------------------------------------------------ diff --git a/test/TestCase/Data/NumberLength/Word.hs b/test/TestCase/Data/NumberLength/Word.hs new file mode 100644 --- /dev/null +++ b/test/TestCase/Data/NumberLength/Word.hs @@ -0,0 +1,242 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: $HEADER$ +-- Description: TODO +-- Copyright: (c) 2015, Peter Trško +-- License: BSD3 +-- +-- Stability: experimental +-- Portability: NoImplicitPrelude +module TestCase.Data.NumberLength.Word + where + +import Prelude (Bounded(maxBound, minBound), Integral, fromIntegral) + +import Control.Applicative (liftA2) +import Data.Bool (Bool) +import Data.Eq (Eq((==))) +import Data.Function ((.)) +import Data.Int (Int) +import qualified Data.List as List (length) +import Data.String (String) +import Data.Word (Word, Word16, Word32, Word64, Word8) +import Text.Printf (PrintfArg, printf) +import Text.Show (Show(show)) + +import Test.HUnit (Assertion, (@?=)) +import Test.Framework (Test) +import Test.Framework.Providers.HUnit (testCase) +import Test.Framework.Providers.QuickCheck2 (testProperty) + +import Data.NumberLength.Word + ( lengthWord + , lengthWord16 + , lengthWord16hex + , lengthWord32 + , lengthWord32hex + , lengthWord64 + , lengthWord64hex + , lengthWord8 + , lengthWord8hex + , lengthWordHex + ) + + +tests :: [Test] +tests = + [ testCase "lengthWord8 minBound" test_lengthWord8_minBound + , testCase "lengthWord8 maxBound" test_lengthWord8_maxBound + , testProperty "lengthWord8 = length . show" property_lengthWord8 + + , testCase "lengthWord16 minBound" test_lengthWord16_minBound + , testCase "lengthWord16 maxBound" test_lengthWord16_maxBound + , testProperty "lengthWord16 = length . show" property_lengthWord16 + + , testCase "lengthWord32 minBound" test_lengthWord32_minBound + , testCase "lengthWord32 maxBound" test_lengthWord32_maxBound + , testProperty "lengthWord32 = length . show" property_lengthWord32 + + , testCase "lengthWord64 minBound" test_lengthWord64_minBound + , testCase "lengthWord64 maxBound" test_lengthWord64_maxBound + , testProperty "lengthWord64 = length . show" property_lengthWord64 + + , testCase "lengthWord minBound" test_lengthWord_minBound + , testCase "lengthWord maxBound" test_lengthWord_maxBound + , testProperty "lengthWord = length . show" property_lengthWord + + , testCase "lengthWord8hex minBound" test_lengthWord8hex_minBound + , testCase "lengthWord8hex maxBound" test_lengthWord8hex_maxBound + , testProperty "lengthWord8hex = length . show" property_lengthWord8 + + , testCase "lengthWord16hex minBound" test_lengthWord16hex_minBound + , testCase "lengthWord16hex maxBound" test_lengthWord16hex_maxBound + , testProperty "lengthWord16hex = length . show" property_lengthWord16 + + , testCase "lengthWord32hex minBound" test_lengthWord32hex_minBound + , testCase "lengthWord32hex maxBound" test_lengthWord32hex_maxBound + , testProperty "lengthWord32hex = length . show" property_lengthWord32 + + , testCase "lengthWord64hex minBound" test_lengthWord64hex_minBound + , testCase "lengthWord64hex maxBound" test_lengthWord64hex_maxBound + , testProperty "lengthWord64hex = length . show" property_lengthWord64hex + + , testCase "lengthWordHex minBound" test_lengthWordHex_minBound + , testCase "lengthWordHex maxBound" test_lengthWordHex_maxBound + , testProperty "lengthWordHex = length . show" property_lengthWordHex + ] + +numberLength :: Show n => n -> Int +numberLength = List.length . show + +numberLengthHex :: (PrintfArg n, Integral n) => n -> Int +numberLengthHex n = + List.length (printf "%x" (fromIntegral n :: Word64) :: String) + +(<==>) :: Eq b => (a -> b) -> (a -> b) -> a -> Bool +(<==>) = liftA2 (==) + +-- {{{ Decimal ---------------------------------------------------------------- +-- {{{ lengthWord8 ------------------------------------------------------------ + +test_lengthWord8_minBound, test_lengthWord8_maxBound :: Assertion + +test_lengthWord8_minBound = + lengthWord8 minBound @?= numberLength (minBound :: Word8) + +test_lengthWord8_maxBound = + lengthWord8 maxBound @?= numberLength (maxBound :: Word8) + +property_lengthWord8 :: Word8 -> Bool +property_lengthWord8 = lengthWord8 <==> numberLength + +-- }}} lengthWord8 ------------------------------------------------------------ +-- {{{ lengthWord16 ----------------------------------------------------------- + +test_lengthWord16_minBound, test_lengthWord16_maxBound :: Assertion + +test_lengthWord16_minBound = + lengthWord16 minBound @?= numberLength (minBound :: Word16) + +test_lengthWord16_maxBound = + lengthWord16 maxBound @?= numberLength (maxBound :: Word16) + +property_lengthWord16 :: Word16 -> Bool +property_lengthWord16 = lengthWord16 <==> numberLength + +-- }}} lengthWord16 ----------------------------------------------------------- +-- {{{ lengthWord32 ----------------------------------------------------------- + +test_lengthWord32_minBound, test_lengthWord32_maxBound :: Assertion + +test_lengthWord32_minBound = + lengthWord32 minBound @?= numberLength (minBound :: Word32) + +test_lengthWord32_maxBound = + lengthWord32 maxBound @?= numberLength (maxBound :: Word32) + +property_lengthWord32 :: Word32 -> Bool +property_lengthWord32 = lengthWord32 <==> numberLength + +-- }}} lengthWord32 ----------------------------------------------------------- +-- {{{ lengthWord64 ----------------------------------------------------------- + +test_lengthWord64_minBound, test_lengthWord64_maxBound :: Assertion + +test_lengthWord64_minBound = + lengthWord64 minBound @?= numberLength (minBound :: Word64) + +test_lengthWord64_maxBound = + lengthWord64 maxBound @?= numberLength (maxBound :: Word64) + +property_lengthWord64 :: Word64 -> Bool +property_lengthWord64 = lengthWord64 <==> numberLength + +-- }}} lengthWord64 ----------------------------------------------------------- +-- {{{ lengthWord ------------------------------------------------------------- + +test_lengthWord_minBound, test_lengthWord_maxBound :: Assertion + +test_lengthWord_minBound = + lengthWord minBound @?= numberLength (minBound :: Word) + +test_lengthWord_maxBound = + lengthWord maxBound @?= numberLength (maxBound :: Word) + +property_lengthWord :: Word -> Bool +property_lengthWord = lengthWord <==> numberLength + +-- }}} lengthWord ------------------------------------------------------------- +-- }}} Decimal ---------------------------------------------------------------- + +-- {{{ Hexadecimal ------------------------------------------------------------ +-- {{{ lengthWord8hex --------------------------------------------------------- + +test_lengthWord8hex_minBound, test_lengthWord8hex_maxBound :: Assertion + +test_lengthWord8hex_minBound = + lengthWord8hex minBound @?= numberLengthHex (minBound :: Word8) + +test_lengthWord8hex_maxBound = + lengthWord8hex maxBound @?= numberLengthHex (maxBound :: Word8) + +property_lengthWord8hex :: Word8 -> Bool +property_lengthWord8hex = lengthWord8hex <==> numberLengthHex + +-- }}} lengthWord8hex --------------------------------------------------------- +-- {{{ lengthWord16hex -------------------------------------------------------- + +test_lengthWord16hex_minBound, test_lengthWord16hex_maxBound :: Assertion + +test_lengthWord16hex_minBound = + lengthWord16hex minBound @?= numberLengthHex (minBound :: Word16) + +test_lengthWord16hex_maxBound = + lengthWord16hex maxBound @?= numberLengthHex (maxBound :: Word16) + +property_lengthWord16hex :: Word16 -> Bool +property_lengthWord16hex = lengthWord16hex <==> numberLengthHex + +-- }}} lengthWord16hex -------------------------------------------------------- +-- {{{ lengthWord32hex -------------------------------------------------------- + +test_lengthWord32hex_minBound, test_lengthWord32hex_maxBound :: Assertion + +test_lengthWord32hex_minBound = + lengthWord32hex minBound @?= numberLengthHex (minBound :: Word32) + +test_lengthWord32hex_maxBound = + lengthWord32hex maxBound @?= numberLengthHex (maxBound :: Word32) + +property_lengthWord32hex :: Word32 -> Bool +property_lengthWord32hex = lengthWord32hex <==> numberLengthHex + +-- }}} lengthWord32hex -------------------------------------------------------- +-- {{{ lengthWord64hex -------------------------------------------------------- + +test_lengthWord64hex_minBound, test_lengthWord64hex_maxBound :: Assertion + +test_lengthWord64hex_minBound = + lengthWord64hex minBound @?= numberLengthHex (minBound :: Word64) + +test_lengthWord64hex_maxBound = + lengthWord64hex maxBound @?= numberLengthHex (maxBound :: Word64) + +property_lengthWord64hex :: Word64 -> Bool +property_lengthWord64hex = lengthWord64hex <==> numberLengthHex + +-- }}} lengthWord64hex -------------------------------------------------------- +-- {{{ lengthWordHex ---------------------------------------------------------- + +test_lengthWordHex_minBound, test_lengthWordHex_maxBound :: Assertion + +test_lengthWordHex_minBound = + lengthWordHex minBound @?= numberLengthHex (minBound :: Word) + +test_lengthWordHex_maxBound = + lengthWordHex maxBound @?= numberLengthHex (maxBound :: Word) + +property_lengthWordHex :: Word -> Bool +property_lengthWordHex = lengthWordHex <==> numberLengthHex + +-- }}} lengthWordHex ---------------------------------------------------------- +-- }}} Hexadecimal ------------------------------------------------------------ diff --git a/test/benchmark.hs b/test/benchmark.hs new file mode 100644 --- /dev/null +++ b/test/benchmark.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: Main +-- Description: Benchmarks for low-level functions. +-- Copyright: (c) 2016, Peter Trško +-- License: BSD3 +-- +-- Stability: stable +-- Portability: NoImplicitPrelude +-- +-- Benchmarks for low-level functions. +module Main (main) + where + +import Prelude (Bounded(minBound, maxBound)) + +import Data.Function (($)) +import System.IO (IO) + +import Criterion.Main (bench, defaultMain, nf) + +import Data.NumberLength.Int + ( lengthInt + , lengthInt16 + , lengthInt16hex + , lengthInt32 + , lengthInt32hex + , lengthInt64 + , lengthInt64hex + , lengthInt8 + , lengthInt8hex + , lengthIntHex + ) +import Data.NumberLength.Word + ( lengthWord + , lengthWord16 + , lengthWord16hex + , lengthWord32 + , lengthWord32hex + , lengthWord64 + , lengthWord64hex + , lengthWord8 + , lengthWord8hex + , lengthWordHex + ) + + +main :: IO () +main = defaultMain + [ bench "lengthInt minBound" $ nf lengthInt minBound + , bench "lengthInt 0" $ nf lengthInt 0 + , bench "lengthInt maxBound" $ nf lengthInt maxBound + + , bench "lengthInt8 minBound" $ nf lengthInt8 minBound + , bench "lengthInt8 0" $ nf lengthInt8 0 + , bench "lengthInt8 maxBound" $ nf lengthInt8 maxBound + + , bench "lengthInt16 minBound" $ nf lengthInt16 minBound + , bench "lengthInt16 0" $ nf lengthInt16 0 + , bench "lengthInt16 maxBound" $ nf lengthInt16 maxBound + + , bench "lengthInt32 minBound" $ nf lengthInt32 minBound + , bench "lengthInt32 0" $ nf lengthInt32 0 + , bench "lengthInt32 maxBound" $ nf lengthInt32 maxBound + + , bench "lengthInt64 minBound" $ nf lengthInt64 minBound + , bench "lengthInt64 0" $ nf lengthInt64 0 + , bench "lengthInt64 maxBound" $ nf lengthInt64 maxBound + + , bench "lengthIntHex minBound" $ nf lengthIntHex minBound + , bench "lengthIntHex 0" $ nf lengthIntHex 0 + , bench "lengthIntHex maxBound" $ nf lengthIntHex maxBound + + , bench "lengthInt8hex minBound" $ nf lengthInt8hex minBound + , bench "lengthInt8hex 0" $ nf lengthInt8hex 0 + , bench "lengthInt8hex maxBound" $ nf lengthInt8hex maxBound + + , bench "lengthInt16hex minBound" $ nf lengthInt16hex minBound + , bench "lengthInt16hex 0" $ nf lengthInt16hex 0 + , bench "lengthInt16hex maxBound" $ nf lengthInt16hex maxBound + + , bench "lengthInt32hex minBound" $ nf lengthInt32hex minBound + , bench "lengthInt32hex 0" $ nf lengthInt32hex 0 + , bench "lengthInt32hex maxBound" $ nf lengthInt32hex maxBound + + , bench "lengthInt64hex minBound" $ nf lengthInt64hex minBound + , bench "lengthInt64hex 0" $ nf lengthInt64hex 0 + , bench "lengthInt64hex maxBound" $ nf lengthInt64hex maxBound + + + , bench "lengthWord 0" $ nf lengthWord 0 + , bench "lengthWord maxBound" $ nf lengthWord maxBound + + , bench "lengthWord8 0" $ nf lengthWord8 0 + , bench "lengthWord8 maxBound" $ nf lengthWord8 maxBound + + , bench "lengthWord16 0" $ nf lengthWord16 0 + , bench "lengthWord16 maxBound" $ nf lengthWord16 maxBound + + , bench "lengthWord32 0" $ nf lengthWord32 0 + , bench "lengthWord32 maxBound" $ nf lengthWord32 maxBound + + , bench "lengthWord64 0" $ nf lengthWord64 0 + , bench "lengthWord64 maxBound" $ nf lengthWord64 maxBound + + , bench "lengthWordHex 0" $ nf lengthWordHex 0 + , bench "lengthWordHex maxBound" $ nf lengthWordHex maxBound + + , bench "lengthWord8hex 0" $ nf lengthWord8hex 0 + , bench "lengthWord8hex maxBound" $ nf lengthWord8hex maxBound + + , bench "lengthWord16hex 0" $ nf lengthWord16hex 0 + , bench "lengthWord16hex maxBound" $ nf lengthWord16hex maxBound + + , bench "lengthWord32hex 0" $ nf lengthWord32hex 0 + , bench "lengthWord32hex maxBound" $ nf lengthWord32hex maxBound + + , bench "lengthWord64hex 0" $ nf lengthWord64hex 0 + , bench "lengthWord64hex maxBound" $ nf lengthWord64hex maxBound + ] diff --git a/test/unit-tests.hs b/test/unit-tests.hs new file mode 100644 --- /dev/null +++ b/test/unit-tests.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module: Main +-- Description: Tests main +-- Copyright: (c) 2015, Jan Šipr, Matej Kollár, Peter Trško +-- License: BSD3 +-- +-- Stability: stable +-- Portability: NoImplicitPrelude +-- +-- Tests main. +module Main (main) + where + +import System.IO (IO) + +import Test.Framework (defaultMain) + +import TestCase (tests) + + +main :: IO () +main = defaultMain tests