diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## Identicon 0.2.0 + +* Added benchmarks. + +* Renamed `applyWords` to `applyBytes` (method of type class `ApplyBytes`). + It's unlikely that anyone uses it though as it's more of internal + machinery. + ## Identicon 0.1.0 * Initial release. diff --git a/Graphics/Identicon.hs b/Graphics/Identicon.hs --- a/Graphics/Identicon.hs +++ b/Graphics/Identicon.hs @@ -70,7 +70,7 @@ import Data.ByteString (ByteString) import Data.Maybe (fromJust) import Data.Proxy -import Data.Word (Word8, Word16) +import Data.Word (Word8) import GHC.TypeLits import qualified Data.ByteString as B @@ -174,7 +174,7 @@ => Renderable (a :+ Consumer n) where render _ (a :+ b) weight height bs0 = let (bs1, x) = render (Proxy :: Proxy a) a weight height bs0 - (bs2, y) = applyWords b bs1 + (bs2, y) = applyBytes b bs1 in (bs2, mixPixels x (unLayer y weight height)) -- | Combine results of two rending functions. @@ -190,26 +190,26 @@ -- efficient thing. saturatedAddition :: Word8 -> Word8 -> Word8 -saturatedAddition x y = fromIntegral $ - (0xff :: Word16) `min` (fromIntegral x + fromIntegral y) +saturatedAddition x y = let z = x + y in + if z < x then 0xff else z {-# INLINE saturatedAddition #-} -- | Consume bytes from strict 'ByteString' and apply them to a function -- that takes 'Word8' until it produces a 'Layer'. class ApplyBytes a where - applyWords + applyBytes :: a -- ^ Function that produces a layer -> ByteString -- ^ Bytes to consume -> (ByteString, Layer) -- ^ The rest of 'ByteString' and produced 'Layer' instance ApplyBytes Layer where - applyWords f bs = (bs, f) + applyBytes f bs = (bs, f) instance ApplyBytes f => ApplyBytes (Word8 -> f) where - applyWords f bs = + applyBytes f bs = let (b,bs') = fromJust (B.uncons bs) - in applyWords (f b) bs' + in applyBytes (f b) bs' -- | Render an identicon. The function returns 'Nothing' if given -- 'ByteString' is too short or when width or height is lesser than 1. @@ -232,3 +232,4 @@ then Nothing else Just $ generateImage (snd $ render proxy impl width height bs) width height +{-# NOINLINE renderIdenticon #-} diff --git a/Graphics/Identicon/Primitive.hs b/Graphics/Identicon/Primitive.hs --- a/Graphics/Identicon/Primitive.hs +++ b/Graphics/Identicon/Primitive.hs @@ -270,3 +270,4 @@ oneof :: Integral n => [a] -> n -> a oneof xs n = xs !! (fromIntegral n `rem` length xs) +{-# INLINE oneof #-} diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,115 @@ +-- +-- Benchmarks for the ‘identicon’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- 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 Mark Karpov nor the names of 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 “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 HOLDERS 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. + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Main (main) where + +import Codec.Picture +import Criterion.Main +import Data.ByteString (ByteString) +import Data.Proxy +import Data.Word (Word8) +import Graphics.Identicon +import Graphics.Identicon.Primitive +import System.Random +import System.Random.TF.Init +import qualified Data.ByteString as B + +main :: IO () +main = defaultMain + [ bgen 0 0 gen0 + , bgen 4 1 gen1 + , bgen 8 2 gen2 + , bgen 12 3 gen3 ] + +-- | Run an identicon benchmark given its name and rendering function. + +bgen + :: Int -- ^ Number of bytes the generator expects + -> Int -- ^ Number of layers the generator has + -> (Int -> Int -> ByteString -> Maybe (Image PixelRGB8)) -- ^ Generator + -> Benchmark -- ^ Benchmark +bgen bytes layers gen = bgroup groupName (f <$> testSizes) + where + groupName = show bytes ++ " bytes/" ++ show layers ++ " layers" + f n = + let n' = show n + in env (getBS bytes) (bench (n' ++ " × " ++ n') . nf (gen n n)) + +-- | Obtain a quite random 'ByteString' of specified length. + +getBS :: Int -> IO ByteString +getBS n = do + gen <- initTFGen + (return . B.pack . take n . randoms) gen + +-- | We render a series of rectangular icons in 'bgen', this list contains +-- size of a side of icon in pixels. + +testSizes :: [Int] +testSizes = [16,32,64,128,256,512,1024] + +---------------------------------------------------------------------------- +-- Identicon generators + +type Gen0 = Identicon 0 + +gen0 :: Int -> Int -> ByteString -> Maybe (Image PixelRGB8) +gen0 = renderIdenticon (Proxy :: Proxy Gen0) Identicon + +type Gen1 = Identicon 4 :+ Consumer 4 + +gen1 :: Int -> Int -> ByteString -> Maybe (Image PixelRGB8) +gen1 = renderIdenticon (Proxy :: Proxy Gen1) i + where + i = Identicon :+ stdLayer + +type Gen2 = Identicon 8 :+ Consumer 4 :+ Consumer 4 + +gen2 :: Int -> Int -> ByteString -> Maybe (Image PixelRGB8) +gen2 = renderIdenticon (Proxy :: Proxy Gen2) i + where + i = Identicon :+ stdLayer :+ stdLayer + +type Gen3 = Identicon 12 :+ Consumer 4 :+ Consumer 4 :+ Consumer 4 + +gen3 :: Int -> Int -> ByteString -> Maybe (Image PixelRGB8) +gen3 = renderIdenticon (Proxy :: Proxy Gen3) i + where + i = Identicon :+ stdLayer :+ stdLayer :+ stdLayer + +stdLayer :: Pixel8 -> Pixel8 -> Pixel8 -> Word8 -> Layer +stdLayer r g b n = rsym $ onGrid 4 4 n $ + circle $ gradientLR (edge . mid) black (PixelRGB8 r g b) diff --git a/identicon.cabal b/identicon.cabal --- a/identicon.cabal +++ b/identicon.cabal @@ -31,7 +31,7 @@ -- POSSIBILITY OF SUCH DAMAGE. name: identicon -version: 0.1.0 +version: 0.2.0 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE.md @@ -43,17 +43,9 @@ synopsis: Flexible generation of identicons build-type: Simple description: Flexible generation of identicons. -extra-source-files: CHANGELOG.md +extra-doc-files: CHANGELOG.md , README.md - , data-examples/identicon-00.png - , data-examples/identicon-01.png - , data-examples/identicon-02.png - , data-examples/identicon-10.png - , data-examples/identicon-11.png - , data-examples/identicon-12.png - , data-examples/identicon-20.png - , data-examples/identicon-21.png - , data-examples/identicon-22.png +data-files: data-examples/*.png source-repository head type: git @@ -65,9 +57,9 @@ default: False library - build-depends: base >= 4.7 && < 5 - , JuicyPixels >= 3.2.6.5 - , bytestring >= 0.10.6 + build-depends: base >= 4.7 && < 5.0 + , JuicyPixels >= 3.2.6.5 && < 4.0 + , bytestring >= 0.10.6 && < 0.13 exposed-modules: Graphics.Identicon , Graphics.Identicon.Primitive if flag(dev) @@ -80,13 +72,30 @@ main-is: Spec.hs hs-source-dirs: tests type: exitcode-stdio-1.0 - build-depends: base >= 4.7 && < 5 - , JuicyPixels >= 3.2.6.5 - , bytestring >= 0.10.6 - , hspec >= 2.0 - , identicon >= 0.1.0 + build-depends: base >= 4.7 && < 5.0 + , JuicyPixels >= 3.2.6.5 && < 4.0 + , bytestring >= 0.10.6 && < 0.13 + , hspec >= 2.0 && < 3.0 + , identicon >= 0.2.0 if flag(dev) ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 + +benchmark bench + main-is: Main.hs + hs-source-dirs: bench + type: exitcode-stdio-1.0 + build-depends: base >= 4.7 && < 5.0 + , JuicyPixels >= 3.2.6.5 && < 4.0 + , bytestring >= 0.10.6 && < 0.13 + , criterion >= 0.6.2.1 && < 1.2 + , identicon >= 0.2.0 + , random >= 1.1 && < 1.2 + , tf-random >= 0.4 && < 0.6 + if flag(dev) + ghc-options: -02 -Wall -Werror else ghc-options: -O2 -Wall default-language: Haskell2010 diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -38,7 +38,7 @@ import Codec.Picture import Control.Monad -import Data.ByteString +import Data.ByteString (ByteString) import Data.Function (on) import Data.Proxy import Data.Word (Word8)