identicon 0.2.2 → 0.2.3
raw patch · 9 files changed
+454/−377 lines, 9 filesdep −semigroupsdep ~JuicyPixelsdep ~QuickCheckdep ~basesetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies removed: semigroups
Dependency ranges changed: JuicyPixels, QuickCheck, base, hspec, random
API changes (from Hackage documentation)
- Graphics.Identicon: data (:+) a b
- Graphics.Identicon: instance Data.Semigroup.Semigroup Graphics.Identicon.Layer
+ Graphics.Identicon: data a :+ b
+ Graphics.Identicon: infixl 8 :+
+ Graphics.Identicon: instance GHC.Base.Semigroup Graphics.Identicon.Layer
+ Graphics.Identicon: type family ToLayer (n :: Nat)
- Graphics.Identicon: Identicon :: Identicon
+ Graphics.Identicon: Identicon :: Identicon (n :: Nat)
Files
- CHANGELOG.md +6/−3
- Graphics/Identicon.hs +109/−101
- Graphics/Identicon/Primitive.hs +117/−95
- LICENSE.md +1/−1
- README.md +41/−30
- Setup.hs +0/−6
- bench/Main.hs +29/−23
- identicon.cabal +79/−65
- tests/Spec.hs +72/−53
CHANGELOG.md view
@@ -1,3 +1,7 @@+## Identicon 0.2.3++* Maintenance release with newer dependencies.+ ## Identicon 0.2.2 * Improved documentation and metadata.@@ -10,9 +14,8 @@ * 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.+* Renamed `applyWords` to `applyBytes` (the method of type class+ `ApplyBytes`). ## Identicon 0.1.0
Graphics/Identicon.hs view
@@ -1,6 +1,15 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+ -- | -- Module : Graphics.Identicon--- Copyright : © 2016–2017 Mark Karpov+-- Copyright : © 2016–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -32,54 +41,40 @@ -- > myGenerator :: Int -> Int -> ByteString -> Maybe (Image PixelRGB8) -- > myGenerator = renderIdenticon myImageType myImpl ----- @myGenerator@ takes desired width, height, and hash that should have at--- least 4 bytes in it and returns an identicon corresponding to that hash--- or 'Nothing' if the hash has less than 4 bytes in it or width\/height--- don't make sense. The identicon has randomly placed circle with gradient--- filling changing (horizontally) from black to some color and back to--- black. The circle is mirrored 4 times, and every repetition is rotated by--- 90°. This identicon consumes 4 bytes and has one layer.--{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-+-- @myGenerator@ takes the desired width, height, and a hash that should+-- have at least 4 bytes in it and returns an identicon corresponding to+-- that hash or 'Nothing' if the hash has less than 4 bytes in it or when+-- width\/height don't make sense. The identicon has randomly placed circle+-- with gradient filling changing (horizontally) from black to some color+-- and back to black. The circle is mirrored 4 times, and every repetition+-- is rotated by 90°. This identicon consumes 4 bytes and has one layer. module Graphics.Identicon ( -- * Basic types- Identicon (..)- , Consumer- , (:+) (..)- , Layer (..)- , BytesAvailable- , BytesConsumed- , Implementation- , ToLayer+ Identicon (..),+ Consumer,+ (:+) (..),+ Layer (..),+ BytesAvailable,+ BytesConsumed,+ Implementation,+ ToLayer,+ -- * Identicon rendering- , Renderable (..)- , ApplyBytes (..)- , renderIdenticon )+ Renderable (..),+ ApplyBytes (..),+ renderIdenticon,+ ) where import Codec.Picture import Data.ByteString (ByteString)+import Data.ByteString qualified as B import Data.Maybe (fromJust) import Data.Proxy+import Data.Semigroup qualified as S import Data.Word (Word8) import GHC.TypeLits-import qualified Data.ByteString as B-import qualified Data.Semigroup as S -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif- ---------------------------------------------------------------------------- -- Basic types @@ -88,30 +83,29 @@ -- natural number on the type level that represents the number of bytes that -- should be provided to generate this type of identicon. Bytes typically -- come from some sort of hash that has a fixed size.- data Identicon (n :: Nat) = Identicon -- | 'Consumer' is a type that represents an entity that consumes bytes that -- are available for identicon generation. It's parametrized over a phantom -- type @n@ which is a natural number on the type level that represents the -- number of bytes that this entity consumes. At this moment, a 'Consumer'--- always adds one 'Layer' to identicon when attached to it. The number of--- bytes, specified as type parameter of 'Identicon' type must be completely--- consumed by a collection of consumers attached to it. To attach a--- consumer to 'Identicon', you use the @(':+')@ type operator, see below.-+-- always adds one 'Layer' to an 'Identicon' when attached to it. The number+-- of bytes, specified as type parameter of 'Identicon' type must be+-- completely consumed by a collection of consumers attached to it. To+-- attach a consumer to 'Identicon', you use the @(':+')@ type operator, see+-- below. data Consumer (n :: Nat) -- | The @(':+')@ type operator is used to attach 'Consumer's to--- 'Identicon', thus adding layers to it and exhausting bytes that are+-- 'Identicon', thus adding layers to it and exhausting the bytes that are -- available for identicon generation. An example of identicon that can be -- generated from 16 byte hash is shown below: -- -- > type Icon = Identicon 16 :+ Consumer 5 :+ Consumer 5 :+ Consumer 6 -- -- The identicon above has three layers.- infixl 8 :++ data a :+ b = a :+ b -- | 'Layer' is the basic building block of an identicon. It's a function@@ -124,43 +118,38 @@ -- -- …and returns a 'PixelRGB8' value. In this library, an identicon is -- generated as a “superposition” of several 'Layers'.- newtype Layer = Layer- { unLayer :: Int -> Int -> Int -> Int -> PixelRGB8 }+ {unLayer :: Int -> Int -> Int -> Int -> PixelRGB8} instance S.Semigroup Layer where Layer a <> Layer b = Layer (\w h -> mixPixels (a w h) (b w h)) instance Monoid Layer where- mempty = Layer $ \_ _ _ _ -> PixelRGB8 0 0 0+ mempty = Layer $ \_ _ _ _ -> PixelRGB8 0 0 0 mappend = (S.<>) -- | The 'BytesAvailable' type function calculates how many bytes are -- available for consumption in a given identicon.- type family BytesAvailable a :: Nat where BytesAvailable (Identicon n) = n- BytesAvailable (x :+ y) = BytesAvailable x+ BytesAvailable (x :+ y) = BytesAvailable x -- | The 'BytesConsumed' type function calculates how many bytes are -- consumed in a given identicon.- type family BytesConsumed a :: Nat where BytesConsumed (Identicon n) = 0- BytesConsumed (Consumer n) = n- BytesConsumed (x :+ y) = BytesConsumed x + BytesConsumed y+ BytesConsumed (Consumer n) = n+ BytesConsumed (x :+ y) = BytesConsumed x + BytesConsumed y -- | The 'Implementation' type function returns the type of the code which -- can implement the given identicon.- type family Implementation a where- Implementation (Identicon n) = Identicon n+ Implementation (Identicon n) = Identicon n Implementation (a :+ Consumer n) = Implementation a :+ ToLayer n -- | The 'ToLayer' type function calculates type that a layer-producing -- function should have to consume the given number of bytes @n@.--type family ToLayer (n :: Nat) :: k where+type family ToLayer (n :: Nat) where ToLayer 0 = Layer ToLayer n = Word8 -> ToLayer (n - 1) @@ -168,79 +157,98 @@ -- Identicon rendering -- | Identicons that can be rendered as an image implement this class.- class Renderable a where- render- :: Proxy a -- ^ A 'Proxy' clarifying identicon type- -> Implementation a -- ^ Corresponding implementation- -> Int -- ^ Width in pixels- -> Int -- ^ Height in pixels- -> ByteString -- ^ Bytes to consume- -> (ByteString, Int -> Int -> PixelRGB8)- -- ^ The rest of bytes and producing function+ render ::+ -- | A 'Proxy' clarifying identicon type+ Proxy a ->+ -- | Corresponding implementation+ Implementation a ->+ -- | Width in pixels+ Int ->+ -- | Height in pixels+ Int ->+ -- | Bytes to consume+ ByteString ->+ -- | The rest of bytes and producing function+ (ByteString, Int -> Int -> PixelRGB8) instance Renderable (Identicon n) where render _ _ _ _ bs = (bs, \_ _ -> PixelRGB8 0 0 0) -instance (Renderable a, ApplyBytes (ToLayer n))- => Renderable (a :+ Consumer n) where+instance+ (Renderable a, ApplyBytes (ToLayer n)) =>+ Renderable (a :+ Consumer n)+ where render _ (a :+ b) weight height bs0 = let (bs1, x) = render (Proxy :: Proxy a) a weight height bs0 (bs2, y) = applyBytes b bs1- in (bs2, mixPixels x (unLayer y weight height))+ in (bs2, mixPixels x (unLayer y weight height)) -- | Combine results of two rending functions.--mixPixels- :: (Int -> Int -> PixelRGB8)- -> (Int -> Int -> PixelRGB8)- -> Int -> Int -> PixelRGB8+mixPixels ::+ (Int -> Int -> PixelRGB8) ->+ (Int -> Int -> PixelRGB8) ->+ Int ->+ Int ->+ PixelRGB8 mixPixels a b x y = mixWith (const saturatedAddition) (a x y) (b x y) {-# INLINE mixPixels #-} -- | An implementation of saturated addition for bytes.- saturatedAddition :: Word8 -> Word8 -> Word8-saturatedAddition x y = let z = x + y in- if z < x then 0xff else z+saturatedAddition x y =+ let z = x + y+ in if z < x then 0xff else z {-# INLINE saturatedAddition #-} -- | Consume bytes from a strict 'ByteString' and apply them to a function -- that takes 'Word8' until it produces a 'Layer'.- class ApplyBytes a where- applyBytes- :: a -- ^ Function that produces a layer- -> ByteString -- ^ Bytes to consume- -> (ByteString, Layer) -- ^ The rest of 'ByteString' and produced 'Layer'+ applyBytes ::+ -- | Function that produces a layer+ a ->+ -- | Bytes to consume+ ByteString ->+ -- | The rest of 'ByteString' and produced 'Layer'+ (ByteString, Layer) instance ApplyBytes Layer where applyBytes f bs = (bs, f) -instance ApplyBytes f => ApplyBytes (Word8 -> f) where+instance (ApplyBytes f) => ApplyBytes (Word8 -> f) where applyBytes f bs =- let (b,bs') = fromJust (B.uncons bs)- in applyBytes (f b) bs'+ let (b, bs') = fromJust (B.uncons 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.--renderIdenticon :: forall a.- ( Renderable a- , KnownNat (BytesAvailable a)- , BytesAvailable a ~ BytesConsumed a )- => Proxy a -- ^ Type that defines an identicon- -> Implementation a -- ^ Implementation that generates layers- -> Int -- ^ Width in pixels- -> Int -- ^ Height in pixels- -> ByteString -- ^ Collection of bytes to use, should be long enough- -> Maybe (Image PixelRGB8)- -- ^ Rendered identicon, or 'Nothing' if there is not enough bytes+renderIdenticon ::+ forall a.+ ( Renderable a,+ KnownNat (BytesAvailable a),+ BytesAvailable a ~ BytesConsumed a+ ) =>+ -- | Type that defines an identicon+ Proxy a ->+ -- | Implementation that generates layers+ Implementation a ->+ -- | Width in pixels+ Int ->+ -- | Height in pixels+ Int ->+ -- | Collection of bytes to use, should be long enough+ ByteString ->+ -- | Rendered identicon, or 'Nothing' if there is not enough bytes+ Maybe (Image PixelRGB8) renderIdenticon proxy impl width height bs = if B.length bs < fromIntegral (natVal (Proxy :: Proxy (BytesAvailable a)))- || width < 1- || height < 1+ || width < 1+ || height < 1 then Nothing- else Just $ generateImage- (snd $ render proxy impl width height bs) width height+ else+ Just $+ generateImage+ (snd $ render proxy impl width height bs)+ width+ height {-# NOINLINE renderIdenticon #-}
Graphics/Identicon/Primitive.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Graphics.Identicon.Primitive--- Copyright : © 2016–2017 Mark Karpov+-- Copyright : © 2016–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -23,31 +23,35 @@ -- > f :: Word8 -> Word8 -> Word8 -> Layer -- > f r g b = circle $ gradientLR id black (PixelRGB8 r g b) ----- The function consumes 3 bytes from a hash when it's used in identicon.-+-- The function consumes 3 bytes. module Graphics.Identicon.Primitive ( -- * Filling- black- , color- , gradientLR- , gradientTB- , gradientTLBR- , gradientTRBL- , gradientXY+ black,+ color,+ gradientLR,+ gradientTB,+ gradientTLBR,+ gradientTRBL,+ gradientXY,+ -- ** Gradient transforming functions -- $gtrans- , mid- , edge+ mid,+ edge,+ -- * Position, size, and shape- , onGrid- , circle+ onGrid,+ circle,+ -- * Symmetry- , hsym- , vsym- , hvsym- , rsym+ hsym,+ vsym,+ hvsym,+ rsym,+ -- * Other- , oneof )+ oneof,+ ) where import Codec.Picture@@ -59,84 +63,97 @@ -- | Black is a special color, it means absence of light. We give this pixel -- a name because it's used very frequently in layer coding.- black :: PixelRGB8 black = PixelRGB8 0 0 0 -- | Layer filled with a given color.- color :: PixelRGB8 -> Layer color a = Layer $ \_ _ _ _ -> a {-# INLINE color #-} -- | Gradient changing from left to right.--gradientLR- :: (Float -> Float) -- ^ Gradient transforming function- -> PixelRGB8 -- ^ Left color- -> PixelRGB8 -- ^ Right color- -> Layer+gradientLR ::+ -- | Gradient transforming function+ (Float -> Float) ->+ -- | Left color+ PixelRGB8 ->+ -- | Right color+ PixelRGB8 ->+ Layer gradientLR f a b = Layer $ \w _ x _ -> mixWith (const $ ξ f x w) a b {-# INLINE gradientLR #-} -- | Gradient changing from top to bottom.--gradientTB- :: (Float -> Float) -- ^ Gradient transforming function- -> PixelRGB8 -- ^ Top color- -> PixelRGB8 -- ^ Bottom color- -> Layer+gradientTB ::+ -- | Gradient transforming function+ (Float -> Float) ->+ -- | Top color+ PixelRGB8 ->+ -- | Bottom color+ PixelRGB8 ->+ Layer gradientTB f a b = Layer $ \_ h _ y -> mixWith (const $ ξ f y h) a b {-# INLINE gradientTB #-} -- | Gradient changing from top left corner to bottom right corner.--gradientTLBR- :: (Float -> Float) -- ^ Gradient transforming function- -> PixelRGB8 -- ^ Top left color- -> PixelRGB8 -- ^ Bottom right color- -> Layer+gradientTLBR ::+ -- | Gradient transforming function+ (Float -> Float) ->+ -- | Top left color+ PixelRGB8 ->+ -- | Bottom right color+ PixelRGB8 ->+ Layer gradientTLBR f a b = Layer $ \w h x y -> mixWith (const $ ξ f (x + y) (w + h)) a b {-# INLINE gradientTLBR #-} -- | Gradient changing from top right corner to bottom left corner.--gradientTRBL- :: (Float -> Float) -- ^ Gradient transforming function- -> PixelRGB8 -- ^ Top right color- -> PixelRGB8 -- ^ Bottom left color- -> Layer+gradientTRBL ::+ -- | Gradient transforming function+ (Float -> Float) ->+ -- | Top right color+ PixelRGB8 ->+ -- | Bottom left color+ PixelRGB8 ->+ Layer gradientTRBL f a b = Layer $ \w h x y -> mixWith (const $ ξ f (w - x + y) (w + h)) a b {-# INLINE gradientTRBL #-} -- | Gradient with one color everywhere and another in the center.--gradientXY- :: (Float -> Float) -- ^ Gradient transforming function- -> PixelRGB8 -- ^ “Edge” color- -> PixelRGB8 -- ^ Color in the center- -> Layer+gradientXY ::+ -- | Gradient transforming function+ (Float -> Float) ->+ -- | “Edge” color+ PixelRGB8 ->+ -- | Color in the center+ PixelRGB8 ->+ Layer gradientXY f a b = Layer $ \w h x y -> let g x' y' = floor $ (1 - n) * fromIntegral x' + n * fromIntegral y'- n = f (nx * ny)+ n = f (nx * ny) nx = mid (fromIntegral x / fromIntegral w) ny = mid (fromIntegral y / fromIntegral h)- in mixWith (const g) a b+ in mixWith (const g) a b {-# INLINE gradientXY #-} -- | A gradient helper function.--ξ- :: (Float -> Float) -- ^ Gradient transforming function- -> Int -- ^ Actual value of coordinate- -> Int -- ^ Maximum value of coordinate- -> Word8 -- ^ Color at the beginning of the range- -> Word8 -- ^ Color at the end of the range- -> Word8 -- ^ Resulting color+ξ ::+ -- | Gradient transforming function+ (Float -> Float) ->+ -- | Actual value of coordinate+ Int ->+ -- | Maximum value of coordinate+ Int ->+ -- | Color at the beginning of the range+ Word8 ->+ -- | Color at the end of the range+ Word8 ->+ -- | Resulting color+ Word8 ξ f v l x y = floor $ (1 - n) * fromIntegral x + n * fromIntegral y where n = f (fromIntegral v / fromIntegral l)@@ -155,13 +172,11 @@ -- | A built-in gradient transforming function. It maps continuous floating -- value changing from 0 to 1 to value changing from 0 to 1 (in the middle) -- and back to 0.- mid :: Float -> Float mid x = 2 * (if x >= 0.5 then 1.0 - x else x) {-# INLINE mid #-} -- | This sharpens gradient transitions.- edge :: Float -> Float edge x = x * x {-# INLINE edge #-}@@ -176,13 +191,18 @@ -- -- The index @n@ can be greater than maximal index, in this case reminder of -- division of @n@ by @w * h@ is used.--onGrid :: Integral a- => Int -- ^ Number of horizontal positions- -> Int -- ^ Number of vertical positions- -> a -- ^ Index of this cell- -> Layer -- ^ Layer to insert- -> Layer -- ^ Resulting layer+onGrid ::+ (Integral a) =>+ -- | Number of horizontal positions+ Int ->+ -- | Number of vertical positions+ Int ->+ -- | Index of this cell+ a ->+ -- | Layer to insert+ Layer ->+ -- | Resulting layer+ Layer onGrid α β n' l = Layer $ \w h x y -> let n = fromIntegral n' `rem` (α * β) (y', x') = n `quotRem` α@@ -193,13 +213,12 @@ xB = floor (fromIntegral (x' + 1) * xu) yA = floor (fromIntegral y' * yu) yB = floor (fromIntegral (y' + 1) * yu)- in if x < xA || x >= xB || y < yA || y >= yB- then black- else unLayer l (xB - xA) (yB - yA) (x - xA) (y - yA)+ in if x < xA || x >= xB || y < yA || y >= yB+ then black+ else unLayer l (xB - xA) (yB - yA) (x - xA) (y - yA) {-# INLINE onGrid #-} --- | Limit given layer so it forms a circle.-+-- | Limit given layer so that it forms a circle. circle :: Layer -> Layer circle l = Layer $ \w h x y -> let w', h', v, r0, r1 :: Float@@ -213,61 +232,64 @@ δ = (r1 - v) / β τ = floor . (* δ) . fromIntegral ~px@(PixelRGB8 r g b) = unLayer l w h x y- e | v < r1 - β = px- | v <= r1 = PixelRGB8 (τ r) (τ g) (τ b)- | otherwise = black- in e+ e+ | v < r1 - β = px+ | v <= r1 = PixelRGB8 (τ r) (τ g) (τ b)+ | otherwise = black+ in e {-# INLINE circle #-} ---------------------------------------------------------------------------- -- Symmetry -- | Add horizontal symmetry to a layer.- hsym :: Layer -> Layer hsym l = Layer $ \w h x y -> let w' = w `quot` 2- in unLayer l w' h (if x > w' then w - x else x) y+ in unLayer l w' h (if x > w' then w - x else x) y {-# INLINE hsym #-} -- | Add vertical symmetry to a layer.- vsym :: Layer -> Layer vsym l = Layer $ \w h x y -> let h' = h `quot` 2- in unLayer l w h' x (if y > h' then h - y else y)+ in unLayer l w h' x (if y > h' then h - y else y) {-# INLINE vsym #-} -- | Add horizontal and vertical symmetry to layer. Result is a layer with -- four mirrored repetitions of the same figure.- hvsym :: Layer -> Layer hvsym l = Layer $ \w h x y -> let h' = h `quot` 2 w' = w `quot` 2- in unLayer l w' h' (if x > w' then w - x else x)- (if y > h' then h - y else y)+ in unLayer+ l+ w'+ h'+ (if x > w' then w - x else x)+ (if y > h' then h - y else y) {-# INLINE hvsym #-} -- | Just like 'hvsym', but every repetition is rotated by 90°. Only works -- with square layers because for speed it just swaps coordinates.- rsym :: Layer -> Layer rsym l = Layer $ \w h x y -> let h' = h `quot` 2 w' = w `quot` 2- α = x > w'- β = y > h'- in unLayer l w' h'- (if α then (if β then w - x else y) else (if β then h - y else x))- (if β then (if α then h - y else x) else (if α then w - x else y))+ α = x > w'+ β = y > h'+ in unLayer+ l+ w'+ h'+ (if α then (if β then w - x else y) else (if β then h - y else x))+ (if β then (if α then h - y else x) else (if α then w - x else y)) {-# INLINE rsym #-} ---------------------------------------------------------------------------- -- Other --- | Select one of provided alternatives given a number.--oneof :: Integral n => [a] -> n -> a+-- | Select one of the provided alternatives given a number.+oneof :: (Integral n) => [a] -> n -> a oneof xs n = xs !! (fromIntegral n `rem` length xs) {-# INLINE oneof #-}
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2016–2017 Mark Karpov+Copyright © 2016–present Mark Karpov All rights reserved.
README.md view
@@ -4,20 +4,18 @@ [](https://hackage.haskell.org/package/identicon) [](http://stackage.org/nightly/package/identicon) [](http://stackage.org/lts/package/identicon)-[](https://travis-ci.org/mrkkrp/identicon)-[](https://coveralls.io/github/mrkkrp/identicon?branch=master)+ -The package implements a flexible framework for identicons generation on top-of the [Juicy Pixels](https://hackage.haskell.org/package/JuicyPixels)-package.+The package implements a flexible framework for generation of identicons on+top of [Juicy Pixels](https://hackage.haskell.org/package/JuicyPixels). ## Quick start -To use the package you usually need the following set of imports (and a-couple of language extensions for the type level magic):+To use the package you usually need the following imports and language+extensions: ```haskell-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} import Codec.Picture -- JuicyPixels@@ -28,9 +26,9 @@ import Graphics.Identicon.Primitive -- some visual primitives ``` -You first write a type that holds information about total number of bytes-your identicon consumes and number of distinct visual components it has-(they are called “layers” in the terminology of the package):+You first write a type that represents the total number of bytes your+identicon consumes and the number of distinct visual components it has (they+are called “layers” in the terminology of the package): ```haskell type MyIcon = Identicon 12 :+ Consumer 4 :+ Consumer 4 :+ Consumer 4@@ -49,24 +47,22 @@ myImpl = Identicon :+ a :+ a :+ a where a :: Word8 -> Word8 -> Word8 -> Word8 -> Layer- a r g b n = rsym $ onGrid 3 3 n $- gradientXY (edge . mid) black (PixelRGB8 r g b)+ a r g b n =+ rsym $ onGrid 3 3 n $+ gradientXY (edge . mid) black (PixelRGB8 r g b) ``` -We could choose to code every layer differently, but since position and-color of every layer are unlikely to be the same, this approach will work-well too.- Every byte is available to the layer-generating function as a distinct `Word8` argument. The type system makes sure that: -* you consume exactly as many bytes as you promised in type of your+* you consume exactly as many bytes as you promised in the type of your identicon; -* you have as many layers as you described in type of your identicon;+* you have as many layers as you have described in the type of your+ identicon; * every function in your implementation has a correct signature (i.e. it- grabs as many `Word8`s as promised and produces a `Layer` in the end).+ takes as many `Word8`s as promised and produces a `Layer` in the end). Mixing of layers and generation is handled by the library like this: @@ -74,23 +70,38 @@ -- | Here is the function that generates your identicons. It's usually -- convenient to wrap the 'renderIdenticon' function that comes with the -- library.--genMyIdenticon- :: Int -- ^ Identicon width- -> Int -- ^ Identicon height- -> ByteString -- ^ Input (some sort of hash or something)- -> Maybe (Image PixelRGB8)- -- ^ Identicon, unless 'ByteString' is too short+genMyIdenticon ::+ -- | Identicon width+ Int ->+ -- | Identicon height+ Int ->+ -- | Input (some sort of hash or something)+ ByteString ->+ -- | Identicon, unless 'ByteString' is too short+ Maybe (Image PixelRGB8) genMyIdenticon = renderIdenticon (Proxy :: Proxy MyIcon) myImpl ``` For more information head straight to the Haddocks. BTW, I have written-[a blog post](https://mrkkrp.github.io/posts/the-identicon-package.html)-about the package where I demonstrate some pictures generated with it.+[a blog post](https://markkarpov.com/post/the-identicon-package.html) about+the package where I demonstrate some pictures generated with it. +## Related packages++The following packages are designed to be used with `identicon`:++* [`identicon-style-squares`](https://hackage.haskell.org/package/identicon-style-squares)++## Contribution++Issues, bugs, and questions may be reported in [the GitHub issue tracker for+this project](https://github.com/mrkkrp/identicon/issues).++Pull requests are also welcome.+ ## License -Copyright © 2016–2017 Mark Karpov+Copyright © 2016–present Mark Karpov Distributed under BSD 3 clause license.
− Setup.hs
@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain
bench/Main.hs view
@@ -1,53 +1,56 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeOperators #-} module Main (main) where import Codec.Picture import Criterion.Main import Data.ByteString (ByteString)+import Data.ByteString qualified as B 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 ]+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 ::+ -- | Number of bytes the generator expects+ Int ->+ -- | Number of layers the generator has+ Int ->+ -- | Generator+ (Int -> Int -> ByteString -> Maybe (Image PixelRGB8)) ->+ -- | Benchmark+ Benchmark bgen bytes layers gen = bgroup groupName (f <$> testSizes) where groupName = show bytes ++ " bytes/" ++ show layers ++ " layers"- f n =+ 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.+ in env (getBS bytes) (bench (n' ++ " × " ++ n') . nf (gen n n)) +-- | Obtain a 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.-+-- size of a side of each icon in pixels. testSizes :: [Int]-testSizes = [16,32,64,128,256,512,1024]+testSizes = [16, 32, 64, 128, 256, 512, 1024] ---------------------------------------------------------------------------- -- Identicon generators@@ -79,5 +82,8 @@ 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)+stdLayer r g b n =+ rsym $+ onGrid 4 4 n $+ circle $+ gradientLR (edge . mid) black (PixelRGB8 r g b)
identicon.cabal view
@@ -1,75 +1,89 @@-name: identicon-version: 0.2.2-cabal-version: >= 1.10-tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1-license: BSD3-license-file: LICENSE.md-author: Mark Karpov <markkarpov92@gmail.com>-maintainer: Mark Karpov <markkarpov92@gmail.com>-homepage: https://github.com/mrkkrp/identicon-bug-reports: https://github.com/mrkkrp/identicon/issues-category: Graphics, Image-synopsis: Flexible generation of identicons-build-type: Simple-description: Flexible generation of identicons.-extra-doc-files: CHANGELOG.md- , README.md-data-files: data-examples/*.png+cabal-version: 2.4+name: identicon+version: 0.2.3+license: BSD-3-Clause+license-file: LICENSE.md+maintainer: Mark Karpov <markkarpov92@gmail.com>+author: Mark Karpov <markkarpov92@gmail.com>+tested-with: ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1+homepage: https://github.com/mrkkrp/identicon+bug-reports: https://github.com/mrkkrp/identicon/issues+synopsis: Flexible generation of identicons+description: Flexible generation of identicons.+category: Graphics, Image+build-type: Simple+data-files: data-examples/*.png+extra-doc-files:+ CHANGELOG.md+ README.md source-repository head- type: git- location: https://github.com/mrkkrp/identicon.git+ type: git+ location: https://github.com/mrkkrp/identicon.git flag dev- description: Turn on development settings.- manual: True- default: False+ description: Turn on development settings.+ default: False+ manual: True library- build-depends: base >= 4.7 && < 5.0- , JuicyPixels >= 3.2.6.5 && < 4.0- , bytestring >= 0.10.6 && < 0.13- if !impl(ghc >= 8.0)- build-depends: semigroups == 0.18.*- exposed-modules: Graphics.Identicon- , Graphics.Identicon.Primitive- if flag(dev)- ghc-options: -Wall -Werror- else- ghc-options: -O2 -Wall- default-language: Haskell2010+ exposed-modules:+ Graphics.Identicon+ Graphics.Identicon.Primitive + default-language: GHC2021+ build-depends:+ base >=4.15 && <5,+ JuicyPixels >=3.2.6.5 && <4,+ bytestring >=0.10.6 && <0.13++ if flag(dev)+ ghc-options:+ -Wall -Werror -Wredundant-constraints -Wpartial-fields+ -Wunused-packages++ else+ ghc-options: -O2 -Wall+ test-suite tests- main-is: Spec.hs- hs-source-dirs: tests- type: exitcode-stdio-1.0- build-depends: JuicyPixels >= 3.2.6.5 && < 4.0- , QuickCheck >= 2.7 && < 3.0- , base >= 4.7 && < 5.0- , bytestring >= 0.10.6 && < 0.13- , hspec >= 2.0 && < 3.0- , identicon- if !impl(ghc >= 8.0)- build-depends: semigroups == 0.18.*- if flag(dev)- ghc-options: -Wall -Werror- else- ghc-options: -O2 -Wall- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: tests+ default-language: GHC2021+ build-depends:+ JuicyPixels >=3.2.6.5 && <4,+ QuickCheck >=2.7 && <3,+ base >=4.15 && <5,+ bytestring >=0.10.6 && <0.13,+ hspec >=2 && <3,+ identicon + if flag(dev)+ ghc-options:+ -Wall -Werror -Wredundant-constraints -Wpartial-fields+ -Wunused-packages++ else+ ghc-options: -O2 -Wall+ 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- , 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+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench+ default-language: GHC2021+ build-depends:+ base >=4.15 && <5,+ JuicyPixels >=3.2.6.5 && <4,+ bytestring >=0.10.6 && <0.13,+ criterion >=0.6.2.1 && <1.7,+ identicon,+ random >=1.1 && <1.3,+ tf-random >=0.4 && <0.6++ if flag(dev)+ ghc-options:+ -Wall -Werror -Wredundant-constraints -Wpartial-fields+ -Wunused-packages++ else+ ghc-options: -O2 -Wall
tests/Spec.hs view
@@ -1,13 +1,13 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeOperators #-} module Main (main) where import Codec.Picture import Control.Monad import Data.ByteString (ByteString)+import Data.ByteString qualified as B import Data.Function (on) import Data.Proxy import Data.Word (Word8)@@ -15,38 +15,45 @@ import Graphics.Identicon.Primitive import Test.Hspec import Test.QuickCheck hiding (oneof)-import qualified Data.ByteString as B -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif- main :: IO () main = hspec spec spec :: Spec spec = do describe "renderIdenticon" renderIdenticonSpec- ω gen0 [0x00,0x00,0x00,0x00] "data-examples/identicon-00.png"- ω gen0 [0x8f,0x55,0x6e,0x93] "data-examples/identicon-01.png"- ω gen0 [0x31,0xa8,0x29,0x5b] "data-examples/identicon-02.png"- ω gen1 [0x3e,0xf1,0xde,0x08,0x85,0x0b,0x9c,0x81,0x25,0xf0,0x53,0x0b]+ ω gen0 [0x00, 0x00, 0x00, 0x00] "data-examples/identicon-00.png"+ ω gen0 [0x8f, 0x55, 0x6e, 0x93] "data-examples/identicon-01.png"+ ω gen0 [0x31, 0xa8, 0x29, 0x5b] "data-examples/identicon-02.png"+ ω+ gen1+ [0x3e, 0xf1, 0xde, 0x08, 0x85, 0x0b, 0x9c, 0x81, 0x25, 0xf0, 0x53, 0x0b] "data-examples/identicon-10.png"- ω gen1 [0xa9,0xf7,0x66,0xf0,0xd7,0xf9,0xb0,0x8e,0x57,0x21,0xc5,0x06]+ ω+ gen1+ [0xa9, 0xf7, 0x66, 0xf0, 0xd7, 0xf9, 0xb0, 0x8e, 0x57, 0x21, 0xc5, 0x06] "data-examples/identicon-11.png"- ω gen1 [0x23,0x29,0x2d,0x29,0x2f,0x05,0x28,0x11,0x1e,0x0e,0x0d,0x06]+ ω+ gen1+ [0x23, 0x29, 0x2d, 0x29, 0x2f, 0x05, 0x28, 0x11, 0x1e, 0x0e, 0x0d, 0x06] "data-examples/identicon-12.png"- ω gen2 [0xcf,0xe7,0xb9,0x49,0x93,0xb1,0x01]+ ω+ gen2+ [0xcf, 0xe7, 0xb9, 0x49, 0x93, 0xb1, 0x01] "data-examples/identicon-20.png"- ω gen2 [0xc8,0xa4,0xda,0xa1,0xe9,0x93,0x86]+ ω+ gen2+ [0xc8, 0xa4, 0xda, 0xa1, 0xe9, 0x93, 0x86] "data-examples/identicon-21.png"- ω gen2 [0xf9,0x9b,0xb7,0x11,0x5b,0xca,0x00]+ ω+ gen2+ [0xf9, 0x9b, 0xb7, 0x11, 0x5b, 0xca, 0x00] "data-examples/identicon-22.png" describe "Semigroup and Monoid instances of Layer" $ do it "mempty always returns black pixel" $ property $ \w h x y -> let (Layer f) = mempty- in f w h x y `shouldBe` PixelRGB8 0 0 0+ in f w h x y `shouldBe` PixelRGB8 0 0 0 it "mappend combines layers" $ property $ \w'' h'' x'' y'' -> let w = w'' `mod` 10@@ -57,11 +64,11 @@ a w' h' x' y' = PixelRGB8 (g $ w' + h') (g $ h' + x') (g $ x' + y') b w' h' x' y' = PixelRGB8 (g $ w' + y') (g $ h' + w') (g $ x' + w') g = fromIntegral- in f w h x y- `shouldBe` PixelRGB8- (g $ w + h + w + y)- (g $ h + x + h + w)- (g $ x + y + x + w)+ in f w h x y+ `shouldBe` PixelRGB8+ (g $ w + h + w + y)+ (g $ h + x + h + w)+ (g $ x + y + x + w) renderIdenticonSpec :: Spec renderIdenticonSpec = do@@ -84,8 +91,11 @@ gen0 = renderIdenticon (Proxy :: Proxy Gen0) i where i = Identicon :+ a- a r g b n = rsym $ onGrid 4 4 n $- circle $ gradientLR (edge . mid) black (PixelRGB8 r g b)+ a r g b n =+ rsym $+ onGrid 4 4 n $+ circle $+ gradientLR (edge . mid) black (PixelRGB8 r g b) type Gen1 = Identicon 12 :+ Consumer 4 :+ Consumer 4 :+ Consumer 4 @@ -93,12 +103,19 @@ gen1 = renderIdenticon (Proxy :: Proxy Gen1) i where i = Identicon :+ a0 :+ a1 :+ a2- a0 r g b n = hsym $ onGrid 3 3 n $- gradientTLBR id black (PixelRGB8 r g b)- a1 r g b n = vsym $ onGrid 4 4 n $- gradientXY id black (PixelRGB8 r g b)- a2 r g b n = hvsym $ onGrid 5 5 n $- circle $ gradientTRBL mid (PixelRGB8 r g b) black+ a0 r g b n =+ hsym $+ onGrid 3 3 n $+ gradientTLBR id black (PixelRGB8 r g b)+ a1 r g b n =+ vsym $+ onGrid 4 4 n $+ gradientXY id black (PixelRGB8 r g b)+ a2 r g b n =+ hvsym $+ onGrid 5 5 n $+ circle $+ gradientTRBL mid (PixelRGB8 r g b) black type Gen2 = Identicon 7 :+ Consumer 3 :+ Consumer 4 @@ -114,35 +131,38 @@ -- | A helper to check that 'Nothing' is returned without requiring that -- argument is an instance of 'Show' or 'Eq' type class.- shouldBeNothing :: Maybe a -> Expectation shouldBeNothing m = case m of Nothing -> return ()- Just _ ->+ Just _ -> expectationFailure "it returned not Nothing" -- | A shorthand for test cases.--ω- :: (Int -> Int -> ByteString -> Maybe (Image PixelRGB8))- -- ^ Identicon generator- -> [Word8] -- ^ Input to use for identicon generation- -> FilePath -- ^ Where to get image to compare with- -> Spec-ω f bs path = describe path $ it ("reproduces " ++ path) $- compareWithFile f (B.pack bs) path+ω ::+ -- | Identicon generator+ (Int -> Int -> ByteString -> Maybe (Image PixelRGB8)) ->+ -- | Input to use for identicon generation+ [Word8] ->+ -- | Where to get image to compare with+ FilePath ->+ Spec+ω f bs path =+ describe path $+ it ("reproduces " ++ path) $+ compareWithFile f (B.pack bs) path -- | Take function that produces identicon, binary input for it, path to -- already rendered identicon and compare them. Fail with informative -- message if they differ.--compareWithFile- :: (Int -> Int -> ByteString -> Maybe (Image PixelRGB8))- -- ^ Identicon generator- -> ByteString -- ^ Input to use for identicon generation- -> FilePath -- ^ Where to get image to compare with- -> Expectation+compareWithFile ::+ -- | Identicon generator+ (Int -> Int -> ByteString -> Maybe (Image PixelRGB8)) ->+ -- | Input to use for identicon generation+ ByteString ->+ -- | Where to get image to compare with+ FilePath ->+ Expectation compareWithFile f bs path = do (Right (ImageRGB8 img)) <- readImage path let mimg = f (imageWidth img) (imageHeight img) bs@@ -154,9 +174,8 @@ -- | Since 'Image' for some reason is not an instance of 'Eq', we use this -- to compare 'Image's.- imageEq :: Image PixelRGB8 -> Image PixelRGB8 -> Bool imageEq a b =- ((==) `on` imageWidth) a b &&- ((==) `on` imageHeight) a b &&- ((==) `on` imageData) a b+ ((==) `on` imageWidth) a b+ && ((==) `on` imageHeight) a b+ && ((==) `on` imageData) a b