Check size constraints about the album cover image

Author: jecaro

README.md

@@ -95,7 +95,8 @@ collection clean and well-organized. Available checks include:
 - Album level:
     - Album directory: Checks that all files from an album are stored in the 
       same directory
-    - Cover file: Checks the presence of a cover image in the album directory
+    - Cover file: Checks the presence of a cover image in the album directory. 
+      Also verifies that the cover image size is within specified limits.
     - Album tags: Checks that the tags from all files in an album are the same
 - Artist level:
     - Genre: Ensures that all tracks from an artist share the same genre

app/Options.hs

@@ -15,6 +15,8 @@ import Check.Artist qualified as Artist
 import Check.Track qualified as Track
 import Config qualified
 import Data.List.Extra qualified as List
+import Data.Text qualified as Text
+import Model.Cover qualified as Cover
 import Model.Pattern qualified as Pattern
 import Model.SetTagsOptions qualified as SetTagsOptions
 import Model.Tag qualified as Tag
@@ -137,17 +139,43 @@ trackFilenameP =
           "Check that filenames match the specified pattern"
     )
 
-albumHaveCoverP :: Options.Parser (NonEmpty (Path.Path Path.Rel Path.File))
+albumHaveCoverP :: Options.Parser Cover.Cover
 albumHaveCoverP =
+  Cover.Cover
+    <$> coverPathsP
+    <*> Options.optional (coverSizeP "album-cover-min-size")
+    <*> Options.optional (coverSizeP "album-cover-max-size")
+
+coverPathsP :: Options.Parser (NonEmpty (Path.Path Path.Rel Path.File))
+coverPathsP =
   Options.some1
     ( Options.option
         (Options.maybeReader Path.parseRelFile)
-        ( Options.long "album-have-cover"
+        ( Options.long "album-cover-filename"
             <> Options.metavar "FILENAME"
             <> Options.help "Check that the specified cover file exists"
         )
     )
 
+coverSizeP :: String -> Options.Parser Cover.Size
+coverSizeP option =
+  Options.option
+    (Options.eitherReader $ first toString . parse . toText)
+    ( Options.long option
+        <> Options.metavar "WIDTHxHEIGHT"
+        <> Options.help
+          ("Specify the " <> option <> " in the form WIDTHxHEIGHT")
+    )
+  where
+    parse :: Text -> Either Text Cover.Size
+    parse text =
+      case Text.splitOn "x" text of
+        [widthTxt, heightTxt] ->
+          case (readMaybe (toString widthTxt), readMaybe (toString heightTxt)) of
+            (Just siWidth, Just siHeight) -> Right $ Cover.Size {..}
+            _ -> Left "Width and height must be integers"
+        _ -> Left "Size must be in the form WIDTHxHEIGHT"
+
 albumSameDirP :: Options.Parser Bool
 albumSameDirP =
   Options.switch

data/cover.png

@@ -85,6 +85,10 @@ enable = true
 [checks.album_cover]
 enable = true
 filenames = ["cover.jpg", "cover.png", "cover.gif"]
+# optional size constraints in pixels, not taken into account if left
+# unspecified
+min_size = { width = 300, height = 300 }
+max_size = { width = 1000, height = 1000 }
 
 # Verify that all tracks from the same album reside in a single directory
 # Note: htagcli groups files by album while scanning input paths recursively.

data/htagcli.toml

@@ -49,6 +49,7 @@ library
     Model.Album
     Model.Artist
     Model.AudioTrack
+    Model.Cover
     Model.Pattern
     Model.SetTagsOptions
     Model.Tag
@@ -57,6 +58,7 @@ library
     Toml.Extra
 
   build-depends:
+    JuicyPixels,
     extra,
     file-embed,
     filepath,
@@ -66,6 +68,7 @@ library
     path,
     path-io,
     tomland,
+    transformers,
     unliftio,
     validation-selective,
 

htagcli.cabal

@@ -1,22 +1,28 @@
 module Check.Album
   ( Check (..),
+    Cover (..),
+    Size (..),
     check,
     Error (..),
     errorToText,
   )
 where
 
+import Codec.Picture qualified as Picture
+import Control.Monad.Extra qualified as Monad
+import Control.Monad.Trans.Except qualified as Except
 import Data.Text qualified as Text
 import Model.Album qualified as Album
 import Model.AudioTrack qualified as AudioTrack
+import Model.Cover as Cover
 import Model.Tag qualified as Tag
 import Path ((</>))
 import Path qualified
 import Path.IO qualified as Path
 import Sound.HTagLib qualified as HTagLib
 
 data Check
-  = HaveCover (NonEmpty (Path.Path Path.Rel Path.File))
+  = HaveCover Cover.Cover
   | InSameDir
   | SameTags (NonEmpty Tag.Tag)
   | TracksSequential
@@ -25,6 +31,8 @@ data Check
 data Error
   = NotInSameDir
   | MissingCover (Path.Path Path.Abs Path.Dir)
+  | BadCoverSize (Path.Path Path.Abs Path.File) Size
+  | UnableToReadCover (Path.Path Path.Abs Path.File) Text
   | SameTagsError (NonEmpty Tag.Tag)
   | TracksNotSequential
   deriving (Eq, Show)
@@ -34,6 +42,16 @@ errorToText NotInSameDir =
   "Audio tracks are not all in the same directory"
 errorToText (MissingCover directory) =
   "Missing cover in directory: " <> Text.pack (Path.toFilePath directory)
+errorToText (BadCoverSize file size) =
+  "Cover file "
+    <> toText (Path.toFilePath file)
+    <> " has size out of range: "
+    <> Cover.sizeToText size
+errorToText (UnableToReadCover file err) =
+  "Unable to read cover file "
+    <> toText (Path.toFilePath file)
+    <> ": "
+    <> err
 errorToText (SameTagsError tags) =
   "These tags are not the same for all tracks in the album: "
     <> Text.intercalate ", " (Tag.asText <$> toList tags)
@@ -47,14 +65,26 @@ check ::
 check InSameDir album
   | isJust $ Album.directory album = pure $ Right ()
   | otherwise = pure $ Left NotInSameDir
-check (HaveCover coverFilenames) album
-  | Just dir <- Album.directory album = do
-      let absFiles = (dir </>) <$> coverFilenames
-      ifM
-        (anyM Path.doesFileExist absFiles)
-        (pure $ Right ())
-        (pure $ Left (MissingCover dir))
+check (HaveCover cover@Cover {..}) album
+  | Just dir <- Album.directory album = runExceptT $ do
+      let absFiles = (dir </>) <$> coPaths
+
+      coverFile <-
+        maybeToExceptT (MissingCover dir) $
+          MaybeT $
+            Monad.findM Path.doesFileExist (toList absFiles)
+      picture <-
+        Except.withExceptT (UnableToReadCover coverFile . toText) $
+          ExceptT $
+            readImage coverFile
+
+      let size = Cover.pictureSize picture
+      unless (Cover.withinRange cover size) $
+        Except.throwE $
+          BadCoverSize coverFile size
   | otherwise = pure $ Left NotInSameDir
+  where
+    readImage = liftIO . Picture.readImage . Path.toFilePath
 check (SameTags tagsToCheck) album = pure $ case checkedTags of
   [] -> Right ()
   (tag : tags) -> Left (SameTagsError (tag :| tags))

lib/Check/Album.hs

@@ -23,6 +23,7 @@ import Data.ByteString qualified as ByteString
 import Data.FileEmbed qualified as FileEmbed
 import Data.Text qualified as Text
 import GHC.IO.Exception qualified as Exception
+import Model.Cover qualified as Cover
 import Model.Pattern qualified as Pattern
 import Model.Tag qualified as Tag
 import Path ((</>))
@@ -71,8 +72,8 @@ data Checks = Checks
     -- one given in the formatting section. This way it is possible to ignore
     -- the padding when checking the filename and still have it when fixing it.
     chTrackFilename :: Bool,
-    -- | The album have a cover file with one of the given names
-    chAlbumHaveCover :: Maybe (NonEmpty (Path.Path Path.Rel Path.File)),
+    -- | The album have a cover file
+    chAlbumHaveCover :: Maybe Cover.Cover,
     -- | All the audio tracks of the album are in the same directory
     chAlbumSameDir :: Bool,
     -- | All the audio tracks of the album have the same value for the given
@@ -228,20 +229,31 @@ checksC =
     <$> maybeValidatedC "track_tags" tagsC chTrackTags
     <*> maybeValidatedC "track_genre" amongC chTrackGenreAmong
     <*> trackFilenameC .= chTrackFilename
-    <*> maybeValidatedC "album_cover" filenamesC chAlbumHaveCover
+    <*> maybeValidatedC "album_cover" albumHaveCoverC chAlbumHaveCover
     <*> albumSameDirC .= chAlbumSameDir
     <*> maybeValidatedC "album_tags" tagsC chAlbumSameTags
     <*> albumTracksSequentialC .= chAlbumTracksSequential
     <*> artistSameGenreC .= chArtistSameGenre
   where
     trackFilenameC = Toml.table (Toml.bool "enable") "track_filename"
-    filenamesC = Toml.arrayNonEmptyOf relFileB "filenames"
     albumSameDirC = Toml.table (Toml.bool "enable") "album_same_dir"
     tagsC = Toml.arrayNonEmptyOf tagB "tags"
     albumTracksSequentialC =
       Toml.table (Toml.bool "enable") "album_tracks_sequential"
     artistSameGenreC = Toml.table (Toml.bool "enable") "artist_same_genre"
     amongC = Toml.arrayNonEmptyOf Toml._Text "among"
+    albumHaveCoverC =
+      Cover.Cover
+        <$> filenamesC .= Cover.coPaths
+        <*> Toml.dioptional (sizeC "min_size") .= Cover.coMinSize
+        <*> Toml.dioptional (sizeC "max_size") .= Cover.coMaxSize
+    filenamesC = Toml.arrayNonEmptyOf relFileB "filenames"
+    sizeC =
+      Toml.table
+        ( Cover.Size
+            <$> Toml.int "width" .= Cover.siWidth
+            <*> Toml.int "height" .= Cover.siHeight
+        )
 
 -- | Unwrap the Maybe value according to the enable flag.
 maybeValidatedC ::

lib/Config.hs

@@ -0,0 +1,44 @@
+module Model.Cover
+  ( Cover (..),
+    Size (..),
+    sizeToText,
+    pictureSize,
+    withinRange,
+  )
+where
+
+import Codec.Picture qualified as Picture
+import Path qualified
+
+data Cover = Cover
+  { coPaths :: NonEmpty (Path.Path Path.Rel Path.File),
+    coMinSize :: Maybe Size,
+    coMaxSize :: Maybe Size
+  }
+  deriving (Eq, Show)
+
+data Size = Size {siWidth :: Int, siHeight :: Int}
+  deriving (Eq, Show)
+
+sizeToText :: Size -> Text
+sizeToText (Size width height) = show width <> "x" <> show height
+
+greaterThan :: Size -> Size -> Bool
+greaterThan (Size width1 height1) (Size width2 height2) =
+  width1 >= width2 && height1 >= height2
+
+lowerThan :: Size -> Size -> Bool
+lowerThan (Size width1 height1) (Size width2 height2) =
+  width1 <= width2 && height1 <= height2
+
+pictureSize :: Picture.DynamicImage -> Size
+pictureSize picture =
+  Size
+    { siWidth = Picture.dynamicMap Picture.imageWidth picture,
+      siHeight = Picture.dynamicMap Picture.imageHeight picture
+    }
+
+withinRange :: Cover -> Size -> Bool
+withinRange Cover {..} size =
+  maybe True (size `greaterThan`) coMinSize
+    && maybe True (size `lowerThan`) coMaxSize

lib/Model/Cover.hs

@@ -16,9 +16,9 @@ import Model.AudioTrack qualified as AudioTrack
 import Model.Tag qualified as Tag
 import Path (reldir, relfile, (</>))
 import Path qualified
+import Path.IO qualified as Path
 import Sound.HTagLib qualified as HTagLib
-import System.IO qualified as System
-import Test.Hspec.Expectations (shouldBe)
+import Test.Hspec.Expectations (shouldBe, shouldSatisfy)
 import Test.Tasty qualified as Tasty
 import Test.Tasty.HUnit qualified as Tasty
 import Tests.Common qualified as Common
@@ -27,22 +27,57 @@ test :: TestTree
 test =
   Tasty.testGroup
     "check cover"
-    [ Tasty.testCase "check an album without a cover.jpg" $
+    [ Tasty.testCase "check an album without a cover.png" $
         Common.withTenTracksFiles $
           \dir album -> do
-            result <- Album.check (Album.HaveCover covers) album
+            result <- Album.check (Album.HaveCover coverNoSize) album
             result `shouldBe` Left (Album.MissingCover dir),
-      Tasty.testCase "check an album with a cover.jpg" $
+      Tasty.testCase "check an album with a cover.png" $
         Common.withTenTracksFiles $
           \dir album -> do
-            System.writeFile
-              (Path.toFilePath $ dir </> head covers)
-              "dummy content"
+            let coverFile = [relfile|./data/cover.png|]
+            Path.copyFile coverFile $ dir </> Path.filename coverFile
 
-            result <- Album.check (Album.HaveCover covers) album
-            result `shouldBe` Right ()
+            result <- Album.check (Album.HaveCover coverNoSize) album
+            result `shouldBe` Right (),
+      Tasty.testCase "check an album with a cover.png but too small" $
+        Common.withTenTracksFiles $
+          \dir album -> do
+            let coverFile = [relfile|./data/cover.png|]
+            Path.copyFile coverFile $ dir </> Path.filename coverFile
+
+            result <- Album.check (Album.HaveCover coverTooSmall) album
+            result `shouldSatisfy` isBadCoverSize,
+      Tasty.testCase "check an album with a cover.png but too big" $
+        Common.withTenTracksFiles $
+          \dir album -> do
+            let coverFile = [relfile|./data/cover.png|]
+            Path.copyFile coverFile $ dir </> Path.filename coverFile
+
+            result <- Album.check (Album.HaveCover coverTooBig) album
+            result `shouldSatisfy` isBadCoverSize
     ]
   where
+    isBadCoverSize (Left (Album.BadCoverSize _ _)) = True
+    isBadCoverSize _ = False
+    coverNoSize =
+      Album.Cover
+        { Album.coPaths = covers,
+          Album.coMinSize = Nothing,
+          Album.coMaxSize = Nothing
+        }
+    coverTooSmall =
+      Album.Cover
+        { Album.coPaths = covers,
+          Album.coMinSize = Just (Album.Size 200 200),
+          Album.coMaxSize = Nothing
+        }
+    coverTooBig =
+      Album.Cover
+        { Album.coPaths = covers,
+          Album.coMinSize = Nothing,
+          Album.coMaxSize = Just (Album.Size 50 50)
+        }
     covers = fromList [[relfile|cover.jpg|], [relfile|cover.png|]]
 
 test :: TestTree