thumbnail-polish (empty) → 0.0.1.0

raw patch · 5 files changed

+267/−0 lines, 5 filesdep +basedep +bytestringdep +data-defaultsetup-changed

Dependencies added: base, bytestring, data-default, directory, filepath, friday, friday-devil, nonce, resourcet, text

Files

• LICENSE +30/−0
• README.md +10/−0
• Setup.hs +2/−0
• src/Graphics/Thumbnail.hs +188/−0
• thumbnail-polish.cabal +37/−0

@@ -0,0 +1,30 @@+Copyright (c) 2019, Daniel Campoverde++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 Daniel Campoverde 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.

@@ -0,0 +1,10 @@+# thumbnail-polish++Haskell image thumbnail creation library with cropping, upscaling, aspect ratio+preservation and nonce suffixing.++## Usage++```haskell+createThumbnails defaultConfig [Size 512 512, Size 128 128] "/opt/app/image.jpg"+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,188 @@+-- | Create image thumbnails+--+-- Using the default configuration+--+-- >>> createThumbnails defaultConfig [Size 512 512, Size 128 128] "/opt/app/image.jpg"+--+-- Or specify a custom 'Configuration'++{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Graphics.Thumbnail+    ( createThumbnails+    , defaultConfig+    , imageSize+    , Thumbnail(..)+    , Configuration(..)+    , ImageFileFormat(..)+    , Rect(..)+    , Size(..)+    , ThumbnailException(..)+    ) where+++import           Control.Exception+import qualified Crypto.Nonce               as Nonce+import           Data.Bool                  (bool)+import           Data.ByteString            (hGetContents)+import           Data.Char                  (toLower)+import           Data.Default               (Default (..))+import           Data.Maybe                 (catMaybes)+import           Data.Text                  (unpack)+import           System.Directory           (getTemporaryDirectory)+import           System.FilePath.Posix      ((</>))+import           System.IO                  (IOMode (..), hClose, hFileSize,+                                             openFile)+import           Vision.Image               (InterpolMethod (NearestNeighbor),+                                             RGB, crop, resize, shape)+import qualified Vision.Image.Storage.DevIL as Devil (Autodetect (..), BMP (..),+                                                      JPG (..), PNG (..),+                                                      SaveImageType, load, save)+import qualified Vision.Primitive           as P (Rect (..), Size, ix2)+import           Vision.Primitive.Shape     as PS++createThumbnails+ :: Configuration -- ^ Use 'defaultConfig' for default values+ -> [Size]        -- ^ Thumbnail sizes to create+ -> FilePath      -- ^ Input image+ -> IO [Thumbnail]+createThumbnails config@Configuration{..} reqSizes inputFp = do+    imageResult <- Devil.load Devil.Autodetect inputFp+    (originalImage :: RGB) <- either+            (\_ -> throwIO FailedToLoadImage)+            pure+            imageResult+    let image = maybe originalImage (`cropImage` originalImage) cropFirst+    let imageSize = size image+    let sizes = bool reqSizes (fitAspectRatio imageSize <$> reqSizes) preserveAspectRatio+    dstDir <- dstDirectory+    suffix <- bool (pure "") (('_' :) <$> nonce) nonceSuffix+    thumbnails <- catMaybes <$>+        traverse (createThumbnail config suffix dstDir image imageSize) sizes+    pure thumbnails+  where+    cropImage :: Rect -> RGB -> RGB+    cropImage (Rect x y (Size w h)) = crop (P.Rect x y w h)++    fitAspectRatio :: Size -> Size -> Size+    fitAspectRatio (Size iW iH) (Size oW oH)+        | iW > iH = Size oW $ round $ fromIntegral (oH * iH) / fromIntegral iW+        | iH > iW = Size (round $ fromIntegral (oW * iW) / fromIntegral iH) oH+        | otherwise = Size oW oH++    nonce :: IO String+    nonce = take 10 . unpack <$> (Nonce.new >>= Nonce.nonce128urlT)++++createThumbnail :: Configuration -> String -> FilePath -> RGB -> Size -> Size -> IO (Maybe Thumbnail)+createThumbnail Configuration{..} suffix dstDir img imgSize size@(Size w h) = do+    let name = namePrefix+            <> show w <> "_" <> show h+            <> suffix+            <> "." <> (toLower <$> show fileFormat)++    if size > imgSize && not upScaleOriginal+    then pure Nothing+    else Just <$> do+        let thumbImg = makeThumb size img+        let filePath = dstDir </> name++        -- FIXME: Horrible hack, what to do?+        case fileFormat of+            BMP -> Devil.save Devil.BMP filePath thumbImg+            JPG -> Devil.save Devil.JPG filePath thumbImg+            PNG -> Devil.save Devil.PNG filePath thumbImg++        pure $ Thumbnail filePath size+  where+    makeThumb :: Size -> RGB -> RGB+    makeThumb (Size w h) = resize NearestNeighbor (ix2 h w)++imageSize :: FilePath -> IO Size+imageSize fp = do+    imgResult <- Devil.load Devil.Autodetect fp+    img <- either (\_ -> throwIO FailedToLoadImage) pure imgResult+    pure $ size img++size :: RGB -> Size+size img =+    let (Z :. h :. w) = shape img+    in Size w h+++data Configuration = Configuration+    { fileFormat          :: ImageFileFormat+        -- ^ In which file format to encode the created thumbnails. Default: JPG+    , cropFirst           :: Maybe Rect+        -- ^ Whether the input image should be cropped to 'Rect' before creating+        -- thumbnails or left intact. The first thumbnail in the list will be+        -- the cropped input image. Default: Nothing+    , preserveAspectRatio :: Bool+        -- ^ Whether the created thumbnails should adhere to only one dimension+        -- of the requested size in order to preserve the original image aspect+        -- ratio or distort the image to make it fit. Default: True+    , upScaleOriginal     :: Bool+        -- ^ Whether the original image should be up scaled to make it fit the+        -- requested thumbnail sizes when the input image is too small (nearest+        -- neighbor interpolation), otherwise ignore the requested thumbnails+        -- that are bigger than the input image. Default: False+    , namePrefix          :: String+        -- ^ Created thumbnail files are named based on it's size, this option+        -- adds a prefix (e.g. "<prefix>512_512.jpg"). Default: "thumbnail-"+    , nonceSuffix         :: Bool+        -- Whether to end thumbnail file names with a small nonce (i.e. a random+        -- string of characters). Useful for overwriting images that are prone+        -- to stay in cache. Default: False+    , dstDirectory        :: IO FilePath+        -- ^ Where to put the created thumbnails.+        -- Default: 'getTemporaryDirectory'+    }++data Size = Size+    { width  :: Int+    , height :: Int+    } deriving (Show, Read, Eq)++instance Ord Size where+    compare s1@(Size w1 h1) s2@(Size w2 h2)+        | s1 == s2 = EQ+        | w1 > w2 || h1 > h2 = GT+        | otherwise = LT++data Rect = Rect+    { rX    :: Int  -- ^ X coordinate of the first pixel+    , rY    :: Int  -- ^ Y coordinate of the first pixel+    , rSize :: Size -- ^ Size of the rectangle+    } deriving (Show, Read, Eq, Ord)++data ImageFileFormat+    = BMP+    | JPG+    | PNG+    deriving (Show, Read, Enum, Eq, Ord)++data Thumbnail = Thumbnail+    { thumbFp   :: FilePath+    , thumbSize :: Size+        -- ^ Actual size of the created thumbnail. Might differ from the+        -- requested size if the `preserveAspectRatio` option is used+    } deriving (Show, Eq)++defaultConfig = Configuration+    { fileFormat          = JPG+    , cropFirst           = Nothing+    , preserveAspectRatio = True+    , upScaleOriginal     = False+    , namePrefix          = "thumbnail-"+    , nonceSuffix         = False+    , dstDirectory        = getTemporaryDirectory+    }++data ThumbnailException+    = FailedToLoadImage+    deriving (Show, Eq)++instance Exception ThumbnailException

@@ -0,0 +1,37 @@+cabal-version:       2.4+name:                thumbnail-polish+version:             0.0.1.0+synopsis:            Image thumbnail creation+homepage:            https://github.com/alx741/thumbnail-polish+-- bug-reports:+license:             BSD-3-Clause+license-file:        LICENSE+author:              Daniel Campoverde+maintainer:          alx@sillybytes.net+category:            Graphics+extra-source-files:  README.md+description:         Image thumbnail creation with cropping, upscaling, aspect+                     ratio preservation and nonce suffixing++library+  exposed-modules:+    Graphics.Thumbnail+  -- other-modules:+  -- other-extensions:+  build-depends:+      base ^>=4.12.0.0+    , bytestring+    , data-default >= 0.5.3+    , directory+    , filepath+    , friday+    , friday-devil+    , nonce >= 1.0.0 && < 1.1.0+    , resourcet >= 1.2.2+    , text+  hs-source-dirs:      src+  default-language:    Haskell2010++source-repository head+  type:     git+  location:    https://github.com/alx741/thumbnail-polish