JuicyPixels-blurhash-0.1.0.0: Blurhash is a very compact represenation of a placeholder for an image

Copyright(c) 2020 Sam Protas
LicenseBSD3
MaintainerSam Protas <sam.protas@gmail.com>
Stabilityexperimental
Portabilityportable
Safe HaskellNone
LanguageHaskell2010

Codec.Picture.Blurhash

Contents

Description

Blurhash is a very compact represenation of a placeholder for an image.

This library provides a Blurhash encoding and decoding implementation based on the JuicyPixels represenation of images.

For the full Blurhash sales pitch and algorithm explaination see either of:

An image such as:

Can be encoded as:

LGFFaWYk^6#M@-5c,1Ex@@or[j6o

Which your client can render as:

Synopsis

Example Use

First some imports.

>>> :set -XOverloadedStrings
>>> import           Codec.Picture (readImage)
>>> import qualified Codec.Picture.Blurhash as BH
>>> import           Data.ByteString.Lazy (ByteString)

Given a an image filepath (imgFilePath :: FilePath).

>>> :{
 do
   Right img <- readImage imgFilePath
   print $ BH.encodeDynamic img
:}
Right "UBMOZfK1GG%LBBNG,;Rj2skq=eE1s9n4S5Na"

Now you can store this nice compact encoding in a database column and send it to the client along with the asset path to the full size image.

If you're lucky enough to write your client in Haskell, you receive that encoding and draw a Blurhash placeholder while the full asset is fetched.

>>> let Right myBlurryPlaceholderImg = BH.decodeRGB8 "UBMOZfK1GG%LBBNG,;Rj2skq=eE1s9n4S5Na"

Encoding Images

The Blurhash algorithm natively supports encoding Image PixelRGB8 and Image PixelRGBF. This library additionally supports encoding a DynamicImage via conversion to Image PixelRGB8.

Default

Encode various image representations to a blurhash using encodeConfigDefault.

encodeDynamic :: DynamicImage -> Either EncodeError ByteString Source #

Encode a DynamicImage to a blurhash. Calls encodeDynamicWithConfig with encodeConfigDefault.

Note: Relies on convertRGB8 before proceding with the standard Blurhash algorithm.

encodeRGB8 :: Image PixelRGB8 -> Either EncodeError ByteString Source #

Encode an Image PixelRGB8 to a blurhash. Calls encodeRGB8WithConfig with encodeConfigDefault.

Note: This is the most direct port of other language's implementation's default encoding function.

encodeLinear :: Image PixelRGBF -> Either EncodeError ByteString Source #

Encode an Image PixelRGBF to a blurhash. Calls encodeLinearWithConfig with encodeConfigDefault.

Note: Blurhash implementations use a non-naive PixelRGB8 to PixelRGBF conversion. Beware that using promotePixel or promoteImage from ColorConvertible to convert an Image PixelRGB8 to an Image PixelRGBF before using encodeLinear will give different results than encodeRGB8.

Custom

encodeDynamicWithConfig :: EncodeConfig -> DynamicImage -> Either EncodeError ByteString Source #

Encode a DynamicImage to a blurhash with a given an EncodeConfig.

Note: Relies on convertRGB8 before proceding with the standard Blurhash algorithm.

encodeRGB8WithConfig :: EncodeConfig -> Image PixelRGB8 -> Either EncodeError ByteString Source #

Encode an Image PixelRGB8 to a blurhash given an EncodeConfig.

Note: This is the most direct port of other languages implementation's encoding function.

encodeLinearWithConfig :: EncodeConfig -> Image PixelRGBF -> Either EncodeError ByteString Source #

Encode an Image PixelRGBF to a blurhash given an EncodeConfig.

Note: Blurhash implementations use a non-naive PixelRGB8 to PixelRGBF conversion. Beware that using promotePixel or promoteImage from ColorConvertible to convert an Image PixelRGB8 to an Image PixelRGBF before using encodeLinearWithConfig will give different results than encodeRGB8WithConfig.

Configuration

encodeConfigDefault :: EncodeConfig Source #

A reasonable default configuration for encoding.

>>> componentsX encodeConfigDefault == 4
True
>>> componentsY encodeConfigDefault == 4
True

data EncodeConfig Source #

Configuration for how to encode an image into a blurhash.

Create custom configs using record update syntax and encodeConfigDefault.

>>> let myEncodeConfig = encodeConfigDefault { componentsX = 4, componentsY = 3 }
Instances
Show EncodeConfig Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Encode

Generic EncodeConfig Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Encode

Associated Types

type Rep EncodeConfig :: Type -> Type #

type Rep EncodeConfig Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Encode

type Rep EncodeConfig = D1 (MetaData "EncodeConfig" "Codec.Picture.Blurhash.Internal.Encode" "JuicyPixels-blurhash-0.1.0.0-DaqpokmttsPFp5F95koWnn" False) (C1 (MetaCons "EncodeConfig" PrefixI True) (S1 (MetaSel (Just "componentsX") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Int) :*: S1 (MetaSel (Just "componentsY") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Int)))

componentsX :: EncodeConfig -> Int Source #

Number of components along the X axis.

See EncodeConfig for example use with record update syntax.

componentsY :: EncodeConfig -> Int Source #

Number of components along the Y axis.

See EncodeConfig for example use with record update syntax.

Errors

data EncodeError Source #

Encoding error types.

Constructors

InvalidComponents

The provided config components were invalid.

B83EncodingError Int Int

The provided number cannot be base83 encoded into the provided length.

Instances
Show EncodeError Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Encode

Generic EncodeError Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Encode

Associated Types

type Rep EncodeError :: Type -> Type #

type Rep EncodeError Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Encode

type Rep EncodeError = D1 (MetaData "EncodeError" "Codec.Picture.Blurhash.Internal.Encode" "JuicyPixels-blurhash-0.1.0.0-DaqpokmttsPFp5F95koWnn" False) (C1 (MetaCons "InvalidComponents" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "B83EncodingError" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int)))

Decoding To Images

The Blurhash algorithm natively supports decoding into Image PixelRGB8 and Image PixelRGBF.

Default

Decode a blurhash to various image representations using decodeConfigDefault.

decodeRGB8 Source #

Arguments

:: ByteString

The blurhash

-> Either DecodeError (Image PixelRGB8) 

Decode a blurhash into an Image PixelRGB8. Calls decodeRGB8WithConfig with decodeConfigDefault.

When in doubt, use this function to decode a blurhash.

decodeLinear Source #

Arguments

:: ByteString

The blurhash

-> Either DecodeError (Image PixelRGBF) 

Decode a blurhash into an Image PixelRGBF. Calls decodeLinearWithConfig with decodeConfigDefault.

Note: Blurhash implementations use a non-naive PixelRGBF to PixelRGB8 conversion. If your ultimate goal is to end up with an Image PixelRGB8, be careful using this function and scaling pixels by 255 as you will get different results.

Custom

decodeRGB8WithConfig Source #

Arguments

:: DecodeConfig 
-> ByteString

The blurhash.

-> Either DecodeError (Image PixelRGB8) 

Decode a blurhash into an Image PixelRGB8 given a DecodeConfig

decodeLinearWithConfig Source #

Arguments

:: DecodeConfig 
-> ByteString

The blurhash

-> Either DecodeError (Image PixelRGBF) 

Decode a blurhash into an Image PixelRGBF given a DecodeConfig.

Note: Blurhash implementations use a non-naive PixelRGBF to PixelRGB8 conversion. If your ultimate goal is to end up with an Image PixelRGB8, be careful using this function and scaling pixels by 255 as you will get different results.

Configuration

decodeConfigDefault :: DecodeConfig Source #

A reasonable default configuration for decoding.

>>> punch decodeConfigDefault == 1
True
>>> outputWidth decodeConfigDefault == 32
True
>>> outputHeight decodeConfigDefault == 32
True

data DecodeConfig Source #

Configuration for how to decode a blurhash to an image.

>>> let myDecodeConfig = decodeConfigDefault { punch = 1.1, outputWidth = 64, outputHeight = 64}
Instances
Show DecodeConfig Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Decode

Generic DecodeConfig Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Decode

Associated Types

type Rep DecodeConfig :: Type -> Type #

type Rep DecodeConfig Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Decode

type Rep DecodeConfig = D1 (MetaData "DecodeConfig" "Codec.Picture.Blurhash.Internal.Decode" "JuicyPixels-blurhash-0.1.0.0-DaqpokmttsPFp5F95koWnn" False) (C1 (MetaCons "DecodeConfig" PrefixI True) (S1 (MetaSel (Just "punch") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Float) :*: (S1 (MetaSel (Just "outputWidth") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int) :*: S1 (MetaSel (Just "outputHeight") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int))))

punch :: DecodeConfig -> Float Source #

Adjusts the contrast of the decoded image. Larger values mean more contrast.

See DecodeConfig for example use with record update syntax.

outputWidth :: DecodeConfig -> Int Source #

Output image pixel width.

See DecodeConfig for example use with record update syntax.

outputHeight :: DecodeConfig -> Int Source #

Output image pixel height.

See DecodeConfig for example use with record update syntax.

Errors

data DecodeError Source #

Decoding error types.

Constructors

InvalidCharacterError Word8

The provided blurhash included an un-decodable byte.

InvalidHashLength

The provided blurhash length was wrong.

Instances
Show DecodeError Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Decode

Generic DecodeError Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Decode

Associated Types

type Rep DecodeError :: Type -> Type #

type Rep DecodeError Source # 
Instance details

Defined in Codec.Picture.Blurhash.Internal.Decode

type Rep DecodeError = D1 (MetaData "DecodeError" "Codec.Picture.Blurhash.Internal.Decode" "JuicyPixels-blurhash-0.1.0.0-DaqpokmttsPFp5F95koWnn" False) (C1 (MetaCons "InvalidCharacterError" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Word8)) :+: C1 (MetaCons "InvalidHashLength" PrefixI False) (U1 :: Type -> Type))